bsreg.pas

漂亮的皮肤控件 for delphi 567

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       BusinessSkinForm                                            }
{       Version 2.52                                                }
{                                                                   }
{       Copyright (c) 2000-2003 Almediadev                          }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{       Home:  http://www.almdev.com                                }
{       Support: [e-mail]                                 }
{                                                                   }
{*******************************************************************}

unit bsreg;

{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}

interface

uses Classes, Menus, Dialogs, Forms, Controls,
    {$IFDEF  VER140} DesignEditors, DesignIntf {$ELSE}
    {$IFDEF  VER150} DesignEditors, DesignIntf {$ELSE} DsgnIntf {$ENDIF}{$ENDIF};

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

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

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

procedure Register;

implementation

uses
  bsUtils, BusinessSkinForm, bsSkinData, bsSkinCtrls, bsSkinHint, bsSkinGrids,
  bsSkinTabs, SysUtils, bsSkinBoxCtrls, bsSkinMenus, bsTrayIcon,
  bsDBGrids, bsDBCtrls, DB, bsCalc, bsMessages, bsSkinZip, bsSkinUnZip,
  bsFileCtrl, bsSkinShellCtrls, NBPagesEditor, bsCalendar, bsColorCtrls,
  bsDialogs;

{ TColumnDataFieldEditor }

type

  { TFilenameProperty }

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

  TbsDBStringProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings); virtual;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TbsSkinDataNameProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings); virtual;
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TbsButtonSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsTrackEditSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsEditSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsSpinEditSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsGaugeSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsToolBarSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsMenuButtonSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsPanelSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsListBoxSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsComboBoxSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

   TbsCheckListBoxSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  TbsSplitterSkinDataNameProperty = class(TbsSkinDataNameProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

  procedure TbsSkinDataNameProperty.GetValueList(List: TStrings);
  begin
  end;

  procedure TbsSkinDataNameProperty.GetValues(Proc: TGetStrProc);
  var
    I: Integer;
    Values: TStringList;
  begin
    Values := TStringList.Create;
    try
      GetValueList(Values);
      for I := 0 to Values.Count - 1 do Proc(Values[I]);
    finally
      Values.Free;
    end;
  end;

  function TbsSkinDataNameProperty.GetAttributes: TPropertyAttributes;
  begin
    Result := [paValueList, paMultiSelect];
  end;

  procedure TbsButtonSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('button');
    List.Add('resizebutton');
    List.Add('toolbutton');
    List.Add('bigtoolbutton');
  end;

  procedure TbsTrackEditSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('buttonedit');
    List.Add('statusbuttonedit');
    List.Add('toolbuttonedit');
  end;

  procedure TbsEditSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('edit');
    List.Add('buttonedit');
    List.Add('statusedit');
    List.Add('statusbuttonedit');
    List.Add('tooledit');
    List.Add('toolbuttonedit');
  end;

  procedure TbsSpinEditSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('spinedit');
    List.Add('statusspinedit');
    List.Add('toolspinedit');
  end;

  procedure TbsGaugeSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('gauge');
    List.Add('vgauge');
    List.Add('statusgauge');
  end;

  procedure TbsMenuButtonSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('toolmenubutton');
    List.Add('bigtoolmenubutton');
    List.Add('toolmenutrackbutton');
    List.Add('bigtoolmenutrackbutton');
  end;

  procedure TbsToolBarSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('toolpanel');
    List.Add('bigtoolpanel');
  end;

  procedure TbsPanelSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('panel');
    List.Add('toolpanel');
    List.Add('bigtoolpanel');
    List.Add('statusbar');
    List.Add('groupbox');
  end;

  procedure TbsListBoxSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('listbox');
    List.Add('captionlistbox');
  end;

  procedure TbsComboBoxSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('combobox');
    List.Add('captioncombobox');
    List.Add('statuscombobox');
    List.Add('toolcombobox');
  end;

  procedure TbsCheckListBoxSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('checklistbox');
    List.Add('captionchecklistbox');
  end;

  procedure TbsSplitterSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('vsplitter');
    List.Add('hsplitter');
  end;

  procedure TbsFilenameProperty.Edit;
  var
    FileOpen: TOpenDialog;
  begin
    FileOpen := TOpenDialog.Create(Application);
    try
      FileOpen.Filename := '';
      FileOpen.InitialDir := ExtractFilePath(FileOpen.Filename);
      FileOpen.Filter := '*.*|*.*';
      FileOpen.Options := FileOpen.Options + [ofHideReadOnly];
      if FileOpen.Execute then SetValue(FileOpen.Filename);
    finally
      FileOpen.Free;
    end;
  end;

  function TbsFilenameProperty.GetAttributes: TPropertyAttributes;
  begin
    Result := [paDialog , paRevertable];
  end;

  function TbsDBStringProperty.GetAttributes: TPropertyAttributes;
  begin
    Result := [paValueList, paSortList, paMultiSelect];
  end;

  procedure TbsDBStringProperty.GetValueList(List: TStrings);
  begin
  end;

procedure TbsDBStringProperty.GetValues(Proc: TGetStrProc);
var
  I: Integer;
  Values: TStringList;
begin
  Values := TStringList.Create;
  try
    GetValueList(Values);
    for I := 0 to Values.Count - 1 do Proc(Values[I]);
  finally
    Values.Free;
  end;
end;

type

  TbsColumnDataFieldProperty = class(TbsDBStringProperty)
    procedure GetValueList(List: TStrings); override;
  end;

procedure TbsColumnDataFieldProperty.GetValueList(List: TStrings);
var
  Grid: TbsSkinCustomDBGrid;
  DataSource: TDataSource;
begin
  Grid := (GetComponent(0) as TbsColumn).Grid;
  if (Grid = nil) then Exit;
  DataSource := Grid.DataSource;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    DataSource.DataSet.GetFieldNames(List);
end;

type
  TbsSkinDBLookUpListBoxFieldProperty = class(TbsDBStringProperty)
    procedure GetValueList(List: TStrings); override;
  end;

procedure TbsSkinDBLookUpListBoxFieldProperty.GetValueList(List: TStrings);
var
  DataSource: TDataSource;
  LookUpControl: TbsDBLookUpControl;
begin
  DataSource := (GetComponent(0) as TbsSkinDBLookUpListBox).ListSource;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    DataSource.DataSet.GetFieldNames(List);
end;

type
  TbsSkinDBLookUpComboBoxFieldProperty = class(TbsDBStringProperty)
    procedure GetValueList(List: TStrings); override;
  end;

procedure TbsSkinDBLookUpComboBoxFieldProperty.GetValueList(List: TStrings);
var
  DataSource: TDataSource;
  LookUpControl: TbsDBLookUpControl;
begin
  DataSource := (GetComponent(0) as TbsSkinDBLookUpComboBox).ListSource;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    DataSource.DataSet.GetFieldNames(List);
end;

type
  TbsSetPagesProperty = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure SetValue(const Value: string); override;
   end;

procedure TbsSetPagesProperty.Edit;
var
  NB: TbsSkinNoteBook;
begin
  try
    NB := TbsSkinNoteBook(GetComponent(0));
    NBPagesEditor.Execute(NB);
  finally
  end;
end;

function TbsSetPagesProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog];
end;

function TbsSetPagesProperty.GetValue: string;
begin
  Result := '(Pages)';
end;

procedure TbsSetPagesProperty.SetValue(const Value: string);
begin
  if Value = '' then SetOrdValue(0);
end;

{ Registration }

resourcestring
  sNEW_PAGE = 'New page';
  sDEL_PAGE = 'Delete page';

  sNEW_STATUSPANEL = 'New panel';
  sNEW_STATUSGAUGE = 'New gauge';
  sNEW_STATUSEDIT = 'New edit';
  sNEW_STATUSBUTTONEDIT = 'New edit with button';
  sNEW_STATUSCOMBOBOX = 'New combobox';
  sNEW_STATUSSPINEDIT = 'New spinedit';

  sNEW_TOOLBUTTON = 'New button';
  sNEW_TOOLMENUBUTTON = 'New button with dropdown menu';
  sNEW_TOOLMENUTRACKBUTTON = 'New button with chevron and dropdown menu';
  sNEW_TOOLSEPARATOR = 'New separator';
  sNEW_TOOLCOMBOBOX = 'New combobox';
  sNEW_TOOLEDIT = 'New edit';
  sNEW_TOOLBUTTONEDIT = 'New edit with button';
  sNEW_TOOLSPINEDIT = 'New spinedit';


procedure Register;
begin
  RegisterComponents('BusinessSkinForm VCL',  [TbsBusinessSkinForm,
    TbsSkinData, TbsCompressedStoredSkin, TbsStoredSkin, TbsSkinMainMenuBar,
    TbsSkinPopupMenu, TbsSkinMainMenu, TbsTrayIcon,
    TbsSkinPanel, TbsSkinGroupBox, TbsSkinExPanel, TbsSkinScrollPanel, 
    TbsSkinRadioGroup, TbsSkinCheckGroup,
    TbsSkinSpeedButton, TbsSkinMenuSpeedButton,
    TbsSkinButton, TbsSkinCheckRadioBox,
    TbsSkinGauge, TbsSkinTrackBar, TbsSkinLabel, TbsSkinStdlabel,