d_frmpropsunit.pas

delphi 运行期间窗体设计

unit d_frmPropsUnit;

interface

uses
  Windows, Messages, SysUtils, {$IFNDEF VER130}Variants,{$ENDIF} Classes, Graphics, Controls, Forms,
  Dialogs, Grids, LMDDsgPropPage, LMDDsgPropInsp, LMDDsgComboBox, TypInfo,
  DB, DBTables, DBGrids, StdCtrls, DBCtrls, Menus{$IFDEF VER130}, LMDDsgD5Adds{$ENDIF};

type
  TfrmProps = class(TForm)
    LMDObjectComboBox1: TLMDObjectComboBox;
    LMDPropertyInspector1: TLMDPropertyInspector;
    PopupMenu1: TPopupMenu;
    ArrangebyCategories1: TMenuItem;
    ArrangebyName1: TMenuItem;
    procedure LMDPropertyInspector1FilterProp(Sender: TObject;
      AInstance: TPersistent; APropInfo: PPropInfo; AIsSubProp: Boolean; 
      var AIncludeProp: Boolean);
    procedure LMDPropertyInspector1GetCaptionColor(Sender: TObject;
      AItem: TLMDPropertyInspectorItem; var AColor: TColor);
    procedure FormCreate(Sender: TObject);
    procedure ArrangebyCategories1Click(Sender: TObject);
    procedure ArrangebyName1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmProps: TfrmProps;

implementation

{$R *.dfm}

type
  PStrArray = ^TStrArray;
  TStrArray = array[0..1000] of string;

function IsStrInArray(ArrayPtr: PStrArray;
  ArrayLength: Integer; const AStr: string): Boolean;
var
  LI: Integer;
begin
  Result := False;
  for LI := 0 to ArrayLength - 1 do
    if SameText(ArrayPtr^[LI], AStr) then
    begin
      Result := True;
      Break;
    end;
end;

const
  StandartProps: array[0..14] of string = (
    'Name',
    'Hint',
    'Hints',
    'ShowHint',
    'Color',
    'Font',
    'Enabled',
    'Visible',
    'ReadOnly',
    'TitleFont',
    'FixedColor',
    'Options',
    'VisibleButtons',
    'WordWrap',
    'ScrollBars'
  );

  TQueryProps: array[0..6] of string = (
    'Active',
    'DatabaseName',
    'Filter',
    'Filtered',
    'FilterOptions',
    'RequestLive',
    'SQL'
  );

  TDataSourceProps: array[0..0] of string = (
    'DataSet'
  );

  TNavigatorProps: array[0..1] of string = (
    'ConfirmDelete',
    'DataSource'
  );

  TGridProps: array[0..0] of string = (
    'DataSource'
  );

  TLabelProps: array[0..2] of string = (
    'AutoSize',
    'DataField',
    'DataSource'
  );

  TEditProps: array[0..2] of string = (
    'AutoSelect',
    'DataField',
    'DataSource'
  );


  TMemoProps: array[0..3] of string = (
    'Alignment',
    'AutoDisplay',
    'DataField',
    'DataSource'
  );

  TImageProps: array[0..5] of string = (
    'AutoDisplay',
    'Center',
    'DataField',
    'DataSource',
    'QuickDraw',
    'Stretch'
  );

  TListBoxProps: array[0..3] of string = (
    'AutoComplite',
    'DataField',
    'DataSource',
    'Items'
  );

  TComboBoxProps: array[0..6] of string = (
    'AutoComplite',
    'AutoDropDown',
    'DataField',
    'DataSource',
    'Items',
    'Sorted',
    'Style'
  );

  TCheckBoxProps: array[0..5] of string = (
    'Alignment',
    'AllowGrayed',
    'DataField',
    'DataSource',
    'ValueChecked',
    'ValueUnchecked'
  );

  TRadioGroupProps: array[0..4] of string = (
    'Columns',
    'DataField',
    'DataSource',
    'Items',
    'Values'
  );

function IsInProps(AInstance: TPersistent; const APropName: string): Boolean;
begin
  Result := False;

  if AInstance is TQuery then
    Result := IsStrInArray(@TQueryProps,
      Length(TQueryProps), APropName)
  else if AInstance is TDataSource then
    Result := IsStrInArray(@TDataSourceProps,
      Length(TDataSourceProps), APropName)
  else if AInstance is TDBNavigator then
    Result := IsStrInArray(@TNavigatorProps,
      Length(TNavigatorProps), APropName)
  else if AInstance is TDBGrid then
    Result := IsStrInArray(@TGridProps,
      Length(TGridProps), APropName)
  else if AInstance is TDBText then
    Result := IsStrInArray(@TLabelProps,
      Length(TLabelProps), APropName)
  else if AInstance is TDBEdit then
    Result := IsStrInArray(@TEditProps,
      Length(TEditProps), APropName)
  else if AInstance is TDBMemo then
    Result := IsStrInArray(@TMemoProps,
      Length(TMemoProps), APropName)
  else if AInstance is TDBImage then
    Result := IsStrInArray(@TImageProps,
      Length(TImageProps), APropName)
  else if AInstance is TDBListBox then
    Result := IsStrInArray(@TListBoxProps,
      Length(TListBoxProps), APropName)
  else if AInstance is TDBComboBox then
    Result := IsStrInArray(@TComboBoxProps,
      Length(TComboBoxProps), APropName)
  else if AInstance is TDBCheckBox then
    Result := IsStrInArray(@TCheckBoxProps,
      Length(TCheckBoxProps), APropName)
  else if AInstance is TDBRadioGroup then
    Result := IsStrInArray(@TRadioGroupProps,
      Length(TRadioGroupProps), APropName);
end;

procedure TfrmProps.LMDPropertyInspector1FilterProp(Sender: TObject;
  AInstance: TPersistent; APropInfo: PPropInfo; AIsSubProp: Boolean;
  var AIncludeProp: Boolean);
begin
  if AIsSubProp then
    Exit;

  AIncludeProp := IsStrInArray(@StandartProps,
    Length(StandartProps), APropInfo.Name);
  if AIncludeProp then
    Exit;

  AIncludeProp := IsInProps(AInstance, APropInfo.Name);
end;

procedure TfrmProps.LMDPropertyInspector1GetCaptionColor(Sender: TObject;
  AItem: TLMDPropertyInspectorItem; var AColor: TColor);
var
  LI: Integer;
  LIsHighLightProp: Boolean;
begin
  LIsHighLightProp := False;
  for LI := 0 to LMDPropertyInspector1.Objects.Count - 1 do
    if IsInProps(LMDPropertyInspector1.Objects[LI], AItem.PropInfo[LI].Name) then
    begin
      LIsHighLightProp := True;
      Break;
    end;

  if LIsHighLightProp then
    AColor := clMaroon;
end;

procedure TfrmProps.FormCreate(Sender: TObject);
begin
  RegisterStandardCategories(LMDPropertyInspector1);
end;

procedure TfrmProps.ArrangebyCategories1Click(Sender: TObject);
begin
  ArrangebyCategories1.Checked:=True;
  LMDPropertyInspector1.ArrangeKind:=akByCategory;
end;

procedure TfrmProps.ArrangebyName1Click(Sender: TObject);
begin
  ArrangebyName1.Checked:=True;
  LMDPropertyInspector1.ArrangeKind:=akByName;
end;

end.