cmoneydbgrided6.pas

Delphi功能强的DBGRID构件,支持钱币网格,从DBGRIDEH中继承.比速达的网格构件功能更强大.

unit CMoneyDBGridEd6;

{$I wuComp.Inc}
{$IMPORTEDDATA OFF}

interface

uses
  Windows, Messages, SysUtils,
{$IFDEF SDComp7}Variants, DesignEditors, DesignIntf,
{$ELSE}DsgnWnds, DsgnIntf, LibIntf, {$ENDIF}
  Classes, Graphics, Controls, Forms, DB,
  Dialogs, ImgList, Menus, ActnList, ExtCtrls, ComCtrls,
  CMoneyDBGrids, DBGrids, ColnEdit, ToolWin;

type
  TCSDBGridColumnsEditor = class(TCollectionEditor)
    N1: TMenuItem;
    AddAllFields1: TMenuItem;
    RestoreDefaults1: TMenuItem;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    AddAllFieldsCmd: TAction;
    RestoreDefaultsCmd: TAction;
    procedure AddAllFieldsCmdExecute(Sender: TObject);
    procedure RestoreDefaultsCmdExecute(Sender: TObject);
    procedure AddAllFieldsCmdUpdate(Sender: TObject);
    procedure RestoreDefaultsCmdUpdate(Sender: TObject);
  private
    { Private declarations }
  protected
    function CanAdd(Index: Integer): Boolean; override;
  public
    { Public declarations }
  end;

{ TCSDBGridColumnsProperty }

  TCSDBGridColumnsProperty = class(TPropertyEditor)
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure Edit; override;
  end;

{ TCSDBGridEditor }

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

{ TCSDBGridFieldProperty }

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

{ TCSDBGridFieldProperty }

  TCSDBGridFieldAggProperty = class(TCSDBGridFieldProperty)
  public
    procedure GetValueList(List: TStrings); override;
  end;

var
  CSDBGridColumnsEditor: TCSDBGridColumnsEditor;

implementation

{$R *.dfm}

type
  TPersistentCracker = class(TPersistent);

{ TCSDBGridColumnsProperty }

procedure TCSDBGridColumnsProperty.Edit;
var
  Obj: TPersistent;
begin
  Obj := GetComponent(0);
  while (Obj <> nil) and not (Obj is TComponent) do
    Obj := TPersistentCracker(Obj).GetOwner;
  ShowCollectionEditorClass(Designer, TCSDBGridColumnsEditor, TComponent(Obj),
    TCollection(GetOrdValue), 'Columns', [coAdd, coDelete, coMove]);
end;

function TCSDBGridColumnsProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly {, paSubProperties}];
end;

function TCSDBGridColumnsProperty.GetValue: string;
begin
  FmtStr(Result, '(%s)', [GetPropType^.Name]);
end;

{ TCSDBGridEditor }

procedure TCSDBGridEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0:
      ShowCollectionEditorClass(Designer, TCSDBGridColumnsEditor, Component,
        TCChinaCustomDBGrid(Component).Columns, 'Columns', [coAdd, coDelete, coMove]);
    1:  Application.MessageBox(PChar('    TSDDBGrid' + #13#10#13#10 + '版本: 6.0'
      + ' (编译版本: 6.0.6.12)' + #13#10#13#10 + ''),
      'About ...', 64);
  end;
end;

function TCSDBGridEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Columns Editor ...';
    1:  Result := 'About ...';
  end;
end;

function TCSDBGridEditor.GetVerbCount: Integer;
begin
  Result := 2;
end;

{ TCChinaCustomDBGridCracker }

type
  TCChinaCustomDBGridCracker = class(TCChinaCustomDBGrid)
  public
    procedure BeginLayout;
    procedure EndLayout;
  end;

procedure TCChinaCustomDBGridCracker.BeginLayout;
begin
  inherited BeginLayout;
end;

procedure TCChinaCustomDBGridCracker.EndLayout;
begin
  inherited EndLayout;
end;

type
  TCollectionCracker = class(TCollection);
{ TCSDBGridColumnsEditor }

procedure TCSDBGridColumnsEditor.AddAllFieldsCmdExecute(Sender: TObject);
var
  msgValue: Word;
  i: Integer;
  Col: TCSColumn;
  CSDBGrid: TCChinaCustomDBGrid;
begin
  CSDBGrid := TCChinaCustomDBGrid(TCollectionCracker(Collection).GetOwner);
  if not Assigned(CSDBGrid) then Exit;
  if (CSDBGrid.Columns.State = csDefault) then
    CSDBGrid.Columns.State := csCustomized
  else
    begin
      TCChinaCustomDBGridCracker(CSDBGrid).BeginLayout;
      try
        if (CSDBGrid.Columns.Count > 0) then
          begin
            msgValue := MessageDlg('Delete existing columns?',
              mtConfirmation, [mbYes, mbNo, mbCancel], 0);
            case msgValue of
              mrYes: CSDBGrid.Columns.Clear;
              mrCancel: Exit;
            end;
          end;
        for i := 0 to CSDBGrid.DataSource.DataSet.FieldCount - 1 do
          begin
            Col := CSDBGrid.Columns.Add;
            Col.FieldName := CSDBGrid.DataSource.DataSet.Fields[i].FieldName;
          end;
      finally
        TCChinaCustomDBGridCracker(CSDBGrid).EndLayout;
        UpdateListbox;
      end;
    end;
  Designer.Modified;
end;

procedure TCSDBGridColumnsEditor.RestoreDefaultsCmdExecute(Sender: TObject);
var
  i: Integer;
  CSDBGrid: TCChinaCustomDBGrid;
begin
  CSDBGrid := TCChinaCustomDBGrid(TCollectionCracker(Collection).GetOwner);
  if not Assigned(CSDBGrid) then Exit;
  if (ListView1.SelCount > 0) then
    begin
      for i := 0 to ListView1.SelCount - 1 do
        CSDBGrid.Columns[i].RestoreDefaults;
      Designer.Modified;
      UpdateListbox;
    end;
end;

procedure TCSDBGridColumnsEditor.AddAllFieldsCmdUpdate(Sender: TObject);
var
  CSDBGrid: TCChinaCustomDBGrid;
begin
  CSDBGrid := TCChinaCustomDBGrid(TCollectionCracker(Collection).GetOwner);
  AddAllFieldsCmd.Enabled := Assigned(CSDBGrid) and
    Assigned(CSDBGrid.DataSource) and Assigned(CSDBGrid.Datasource.Dataset) and
    (CSDBGrid.Datasource.Dataset.FieldCount > 0);
end;

procedure TCSDBGridColumnsEditor.RestoreDefaultsCmdUpdate(Sender: TObject);
begin
  RestoreDefaultsCmd.Enabled := ListView1.Items.Count > 0;
end;

function TCSDBGridColumnsEditor.CanAdd(Index: Integer): Boolean;
var
  CSDBGrid: TCChinaCustomDBGrid;
begin
  Result := False;
  CSDBGrid := TCChinaCustomDBGrid(TCollectionCracker(Collection).GetOwner);
  if Assigned(CSDBGrid) then
    Result := (CSDBGrid.Columns.State = csCustomized);
end;

{ TCSDBGridFieldProperty }

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

procedure TCSDBGridFieldProperty.GetValueList(List: TStrings);
var
  CSG: TCChinaCustomDBGrid;
begin
  if (GetComponent(0) = nil) then Exit;
  if (GetComponent(0) is TCSColumn) then
    CSG := (GetComponent(0) as TCSColumn).Grid
  else
    Exit;

  if (CSG <> nil) and (TCChinaCustomDBGrid(CSG).DataSource <> nil) and (TCChinaCustomDBGrid(CSG).DataSource.DataSet <> nil) then
    TCChinaCustomDBGrid(CSG).DataSource.DataSet.GetFieldNames(List);
end;

procedure TCSDBGridFieldProperty.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;

{ TCSDBGridFieldAggProperty }

procedure TCSDBGridFieldAggProperty.GetValueList(List: TStrings);
var
  CSG: TCChinaCustomDBGrid;
  AggList: TStringList;
begin
  if (GetComponent(0) = nil) then Exit;
  if (GetComponent(0) is TCSColumn) then
    CSG := (GetComponent(0) as TCSColumn).Grid
  else
    Exit;

  if (CSG <> nil) and (TCChinaCustomDBGrid(CSG).DataSource <> nil) and (TCChinaCustomDBGrid(CSG).DataSource.DataSet <> nil) then
    begin
      TCChinaCustomDBGrid(CSG).DataSource.DataSet.GetFieldNames(List);
      if TCChinaCustomDBGrid(CSG).DataSource.DataSet.AggFields.Count > 0 then
        begin
          AggList := TStringList.Create;
          try
            TCChinaCustomDBGrid(CSG).DataSource.DataSet.AggFields.GetFieldNames(AggList);
            List.AddStrings(AggList);
          finally
            AggList.Free;
          end;
        end;
    end;
end;

end.