tntunicodecontrolsex_designeditors.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

unit TntUnicodeControlsEx_DesignEditors;

interface

uses
  Classes, SysUtils, TypInfo, DB, DesignIntf, DesignEditors, ADODB;

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

  TCommandTextProperty = class(TDBStringProperty)
  private
    FCommandType: TCommandType;
    FConnection: TADOConnection;
  public
    procedure Activate; override;
    function AutoFill: Boolean; override;
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetConnection(Opened: Boolean): TADOConnection;
    procedure GetValueList(List: TStrings); override;
    property CommandType: TCommandType read FCommandType write FCommandType;
  end;

{ TProcedureNameProperty }
  TProcedureNameProperty = class(TCommandTextProperty)
  public
    procedure Activate; override;
  end;

implementation

{ TDBStringProperty }

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

procedure TDBStringProperty.GetValueList(List: TStrings);
begin
end;

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


{ TCommandTextProperty }

function TCommandTextProperty.GetAttributes: TPropertyAttributes;
begin
  if CommandType in [cmdTable, cmdTableDirect, cmdStoredProc] then
    Result := [paValueList, paSortList, paMultiSelect] else {Drop down list for name list}
    Result := [paMultiSelect, paRevertable, paDialog]; {SQL or File}
end;

procedure TCommandTextProperty.Activate;
var
  PropInfo: PPropInfo;
  Component: TComponent;
begin
  Component := GetComponent(0) as TComponent;
  PropInfo := TypInfo.GetPropInfo(Component.ClassInfo, 'CommandType'); { do not localize }
  if Assigned(PropInfo) then
    CommandType := TCommandType(GetOrdProp(Component, PropInfo)) else
    CommandType := cmdText;
end;


procedure TCommandTextProperty.Edit;
begin
  inherited;
end;

function TCommandTextProperty.GetConnection(Opened: Boolean): TADOConnection;
var
  Component: TComponent;
  ConnectionString: string;
begin
  Component := GetComponent(0) as TComponent;
  Result := TObject(GetOrdProp(Component, TypInfo.GetPropInfo(Component.ClassInfo,
    'Connection'))) as TADOConnection; { do not localize }
  if not Opened then Exit;
  if not Assigned(Result) then
  begin
    ConnectionString := TypInfo.GetStrProp(Component,
      TypInfo.GetPropInfo(Component.ClassInfo, 'ConnectionString')); { do not localize }
    if ConnectionString = '' then Exit;
    FConnection := TADOConnection.Create(nil);
    FConnection.ConnectionString := ConnectionString;
    FConnection.LoginPrompt := False;
    Result := FConnection;
  end;
  Result.Open;
end;

procedure TCommandTextProperty.GetValueList(List: TStrings);
var
  Connection: TADOConnection;
begin
  Connection := GetConnection(True);
  if Assigned(Connection) then
  try
    case CommandType of
      cmdTable, cmdTableDirect:
        Connection.GetTableNames(List);
      cmdStoredProc:
        Connection.GetProcedureNames(List);
    end;
  finally
    FConnection.Free;
    FConnection := nil;
  end;
end;

function TCommandTextProperty.AutoFill: Boolean;
var
  Connection: TADOConnection;
begin
  Connection := GetConnection(False);
  Result := Assigned(Connection) and Connection.Connected;
end;

{ TProcedureNameProperty }

procedure TProcedureNameProperty.Activate;
begin
  CommandType := cmdStoredProc;
end;


end.