spropeditors.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sPropEditors;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, sConst, ExtCtrls, sPanel, sGraphUtils, acntUtils, ImgList,
  Consts, ComStrs, CommCtrl{$IFNDEF ALITE}, sDialogs, sPageControl{$ENDIF} , TypInfo,
  {$IFDEF DELPHI6UP}DesignEditors, DesignIntf, VCLEditors,{$ELSE}dsgnintf,{$ENDIF}
  sVclUtils, ColnEdit;

type
{$IFNDEF ALITE}
  TacImageIndexEditor = class(TIntegerProperty)//, ICustomPropertyListDrawing)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
    function GetMyList:TCustomImageList;
    procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas; var AHeight: Integer);
    procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas; var AWidth: Integer);
    procedure ListDrawValue(const Value: string; ACanvas: TCanvas; const ARect: TRect; ASelected: Boolean);
  end;

  TacSkinInfoProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

  TsHintProperty = class(TCaptionProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetEditLimit: Integer; override;
    procedure Edit; override;
  end;

  TsPageControlEditor = class(TDefaultEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TsFrameBarEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TsTabSheetEditor = class(TDefaultEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TsImageListEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TsCtrlCollectionProperty = class(TClassProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

  TsCtrlCollectionEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TsPathDlgEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

{$ENDIF}

  TsSkinSectionProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TsSkinNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TsDirProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

  TsInternalSkinsProperty = class(TClassProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

  TsInternalSkinsEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

procedure Register;

implementation

uses sDefaults, sSkinManager, FileCtrl, sMaskData, sSkinProps,
{$IFNDEF ALITE}
  sToolEdit, sImageList, sImgListEditor, sComboBoxes, sAdapter, sBitBtn,
  sLabel, sStrEdit, acShellCtrls, acRootEdit, acSkinInfo, acPathDialog, sFrameBar, 
{$ENDIF}
  FiltEdit, sInternalSkins, stdreg, sSpeedButton, sStyleSimply;

{$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 := TsTabSheet((Component as TsPageControl).ActivePage);
      NewPage.Free;
    end;
    2: begin
      (Component as TsPageControl).SelectNextPage(True);
    end;
    3: begin
      (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;
{$ENDIF}

procedure Register;
begin
{$IFNDEF ALITE}
  RegisterComponentEditor(TsPageControl, TsPageControlEditor);
  RegisterComponentEditor(TsTabSheet, TsTabSheetEditor);
  RegisterComponentEditor(TsImageList, TsImageListEditor);
  RegisterComponentEditor(TsFrameBar, TsFrameBarEditor);
{$ENDIF}
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'MenuLineSkin', TsSkinSectionProperty);
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'IcoLineSkin', TsSkinSectionProperty);
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'SkinSection', TsSkinSectionProperty);
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'TitleSkin', TsSkinSectionProperty);
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'ButtonSkin', TsSkinSectionProperty);
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'TabSkin', TsSkinSectionProperty);
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'HeaderSkin', TsSkinSectionProperty);
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'CaptionSkin', TsSkinSectionProperty);
  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, 'ProgressSkin', TsSkinSectionProperty);
//  RegisterPropertyEditor(TypeInfo(TsSkinSection), TObject, '', TsSkinSectionProperty);
  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(Integer),TsSpeedButton,'ImageIndex',TAcImageIndexEditor);
  RegisterPropertyEditor(TypeInfo(Integer),TsBitBtn,'ImageIndex',TAcImageIndexEditor);

{$IFNDEF TNTUNICODE}
  RegisterPropertyEditor(TypeInfo(TCaption), TObject, 'Caption', TsHintProperty);
{$ENDIF}
  RegisterPropertyEditor(TypeInfo(TCollection), TsCtrlAdapter, 'Controls', TsCtrlCollectionProperty);
  RegisterComponentEditor(TsCtrlAdapter, TsCtrlCollectionEditor);
  RegisterPropertyEditor(TypeInfo(string), TsFileNameEdit, 'Filter', TFilterProperty);

  RegisterPropertyEditor(TypeInfo(TacSkinInfo), TsSkinManager, 'SkinInfo', TacSkinInfoProperty);
//  RegisterPropertyEditor(TypeInfo(TStringList), TsSkinManager, 'CommonSections', TsHintProperty);

  // Shell ctrls
  RegisterPropertyEditor(TypeInfo(TacRoot), TsShellListView, 'Root', TacRootProperty);
  RegisterPropertyEditor(TypeInfo(TacRoot), TsShellTreeView, 'Root', TacRootProperty);
  RegisterPropertyEditor(TypeInfo(TacRoot), TsShellComboBox, 'Root', TacRootProperty);
  RegisterPropertyEditor(TypeInfo(TacRoot), TsPathDialog, 'Root', TacRootProperty);
  RegisterPropertyEditor(TypeInfo(TacRoot), TsDirectoryEdit, 'Root', TacRootProperty);
  RegisterComponentEditor(TsPathDialog, TsPathDlgEditor);
{$ENDIF}

{.$IFDEF TNTUNICODE}
//  RegisterPropertyEditor(TypeInfo(WideString), nil, '', TWideStringProperty);
//  RegisterPropertyEditor(TypeInfo(TWideCaption), nil, '', TWideCaptionProperty);
{.$ENDIF}
end;

{ TsSkinNameProperty }

function TsSkinNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList, paSortList, 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 DirectoryExists(TsSkinManager(GetComponent(0)).GetFullskinDirectory) then begin
    s := TsSkinManager(GetComponent(0)).GetFullskinDirectory + '\*.*';

    DosCode := FindFirst(s, faVolumeID or faDirectory, FileInfo);
    try
      while DosCode = 0 do begin
        if (FileInfo.Name[1] <> '.') then begin
          if {(SkinType in. [stUnpacked, stAllSkins]) and} (FileInfo.Attr and faDirectory = faDirectory) then begin
            Proc(FileInfo.Name);
          end
          else if { (SkinType in [stPacked, stAllSkins]) and} (FileInfo.Attr and faDirectory <> faDirectory) and (ExtractFileExt(FileInfo.Name) = '.' + acSkinExt) then begin
            s := ExtractWord(1, FileInfo.Name, ['.']);
            Proc(s);
          end;
        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 not directoryExists(s) then s := '';

{$IFNDEF ALITE}
  if TsSkinManager(GetComponent(0)).SkinData.Active then begin
    PathDialogForm := TPathDialogForm.Create(Application);
    try
      PathDialogForm.sShellTreeView1.Path := s;
      if PathDialogForm.ShowModal = mrOk then begin
        s := PathDialogForm.sShellTreeView1.Path;
        if (s <> '') and DirectoryExists(s) then TsSkinManager(GetComponent(0)).SkinDirectory := s;
      end;
    finally
      FreeAndNil(PathDialogForm);
    end;
  end
  else
{$ENDIF}
    if SelectDirectory('', '', s) then begin
      if (s <> '') and DirectoryExists(s) then TsSkinManager(GetComponent(0)).SkinDirectory := s;
    end;
{v4.40 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;
//  SkinForm(FormInternalSkins);
  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;
  if (FormInternalSkins.ShowModal = mrOk) and (Designer <> nil) then Designer.Modified;
//  UnSkinForm(FormInternalSkins);
  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