rmd_diamond.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{           Report Machine 2.0           }
{       Wrapper for Diamond Access        }
{                                         }
{*****************************************}

unit RMD_Diamond;

interface

{$I RM.INC}
{$IFDEF DM_Diamond}
uses
  Classes, SysUtils, Forms, ExtCtrls, DB, DAODatabase, DAODataset, DAOMDTable,
  DAOQuery, DAOTable, DAOTlb, Dialogs, Controls, StdCtrls, RM_Class, RMD_DBWrap
{$IFDEF Delphi6}, Variants{$ENDIF};

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

  TRMDDiamondDatabase = class(TRMNonVisualControl)
  private
    FDatabase: TDAODatabase;
    procedure PropEditor(Sender: TObject);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    procedure ShowEditor; override;
    property Database: TDAODatabase read FDatabase;
  end;

 { TRMDDiamondTable }
  TRMDDiamondTable = class(TRMDTable)
  private
    FTable: TDAOMasterDetailTable;
  protected
    function GetDatabases: string; override;
    function GetTableNames: string; override;

    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
  public
    constructor Create; override;
    procedure GetIndexNames(sl: TStrings); override;
    procedure DefineProperties; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  end;

  { TRMDDiamondQuery }
  TRMDDiamondQuery = class(TRMDQuery)
  private
    FQuery: TDAOQuery;
  protected
    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;

    function GetDatabases: string; override;
    procedure GetTableNames(DB: string; Strings: TStrings); override;

    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;
  public
    constructor Create; override;
    procedure GetTableFieldNames(const DB, TName: string; sl: TStrings); override;
    procedure DefineProperties; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  published
  end;

{$ENDIF}

implementation

{$IFDEF DM_Diamond}
uses RM_Const, RM_CmpReg, RM_utils;

{$R RMD_Diamond.RES}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDiamondDatabase}

constructor TRMDDiamondDatabase.Create;
begin
  inherited Create;
  FDatabase := TDAODatabase.Create(RMDialogForm);
  Component := FDatabase;
  BaseName := 'DAODatabase';
  Bmp.LoadFromResourceName(hInstance, 'RMD_DiamondDB');
  Flags := Flags or flDontUndo;

  RMConsts['Dao35'] := Dao35;
  RMConsts['Dao36'] := Dao36;
end;

destructor TRMDDiamondDatabase.Destroy;
begin
	if Assigned(RMDialogForm) then
	  FDatabase.Free;
  inherited Destroy;
end;

procedure TRMDDiamondDatabase.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Connected', [rmdtBoolean], nil);
  AddProperty('DatabaseName', [rmdtString, rmdtHasEditor], PropEditor);
  AddProperty('Password', [rmdtString], nil);
  AddProperty('UserName', [rmdtString], nil);
  AddEnumProperty('DAOVersion',
    'Dao35;Dao36', [Dao35, Dao36]);
end;

procedure TRMDDiamondDatabase.SetPropValue(Index: string; Value: Variant);
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'DATABASENAME' then
    FDatabase.DatabaseName := Value
  else if Index = 'CONNECTED' then
    FDatabase.Connected := Value
  else if Index = 'USERNAME' then
    FDatabase.Workspace.UserName := Value
  else if Index = 'PASSWORD' then
    FDatabase.Workspace.Password := Value
  else if Index = 'DAOVERSION' then
    FDatabase.DaoVersion := Value
end;

function TRMDDiamondDatabase.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'DATABASENAME' then
    Result := FDatabase.DatabaseName
  else if Index = 'CONNECTED' then
    Result := FDatabase.Connected
  else if Index = 'USERNAME' then
    Result := FDatabase.Workspace.UserName
  else if Index = 'PASSWORD' then
    Result := FDatabase.Workspace.Password
  else if Index = 'DAOVERSION' then
    Result := FDatabase.DAOVersion
end;

procedure TRMDDiamondDatabase.LoadFromStream(Stream: TStream);
begin
  inherited LoadFromStream(Stream);
  FDatabase.DatabaseName := RMReadString(Stream);
  FDatabase.DAOVersion := TDAOVersion(RMReadByte(Stream));
  FDatabase.Workspace.UserName := RMReadString(Stream);
  FDatabase.Workspace.Password := RMReadString(Stream);
  FDatabase.Connected := RMReadBoolean(Stream);
end;

procedure TRMDDiamondDatabase.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteString(Stream, FDatabase.DatabaseName);
  RMWriteByte(Stream, Byte(FDatabase.DAOVersion));
  RMWriteString(Stream, FDatabase.Workspace.UserName);
  RMWriteString(Stream, FDatabase.Workspace.Password);
  RMWriteBoolean(Stream, FDatabase.Connected);
end;

procedure TRMDDiamondDatabase.ShowEditor;
begin
  PropEditor(nil);
end;

procedure TRMDDiamondDatabase.PropEditor(Sender: TObject);
var
  OpenDialog: TOpenDialog;
begin
  OpenDialog := TOpenDialog.Create(nil);
  OpenDialog.Filter := '*.MDB|*.MDB';
  try
    if OpenDialog.Execute then
    begin
      FDatabase.DatabaseName := OpenDialog.FileName;
    end;
  finally
    OpenDialog.Free;
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDiamondTable}

constructor TRMDDiamondTable.Create;
begin
  inherited Create;
  FTable := TDAOMasterDetailTable.Create(RMDialogForm);
  DataSet := FTable;

  Component := FTable;
  BaseName := 'DAOMasterDetailTable';
  Bmp.LoadFromResourceName(hInstance, 'RMD_DiamondTABLE');
end;

function TRMDDiamondTable.GetDatabases: string;
var
  i: Integer;
  sl: TStringList;
begin
  Result := '';
  sl := TStringList.Create;
  RMGetComponents(RMDialogForm, TDAODatabase, sl, nil);
  sl.Sort;
  for i := 0 to sl.Count - 1 do
    Result := Result + sl[i] + ';';
  sl.Free;
end;

procedure TRMDDiamondTable.GetIndexNames(sl: TStrings);
begin
  sl.Clear;
{  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;
}
end;

function TRMDDiamondTable.GetTableNames: string;
var
  i: Integer;
  sl: TStringList;
begin
  Result := '';
  if FTable.Database <> nil then
  begin
    sl := TStringList.Create;
    try
      try
        FTable.Database.GetTableNames(sl);
        sl.Sort;
        for i := 0 to sl.Count - 1 do
          Result := Result + sl[i] + ';';
      except
      end;
    finally
      sl.Free;
    end;
  end;
end;

procedure TRMDDiamondTable.DefineProperties;
begin
  inherited DefineProperties;
end;

procedure TRMDDiamondTable.SetPropValue(Index: string; Value: Variant);
var
  d: TComponent;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'INDEXNAME' then
    FTable.IndexFieldNames := Value //FTable.IndexName := Value
  else if Index = 'MASTERSOURCE' then
  begin
    d := RMFindComponent(FTable.Owner, Value);
    FTable.MasterSource := RMGetDataSource(FTable.Owner, TDataSet(d));