rmd_dbx.pas

这是一个功能强大

{*****************************************}
{                                         }
{           Report Machine v2.0           }
{             Wrapper for Dbx             }
{                                         }
{*****************************************}

unit RMD_Dbx;

interface

{$I RM.INC}

{$IFDEF DM_DBX}
uses
  Windows, Classes, SysUtils, Forms, Dialogs, ExtCtrls, StdCtrls, Controls, DB,
  SqlExpr, RM_Class, RMD_DBWrap
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants, ValEdit, Menus{$ENDIF}
{$IFDEF COMPILER7_UP}, SimpleDS{$ELSE}, DBLocalS{$ENDIF};

type
  TRMDDBXComponents = class(TComponent) // fake component
  end;

 { TRMDDBXDatabase }
  TRMDDBXDatabase = class(TRMDialogComponent)
  private
    FDatabase: TSQLConnection;

    function GetConnected: Boolean;
    procedure SetConnected(Value: Boolean);
    function GetConnectionName: string;
    procedure SetConnectionName(Value: string);
    function GetDriverName: string;
    procedure SetDriverName(Value: string);
    function GetLoginPrompt: Boolean;
    procedure SetLoginPrompt(Value: Boolean);
    function GetParams: string;
    procedure SetParams(Value: string);
  protected
    procedure AfterChangeName; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure ShowEditor; override;
  published
    property Database: TSQLConnection read FDatabase;
    property Connected: Boolean read GetConnected write SetConnected;
    property ConnectionName: string read GetConnectionName write SetConnectionName;
    property DriverName: string read GetDriverName write SetDriverName;
    property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt;
    property Params: string read GetParams write SetParams;
  end;

 { TRMDDBXTable }
  TRMDDBXTable = class(TRMDTable)
  private
    FTable: TSQLTable;
  protected
    function GetTableName: string; override;
    procedure SetTableName(Value: string); override;
    function GetFilter: string; override;
    procedure SetFilter(Value: string); override;
    function GetIndexName: string; override;
    procedure SetIndexName(Value: string); override;
    function GetMasterFields: string; override;
    procedure SetMasterFields(Value: string); override;
    function GetMasterSource: string; override;
    procedure SetMasterSource(Value: string); override;
    function GetDatabaseName: string; override;
    procedure SetDatabaseName(const Value: string); override;
    procedure GetIndexNames(sl: TStrings); override;
    function GetIndexFieldNames: string; override;
    procedure SetIndexFieldNames(Value: string); override;

    function GetIndexDefs: TIndexDefs; override;
  public
    constructor Create; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
	published
    property IndexName;
  end;

  { TRMDDBXQuery}
  TRMDDBXQuery = class(TRMDQuery)
  private
{$IFDEF COMPILER7_UP}
    FQuery: TSimpleDataSet;
{$ELSE}
    FQuery: TSQLClientDataSet;
{$ENDIF}

    procedure OnSQLTextChangedEvent(Sender: TObject);
  protected
    function GetParamCount: Integer; override;
    function GetSQL: string; override;
    procedure SetSQL(Value: string); override;
    function GetFilter: string; override;
    procedure SetFilter(Value: string); override;
    function GetDatabaseName: string; override;
    procedure SetDatabaseName(const Value: string); override;
    function GetDataSource: string; override;
    procedure SetDataSource(Value: string); override;

    function GetParamName(Index: Integer): string; override;
    function GetParamType(Index: Integer): TFieldType; override;
    procedure SetParamType(Index: Integer; Value: TFieldType); override;
    function GetParamKind(Index: Integer): TRMParamKind; override;
    procedure SetParamKind(Index: Integer; Value: TRMParamKind); override;
    function GetParamText(Index: Integer): string; override;
    procedure SetParamText(Index: Integer; Value: string); override;
    function GetParamValue(Index: Integer): Variant; override;
    procedure SetParamValue(Index: Integer; Value: Variant); override;

    procedure GetDatabases(sl: TStrings); override;
    procedure GetTableNames(DB: string; Strings: TStrings); override;
    procedure GetTableFieldNames(const DB, TName: string; sl: TStrings); override;
  public
    constructor Create; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
  published
  	property DataSource;
  end;

  { TDBEditForm }
  TRMDFormDbxDBProp = class(TForm)
    btnOK: TButton;
    btnCancel: TButton;
    StringEditorMenu: TPopupMenu;
    LoadItem: TMenuItem;
    SaveItem: TMenuItem;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    procedure btnOKClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure LoadItemClick(Sender: TObject);
    procedure SaveItemClick(Sender: TObject);
  private
    FValueListEditor: TValueListEditor;

    procedure Localize;
  end;
{$ENDIF}

implementation

{$IFDEF DM_DBX}
{$R *.DFM}
{$R RMD_DBX.RES}

uses RM_Utils, RM_Common, RM_Const, RM_PropInsp, RM_Insp;

type
  THackSQLConnection = class(TSQLConnection)
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDBXDatabase}

constructor TRMDDBXDatabase.Create;
begin
  inherited Create;
  BaseName := 'DBXDatabase';
  FBmpRes := 'RMD_DBXDB';

  FDatabase := TSQLConnection.Create(RMDialogForm);
  THackSQLConnection(FDataBase).SetDesigning(True, False);
  DontUndo := True;
  FComponent := FDatabase;
end;

destructor TRMDDBXDatabase.Destroy;
begin
  if Assigned(RMDialogForm) then
  begin
    FDatabase.Free;
    FDatabase := nil;
  end;
  inherited Destroy;
end;

procedure TRMDDBXDatabase.AfterChangeName;
begin
  FDatabase.Name := Name;
end;

procedure TRMDDBXDatabase.LoadFromStream(aStream: TStream);
var
  lVersion: Integer;
  lStr: string;
{$IFDEF COMPILER10_UP}
  lStrList: TStringList;
{$ENDIF}
begin
  inherited LoadFromStream(aStream);
  lVersion := RMReadWord(aStream);
  FDatabase.ConnectionName := RMReadString(aStream);
  lStr := RMReadString(aStream);
  if lStr <> '' then
    FDatabase.DriverName := lStr;
  FDatabase.LoginPrompt := RMReadBoolean(aStream);

  if lVersion >= 1 then
  begin
    FDatabase.Params.Text := RMReadWideString(aStream);
  end
  else
  begin
  {$IFDEF COMPILER10_UP}
    lStrList := TStringList.Create;
    RMReadMemo(aStream, lStrList);
    FDatabase.Params.Assign(lStrList);
    lStrList.Free;
  {$ELSE}
    RMReadMemo(aStream, FDatabase.Params);
  {$ENDIF}
  end;

  FDatabase.Connected := RMReadBoolean(aStream);
end;

procedure TRMDDBXDatabase.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 1);
  RMWriteString(aStream, FDatabase.ConnectionName);
  RMWriteString(aStream, FDatabase.DriverName);
  RMWriteBoolean(aStream, FDatabase.LoginPrompt);
  RMWriteWideString(aStream, FDatabase.Params.Text);
  RMWriteBoolean(aStream, FDatabase.Connected);
end;

procedure TRMDDBXDatabase.ShowEditor;
var
  tmp: TRMDFormDbxDBProp;
  SaveConnected: Boolean;
begin
  tmp := TRMDFormDbxDBProp.Create(nil);
  try
    tmp.FValueListEditor.Strings.Assign(FDatabase.Params);
    if tmp.ShowModal = mrOk then
    begin
      RMDesigner.BeforeChange;
      SaveConnected := FDatabase.Connected;
      FDatabase.Connected := False;
      FDatabase.Params.Assign(tmp.FValueListEditor.Strings);
      FDatabase.Connected := SaveConnected;
      RMDesigner.AfterChange;
    end;
  finally
    tmp.Free;
  end;
end;

function TRMDDBXDatabase.GetConnected: Boolean;
begin
  Result := FDatabase.Connected;
end;

procedure TRMDDBXDatabase.SetConnected(Value: Boolean);
begin
  FDatabase.Connected := Value;
end;

function TRMDDBXDatabase.GetConnectionName: string;
begin
  Result := FDatabase.ConnectionName;
end;

procedure TRMDDBXDatabase.SetConnectionName(Value: string);
begin
  FDatabase.ConnectionName := Value;
end;

function TRMDDBXDatabase.GetDriverName: string;
begin
  Result := FDatabase.DriverName;
end;

procedure TRMDDBXDatabase.SetDriverName(Value: string);
begin
  FDatabase.DriverName := Value;
end;

function TRMDDBXDatabase.GetLoginPrompt: Boolean;
begin
  Result := FDatabase.LoginPrompt;
end;

procedure TRMDDBXDatabase.SetLoginPrompt(Value: Boolean);
begin
  FDatabase.LoginPrompt := Value;
end;

function TRMDDBXDatabase.GetParams: string;
begin
  Result := FDatabase.Params.Text;
end;

procedure TRMDDBXDatabase.SetParams(Value: string);
begin
  FDatabase.Params.Text := Value;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDBXTable}

constructor TRMDDBXTable.Create;
begin
  inherited Create;
  BaseName := 'DBXTable';
  FBmpRes := 'RMD_DBXTABLE';

  FCanBrowse := False;
  FHaveFilter := False;
  FTable := TSQLTable.Create(RMDialogForm);
  DataSet := FTable;
  FComponent := FTable;
end;

procedure TRMDDBXTable.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);
  RMReadWord(aStream);
end;

procedure TRMDDBXTable.SaveToStream(aStream: TStream);
begin
  inherited SaveToStream(aStream);
  RMWriteWord(aStream, 0);
end;

procedure TRMDDBXTable.GetIndexNames(sl: TStrings);
var
  i: integer;
begin
  try
    if (Length(FTable.TableName) > 0) and (FTable.IndexDefs <> nil) then
    begin
      FTable.IndexDefs.Update;
      for i := 0 to FTable.IndexDefs.Count - 1 do
      begin
        if FTable.IndexDefs[i].Name <> '' then
          sl.Add(FTable.IndexDefs[i].Name);
      end;
    end;
  except
  end;
end;

function TRMDDBXTable.GetIndexFieldNames: string;
begin
  Result := FTable.IndexFieldNames;
end;

procedure TRMDDBXTable.SetIndexFieldNames(Value: string);
begin
  FTable.IndexFieldNames := Value;
end;

function TRMDDBXTable.GetIndexDefs: TIndexDefs;
begin
  Result := FTable.IndexDefs;
end;

function TRMDDBXTable.GetDatabaseName: string;
begin
  Result := '';
  if FTable.SQLConnection <> nil then
  begin
    Result := FTable.SQLConnection.Name;
    if FTable.SQLConnection.Owner <> FTable.Owner then
      Result := FTable.SQLConnection.Owner.Name + '.' + Result;
  end;
end;

procedure TRMDDBXTable.SetDatabaseName(const Value: string);
var
  liComponent: TComponent;
begin
  FTable.Close;
  liComponent := RMFindComponent(FTable.Owner, Value);

  if (liComponent <> nil) and (liComponent is TSQLConnection) then
    FTable.SQLConnection := TSQLConnection(liComponent)
  else
    FTable.SQLConnection := nil;
end;

function TRMDDBXTable.GetTableName: string;
begin
  Result := FTable.TableName;
end;

procedure TRMDDBXTable.SetTableName(Value: string);
begin
  FTable.Active := False;
  FTable.TableName := Value;
end;

function TRMDDBXTable.GetFilter: string;
begin
  Result := FTable.Filter;
end;

procedure TRMDDBXTable.SetFilter(Value: string);
begin
  FTable.Active := False;
  FTable.Filter := Value;
  FTable.Filtered := Value <> '';
end;

function TRMDDBXTable.GetIndexName: string;
begin
  Result := FTable.IndexName;
end;

procedure TRMDDBXTable.SetIndexName(Value: string);
begin
  FTable.IndexName := Value;
end;

function TRMDDBXTable.GetMasterFields: string;
begin
  Result := FTable.MasterFields;
end;

procedure TRMDDBXTable.SetMasterFields(Value: string);
begin
  FTable.MasterFields := Value;
end;

function TRMDDBXTable.GetMasterSource: string;
begin
  Result := RMGetDataSetName(FTable.Owner, FTable.MasterSource)
end;

procedure TRMDDBXTable.SetMasterSource(Value: string);
var
  liComponent: TComponent;
begin
  liComponent := RMFindComponent(FTable.Owner, Value);
  if (liComponent <> nil) and (liComponent is TDataSet) then
    FTable.MasterSource := RMGetDataSource(FTable.Owner, TDataSet(liComponent))
  else
    FTable.MasterSource := nil;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDBXQuery}

type
{$IFDEF COMPILER7_UP}
  THackClientDataSet = class(TSimpleDataSet)
{$ELSE}
  THackClientDataSet = class(TSQLClientDataSet)
{$ENDIF}
  end;

constructor TRMDDBXQuery.Create;
begin
  inherited Create;
  BaseName := 'DBXQuery';
  FBmpRes := 'RMD_DBXQUERY';

{$IFDEF COMPILER7_UP}
  FQuery := TSimpleDataSet.Create(RMDialogForm);
  FQuery.DataSet.CommandType := ctQuery;
{$ELSE}
  FQuery := TSQLClientDataSet.Create(RMDialogForm);
  FQuery.CommandType := ctQuery;
{$ENDIF}
  OnSQLTextChanged := OnSQLTextChangedEvent;
  THackClientDataSet(FQuery).SetDesigning(True, False);
  DataSet := FQuery;
end;

procedure TRMDDBXQuery.LoadFromStream(aStream: TStream);
begin
  inherited LoadFromStream(aStream);