fr_odacquery.pas

医院信息管理系统 后台采用ORACLE

//////////////////////////////////////////////////
//  FastReport v2.4 - ODAC components
//  Copyright (c) 2003 Core Lab. All right reserved.
//  Query component
//  Created:
//  Last modified:
//////////////////////////////////////////////////

unit FR_ODACQuery;

interface

{$I FR.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, StdCtrls, Controls, Forms,
  Menus, Dialogs, FR_Class, FR_Pars, DB, Ora, OraSmart, FR_ODACTable, FR_DBUtils;

type
  TfrODACQuery = class(TfrODACDataSet)
  private
    FQuery: TSmartQuery;
    FParams: TfrVariables;
    procedure SQLEditor(Sender: TObject);
    procedure ParamsEditor(Sender: TObject);
    procedure ReadParams(Stream: TStream);
    procedure WriteParams(Stream: TStream);
    function GetParamKind(Index: Integer): TfrParamKind;
    procedure SetParamKind(Index: Integer; Value: TfrParamKind);
    function GetParamText(Index: Integer): String;
    procedure SetParamText(Index: Integer; Value: String);
  protected
    procedure SetPropValue(Index: String; Value: Variant); override;
    function GetPropValue(Index: String): Variant; override;
    function DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant; override;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    procedure DefineProperties; override;
    procedure Loaded; override;
    property Query: TSmartQuery read FQuery;
    property ParamKind[Index: Integer]: TfrParamKind read GetParamKind write SetParamKind;
    property ParamText[Index: Integer]: String read GetParamText write SetParamText;
  end;

implementation

uses
  FR_Utils, FR_Const, FR_DBSQLEdit, EdSmart
{$IFDEF Delphi6}
, Variants
{$ENDIF};


{ TfrODACQuery }

constructor TfrODACQuery.Create;
begin
  inherited Create;
  FQuery := TSmartQuery.Create(frDialogForm);
  FQuery.ReadOnly:=true;
  FDataSet := FQuery;
  FDataSource.DataSet := FDataSet;

  FParams := TfrVariables.Create;

  Component := FQuery;
  BaseName := 'Query';
  Bmp.LoadFromResourceName(hInstance, 'FR_ODACQUERY');
end;

destructor TfrODACQuery.Destroy;
begin
  FParams.Free;
  inherited Destroy;
end;

procedure TfrODACQuery.DefineProperties;

  function GetMasterSource: String;
  var
    i: Integer;
    sl: TStringList;
  begin
    Result := '';
    sl := TStringList.Create;
    frGetComponents(FQuery.Owner, TDataSet, sl, FQuery);
    sl.Sort;
    for i := 0 to sl.Count - 1 do
      Result := Result + sl[i] + ';';
    sl.Free;
  end;

begin
  inherited DefineProperties;
  AddEnumProperty('MasterSource', GetMasterSource, [Null]);
  AddProperty('DetailFields', [frdtString], nil);
  AddProperty('MasterFields', [frdtString], nil);
  AddProperty('Params', [frdtHasEditor], ParamsEditor);
  AddProperty('SQL', [frdtHasEditor], SQLEditor);
  AddProperty('SQL.Count', [], nil);
  AddProperty('FetchAll', [frdtBoolean], nil);
  AddProperty('FetchRows', [frdtInteger], nil);
end;

procedure TfrODACQuery.SetPropValue(Index: String; Value: Variant);
var
  d: TDataset;
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 = 'MASTERSOURCE' then
  begin
    d := frFindComponent(FQuery.Owner, Value) as TDataSet;
    FQuery.MasterSource := frGetDataSource(FQuery.Owner, d);
  end
  else if Index = 'SQL' then
    FQuery.SQL.Text := Value
  else if Index = 'MASTERFIELDS' then
    FQuery.MasterFields := Value
  else if Index = 'DETAILFIELD' then
    FQuery.DetailFields := Value
  else if Index = 'FETCHALL' then
    FQuery.FetchAll := Value
  else if Index = 'FETCHROWS' then
    FQuery.FetchRows := Value
end;

function TfrODACQuery.GetPropValue(Index: String): Variant;
begin
  Index := AnsiUpperCase(Index);
  Result := inherited GetPropValue(Index);
  if Result <> Null then Exit;
  if Index = 'MASTERSOURCE' then
    Result := frGetDataSetName(FQuery.Owner, FQuery.MasterSource)
  else if Index = 'SQL' then
    Result := FQuery.SQL.Text
  else if Index = 'SQL.COUNT' then
    Result := FQuery.SQL.Count
  else if Index = 'RECORDCOUNT' then
    Result := FDataSet.RecordCount
  else if Index = 'FIELDCOUNT' then
    Result := FDataSet.FieldCount
  else if Index = 'MASTERFIELDS' then
    Result := FQuery.MasterFields
  else if Index = 'DETAILFIELDS' then
    Result := FQuery.DetailFields
  else if Index = 'FETCHALL' then
    Result := FQuery.FetchAll
  else if Index = 'FETCHROWS' then
    Result := FQuery.FetchRows
end;

function TfrODACQuery.DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant;
var
  S : string;
begin
  Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  if Result = Null then
    Result := LinesMethod(FQuery.SQL, MethodName, 'SQL', Par1, Par2, Par3);
  if MethodName = 'EXECSQL' then
  begin
    FQuery.ExecSQL;
  end else if MethodName = 'ADDWHERE' then begin
    S := Par1;
    if (Length(S) > 0) and (S[1] = '''') then
      System.Delete(S, 1, 1);
    if (Length(S) > 0) and (S[Length(S)] = '''') then
      SetLength(S, Length(S)-1);
    FQuery.AddWhere(S);
  end;
end;

procedure TfrODACQuery.LoadFromStream(Stream: TStream);
var
  S: String;
begin
  FFixupList.Clear;
  inherited LoadFromStream(Stream);

  FFixupList['Session'] := frReadString(Stream);
  Prop['Session'] := FFixupList['Session'];

  FQuery.Filter := frReadString(Stream);
  FQuery.Filtered := Trim(FQuery.Filter) <> '';
  S := frReadString(Stream);
  FFixupList['MasterSource'] := S;
  Prop['MasterSource'] := FFixupList['MasterSource'];

  FQuery.MasterFields := frReadString(Stream);
  FQuery.DetailFields := frReadString(Stream);

  FQuery.FetchAll := frReadBoolean(Stream);
  FQuery.FetchRows := frReadInteger(Stream);

  frReadMemo(Stream, FQuery.SQL);
  FFixupList['Active'] := frReadBoolean(Stream);
  ReadFields(Stream);
  ReadParams(Stream);
  try
    FQuery.Active := FFixupList['Active'];
  except;
  end;
end;

procedure TfrODACQuery.SaveToStream(Stream: TStream);
begin
  LVersion := 1;
  inherited SaveToStream(Stream);

  frWriteString(Stream, Prop['Session']);

  frWriteString(Stream, FQuery.Filter);
  frWriteString(Stream, Prop['MasterSource']);

  frWriteString(Stream, FQuery.MasterFields);
  frWriteString(Stream, FQuery.DetailFields);

  frWriteBoolean(Stream, FQuery.FetchAll);
  frWriteInteger(Stream, FQuery.FetchRows);

  frWriteMemo(Stream, FQuery.SQL);
  frWriteBoolean(Stream, FQuery.Active);
  WriteFields(Stream);
  WriteParams(Stream);
end;

procedure TfrODACQuery.Loaded;
begin
  Prop['MasterSource'] := FFixupList['MasterSource'];
  inherited Loaded;
end;

procedure TfrODACQuery.SQLEditor(Sender: TObject);
begin
  with TfrDBSQLEditorForm.Create(nil) do
  begin
    Query := FQuery;
    M1.Lines.Assign(FQuery.SQL);
{$IFDEF QBUILDER}
    QBEngine := TfrQBBDEEngine.Create(nil);
    TfrQBBDEEngine(QBEngine).Query := FQuery;
    QBEngine.DatabaseName := FQuery.DatabaseName;
{$ENDIF}
    if (ShowModal = mrOk) and ((Restrictions and frrfDontModify) = 0) then
    begin
      FQuery.SQL := M1.Lines;
      frDesigner.Modified := True;
    end;
{$IFDEF QBUILDER}
    QBEngine.Free;
{$ENDIF}
    Free;
  end;
end;

procedure TfrODACQuery.ParamsEditor(Sender: TObject);
var
  Form: TSmartQueryEditorForm;
begin
  Form := TSmartQueryEditorForm.Create(nil);
  try
    Form.DataSet := FQuery;
    Form.ActivateParamsSheet;
    if Form.ShowModal = mrOK then
      frDesigner.Modified := True;
  finally
    Form.Free;
  end;
end;

function TfrODACQuery.GetParamKind(Index: Integer): TfrParamKind;
begin
  Result := pkValue;
end;

procedure TfrODACQuery.SetParamKind(Index: Integer; Value: TfrParamKind);
begin
end;

function TfrODACQuery.GetParamText(Index: Integer): String;
begin
  Result := FQuery.Params[Index].AsString;
end;

procedure TfrODACQuery.SetParamText(Index: Integer; Value: String);
begin
  if Value <> '' then
    FQuery.Params[Index].Value := Value
  else
    FQuery.Params[Index].Clear
end;

procedure TfrODACQuery.ReadParams(Stream: TStream);
var
  i: Integer;
  w, n: Word;
begin
  Stream.Read(n, 2);
  for i := 0 to n - 1 do
  with FQuery.Params[i] do
  begin
    Stream.Read(w, 2);
    DataType := ParamTypes[w];
    Stream.Read(w, 2);
    ParamKind[i] := TfrParamKind(w);
    ParamText[i] := frReadString(Stream);
  end;
end;

procedure TfrODACQuery.WriteParams(Stream: TStream);
var
  i: Integer;
  w: Word;
begin
  w := FQuery.Params.Count;
  Stream.Write(w, 2);
  for i := 0 to FQuery.Params.Count - 1 do
  with FQuery.Params[i] do
  begin
    for w := 0 to 10 do
      if DataType = ParamTypes[w] then
        break;
    Stream.Write(w, 2);
    w := Word(ParamKind[i]);
    Stream.Write(w, 2);
      frWriteString(Stream, ParamText[i]);
  end;
end;

end.