memtabledesigneh.pas

Ehlib.v3.4.for.Delphi5678.rar是DELPHI的三方控件源码.此控件适用于DELPHI5,6,7,8.

unit MemTableDesignEh;

{$I EhLib.Inc}

interface

uses
  Windows, Messages, SysUtils,
{$IFDEF CIL} Borland.Vcl.Design.DesignIntf,
             Borland.Vcl.Design.DesignEditors,
             Borland.Vcl.Design.ColnEdit,
             Borland.Vcl.Design.DSDesign,
             Borland.Vcl.Design.DsnDBCst,
{$ELSE}
  DSDesign, DsnDBCst,
  {$IFDEF EH_LIB_6} Variants,
  DesignEditors, DesignIntf, DesignWindows,
    {$ELSE} //EH_LIB_6
      DsgnIntf,  DsgnWnds,
    {$ENDIF}
{$ENDIF}
  Classes, Graphics, Controls, Forms,
  Dialogs, Menus, DB, StdCtrls, DBCtrls, ExtCtrls, Grids,
  DBGridEh, ComCtrls, Buttons, ActnList, MemTableEh, DBGridEhImpExp;

type

{$IFNDEF EH_LIB_6}
  IDesigner = IFormDesigner;
{$ENDIF}

  TMemTableFieldsEditorEh = class(TFieldsEditor)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    DBGridEh1: TDBGridEh;
    TabSheet3: TTabSheet;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    ActionList1: TActionList;
    actFetchParams: TAction;
    actAssignLocalData: TAction;
    actLoadFromMyBaseTable: TAction;
    actCreateDataSet: TAction;
    actSaveToMyBaseXmlTable: TAction;
    actSaveToMyBaseXmlUTF8Table: TAction;
    actSaveToBinaryMyBaseTable: TAction;
    actClearData: TAction;
    GridMenu: TPopupMenu;
    GridCut: TMenuItem;
    GridCopy: TMenuItem;
    GridPaste: TMenuItem;
    GridDelete: TMenuItem;
    GridSelectAll: TMenuItem;
    procedure actFetchParamsExecute(Sender: TObject);
    procedure actAssignLocalDataExecute(Sender: TObject);
    procedure actLoadFromMyBaseTableExecute(Sender: TObject);
    procedure actCreateDataSetExecute(Sender: TObject);
    procedure actSaveToMyBaseXmlTableExecute(Sender: TObject);
    procedure actSaveToMyBaseXmlUTF8TableExecute(Sender: TObject);
    procedure actSaveToBinaryMyBaseTableExecute(Sender: TObject);
    procedure actClearDataExecute(Sender: TObject);
    procedure actCreateDataSetUpdate(Sender: TObject);
    procedure SelectTable(Sender: TObject);
    procedure GridCutClick(Sender: TObject);
    procedure GridCopyClick(Sender: TObject);
    procedure GridPasteClick(Sender: TObject);
    procedure GridDeleteClick(Sender: TObject);
    procedure GridSelectAllClick(Sender: TObject);
    procedure DBGridEh1ContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
  private
    { Private declarations }
  public
    constructor Create(AOwner: TComponent); override;
    { Public declarations }
  end;

  TMemTableEditorEh = class(TComponentEditor{$IFDEF LINUX}, IDesignerThreadAffinity{$ENDIF})
  protected
    function GetDSDesignerClass: TDSDesignerClass; virtual;
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
{$IFDEF LINUX}
    procedure Edit; override;
    {IDesignerThreadAffinity}
    function GetThreadAffinity: TThreadAffinity;
{$ENDIF}
  end;

procedure ShowFieldsEditorEh(Designer: IDesigner; ADataset: TDataset;
  DesignerClass: TDSDesignerClass);
function CreateFieldsEditorEh(Designer: IDesigner; ADataset: TDataset;
  DesignerClass: TDSDesignerClass; var Shared: Boolean): TFieldsEditor;

//function CreateUniqueName(Dataset: TDataset; const FieldName: string;
//  FieldClass: TFieldClass; Component: TComponent): string;

var
  MemTableFieldsEditor: TMemTableFieldsEditorEh;

procedure Register;

implementation

uses Clipbrd, MemTableEditEh, DataDriverEh, TypInfo,
  DBTables, bdeconst, BDEDataDriverEh,
{$IFDEF CIL}
  Borland.Vcl.Design.Updsqled,
  Borland.Vcl.Design.FldProp,
{$ELSE}
  Updsqled,
  DBReg,
  {$IFDEF EH_LIB_5}
  ADODataDriverEh,
  ADOReg,
  {$ENDIF}
{$ENDIF}

{$IFDEF EH_LIB_6}
  DBXDataDriverEh,
{$ENDIF}
  IBXDataDriverEh;

{$R *.dfm}

type
  TSQLCommandProperty  = class(TClassProperty)
  public
{$IFDEF EH_LIB_6}
    FCommandTextProp: IProperty;
{$ELSE}
    FCommandTextProp: TPropertyEditor;
{$ENDIF}
    function GetAttributes: TPropertyAttributes; override;
    procedure Edit; override;
{$IFDEF EH_LIB_6}
    procedure SetCommandTextProp(const Prop: IProperty);
{$ELSE}
    procedure SetCommandTextProp(Prop: TPropertyEditor);
{$ENDIF}
  end;

{ TSQLCommandProperty }

procedure TSQLCommandProperty.Edit;
var
  Command: TSQLCommandEh;
{$IFDEF EH_LIB_6}
  FSQLCommandSel: IDesignerSelections;
{$ELSE}
  FSQLCommandSel: TDesignerSelectionList;
{$ENDIF}
begin
  FCommandTextProp := nil;
{$IFDEF CIL}
  Command := TSQLCommandEh(GetObjValue);
{$ELSE}
  Command := TSQLCommandEh(GetOrdValue);
{$ENDIF}
{$IFDEF EH_LIB_6}
  FSQLCommandSel := CreateSelectionList;
  FSQLCommandSel.Add(Command);
  GetComponentProperties(FSQLCommandSel, [tkClass], Designer, SetCommandTextProp, nil);
  if FCommandTextProp <> nil then
    FCommandTextProp.Edit;
{$ELSE}
  FSQLCommandSel := TDesignerSelectionList.Create;
  FSQLCommandSel.Add(Command);
  GetComponentProperties(FSQLCommandSel, [tkClass], Designer, SetCommandTextProp);
  if FCommandTextProp <> nil then
    FCommandTextProp.Edit;
{$ENDIF}
end;

function TSQLCommandProperty.GetAttributes: TPropertyAttributes;
begin
  Result := inherited GetAttributes + [paDialog];
end;

{$IFDEF EH_LIB_6}
procedure TSQLCommandProperty.SetCommandTextProp(const Prop: IProperty);
{$ELSE}
procedure TSQLCommandProperty.SetCommandTextProp(Prop: TPropertyEditor);
{$ENDIF}
begin
  if Prop.GetName = 'CommandText' then
    FCommandTextProp := Prop;
end;

{ Utility functions }

procedure ShowFieldsEditorEh(Designer: IDesigner; ADataset: TDataset;
  DesignerClass: TDSDesignerClass);
var
  FieldsEditor: TFieldsEditor;
  vShared: Boolean;
begin
  FieldsEditor := CreateFieldsEditorEh(Designer, ADataSet, DesignerClass, vShared);
  if FieldsEditor <> nil then
    FieldsEditor.Show;
end;

function CreateFieldsEditorEh(Designer: IDesigner; ADataset: TDataset;
  DesignerClass: TDSDesignerClass; var Shared: Boolean): TFieldsEditor;
begin
  Shared := True;
  if ADataset.Designer <> nil then
  begin
    Result := (ADataset.Designer as TDSDesigner).FieldsEditor;
  end
  else
  begin
    Result := TMemTableFieldsEditorEh.Create(Application);
    Result.DSDesignerClass := DesignerClass;
{$IFDEF EH_LIB_6}
    Result.Designer := Designer;
{$ELSE}
    Result.Designer := IFormDesigner(Designer);
    Result.Form := Designer.Form;
{$ENDIF}
    Result.Dataset := ADataset;
    Shared := False;
  end;
end;

{ TMTDesigner }

type

  TMTDesigner = class(TDSDesigner)
  public
    function SupportsAggregates: Boolean; override;
    function SupportsInternalCalc: Boolean; override;
  end;

{ TMTDesigner }

function TMTDesigner.SupportsAggregates: Boolean;
begin
  Result := True;
end;

function TMTDesigner.SupportsInternalCalc: Boolean;
begin
  Result := True;
end;

{ TDataSetEditor }

function TMemTableEditorEh.GetDSDesignerClass: TDSDesignerClass;
begin
  Result := TMTDesigner;
end;

procedure TMemTableEditorEh.ExecuteVerb(Index: Integer);
begin
  case Index of
    0:
      ShowFieldsEditorEh(Designer, TDataSet(Component), GetDSDesignerClass);
    1:
      begin
        TCustomMemTableEh(Component).FetchParams;
        Designer.Modified;
      end;
    2: if EditMemTable(TCustomMemTableEh(Component), Designer)
         then Designer.Modified;

//    3: ;
      //if LoadFromFile(TClientDataSet(Component))
      //  then Designer.Modified;
  else
    if TDataSet(Component).Active then
      case Index of
//        4: ;//SaveToFile(TClientDataSet(Component) {$IFDEF EH_LIB_6},dfXML{$ENDIF} );
//        5: ;//SaveToFile(TClientDataSet(Component) {$IFDEF EH_LIB_6},dfXMLUTF8{$ENDIF} );
//        6: ;//SaveToFile(TClientDataSet(Component) {$IFDEF EH_LIB_6},dfBinary{$ENDIF} );
        3:
          begin
            TCustomMemTableEh(Component).Close;
            TCustomMemTableEh(Component).FieldDefs.Clear;
            Designer.Modified;
          end;
      end
    else if ((TDataSet(Component).FieldCount > 0) or
             (TDataSet(Component).FieldDefs.Count > 0)) and
            not TDataSet(Component).Active
    then
      case Index of
        3:
          begin
            TCustomMemTableEh(Component).CreateDataSet;
            Designer.Modified;
          end;
      end
  end;
end;

function TMemTableEditorEh.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := 'Fields Editor...';
    1: Result := 'Fetch Params';
    2: Result := 'Assign Local Data...';
//    3: Result := 'Load from MyBase table...';
  else
    if TDataSet(Component).Active then
      case Index of
//        4: Result := 'Save to MyBase Xml table...';
//        5: Result := 'Save to MyBase Xml UTF8 table...';
//        6: Result := 'Save to binary MyBase table...';
        3: Result := 'Clear Data';
      end