Delphi控件源码

开发平台：
Delphi

sPropEditors.pas：源码内容
							unit sPropEditors;
{$I sDefs.inc}
{$IFDEF DELPHI6UP}
{$WARN UNIT_PLATFORM OFF}
{$ENDIF}
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, sStyleUtil, sConst, ExtCtrls, sPanel, sGraphUtils, sUtils, ImgList,
  Consts, ComStrs, CommCtrl
{$IFNDEF ALITE}
  , sPageControl//, colnedit
{$ENDIF}
  , sColors, TypInfo,
  {$IFDEF DELPHI6UP} DesignEditors, DesignIntf, VCLEditors,
  {$ELSE}dsgnintf,
  {$ENDIF}sVclUtils
  ;
type
{$IFNDEF ALITE}
  TsPageControlEditor = class(TDefaultEditor)
  protected
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;
  TsTabSheetEditor = class(TDefaultEditor)
  protected
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;
  TsToolBarEditor = class(TDefaultEditor)
  protected
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;
  TsImageListEditor = class(TComponentEditor)
  protected
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;
{$ENDIF}
{ TsColorProperty }
  TsColorProperty = class(TColorProperty)
  public
    function GetValue: string; override;
    procedure GetValues (Proc: TGetStrProc); override;
    procedure SetValue (const Value: string); override;
{$IFDEF DELPHI5}
    procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean); override;
{$ELSE}
{$ENDIF}
  end;
  TsSkinNameProperty = class(TStringProperty)
  private
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;
  TsDirProperty = class(TStringProperty)
  private
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;
  TsInternalSkinsProperty = class(TClassProperty)
  private
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;
  TsInternalSkinsEditor = class(TComponentEditor)
  private
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;
procedure Register;
implementation
uses sDefaults, sCustomButton, sSkinManager, FileCtrl,
{$IFNDEF ALITE}
  sToolEdit, sImageList, sImgListEditor, sComboBoxes,
{$ENDIF}
  FiltEdit,
  sInternalSkins, stdreg, sButtonControl;
{$IFNDEF ALITE}
{ TsPageControlEditor }
procedure TsPageControlEditor.ExecuteVerb(Index: Integer);
var
  NewPage: TsTabSheet;
begin
  case Index of
    0: begin
      NewPage := TsTabSheet.Create(Designer.GetRoot);
      NewPage.Parent := (Component as TsPageControl);
      NewPage.PageControl := (Component as TsPageControl);
      NewPage.Caption := Designer.UniqueName('sTabSheet');
      NewPage.Name := NewPage.Caption;
    end;
    1: begin
      NewPage := (Component as TsPageControl).ActivePage;
      NewPage.Free;
    end;
    2: begin
//      (Component as TsPageControl).FindNextPage((Component as TsPageControl).ActivePage,True,False);
      (Component as TsPageControl).SelectNextPage(True);
    end;
    3: begin
//      (Component as TsPageControl).FindNextPage((Component as TsPageControl).ActivePage,False,False);
      (Component as TsPageControl).SelectNextPage(False);
    end;
  end;
  if Designer <> nil then Designer.Modified;
end;
function TsPageControlEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0:  result := 'New Page';
    1:  result := 'Delete Page';
    2:  result := 'Next Page';
    3:  result := 'Previous Page';
  end;
end;
function TsPageControlEditor.GetVerbCount: Integer;
begin
  result := 4;
end;
{ TsToolBarEditor }
procedure TsToolBarEditor.ExecuteVerb(Index: Integer);
var
  NewButton : TsSpeedButton;
begin
  (Component as TsToolBar).DontAutoSize := True;
  NewButton := TsSpeedButton.Create(Designer.GetRoot);
  NewButton.Parent := (Component as TsToolBar);
  NewButton.Align := alLeft;
  NewButton.sStyle.Painting.Transparency := 50;
  NewButton.sStyle.Painting.Bevel := cbRaisedSoft;
  NewButton.sStyle.HotStyle.HotPainting.BevelWidth := 2;
//  NewButton.sStyle.HotStyle.Painting.Bevel := sConst.bsRaised;
  NewButton.ShowCaption := False;
  NewButton.Left := (Component as TsToolBar).Width - 1;
  NewButton.Images := (Component as TsToolBar).Buttons.Images;
  NewButton.ImagesGrayed := (Component as TsToolBar).Buttons.ImagesGrayed;
  NewButton.ImagesDisabled := (Component as TsToolBar).Buttons.ImagesDisabled;
//  NewButton.sStyle.Selection.Color := scViolet;
  NewButton.Height  := (Component as TsToolBar).Buttons.ButtonHeight;
  NewButton.Width   := (Component as TsToolBar).Buttons.ButtonWidth;
  NewButton.Grayed  := (Component as TsToolBar).Buttons.Grayed;
  case Index of
    0:  begin
      NewButton.ShowCaption := (Component as TsToolBar).Buttons.ShowCaptions;
      NewButton.Name := Designer.UniqueName('TsToolButton');
      NewButton.Caption := NewButton.Name;
      NewButton.sStyle.Background.ListenMSG := False;
      NewButton.sStyle.Background.Gradient.Data := GradientTsToolButton;
      NewButton.sStyle.HotStyle.HotBackground.Gradient.Data := GradientTsToolButtonHot;
      NewButton.sStyle.HotStyle.HotPainting.BevelWidth := DefBevelWidthHot;
      NewButton.sStyle.Painting.Bevel := cbRaisedSoft;
      NewButton.sStyle.SkinSection := 'TsToolButton';
      NewButton.BevelWidth := 1;
      NewButton.sStyle.Painting.Transparency := 100;
    end;
    1:  begin
      NewButton.ButtonStyle := tbsDivider;
      NewButton.sStyle.Painting.Bevel := cbRaisedSoft;
      NewButton.Name := Designer.UniqueName('TsToolDivider');
      NewButton.sStyle.Painting.Bevel := cbLoweredHard;
      NewButton.BevelWidth := 1;
    end;
    2:  begin
      NewButton.ButtonStyle := tbsSeparator;
      NewButton.Name := Designer.UniqueName('TsToolSeparator');
    end;
  end;
//  NewButton.AutoSize := True;
  (Component as TsToolBar).DontAutoSize := True;
  Designer.SelectComponent(NewButton);
  if Designer <> nil then Designer.Modified;
end;
function TsToolBarEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0:  result := 'New button';
    1:  result := 'New divider';
    2:  result := 'New separator';
  end;
end;
function TsToolBarEditor.GetVerbCount: Integer;
begin
  result := 3;
end;
{$ENDIF}
function TsColorProperty.GetValue: string;
var
  Color: TColor;
begin
  try
    Color := TColor(GetOrdValue);
    if Color = clNone16
      then Color := clNone
      else if Color = clInfoBk16
             then Color := clInfoBk;
    Result := RxColorToString(Color);
  except
  end;
end;
procedure TsColorProperty.GetValues(Proc: TGetStrProc);
begin
  try
    RxGetColorValues(Proc);
  except
  end;
end;
procedure TsColorProperty.SetValue(const Value: string);
begin
  try
    SetOrdValue(RxStringToColor(Value));
  except
  end;
end;
{$IFDEF DELPHI5}
procedure TsColorProperty.ListDrawValue(const Value: string; ACanvas: TCanvas;
  const ARect: TRect; ASelected: Boolean);
  function ColorToBorderColor(AColor: TColor): TColor;
  type
    TColorQuad = record
      Red, Green, Blue, Alpha: Byte;
    end;
  begin
    Result := AColor;
    try
      if (TColorQuad(AColor).Red > 192) or (TColorQuad(AColor).Green > 192) or (TColorQuad(AColor).Blue > 192) then
        Result := clBlack
      else if ASelected then begin
        Result := clWhite;
      end;
    except
    end;
  end;
var
  vRight: Integer;
  vOldPenColor, vOldBrushColor: TColor;
begin
  vRight := (ARect.Bottom - ARect.Top) + ARect.Left;
  with ACanvas do
  try
    vOldPenColor := Pen.Color;
    vOldBrushColor := Brush.Color;
    Pen.Color := Brush.Color;
    Rectangle(ARect.Left, ARect.Top, vRight, ARect.Bottom);
    Brush.Color := RxStringToColor(Value);
    Pen.Color := ColorToBorderColor(ColorToRGB(Brush.Color));
    Rectangle(ARect.Left + 1, ARect.Top + 1, vRight - 1, ARect.Bottom - 1);
    Brush.Color := vOldBrushColor;
    Pen.Color := vOldPenColor;
  finally
    ACanvas.TextRect(Rect(vRight, ARect.Top, ARect.Right, ARect.Bottom),
      vRight + 1, ARect.Top + 1, Value);
  end;
end;
{$ENDIF}
procedure Register;
begin
//  RegisterPropertyEditor(TypeInfo(TImageIndex), TsButtoncontrol, 'ImageIndex', TComponentImageIndexPropertyEditor);
{$IFNDEF ALITE}
  RegisterComponentEditor(TsPageControl, TsPageControlEditor);
  RegisterComponentEditor(TsTabSheet, TsTabSheetEditor);
  RegisterComponentEditor(TsToolBar, TsToolBarEditor);
  RegisterComponentEditor(TsImageList, TsImageListEditor);
{$ENDIF}
{$IFDEF DELPHI5}
  RegisterPropertyEditor(TypeInfo(TColor), TPersistent, '', TsColorProperty);
{$ENDIF}
  RegisterPropertyEditor(TypeInfo(TsSkinName), TsSkinManager, 'SkinName', TsSkinNameProperty);
  RegisterPropertyEditor(TypeInfo(TsDirectory), TsSkinManager, 'SkinDirectory', TsDirProperty);
  RegisterPropertyEditor(TypeInfo(TsStoredSkins), TsSkinManager, 'InternalSkins', TsInternalSkinsProperty);
  RegisterComponentEditor(TsSkinManager, TsInternalSkinsEditor);
{$IFNDEF ALITE}
  RegisterPropertyEditor(TypeInfo(string), TsFileNameEdit, 'Filter', TFilterProperty);
{$ENDIF}
end;
{ TsSkinNameProperty }
function TsSkinNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, {paReadOnly, }paAutoUpdate];
end;
procedure TsSkinNameProperty.GetValues(Proc: TGetStrProc);
var
  i: integer;
  FileInfo: TSearchRec;
  DosCode: Integer;
  s : string;
begin
  // Internal skins names loading
  if TsSkinManager(GetComponent(0)).InternalSkins.Count > 0 then begin
    for i := 0 to TsSkinManager(GetComponent(0)).InternalSkins.Count - 1 do begin
      Proc(TsSkinManager(GetComponent(0)).InternalSkins[i].Name);
    end;
  end;
  // External skins names loading
  if DirExists(TsSkinManager(GetComponent(0)).SkinDirectory) then begin
    s := TsSkinManager(GetComponent(0)).SkinDirectory + '*.*';
    DosCode := FindFirst(s, faVolumeID or faDirectory, FileInfo);
    try
      while DosCode = 0 do begin
        if (FileInfo.Name[1] <> '.') and (FileInfo.Attr and faDirectory = faDirectory) then begin
          Proc(FileInfo.Name);
        end;
        DosCode := FindNext(FileInfo);
      end;
    finally
      FindClose(FileInfo);
    end;
  end;
end;
{ TsDirProperty }
function TsDirProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paAutoUpdate];
end;
procedure TsDirProperty.Edit;
var
  s : string;
begin
  s := TsSkinManager(GetComponent(0)).SkinDirectory;
  if SelectDirectory(s, [], 0) then begin
    TsSkinManager(GetComponent(0)).SkinDirectory := s
  end;
end;
{ TsInternalSkinsProperty }
procedure TsInternalSkinsProperty.Edit;
var
  i : integer;
begin
  Application.CreateForm(TFormInternalSkins, FormInternalSkins);
  FormInternalSkins.ListBox1.Clear;
  FormInternalSkins.SkinManager := TsSkinManager(GetComponent(0));
  for i := 0 to TsSkinManager(GetComponent(0)).InternalSkins.Count - 1 do begin
    FormInternalSkins.ListBox1.Items.Add(TsSkinManager(GetComponent(0)).InternalSkins.Items[i].Name);
  end;
  FormInternalSkins.ShowModal;
  if Assigned(FormInternalSkins) then FreeAndNil(FormInternalSkins);
  inherited;
end;
function TsInternalSkinsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paAutoUpdate];
end;
{ TsInternalSkinsEditor }
procedure TsInternalSkinsEditor.ExecuteVerb(Index: Integer);
var
  i : integer;
  sm : TsSkinManager;
begin
  inherited;
  sm := TsSkinManager(Component);
  Application.CreateForm(TFormInternalSkins, FormInternalSkins);
  FormInternalSkins.ListBox1.Clear;
  FormInternalSkins.SkinManager := sm;
  for i := 0 to sm.InternalSkins.Count - 1 do begin
    FormInternalSkins.ListBox1.Items.Add(sm.InternalSkins.Items[i].Name);
  end;
  FormInternalSkins.ShowModal;
  if Assigned(FormInternalSkins) then FreeAndNil(FormInternalSkins);
  if Designer <> nil then Designer.Modified;
end;
function TsInternalSkinsEditor.GetVerb(Index: Integer): string;
begin
  case Index of 
    0 : Result := '&Internal skins...';
    1 : Result := '-';
  end;
end;
function TsInternalSkinsEditor.GetVerbCount: Integer;
begin
  Result := 2;
end;
{$IFNDEF ALITE}
{ TsImageListEditor }
procedure TsImageListEditor.ExecuteVerb(Index: Integer);
var
  Form : TFormImgListEditor;
begin
  case Index of
    0:  begin
      Application.CreateForm(TFormImgListEditor, Form);
      Form.InitFromImgList(Component as TsImageList);
      Form.ShowModal;
      FreeAndNil(Form);
    end;
  end;
  if Designer <> nil then Designer.Modified;
end;
function TsImageListEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0:  result := '&ImageList editor...';
  end;
end;
function TsImageListEditor.GetVerbCount: Integer;
begin
  result := 1;
end;
{$ENDIF}
{ TsTabSheetEditor }
procedure TsTabSheetEditor.ExecuteVerb(Index: Integer);
var
  NewPage: TsTabSheet;
begin
  case Index of
    0: begin
      NewPage := TsTabSheet.Create(Designer.GetRoot);
      NewPage.Parent := TsTabSheet(Component).PageControl;
      NewPage.PageControl := TsTabSheet(Component).PageControl;
      NewPage.Caption := Designer.UniqueName('sTabSheet');
      NewPage.Name := NewPage.Caption;
    end;
    1: begin
      NewPage := TsTabSheet(Component).PageControl.ActivePage;
      NewPage.Free;
    end;
    2: begin
//      TsTabSheet(Component).PageControl.FindNextPage(TsTabSheet(Component), True, False);
      TsTabSheet(Component).PageControl.SelectNextPage(True);
    end;
    3: begin
//      TsTabSheet(Component).PageControl.FindNextPage(TsTabSheet(Component), False, False);
      TsTabSheet(Component).PageControl.SelectNextPage(False);
    end;
  end;
  if Designer <> nil then Designer.Modified;
end;
function TsTabSheetEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0:  result := 'New Page';
    1:  result := 'Delete Page';
    2:  result := 'Next Page';
    3:  result := 'Previous Page';
  end;
end;
function TsTabSheetEditor.GetVerbCount: Integer;
begin
  result := 4;
end;
end.

						