ctrlsvclreg.pas

天涯進銷存系統

unit CtrlsVclReg;

interface

uses
  Classes, Controls, DesignIntf, DesignEditors, VCLEditors,
  TypInfo, Db, ColnEdit;

procedure Register;

implementation

uses
  LBCtrls, LBDBCtrls, LBDBGrid, LBCalen, LBDBScrollBar, LBCurrencyCtrls,
  LBDBCurrencyCtrls, LBTrayIcon, LBMorphBmp, LBMorphButton;
  
type
  TListFieldProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings); virtual;
    procedure GetValues(Proc: TGetStrProc); override;
    function GetDataSourcePropName: string; virtual;
  end;


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

function GetPropertyValue(Instance: TPersistent; const PropName: string): TPersistent;
var
  PropInfo: PPropInfo;
begin
  Result := nil;
  PropInfo := TypInfo.GetPropInfo(Instance.ClassInfo, PropName);
  if (PropInfo <> nil) and (PropInfo^.PropType^.Kind = tkClass) then
    Result := TObject(GetOrdProp(Instance, PropInfo)) as TPersistent;
end;

procedure TListFieldProperty.GetValueList(List: TStrings);
var
  DataSource: TDataSource;
begin
  DataSource := GetPropertyValue(GetComponent(0), GetDataSourcePropName) as TDataSource;
  if (DataSource <> nil) and (DataSource.DataSet <> nil) then
    DataSource.DataSet.GetFieldNames(List);
end;

procedure TListFieldProperty.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 TListFieldProperty.GetDataSourcePropName: string;
begin
  Result := 'ListSource';
end;

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

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

procedure TLBDBGridFieldProperty.GetValueList(List: TStrings);
var
  Lbg : TLBCustomDBGrid;
begin
  if (GetComponent(0) = nil) then Exit;
  if (GetComponent(0) is TLBColumn) then
    Lbg := (GetComponent(0) as TLBColumn).Grid
  else Exit;

  if (Lbg <> nil) and (TLBCustomDBGrid(Lbg).DataSource <> nil) and (TLBCustomDBGrid(Lbg).DataSource.DataSet <> nil) then
       TLBCustomDBGrid(Lbg).DataSource.DataSet.GetFieldNames(List);
end;

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

procedure Register;
begin
  RegisterComponents('LBCtrlsVcl', [TLBLabel]);
  RegisterComponents('LBCtrlsVcl', [TLBEdit]);
  RegisterComponents('LBCtrlsVcl', [TLBCombobox]);
  RegisterComponents('LBCtrlsVcl', [TLBButton]);
  RegisterComponents('LBCtrlsVcl', [TLBSpeecButton]);
  RegisterComponents('LBCtrlsVcl', [TLBCalen]);
  RegisterComponents('LBCtrlsVcl', [TLBNumberEdit]);
  RegisterComponents('LBCtrlsVcl', [TLBCheckBox]);
  RegisterComponents('LBCtrlsVcl', [TLBEditButton]);
  RegisterComponents('LBCtrlsVcl', [TLBCurrencyLabel]);
  RegisterComponents('LBCtrlsVcl', [TLBCurrencyEdit]);
  RegisterComponents('LBCtrlsVcl', [TLBRegulator]);
  RegisterComponents('LBCtrlsVcl', [TLBMorphButton]);
  RegisterComponents('LBCtrlsVcl', [TLBListBox]);
  RegisterComponents('LBDBCtrlsVcl', [TLBDBEdit]);
  RegisterComponents('LBDBCtrlsVcl', [TLBDBCombobox]);
  RegisterComponents('LBDBCtrlsVcl', [TLBDBNumberEdit]);
  RegisterComponents('LBDBCtrlsVcl', [TLBDBCheckBox]);
  RegisterComponents('LBDBCtrlsVcl', [TLBDBGrid]);
  RegisterComponents('LBDBCtrlsVcl', [TLBDBCalen]);
  RegisterComponents('LBDBCtrlsVcl', [TLBDBScrollBar]);
  RegisterComponents('LBDBCtrlsVcl', [TLBDBCurrencyEdit]);

  RegisterComponents('LBSysVcl', [TLBTrayIcon]);

  RegisterPropertyEditor(TypeInfo(string), TLBColumn, 'FieldName', TLBDBGridFieldProperty);
//  RegisterComponentEditor(TLBDBGrid, TCollectionEditor);
end;

end.