bsreg.pas

一套支持Delphi的VCL库

{*******************************************************************}
{                                                                   }
{       Almediadev Visual Component Library                         }
{       BusinessSkinForm                                            }
{       Version 6.15                                                }
{                                                                   }
{       Copyright (c) 2000-2008 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,
     {$IFNDEF  VER130} DesignEditors, DesignIntf {$ELSE} DsgnIntf {$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, bsRootEdit, bsSkinPrinter, bsCategoryButtons, bsButtonGroup,
  bsSkinExCtrls;

{ 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;

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

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

  TbsCategorySkinDataNameProperty = 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');
    List.Add('resizetoolbutton');
  end;

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

  procedure TbsCategorySkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('resizetoolpanel');
    List.Add('panel');
  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');
  end;

  procedure TbsSpinEditSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('spinedit');
    List.Add('statusspinedit');
  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');
    List.Add('resizetoolbutton');
    List.Add('resizebutton');
  end;

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

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

  procedure TbsCalendarSkinDataNameProperty.GetValueList(List: TStrings);
  begin
    List.Add('panel');
    List.Add('groupbox');
    List.Add('resizetoolpanel');
  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');
  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