acldbreg.pas

来自「delphi编程控件」· PAS 代码 · 共 1,263 行 · 第 1/3 页

  function ParamCheck : Boolean;
  Var
    j : Integer;
  begin
    Result := True;
    for j := 0 to i - 1 do
      if(CompareText(Params[i].Name, Params[j].Name) = 0) then begin
        Result := False;
        Break;
      end;
  end;

begin
  FilterLink := GetComponent(0) as TFilterLink;
  if(FilterLink.DataSet <> nil) then begin
    PropInfo := TypInfo.GetPropInfo(FilterLink.DataSet.ClassInfo, 'Params');
    if(PropInfo <> Nil) then
      Params := TParams(GetOrdProp(FilterLink.DataSet, PropInfo))
    else Params := Nil;
    if(Params <> Nil) then
      for i := 0 to Params.Count - 1 do
        if(ParamCheck) then
          List.Add(Params[i].Name);
  end;
end;

procedure TFilterLinkParamProperty.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
  TCustomReferenceEditor = class(TComponentEditor)
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

procedure TCustomReferenceEditor.ExecuteVerb(Index: Integer);
Var
  Reference : TCustomReference;
  AWinWidth, AWinHeight : Integer;
begin
  Reference := TCustomReference(Component);
  case Index of
    0 :
      with Reference do begin
        AWinWidth := WinWidth;
        AWinHeight := WinHeight;
        PopupReference(GridLayout, ReferencePanel, ReferencePanelAlign,
          Repository, AWinWidth, AWinHeight);
        WinWidth := AWinWidth;
        WinHeight := AWinHeight;
      end;
    1 : TCustomReference(Component).VisibleText := Not TCustomReference(Component).VisibleText;
  end;
end;

function TCustomReferenceEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := LoadStr(ACDB_REFERPOPUPFORM);
    1: Result := LoadStr(ACDB_REFERCHANGEVISIBLETEXT);
  end;
end;

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

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

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

procedure TReferenceFieldProperty.GetValueList(List: TStrings);
var
  Reference : TCustomReference;
begin
  Reference := GetComponent(0) as TCustomReference;
  if(Reference.GridLayout.DataSource <> Nil)
  And (Reference.GridLayout.DataSource.DataSet <> nil) then
      Reference.GridLayout.DataSource.DataSet.GetFieldNames(List);
end;

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

{TReferencePatternTextProperty}
type
  TReferencePatternTextProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

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

procedure TReferencePatternTextProperty.Edit;
begin
  if EditReferenceText(GetComponent(0) As TCustomreference) then
    Modified;
end;

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

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

procedure TReferenceTableNameProperty.GetValueList(List: TStrings);
var
  Reference: TCustomReference;
  DBSession : TSession;
  DatabaseName : TFileName;
begin
  Reference := GetComponent(0) as TCustomReference;
  if(Reference.GridLayout.DataSource <> Nil)
  And (Reference.GridLayout.DataSource.DataSet <> Nil) then begin
    DBSession := Nil;
    if(Reference.GridLayout.DataSource.DataSet is TQuery) then begin
      DBSession := TQuery(Reference.GridLayout.DataSource.DataSet).DBSession;
      DatabaseName := TQuery(Reference.GridLayout.DataSource.DataSet).DataBaseName;
    end;
    if(Reference.GridLayout.DataSource.DataSet is TTable) then begin
      DBSession := TTable(Reference.GridLayout.DataSource.DataSet).DBSession;
      DatabaseName := TTable(Reference.GridLayout.DataSource.DataSet).DataBaseName;
    end;
    if(DBSession <> Nil) then
      DBSession.GetTableNames(DatabaseName, '', True, False, List);
  end;
end;

procedure TReferenceTableNameProperty.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
  TCustomAutoDBMakerProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings);
    procedure GetValues(Proc: TGetStrProc); override;
  end;

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

procedure TCustomAutoDBMakerProperty.GetValueList(List: TStrings);
var
  DBMaker: TCustomAutoDBMaker;
  AList: PPropList;
  i, ACount, ASize : Integer;
  AKind : TTypeKinds;
begin
  DBMaker := GetComponent(0) as TCustomAutoDBMaker;
  if(DBMaker.Control <> Nil) then begin
    AKind := [tkInteger, tkChar, tkEnumeration, tkFloat,
     tkString, tkSet, tkWChar, tkLString
     {$IFNDEF DELPHI3_0}, tkLWString {$ENDIF}, tkVariant];
    ACount := GetPropList(DBMaker.Control.ClassInfo, AKind, nil);
    ASize := ACount * SizeOf(Pointer);
    GetMem(AList, ASize);
    GetPropList(DBMaker.Control.ClassInfo, AKind, AList);
    for i := 0 to ACount - 1 do
      List.Add(AList^[i]^.Name);
    FreeMem(AList, ASize);
  end;
end;

procedure TCustomAutoDBMakerProperty.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
  TACLControlFieldProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure GetValueList(List: TStrings);
    procedure GetValues(Proc: TGetStrProc); override;
  end;

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

procedure TACLControlFieldProperty.GetValueList(List: TStrings);
var
  DataSource : TDataSource;
  DataSet : TDataSet;
  PropInfo : PPropInfo;
begin
  DataSet := Nil;
  PropInfo := TypInfo.GetPropInfo(GetComponent(0).ClassInfo, 'DataSource');
  if(PropInfo <> Nil) then
      DataSource := TDataSource(GetOrdProp(GetComponent(0), PropInfo))
  else DataSource := Nil;
  if(DataSource = Nil) then begin
    PropInfo := TypInfo.GetPropInfo(GetComponent(0).ClassInfo, 'DataSet');
    if(PropInfo <> Nil) then
      DataSet := TDataSet(GetOrdProp(GetComponent(0), PropInfo))
  end else DataSet := DataSource.DataSet;
  if(DataSet <> nil) then
    DataSet.GetFieldNames(List);
end;

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

{TACLMaskEditProperty}
type
  TACLMaskEditProperty = class(TStringProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
  end;

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

procedure TACLMaskEditProperty.Edit;
Var
  St : String;
begin
  St := GetStrValue;
  if EditACLMaskEditString(St) then begin
    SetStrValue(St);
    Modified;
  end;  
end;


procedure Register;
begin
  RegisterComponents('Auto Controls', [TAutoBtnEdit]);

  RegisterComponents('Auto Data Access',[TAutoRepository, TAutoTable, TAutoQuery,
      TAutoStoredProc]);
  RegisterNoIcon([TAutoDBDefControl, TAutoDBGridTemplate,
    TAutoDBPanelTemplate]);
  RegisterNoIcon([TAutoDBDefMaskEdit, TAutoDBDefBtnEdit, TAutoDBDefMemo,
    TAutoDBDefImage, TAutoDBDefListBox, TAutoDBDefComboBox,
    TAutoDBDefCheckBox, TAutoDBDefRadioGroup, TAutoDBDefLookupListBox,
    TAutoDBDefLookupComboBox, TAutoDBDefReference, TAutoDBDefDate,
    {TAutoDBDefDateTime,} TAutoDBDefTime, TAutoDBDefSpinImage,
    TAutoDBDefImageCombo, TAutoDBDefImageList]);

  RegisterComponents('Auto Data Controls',
  [TAutoDBGrid, TAutoDBPanel, TAutoDBComboBox, TAutoDBImageListBox,
   TAutoDBImageComboBox, TAutoDBSpinImage, TReference, TDBReference,
   TReferencePanel, TAutoDBForm, TAutoDBControlMaker, TAutoDBDateControl,
   TAutoDBDateEdit, TAutoDBTimeControl, TAutoDBTimeEdit, TAutoDBBtnEdit]);

  {$IFDEF DELPHI3_0}
  RegisterComponents('Auto Data Controls', [TAutoDBRichEdit]);
  {$ENDIF}

  RegisterComponents('Auto Filters', [TAutoFilterForm,  TFilterLink,
    TEasyFilter, TDateControlFilter, TDateFilter, TTimeControlFilter,
    TTimeEditFilter, TCheckBoxFilter, TRadioGroupFilter, TListBoxFilter,
    TComboBoxFilter, TMaskEditFilter, TLookupListFilter, TLookupComboFilter,
    TReferenceFilter, TImageComboBoxFilter, TImageListBoxFilter,
    TSpinImageFilter, TAutoDBComboBoxFilter, TFilterMaker]);

  RegisterComponents('Auto Locates', [TAutoLocateForm, TAutoFind, TAutoIncSearch,
      TAutoDBComboBoxLocate, TAutoEditLocate]);
  RegisterComponents('Auto Tools', [TAutoQuickTyper, TAutoDBQuickTyper]);


  RegisterPropertyEditor(TypeInfo(String), TAutoQuery, 'Filter', TAutoDataSetFilterProperty);
  RegisterPropertyEditor(TypeInfo(String), TAutoTable, 'Filter', TAutoDataSetFilterProperty);
  RegisterPropertyEditor(TypeInfo(String), TAutoStoredProc, 'Filter', TAutoDataSetFilterProperty);
  RegisterPropertyEditor(TypeInfo(TMacros), TAutoQuery, 'Macros', TDataSetMacrosProperty);
  RegisterPropertyEditor(TypeInfo(TMacros), TAutoTable, 'Macros', TDataSetMacrosProperty);
  RegisterPropertyEditor(TypeInfo(TMacros), TAutoStoredProc, 'Macros', TDataSetMacrosProperty);
  RegisterPropertyEditor(TypeInfo(TAutoDefDataSets), TAutoRepository, 'DefDataSets', TAutoRepositoryPropertyEditor);

  RegisterPropertyEditor(TypeInfo(TFileName), TAutoCustomDBComboBox, 'DataBaseName',
  TDBComboBoxDatabaseNameProperty);
  RegisterPropertyEditor(TypeInfo(TFileName), TAutoCustomDBComboBox, 'TableName',
  TDBComboBoxTableNameProperty);
  RegisterPropertyEditor(TypeInfo(String), TAutoCustomDBComboBox, 'FieldName',
  TDBComboBoxFieldNameProperty);

  RegisterPropertyEditor(TypeInfo(TAutoSpinImageItems), TAutoDBDefSpinImage, 'Items',
  TAutoDBDefSpinImageItemsProperties);
  RegisterPropertyEditor(TypeInfo(TStrings), TCustomAutoDBDefImageCombo, 'Strings',
  TAutoImageDBDefControlItemProperties);
  RegisterPropertyEditor(TypeInfo(string), TCustomAutoDBDefLookup, 'KeyField',
     TCustomAutoDBDefLookupFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TCustomAutoDBDefLookup, 'ListField',
     TCustomAutoDBDefLookupFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TAutoDBDefReference, 'KeyField',
     TDBDefReferenceFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TAutoDBDefReference, 'AssignField',
     TDBDefReferenceFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TAutoDBDefReference, 'TableName',
     TDBDefReferenceTableNameProperty);

  RegisterPropertyEditor(TypeInfo(string), Nil, 'DateDataField',
     TACLControlFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), Nil, 'BeginDateDataField',
     TACLControlFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), Nil, 'EndDateDataField',
     TACLControlFieldProperty);
  RegisterPropertyEditor(TypeInfo(TAutoGridLayout), Nil, '',
    TAutoGridLayoutPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TAutoGridFields), Nil, '',
    TAutoGridLayoutFieldsPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TAutoGridGroups), nil, '',
    TAutoGridLayoutGroupsPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TAutoPanelLayout), Nil, '',
    TAutoPanelLayoutPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TAutoPanelFields), Nil, '',
    TAutoPanelLayoutFieldsPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TAutoPanelPages), Nil, '',
    TAutoPanelLayoutPagesPropertyEditor);
  RegisterPropertyEditor(TypeInfo(TAutoFilterFields), TCustomAutoFilterForm, 'FilterFields',
    TAutoFilterFormFieldsPropertyEditor);
  RegisterPropertyEditor(TypeInfo(string), TCustomReference, 'AssignField', TReferenceFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TCustomReference, 'KeyField', TReferenceFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TCustomReference, 'PatternText', TReferencePatternTextProperty);
  RegisterPropertyEditor(TypeInfo(string), TCustomReference, 'TableName', TReferenceTableNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TCustomAutoDBMaker, 'PropName', TCustomAutoDBMakerProperty);

  RegisterPropertyEditor(TypeInfo(TComponent), TFilterLink, 'Filter', TFilterLinkAutoFilterProperty);
  RegisterPropertyEditor(TypeInfo(string), TFilterLink, 'FilterName', TFilterLinkFilterNameProperty);
  RegisterPropertyEditor(TypeInfo(string), TFilterLink, 'Macro', TFilterLinkMacroProperty);
  RegisterPropertyEditor(TypeInfo(string), TFilterLink, 'Param', TFilterLinkParamProperty);
  RegisterPropertyEditor(TypeInfo(string), TFilterLink, 'Param', TFilterLinkParamProperty);

  RegisterPropertyEditor(TypeInfo(string), TAutoFind, 'DataField',
     TACLControlFieldProperty);
  RegisterPropertyEditor(TypeInfo(string), TAutoDBDefMaskEdit, 'EditMask', TACLMaskEditProperty);
  RegisterPropertyEditor(TypeInfo(string), TField, 'DisplayText', TACLMaskEditProperty);
  RegisterPropertyEditor(TypeInfo(string), TField, 'EditMask', TACLMaskEditProperty);

  RegisterComponentEditor(TAutoRepository, TAutoRepositoryEditor);
  RegisterComponentEditor(TAutoDBGrid, TAutoDBGridEditor);
  RegisterComponentEditor(TAutoDBPanel, TAutoDBPanelEditor);
  RegisterComponentEditor(TCustomReference, TCustomReferenceEditor);
  RegisterComponentEditor(TReferencePanel, TReferencePanelEditor);
end;

end.