rmd_dbwrap.pas

来自「report machine 2.3 功能强大」· PAS 代码 · 共 871 行 · 第 1/2 页

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

unit RMD_DBWrap;

interface

{$I RM.inc}

uses
  Classes, SysUtils, Controls, Forms, Menus, DB, RM_Class, RM_DBSet, RM_Pars
{$IFDEF Delphi6}, 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(TRMNonVisualControl)
  private
    FDataSet: TDataSet;
    procedure P1Click(Sender: TObject);
    procedure SetDataSet(Value: TDataSet);
    function GetDatabaseName: string;
    procedure SetDatabaseName(const Value: string);
  protected
		FCanBrowse: Boolean;
  	FHaveFilter: Boolean;
    FDataSource: TDataSource;
    FDBDataSet: TRMDBDataset;
    procedure FieldsEditor(Sender: TObject);
    procedure SetPropValue(Index: string; Value: Variant); override;
    function GetPropValue(Index: string): Variant; override;
    function DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant; override;

    function GetDatabases: string; virtual; abstract;  //获取数据库列表
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure DefineProperties; override;
    procedure Loaded; override;
    procedure ShowEditor; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefinePopupMenu(Popup: TPopupMenu); override;

    property DataSet: TDataSet read FDataSet write SetDataSet;
    property DatabaseName: string read GetDatabaseName write SetDatabaseName;
  published
  end;

 { TRMDTable }
  TRMDTable = class(TRMDDataSet)
  private
    procedure JoinEditor(Sender: TObject);
  protected
    function GetTableNames: string; virtual; abstract; //获取表列表
    procedure GetIndexNames(sl: TStrings); virtual; abstract; //获取索引列表
  public
    procedure DefineProperties; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure Loaded; override;
  published
  end;

  { TRMDQuery }
  TRMDQuery = class(TRMDDataSet)
  private
    FEditSQLAsText: Boolean;
    FVisualSQL: TStringList;
    FParamCount: Integer;
    FOnSQLTextChanged: TNotifyEvent;
    procedure SQLEditor(Sender: TObject);
    procedure ParamsEditor(Sender: TObject);
    function GetParamCount: Integer;
    function GetSQL: string;
    procedure SetSQL(aSql: string);
  protected
    FParams: TRMVariables;
    procedure OnBeforeOpenQueryEvent(DataSet: TDataSet); virtual;

    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 DefineProperties; override;
    procedure Loaded; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    function ParamIndex(const ParName: string): Integer;

    property EditSQLAsText: Boolean read FEditSQLAsText write FEditSQLAsText;
    property SQL: string read GetSQL write SetSQL;
    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;
   published
  end;

function RMFindFieldDef(DataSet: TDataSet; FieldName: string): TFieldDef;
function RMGetDataSetName(Owner: TComponent; d: TDataSource): string;
function RMGetDataSource(Owner: TComponent; d: TDataSet): TDataSource;

implementation

uses RM_Const, RM_Utils, RMD_DBFldEditor, RMD_md, RMD_QueryParm, RMD_QryDesigner,
  RMD_DataPrv, RM_DCtrl, RM_DBCtrls;

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
  sl := TStringList.Create;
  Result := nil;
  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;
  sl.Free;
end;


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

constructor TRMDDataset.Create;
begin
  inherited Create;
  FDataSource := TDataSource.Create(RMDialogForm);
  FDataSource.DataSet := nil;

  FDBDataSet := TRMDBDataSet.Create(RMDialogForm);
  FDBDataSet.DataSource := FDataSource;

  Flags := Flags or flDontUndo;
  FCanBrowse := True;
	FHaveFilter := True;
end;

destructor TRMDDataset.Destroy;
begin
	if Assigned(RMDialogForm) then
  begin
	  FDBDataset.Free;
  	FDataSource.Free;
	  FDataSet.Free;
  end;
  inherited Destroy;
end;

procedure TRMDDataset.DefineProperties;
begin
  inherited DefineProperties;
  AddProperty('Active', [rmdtBoolean], nil);
  AddEnumProperty('Database', GetDatabases, [Null]);
  AddProperty('Fields', [rmdtHasEditor, rmdtOneObject], FieldsEditor);
  AddProperty('FieldCount', [], nil);
	if FHaveFilter then
	  AddProperty('Filter', [rmdtString], nil);
  AddProperty('EOF', [], nil);
  AddProperty('RecordCount', [], nil);
{$IFNDEF Delphi2}
  AddProperty('IsEmpty', [], nil);
{$ENDIF}
end;

procedure TRMDDataset.SetPropValue(Index: string; Value: Variant);
var
	d: TComponent;
  ds: TDataSource;
begin
  inherited SetPropValue(Index, Value);
  Index := AnsiUpperCase(Index);
  if Index = 'NAME' then
  begin
    FDataSource.Name := 'S' + FDataSet.Name;
    FDBDataSet.Name := '_' + FDataSet.Name;
  end
  else if Index = 'ACTIVE' then
  begin
		if Boolean(Value) and (Self is TRMDQuery) then
    begin
	    d := RMFindComponent(FDataSet.Owner, Prop['DataSource']);
      if d <> nil then
      begin
	  	  ds := RMGetDataSource(FDataSet.Owner, TDataSet(d));
	      if (ds <> nil) and (ds.DataSet <> nil) then
  	    	ds.DataSet.Open;
      end;
		end;
    FDataSet.Active := Value;
  end
  else if Index = 'FILTER' then
  begin
    FDataSet.Filter := Value;
    FDataSet.Filtered := Trim(Value) <> '';
  end;
end;

function TRMDDataset.GetPropValue(Index: string): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'ACTIVE' then
    Result := FDataSet.Active
  else if Index = 'FILTER' then
    Result := FDataSet.Filter
  else if Index = 'EOF' then
    Result := FDataSet.Eof
  else if Index = 'RECORDCOUNT' then
    Result := FDataSet.RecordCount
  else if Index = 'FIELDCOUNT' then
    Result := FDataSet.FieldCount
{$IFNDEF Delphi2}
  else if Index = 'ISEMPTY' then
    Result := FDataSet.IsEmpty
{$ENDIF}
end;

function TRMDDataset.DoMethod(const MethodName: string; Par1, Par2, Par3: Variant): Variant;
var
	d: TComponent;
  ds: TDataSource;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if MethodName = 'GETINDEXPROPERTY' then
  begin
    if Par1 = 'FIELDS' then
      Result := FDataSet.FieldByName(Par2).AsVariant;
  end
  else if MethodName = 'OPEN' then
  begin
		if Self is TRMDQuery then
    begin
	    d := RMFindComponent(FDataSet.Owner, Prop['DataSource']);
      if d <> nil then
      begin
	  	  ds := RMGetDataSource(FDataSet.Owner, TDataSet(d));
	      if (ds <> nil) and (ds.DataSet <> nil) then
  	    	ds.DataSet.Open;
      end;
    end;
    FDataSet.Open;
  end
  else if MethodName = 'CLOSE' then
    FDataSet.Close
  else if MethodName = 'NEXT' then
    FDataSet.Next
  else if MethodName = 'PRIOR' then
    FDataSet.Prior
  else if MethodName = 'FIRST' then
    FDataSet.First
  else if MethodName = 'LAST' then
    FDataSet.Last;
end;

function TRMDDataset.GetDatabaseName: string;
begin
  Result := Prop['Database'];
end;

procedure TRMDDataset.SetDatabaseName(const Value: string);
begin
  Prop['Database'] := Value;
end;

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

procedure TRMDDataset.Loaded;
var
  i: Integer;
  s: string;
  ds: TDataSet;
  f: TField;
begin
  try
    for i := 0 to FFixupList.Count - 1 do
    begin
      s := FFixupList.Name[i];
      if s[1] = '.' then // lookup field
      begin
        f := FDataSet.FindField(Copy(s, 2, 255));
        ds := RMFindComponent(FDataSet.Owner, FFixupList.Value[i]) as TDataSet;
        f.LookupDataset := ds;
      end
    end;
    Prop['Active'] := FFixupList['Active'];
  except;
  end;
  FFixupList.Clear;
end;

procedure TRMDDataset.ShowEditor;
begin
  FieldsEditor(nil);
end;

procedure TRMDDataset.FieldsEditor(Sender: TObject);
var
  SaveActive: Boolean;
  tmpForm: TRMDFieldsEditorForm;
begin
  SaveActive := FDataSet.Active;
  FDataSet.Close;

  tmpForm := TRMDFieldsEditorForm.Create(nil);
  tmpForm.DataSet := FDataSet;
  tmpForm.ShowModal;
  tmpForm.Free;

  RMDesigner.BeforeChange;
  FDataSet.Active := SaveActive;
end;

procedure TRMDDataset.LoadFromStream(Stream: TStream);

  procedure LoadFields;
  var
    i: Integer;
    n: Word;
    s: string;
    Field: TField;
    ds1: TDataset;
    fName: string;
    fType: TFieldType;
    fLookup: Boolean;
    fSize: Word;
    fDefs: TFieldDefs;
  begin
    fDefs := FDataSet.FieldDefs;
    Stream.Read(n, 2); // FieldCount
    for i := 0 to n - 1 do
    begin
      fType := TFieldType(RMReadByte(Stream)); // DataType
      fName := RMReadString(Stream); // FieldName
      fLookup := RMReadBoolean(Stream); // Lookup
      fSize := RMReadWord(Stream); // Size

      fDefs.Add(fName, fType, fSize, False);
      Field := fDefs[fDefs.Count - 1].CreateField(FDataSet);
      if fLookup then
      begin
        with Field do
        begin
          Lookup := True;
          KeyFields := RMReadString(Stream); // KeyFields
          s := RMReadString(Stream); // LookupDataset
          ds1 := RMFindComponent(FDataSet.Owner, s) as TDataSet;
          FFixupList['.' + FieldName] := s;
          LookupDataset := ds1;
          LookupKeyFields := RMReadString(Stream); // LookupKeyFields
          LookupResultField := RMReadString(Stream); // LookupResultField
        end;
      end;
    end;