acldbreg.pas

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

    Name := DefControl.Name;
    DefaultImages := DefControl.DefaultImages;
    ImageList := DefControl.ImageList;
    ImageHAlign := DefControl.ImageHAlign;
    ImageVAlign := DefControl.ImageVAlign;
    Items.Assign(DefControl.Items);
  end;
  if AutoSpinImageItemsPropEditor(SpinImage) then begin
    DefControl.Items.Assign(SpinImage.Items);
    Modified;
  end;
  SpinImage.Free;
end;

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

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

procedure TAutoDataSetFilterProperty.Edit;
Var
  St : String;
  DataSet : TDataSet;
begin
  if(GetComponent(0) is TDataSet) then begin
    DataSet := GetComponent(0) as TDataSet;
    St := GetStrValue;
    if EditAutoDataSetFilter(DataSet, St) then begin
      Modified;
      SetStrValue(St);
    end;  
  end;
end;

{TDataSetMacrosProperty}
type
TDataSetMacrosProperty = class(TPropertyEditor)
public
  function GetValue: string; override;
  function GetAttributes: TPropertyAttributes; override;
  procedure Edit; override;
end;

function TDataSetMacrosProperty.GetValue: string;
begin
  Result := Format('(%s)', [TMacros.ClassName]);
end;

function TDataSetMacrosProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog];
end;

procedure TDataSetMacrosProperty.Edit;
var
  List, Macros: TMacros;
  Name : String;
begin
  Name := TComponent(GetComponent(0)).Name;
  Macros := TMacros(GetOrdValue);
  List := TMacros.Create;
  try
    List.Assign(Macros);
    if EditDataSetMacros(Name, List) then
    begin
      Modified;
      Macros.AssignValues(List);
    end;
  finally
    List.Free;
  end;
end;

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

function TAutoImageDBDefControlItemProperties.GetValue: string;
begin
  Result := Format('(%s)', [TStrings.ClassName]);
end;

function TAutoImageDBDefControlItemProperties.GetAttributes: TPropertyAttributes;
begin
  Result := [paMultiSelect, paDialog];
end;

procedure TAutoImageDBDefControlItemProperties.Edit;
Var
  DefControl : TCustomAutoDBDefImageCombo;
  ImageControl : TAutoImageListBox;
  i : Integer;
begin
  ImageControl := TAutoImageListBox.Create(Nil);
  DefControl := GetComponent(0) as TCustomAutoDBDefImageCombo;
  with ImageControl do begin
    SetBounds(0, 0, 0, 0);
    Parent := Designer.Form;
    Name := DefControl.Name;
    ImageList := DefControl.ImageList;
    for i := 0 to DefControl.Strings.Count - 1 do begin
      AddItem(DefControl.Items[i], DefControl.ImageIndexes[i]);
      Values[i] := DefControl.Values[i];
    end;
  end;
  if(AutoImageItemsPropEditor(ImageControl as TWinControl)) then begin
    DefControl.Strings.Clear;
    for i := 0 to ImageControl.Items.Count - 1 do
      DefControl.AddItem(ImageControl.Items[i], ImageControl.ImageIndexes[i], ImageControl.Values[i]);
    Modified;
  end;
  ImageControl.Free;
end;

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

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

procedure TCustomAutoDBDefLookupFieldProperty.GetValueList(List: TStrings);
var
  DefLookup : TCustomAutoDBDefLookup;
begin
  DefLookup := GetComponent(0) as TCustomAutoDBDefLookup;
  if(DefLookup.ListSource <> Nil)
  And (DefLookup.ListSource.DataSet <> nil) then
      DefLookup.ListSource.DataSet.GetFieldNames(List);
end;

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

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

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

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

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


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

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

procedure TDBDefReferenceTableNameProperty.GetValueList(List: TStrings);
var
  Reference: TAutoDBDefReference;
  DBSession : TSession;
  DatabaseName : TFileName;
begin
  Reference := GetComponent(0) as TAutoDBDefReference;
  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 TDBDefReferenceTableNameProperty.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;

{TReferencePanelEditor}
type
TReferencePanelEditor = class(TComponentEditor)
  procedure ExecuteVerb(Index: Integer); override;
  function GetVerb(Index: Integer): string; override;
  function GetVerbCount: Integer; override;
end;

procedure TReferencePanelEditor.ExecuteVerb(Index: Integer);
begin
  if(TReferencePanel(Component).Style = bpStandart) then
    TReferencePanel(Component).Style := bpComponent
  else TReferencePanel(Component).Style := bpStandart;
end;

function TReferencePanelEditor.GetVerb(Index: Integer): string;
begin
  Result := LoadStr(ACDB_REFERCHANGESTYLE); 
end;

function TReferencePanelEditor.GetVerbCount: Integer;
begin
  Result := 1;
end;

{ TFilterLinkAutoFilterProperty }
type
TFilterLinkAutoFilterProperty = class(TComponentProperty)
public
  procedure GetValues(Proc: TGetStrProc); override;
  procedure GetValueList(List: TStrings);
end;

procedure TFilterLinkAutoFilterProperty.GetValueList(List: TStrings);
var
  i : Integer;
begin
  if (AutoComponentsRegister <> nil) then
    for i := 0 to AutoComponentsRegister.ComponentCount - 1 do
      if(AutoComponentsRegister.ComponentItems[i] <> Nil)
      And (Length(AutoComponentsRegister.ComponentItems[i].Name) > 0) then
        List.Add(Designer.GetComponentName(AutoComponentsRegister.ComponentItems[i]));
end;

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

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

procedure TFilterLinkFilterNameProperty.GetValueList(List: TStrings);
var
  FilterLink : TFilterLink;
  FList : TList;
  i : Integer;
begin
  FilterLink := GetComponent(0) as TFilterLink;
  if(FilterLink.GetFilterComponent <> nil) And (AutoComponentsRegister <> Nil) then begin
    FList := TList.Create;
    AutoComponentsRegister.GetAutoFilters(FList, FilterLink.GetFilterComponent);
    for i := 0 to FList.Count - 1 do
      List.Add(TAutoFilter(FList[i]).Name);
    FList.Free;
  end;
end;

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

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

procedure TFilterLinkMacroProperty.GetValueList(List: TStrings);
var
  FilterLink : TFilterLink;
  Macros : TMacros;
  i : integer;
  PropInfo : PPropInfo;
begin
  FilterLink := GetComponent(0) as TFilterLink;
  if(FilterLink.DataSet <> Nil) then begin
    PropInfo := TypInfo.GetPropInfo(FilterLink.DataSet.ClassInfo, 'Macros');
    if(PropInfo <> Nil) then
      Macros := TMacros(GetOrdProp(FilterLink.DataSet, PropInfo))
    else Macros := Nil;
    if(Macros <> Nil) then
      for i := 0 to Macros.Count - 1 do
        List.Add(Macros[i].Name);
  end;
end;

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

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

procedure TFilterLinkParamProperty.GetValueList(List: TStrings);
var
  FilterLink : TFilterLink;
  Params : TParams;
  i : integer;
  PropInfo : PPropInfo;