rmd_dbwrap.pas

这是一个功能强大

{*****************************************}
{                                         }
{           Report Machine v2.0           }
{        Wrapper for Table & Query        }
{                                         }
{*****************************************}

unit RMD_DBWrap;

interface

{$I RM.inc}

uses
  Windows, Classes, SysUtils, Controls, Forms, Menus, DB, RM_Class, RM_DataSet,
  RM_Parser, RM_Common, RM_Ctrls
{$IFDEF USE_INTERNAL_JVCL}, rm_JvInterpreter{$ELSE}, JvInterpreter{$ENDIF}
{$IFDEF COMPILER6_UP}, Variants{$ENDIF};

const
  RMFieldClasses: array[0..9] of TFieldClass = (
    TStringField, TSmallintField, TIntegerField, TWordField,
    TBooleanField, TFloatField, TCurrencyField, TDateField,
    TTimeField, TBlobField);

  RMParamTypes: array[0..10] of TFieldType = (
    ftBCD, ftBoolean, ftCurrency, ftDate, ftDateTime, ftInteger,
    ftFloat, ftSmallint, ftString, ftTime, ftWord);

type
  TRMParamKind = (rmpkValue, rmpkAssignFromMaster);

  { TRMDDataSet }
  TRMDDataSet = class(TRMDialogComponent)
  private
    procedure P1Click(Sender: TObject);

    procedure SetDataSet(Value: TDataSet);
  protected
    FIndexBased: Boolean;
    FCanBrowse: Boolean;
    FHaveFilter: Boolean;
    FDataSet: TDataSet;
    FDataSource: TDataSource;
    FRMDataSet: TRMDBDataset;
    FFixupList: TRMVariables;

  	procedure DBInternalLoaded; virtual;
    procedure AfterChangeName; override;

    function GetIndexDefs: TIndexDefs; virtual;
    function GetActive: Boolean; virtual;
    procedure SetActive(Value: Boolean); virtual;
    function GetTableName: string; virtual; abstract;
    function GetDatabaseName: string; virtual; abstract;
    procedure SetDatabaseName(const Value: string); virtual; abstract;

    procedure LoadFields(aStream: TStream);
    procedure SaveFields(aStream: TStream);

    function GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
      Args: array of Variant): Boolean; override;
    function SetPropValue(aObject: TObject; aPropName: string; aValue: Variant): Boolean; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure AfterLoaded; override;
    procedure ShowEditor; override;
    procedure DefinePopupMenu(aPopup: TRMCustomMenuItem); override;

    property DataSet: TDataSet read FDataSet write SetDataSet;
    property IndexBased: Boolean read FIndexBased;
    property IndexDefs: TIndexDefs read GetIndexDefs;
  published
    property Active: Boolean read GetActive write SetActive;
    property DatabaseName: string read GetDatabaseName write SetDatabaseName;
  end;

  { TRMDTable }
  TRMDTable = class(TRMDDataSet)
  private
  protected
    procedure SetTableName(Value: string); virtual; abstract;
    function GetFilter: string; virtual; abstract;
    procedure SetFilter(Value: string); virtual; abstract;
    function GetIndexName: string; virtual; abstract;
    procedure SetIndexName(Value: string); virtual; abstract;
    function GetIndexFieldNames: string; virtual; abstract;
    procedure SetIndexFieldNames(Value: string); virtual; abstract;
    function GetMasterFields: string; virtual; abstract;
    procedure SetMasterFields(Value: string); virtual; abstract;
    function GetMasterSource: string; virtual; abstract;
    procedure SetMasterSource(Value: string); virtual; abstract;

    procedure GetIndexNames(sl: TStrings); virtual; abstract; //获取索引列表
  public
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    procedure AfterLoaded; override;
    property IndexName: string read GetIndexName write SetIndexName;
  published
    property TableName: string read GetTableName write SetTableName;
    property Filter: string read GetFilter write SetFilter;
    property IndexFieldNames: string read GetIndexFieldNames write SetIndexFieldNames;
    property MasterFields: string read GetMasterFields write SetMasterFields;
    property MasterSource: string read GetMasterSource write SetMasterSource;
  end;

  { TRMDQuery }
  TRMDQuery = class(TRMDDataSet)
  private
    FUseSqlBuilder: Boolean;
    FVisualSQL: TStringList;
    FOnSQLTextChanged: TNotifyEvent;
    FParameters: string;
  protected
    FParams: TRMVariables;
    FParamCount: Integer;

    procedure Prepare; override;
    procedure OnBeforeOpenQueryEvent(DataSet: TDataSet); virtual;

    function GetFilter: string; virtual; abstract;
    procedure SetFilter(Value: string); virtual; abstract;
    function GetDataSource: string; virtual; abstract;
    procedure SetDataSource(Value: string); virtual; abstract;
    procedure GetDatabases(sl: TStrings); virtual; abstract; //获取数据库列表

    function GetParamCount: Integer; virtual; abstract;
    function GetSQL: string; virtual; abstract;
    procedure SetSQL(aSql: string); virtual; abstract;
    function GetParamName(Index: Integer): string; virtual; abstract;
    function GetParamType(Index: Integer): TFieldType; virtual; abstract;
    procedure SetParamType(Index: Integer; Value: TFieldType); virtual; abstract;
    function GetParamKind(Index: Integer): TRMParamKind; virtual; abstract;
    procedure SetParamKind(Index: Integer; Value: TRMParamKind); virtual; abstract;
    function GetParamText(Index: Integer): string; virtual; abstract;
    procedure SetParamText(Index: Integer; Value: string); virtual; abstract;
    function GetParamValue(Index: Integer): Variant; virtual; abstract;
    procedure SetParamValue(Index: Integer; Value: Variant); virtual; abstract;
    procedure GetTableNames(DB: string; Strings: TStrings); virtual; abstract;

    procedure GetTableFieldNames(const DB, TName: string; sl: TStrings); virtual; abstract; //获取表的字段名称列表
  public
    constructor Create; override;
    destructor Destroy; override;

    procedure AfterLoaded; override;
    procedure LoadFromStream(aStream: TStream); override;
    procedure SaveToStream(aStream: TStream); override;
    function ParamIndex(const ParName: string): Integer;

    property VisualSQL: TStringList read FVisualSQL write FVisualSQL;

    property ParamCount: Integer read GetParamCount;
    property ParamName[Index: Integer]: string read GetParamName; //取得参数的名称
    property ParamType[Index: Integer]: TFieldType read GetParamType write SetParamType; //取得(设置)参数类型
    property ParamKind[Index: Integer]: TRMParamKind read GetParamKind write SetParamKind; //取得(设置)参数初始化类型
    property ParamText[Index: Integer]: string read GetParamText write SetParamText; //取得(设置)参数初始化值
    property ParamValue[Index: Integer]: Variant read GetParamValue write SetParamValue; //取得(设置)参数值

    property OnSQLTextChanged: TNotifyEvent read FOnSQLTextChanged write FOnSQLTextChanged;
    property DataSource: string read GetDataSource write SetDataSource;
  published
    property UseSqlBuilder: Boolean read FUseSqlBuilder write FUseSqlBuilder;
    property Filter: string read GetFilter write SetFilter;
    property SQL: string read GetSQL write SetSQL;
    property Parameters: string read FParameters write FParameters;
  end;

function RMFindFieldDef(DataSet: TDataSet; FieldName: string): TFieldDef;
function RMGetDataSetName(Owner: TComponent; d: TDataSource): string;
function RMGetDataSource(Owner: TComponent; d: TDataSet): TDataSource;
procedure RMGetFieldNames(aDataSet: TDataSet; aList: TStrings);

implementation

uses RM_Const, RM_Utils, RMD_EditorField, RMD_Editorldlinks, RMD_DataPrv,
  RMD_QryDesigner, RMD_QueryParm, RM_Insp, RM_PropInsp, RM_DialogCtls;

{$R RMD_DBWrap.RES}

function RMFindFieldDef(DataSet: TDataSet; FieldName: string): TFieldDef;
var
  i: Integer;
begin
  Result := nil;
  with DataSet do
  begin
    for i := 0 to FieldDefs.Count - 1 do
    begin
      if AnsiCompareText(FieldDefs.Items[i].Name, FieldName) = 0 then
      begin
        Result := FieldDefs.Items[i];
        break;
      end;
    end;
  end;
end;

function RMGetDataSetName(Owner: TComponent; d: TDataSource): string;
begin
  Result := '';
  if (d <> nil) and (d.DataSet <> nil) then
  begin
    Result := d.Dataset.Name;
    if d.Dataset.Owner <> Owner then
      Result := d.Dataset.Owner.Name + '.' + Result;
  end;
end;

function RMGetDataSource(Owner: TComponent; d: TDataSet): TDataSource;
var
  i: Integer;
  sl: TStringList;
  ds: TDataSource;
begin
  Result := nil;
  sl := TStringList.Create;
  try
    RMGetComponents(Owner, TDataSource, sl, nil);
    for i := 0 to sl.Count - 1 do
    begin
      ds := RMFindComponent(Owner, sl[i]) as TDataSource;
      if (ds <> nil) and (ds.DataSet = d) then
      begin
        Result := ds;
        break;
      end;
    end;
  finally
    sl.Free;
  end;
end;

{$HINTS OFF}

procedure RMGetFieldNames(aDataSet: TDataSet; aList: TStrings);
var
  i: Integer;
begin
  try
    aDataSet.GetFieldNames(aList);
  except;
  end;
end;
{$HINTS ON}

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{TRMDDataset}

constructor TRMDDataset.Create;
begin
  inherited Create;

  FFixupList := TRMVariables.Create;
  FRMDataSet := TRMDBDataSet.Create(RMDialogForm);
  FDataSource := TDataSource.Create(RMDialogForm);
  FDataSource.DataSet := nil;

  FCanBrowse := True;
  FHaveFilter := True;
  DontUndo := True;
end;

destructor TRMDDataset.Destroy;
begin
  FFixupList.Free;
  if Assigned(RMDialogForm) then
  begin
    FRMDataSet.Free;
    FRMDataSet := nil;
    FDataSet.Free;
    FDataSet := nil;
    FDataSource.Free;
    FDataSource := nil;
  end;
  inherited Destroy;
end;

function TRMDDataset.GetPropValue(aObject: TObject; aPropName: string; var aValue: Variant;
  Args: array of Variant): Boolean;
begin
  Result := True;
  if aPropName = 'DATASET' then
  begin
    aValue := O2V(DataSet);
  end
  else
    Result := inherited GetPropValue(aObject, aPropName, aValue, Args);
end;

function TRMDDataset.SetPropValue(aObject: TObject; aPropName: string;
  aValue: Variant): Boolean;
begin
//  Result := True;
{  if aPropName = 'MEMO' then
    FMemo.Text := aValue
  else}
  Result := inherited SetPropValue(aObject, aPropName, aValue);
end;

procedure TRMDDataset.DBInternalLoaded;
begin
//
end;

procedure TRMDDataset.AfterChangeName;
begin
  FDataSource.Name := '_DS' + Name;
  FDataSet.Name := Name;
  FRMDataSet.Name := '_' + Name;
end;

function TRMDDataset.GetIndexDefs: TIndexDefs;
begin
  Result := nil;
end;

function TRMDDataset.GetActive: Boolean;
begin
  Result := FDataSet.Active;
end;

procedure TRMDDataset.SetActive(Value: Boolean);
begin
  FDataSet.Active := Value;
end;

procedure TRMDDataset.SetDataSet(Value: TDataSet);
begin
  if FDataSet <> Value then
  begin
    FDataSet := Value;
    FDataSource.DataSet := FDataSet;
    FRMDataSet.DataSet := FDataSet;
    if Self is TRMDQuery then
      FDataSet.BeforeOpen := TRMDQuery(Self).OnBeforeOpenQueryEvent;
  end;
end;

procedure TRMDDataset.AfterLoaded;
var
  i: Integer;
  s: string;
  liComponent: TComponent;
  liField: TField;
begin
  try
    for i := 0 to FFixupList.Count - 1 do
    begin
      s := FFixupList.Name[i];