rmd_halcyon.pas

report machine 2.3 功能强大

{*****************************************}
{                                         }
{            Report Machine 2.0           }
{           Wrapper for Halcyon           }
{                                         }
{*****************************************}

unit RMD_Halcyon;

interface

{$I RM.INC}
{$IFDEF DM_Halcyon}
uses
  Classes, SysUtils, Forms, ExtCtrls, DB, Dialogs, Controls, StdCtrls,
  RM_Class, RMD_DBWrap, Halcn6DB
{$IFDEF Delphi6}, Variants{$ENDIF};

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

 { TRMDHalcyonTable }
  TRMDHalcyonTable = class(TRMDTable)
  private
    FTable: THalcyonDataSet;
    procedure PropEditor(Sender: TObject);
  protected
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;

    function GetDatabases: string; override;
    function GetTableNames: string; override;
    procedure GetIndexNames(sl: TStrings); override;
  public
    constructor Create; override;
    procedure DefineProperties; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
  end;

{$ENDIF}

implementation

{$IFDEF DM_Halcyon}
uses FileCtrl, RM_Const, RM_CmpReg, RM_utils;

{$R RMD_Halcyon.RES}
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDHalcyonTable}

constructor TRMDHalcyonTable.Create;
begin
  inherited Create;
  FTable := THalcyonDataSet.Create(RMDialogForm);
  DataSet := FTable;

  Component := FTable;
  BaseName := 'HalcyonTable';
  Bmp.LoadFromResourceName(hInstance, 'RMD_HalcyonTABLE');
end;

function TRMDHalcyonTable.GetDatabases: string;
begin
  Result := FTable.DatabaseName;
end;

procedure TRMDHalcyonTable.GetIndexNames(sl: TStrings);
var
  i: integer;
begin
  sl.Clear;
  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 TRMDHalcyonTable.GetTableNames: string;
var
  i: Integer;
  sl: TStringList;

begin
  Result := '';
  sl := TStringList.Create;
  try
    try
      FTable.GetTableNames(sl);
      sl.Sort;
      for i := 0 to sl.Count - 1 do
        Result := Result + sl[i] + ';';
    except
    end;
  finally
    sl.Free;
  end;
end;

procedure TRMDHalcyonTable.DefineProperties;
var
  p: PRMPropRec;
begin
  inherited DefineProperties;
  AddProperty('EncryptionKey', [rmdtString], nil);
  p := PropRec['Database'];
  p.PropType := [rmdtString, rmdtHasEditor];
  p.PropEditor := PropEditor;
end;

procedure TRMDHalcyonTable.SetPropValue(Index: string; Value: Variant);
var
  d: TComponent;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'INDEXNAME' then
    FTable.IndexName := Value
  else if Index = 'MASTERSOURCE' then
  begin
    d := RMFindComponent(FTable.Owner, Value);
    FTable.MasterSource := RMGetDataSource(FTable.Owner, TDataSet(d));
  end
  else if Index = 'MASTERFIELDS' then
    FTable.MasterFields := Value
  else if Index = 'TABLENAME' then
  begin
    FTable.Close;
    FTable.TableName := Value;
  end
  else if (index = 'DATABASE') or (index = 'DATABASENAME') then
  begin
    FTable.Close;
    FTable.DatabaseName := Value;
  end
  else if index = 'ENCRYPTIONKEY' then
  begin
    FTable.Close;
    FTable.EncryptionKey := Value;
  end
end;

function TRMDHalcyonTable.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'INDEXNAME' then
    Result := FTable.IndexName
  else if Index = 'MASTERSOURCE' then
    Result := RMGetDataSetName(FTable.Owner, FTable.MasterSource)
  else if Index = 'MASTERFIELDS' then
    Result := FTable.MasterFields
  else if Index = 'TABLENAME' then
    Result := FTable.TableName
  else if (Index = 'DATABASE') or (Index = 'DATABASENAME') then
    Result := FTable.DatabaseName
  else if index = 'ENCRYPTIONKEY' then
    Result := FTable.EncryptionKey
end;

procedure TRMDHalcyonTable.LoadFromStream(Stream: TStream);
var
  SaveActive: Boolean;
begin
  inherited LoadFromStream(Stream);
  SaveActive := FTable.Active;
  FTable.Active := FALSE;
  FTable.EncryptionKey := RMReadString(Stream);
  FTable.Active := SaveActive;
end;

procedure TRMDHalcyonTable.SaveToStream(Stream: TStream);
begin
	LVersion := 0;
  inherited SaveToStream(Stream);
  RMWriteString(Stream, FTable.EncryptionKey);
end;

procedure TRMDHalcyonTable.PropEditor(Sender: TObject);
var
  str: string;
  i: integer;
  t: TRMView;
begin
  if SelectDirectory('选择文件夹', '', str) then
  begin
    RMDesigner.BeforeChange;
    for i := 0 to RMDesigner.Page.Objects.Count - 1 do
    begin
      t := RMDesigner.Page.Objects[i];
      if (t.Selected) and (t is TRMDHalcyonTable) then
        TRMDHalcyonTable(t).FTable.DatabaseName := str;
    end;
    RMDesigner.AfterChange;
  end;
end;

initialization
  RMRegisterControl(TRMDHalcyonTable, 'RMD_HalcyonTABLE', RMLoadStr(SInsertTable));

finalization

{$ENDIF}
end.