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