home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / IBX / FR_IBXQuery.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  10KB  |  375 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {   FastReport CLX v2.4 - IBX components   }
  5. {             Query component              }
  6. {                                          }
  7. {        Copyright (c) 2000 by EMS         }
  8. { Copyright (c) 1998-2001 by Tzyganenko A. }
  9. {                                          }
  10. {******************************************}
  11.  
  12. unit FR_IBXQuery;
  13.  
  14. interface
  15.  
  16. {$I FR.inc}
  17.  
  18. uses
  19.   Types, SysUtils, Classes, QGraphics, QStdCtrls, QControls, QForms,
  20.   QMenus, QDialogs, FR_Class, FR_Pars, DB, IBQuery, FR_IBXTable, FR_DBUtils;
  21.  
  22. type
  23.   TfrIBXQuery = class(TfrIBXDataSet)
  24.   private
  25.     FQuery: TIBQuery;
  26.     FParams: TfrVariables;
  27.     procedure SQLEditor(Sender: TObject);
  28.     procedure ParamsEditor(Sender: TObject);
  29.     procedure ReadParams(Stream: TStream);
  30.     procedure WriteParams(Stream: TStream);
  31.     function GetParamKind(Index: Integer): TfrParamKind;
  32.     procedure SetParamKind(Index: Integer; Value: TfrParamKind);
  33.     function GetParamText(Index: Integer): String;
  34.     procedure SetParamText(Index: Integer; Value: String);
  35.     procedure BeforeOpenQuery(DataSet: TDataSet);
  36.   protected
  37.     procedure SetPropValue(Index: String; Value: Variant); override;
  38.     function GetPropValue(Index: String): Variant; override;
  39.     function DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant; override;
  40.   public
  41.     constructor Create; override;
  42.     destructor Destroy; override;
  43.     procedure LoadFromStream(Stream: TStream); override;
  44.     procedure SaveToStream(Stream: TStream); override;
  45.     procedure DefineProperties; override;
  46.     procedure Loaded; override;
  47.     property Query: TIBQuery read FQuery;
  48.     property ParamKind[Index: Integer]: TfrParamKind read GetParamKind write SetParamKind;
  49.     property ParamText[Index: Integer]: String read GetParamText write SetParamText;
  50.   end;
  51.  
  52.  
  53. implementation
  54.  
  55. uses
  56.   FR_Utils, FR_Const, FR_DBSQLEdit, FR_IBXQueryParam, Variants;
  57.  
  58.  
  59. { TfrIBXQuery }
  60.  
  61. constructor TfrIBXQuery.Create;
  62. begin
  63.   inherited Create;
  64.   FQuery := TIBQuery.Create(frDialogForm);
  65.   FQuery.BeforeOpen := BeforeOpenQuery;
  66.   FDataSet := FQuery;
  67.   FDataSource.DataSet := FDataSet;
  68.  
  69.   FParams := TfrVariables.Create;
  70.  
  71.   Component := FQuery;
  72.   BaseName := 'Query';
  73.   Bmp.LoadFromResourceName(hInstance, 'FR_IBXQUERY');
  74. end;
  75.  
  76. destructor TfrIBXQuery.Destroy;
  77. begin
  78.   FParams.Free;
  79.   FDataSet := nil;
  80.   FQuery.Free;
  81.   inherited Destroy;
  82. end;
  83.  
  84. procedure TfrIBXQuery.DefineProperties;
  85.  
  86.   function GetMasterSource: String;
  87.   var
  88.     i: Integer;
  89.     sl: TStringList;
  90.   begin
  91.     Result := '';
  92.     sl := TStringList.Create;
  93.     frGetComponents(FQuery.Owner, TDataSet, sl, FQuery);
  94.     sl.Sort;
  95.     for i := 0 to sl.Count - 1 do
  96.       Result := Result + sl[i] + ';';
  97.     sl.Free;
  98.   end;
  99.  
  100. begin
  101.   inherited DefineProperties;
  102.   AddEnumProperty('DataSource', GetMasterSource, [Null]);
  103.   AddProperty('Params', [frdtHasEditor], ParamsEditor);
  104.   AddProperty('SQL', [frdtHasEditor], SQLEditor);
  105.   AddProperty('SQL.Count', [], nil);
  106. end;
  107.  
  108. procedure TfrIBXQuery.SetPropValue(Index: String; Value: Variant);
  109. var
  110.   d: TDataset;
  111. begin
  112.   inherited SetPropValue(Index, Value);
  113.   Index := AnsiUpperCase(Index);
  114.   if Index = 'DATASOURCE' then
  115.   begin
  116.     d := frFindComponent(FQuery.Owner, Value) as TDataSet;
  117.     FQuery.DataSource := frGetDataSource(FQuery.Owner, d);
  118.   end
  119.   else if Index = 'SQL' then
  120.     FQuery.SQL.Text := Value
  121. end;
  122.  
  123. function TfrIBXQuery.GetPropValue(Index: String): Variant;
  124. begin
  125.   Index := AnsiUpperCase(Index);
  126.   Result := inherited GetPropValue(Index);
  127.   if Result <> Null then Exit;
  128.   if Index = 'DATASOURCE' then
  129.     Result := frGetDataSetName(FQuery.Owner, FQuery.DataSource)
  130.   else if Index = 'SQL' then
  131.     Result := FQuery.SQL.Text
  132.   else if Index = 'SQL.Count' then
  133.     Result := FQuery.SQL.Count;
  134. end;
  135.  
  136. function TfrIBXQuery.DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant;
  137. begin
  138.   Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  139.   if Result = Null then
  140.     Result := LinesMethod(FQuery.SQL, MethodName, 'SQL', Par1, Par2, Par3);
  141.   if MethodName = 'EXECSQL' then
  142.   begin
  143.     BeforeOpenQuery(FQuery);
  144.     FQuery.ExecSQL
  145.   end;
  146. end;
  147.  
  148. procedure TfrIBXQuery.LoadFromStream(Stream: TStream);
  149. var
  150.   s: String;
  151. begin
  152.   FFixupList.Clear;
  153.   inherited LoadFromStream(Stream);
  154.   FFixupList['DataBase'] := frReadString(Stream);
  155.   Prop['DataBase'] := FFixupList['DataBase'];
  156.   FQuery.Filter := frReadString(Stream);
  157.   FQuery.Filtered := Trim(FQuery.Filter) <> '';
  158.   s := frReadString(Stream);
  159.   FFixupList['DataSource'] := s;
  160.   Prop['DataSource'] := FFixupList['DataSource'];
  161.   frReadMemo(Stream, FQuery.SQL);
  162.  
  163.   FFixupList['Active'] := frReadBoolean(Stream);
  164.   ReadFields(Stream);
  165.   ReadParams(Stream);
  166.   try
  167.     FQuery.Active := FFixupList['Active'];
  168.   except;
  169.   end;
  170. end;
  171.  
  172. procedure TfrIBXQuery.SaveToStream(Stream: TStream);
  173. begin
  174.   inherited SaveToStream(Stream);
  175.   frWriteString(Stream, Prop['DataBase']);
  176.   frWriteString(Stream, FQuery.Filter);
  177.   frWriteString(Stream, Prop['DataSource']);
  178.   frWriteMemo(Stream, FQuery.SQL);
  179.   frWriteBoolean(Stream, FQuery.Active);
  180.   WriteFields(Stream);
  181.   WriteParams(Stream);
  182. end;
  183.  
  184. procedure TfrIBXQuery.Loaded;
  185. begin
  186.   Prop['DataSource'] := FFixupList['DataSource'];
  187.   inherited Loaded;
  188. end;
  189.  
  190. procedure TfrIBXQuery.SQLEditor(Sender: TObject);
  191. begin
  192.   with TfrDBSQLEditorForm.Create(nil) do
  193.   begin
  194.     Query := FQuery;
  195.     M1.Lines.Assign(FQuery.SQL);
  196. {$IFDEF QBUILDER}
  197.     QBEngine := TfrQBIBXEngine.Create(nil);
  198.     TfrQBIBXEngine(QBEngine).Query := FQuery;
  199.     QBEngine.DatabaseName := Prop['Database'];
  200. {$ENDIF}
  201.     if (ShowModal = mrOk) and ((Restrictions and frrfDontModify) = 0) then
  202.     begin
  203.       FQuery.SQL := M1.Lines;
  204.       frDesigner.Modified := True;
  205.     end;
  206. {$IFDEF QBUILDER}
  207.     QBEngine.Free;
  208. {$ENDIF}
  209.     Free;
  210.   end;
  211. end;
  212.  
  213. procedure TfrIBXQuery.ParamsEditor(Sender: TObject);
  214. var
  215.   Params: TParams;
  216.   ParamValues: TfrVariables;
  217. begin
  218.   if FQuery.Params.Count > 0 then
  219.   begin
  220.     Params := TParams.Create;
  221.     Params.Assign(FQuery.Params);
  222.     ParamValues := TfrVariables.Create;
  223.     ParamValues.Assign(FParams);
  224.     with TfrIBXParamsForm.Create(nil) do
  225.     begin
  226.       QueryComp := Self;
  227.       Query := FQuery;
  228.       Caption := Self.Name + ' ' + (SParams);
  229.       if ShowModal = mrOk then
  230.         frDesigner.Modified := True
  231.       else
  232.       begin
  233.         FQuery.Params.Assign(Params);
  234.         FParams.Assign(ParamValues);
  235.       end;
  236.       Free;
  237.     end;
  238.     Params.Free;
  239.     ParamValues.Free;
  240.   end;
  241. end;
  242.  
  243. function TfrIBXQuery.GetParamKind(Index: Integer): TfrParamKind;
  244. begin
  245.   Result := pkValue;
  246.   if not FQuery.Params[Index].Bound then
  247.     Result := pkAssignFromMaster;
  248. end;
  249.  
  250. procedure TfrIBXQuery.SetParamKind(Index: Integer; Value: TfrParamKind);
  251. begin
  252.   if Value = pkAssignFromMaster then
  253.   begin
  254.     FQuery.Params[Index].Bound := False;
  255.     FParams.Delete(FParams.IndexOf(FQuery.Params[Index].Name));
  256.   end
  257.   else
  258.   begin
  259.     FQuery.Params[Index].Clear;
  260.     FQuery.Params[Index].Bound := True;
  261.     FParams[FQuery.Params[Index].Name] := '';
  262.   end;
  263. end;
  264.  
  265. function TfrIBXQuery.GetParamText(Index: Integer): String;
  266. begin
  267.   Result := '';
  268.   if ParamKind[Index] = pkValue then
  269.     Result := FParams[FQuery.Params[Index].Name];
  270. end;
  271.  
  272. procedure TfrIBXQuery.SetParamText(Index: Integer; Value: String);
  273. begin
  274.   if ParamKind[Index] = pkValue then
  275.     FParams[FQuery.Params[Index].Name] := Value;
  276. end;
  277.  
  278. procedure TfrIBXQuery.ReadParams(Stream: TStream);
  279. var
  280.   i: Integer;
  281.   w, n: Word;
  282. begin
  283.   Stream.Read(n, 2);
  284.   for i := 0 to n - 1 do
  285.   with FQuery.Params[i] do
  286.   begin
  287.     Stream.Read(w, 2);
  288.     DataType := ParamTypes[w];
  289.     Stream.Read(w, 2);
  290.     ParamKind[i] := TfrParamKind(w);
  291.     ParamText[i] := frReadString(Stream);
  292.   end;
  293. end;
  294.  
  295. procedure TfrIBXQuery.WriteParams(Stream: TStream);
  296. var
  297.   i: Integer;
  298.   w: Word;
  299. begin
  300.   w := FQuery.Params.Count;
  301.   Stream.Write(w, 2);
  302.   for i := 0 to FQuery.Params.Count - 1 do
  303.   with FQuery.Params[i] do
  304.   begin
  305.     for w := 0 to 10 do
  306.       if DataType = ParamTypes[w] then
  307.         break;
  308.     Stream.Write(w, 2);
  309.     w := Word(ParamKind[i]);
  310.     Stream.Write(w, 2);
  311.     frWriteString(Stream, ParamText[i]);
  312.   end;
  313. end;
  314.  
  315. procedure TfrIBXQuery.BeforeOpenQuery(DataSet: TDataSet);
  316. var
  317.   i: Integer;
  318.   SaveView: TfrView;
  319.   SavePage: TfrPage;
  320.   SaveBand: TfrBand;
  321.  
  322.   function DefParamValue(Param: TParam): String;
  323.   begin
  324.     if Param.DataType in [ftDate, ftDateTime] then
  325.       Result := '01.01.00'
  326.     else if Param.DataType = ftTime then
  327.       Result := '00:00'
  328.     else
  329.       Result := '0';
  330.   end;
  331.  
  332. begin
  333.   SaveView := CurView;
  334.   CurView := nil;
  335.   SavePage := CurPage;
  336.   CurPage := ParentPage;
  337.   SaveBand := CurBand;
  338.   CurBand := nil;
  339.   i := 0;
  340.   try
  341.     while i < FQuery.Params.Count do
  342.     begin
  343.       if ParamKind[i] = pkValue then
  344.         if DocMode = dmPrinting then
  345.           FQuery.Params[i].Text := frParser.Calc(ParamText[i]) else
  346.           FQuery.Params[i].Text := DefParamValue(FQuery.Params[i]);
  347.       Inc(i);
  348.     end;
  349.   except
  350.     Memo.Clear;
  351.     Memo.Add(ParamText[i]);
  352.     CurView := Self;
  353.     raise;
  354.   end;
  355.   CurView := SaveView;
  356.   CurPage := SavePage;
  357.   CurBand := SaveBand;
  358. end;
  359.  
  360.  
  361. var
  362.   Bmp: TBitmap;
  363.  
  364. initialization
  365.   Bmp := TBitmap.Create;
  366.   Bmp.LoadFromResourceName(hInstance, 'FR_IBXQUERYCONTROL');
  367.   frRegisterControl(TfrIBXQuery, Bmp, (SInsertQuery));
  368.  
  369. finalization
  370.   frUnRegisterObject(TfrIBXQuery);
  371.   Bmp.Free;
  372.  
  373. end.
  374.  
  375.