home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / IBX / FR_IBXDB.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-06  |  6KB  |  217 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {   FastReport CLX v2.4 - IBX components   }
  5. {           Database component             }
  6. {                                          }
  7. {        Copyright (c) 2000 by EMS         }
  8. { Copyright (c) 1998-2001 by Tzyganenko A. }
  9. {                                          }
  10. {******************************************}
  11.  
  12. unit FR_IBXDB;
  13.  
  14. interface
  15.  
  16. {$I FR.inc}
  17.  
  18. uses
  19.   Types, SysUtils, Classes, QGraphics, FR_Class, QStdCtrls,
  20.   QControls, QForms, QMenus, QDialogs, DB, IBDatabase;
  21.  
  22. type
  23.   TfrIBXComponents = class(TComponent) // fake component
  24.   end;
  25.  
  26.   TfrIBXDatabase = class(TfrNonVisualControl)
  27.   private
  28.     FDatabase: TIBDatabase;
  29.     FTransaction: TIBTransaction;
  30.     procedure LinesEditor(Sender: TObject);
  31.     procedure DBNameEditor(Sender: TObject);
  32.   protected
  33.     procedure SetPropValue(Index: String; Value: Variant); override;
  34.     function GetPropValue(Index: String): Variant; override;
  35.     function DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant; override;
  36.   public
  37.     constructor Create; override;
  38.     destructor Destroy; override;
  39.     procedure LoadFromStream(Stream: TStream); override;
  40.     procedure SaveToStream(Stream: TStream); override;
  41.     procedure DefineProperties; override;
  42.     procedure ShowEditor; override;
  43.     property Database: TIBDatabase read FDatabase;
  44.   end;
  45.  
  46.  
  47. implementation
  48.  
  49. uses
  50.   FR_Utils, FR_DBUtils, FR_Const, FR_LEdit, FR_DBLookupCtl,
  51.   FR_IBXTable, FR_IBXQuery, Variants;
  52.  
  53. {$R FR_IBX.res}
  54.  
  55.  
  56. { TfrIBXDatabase }
  57.  
  58. constructor TfrIBXDatabase.Create;
  59. begin
  60.   inherited Create;
  61.   FDatabase := TIBDataBase.Create(frDialogForm);
  62.   FTransaction := TIBTransaction.Create(frDialogForm);
  63.   FDatabase.DefaultTransaction := FTransaction;
  64.   Component := FDatabase;
  65.   BaseName := 'Database';
  66.   Bmp.LoadFromResourceName(hInstance, 'FR_IBXDB');
  67.   Flags := Flags or flDontUndo;
  68. end;
  69.  
  70. destructor TfrIBXDatabase.Destroy;
  71. begin
  72.   FTransaction.Free;
  73.   FDatabase.Free;
  74.   inherited Destroy;
  75. end;
  76.  
  77. procedure TfrIBXDatabase.DefineProperties;
  78. begin
  79.   inherited DefineProperties;
  80.   AddProperty('Connected', [frdtBoolean], nil);
  81.   AddProperty('DatabaseName', [frdtString], DBNameEditor);
  82.   AddProperty('LoginPrompt', [frdtBoolean], nil);
  83.   AddProperty('Params', [frdtHasEditor, frdtOneObject], LinesEditor);
  84.   AddProperty('Params.Count', [], nil);
  85.   AddProperty('SQLDialect', [frdtInteger], nil);
  86. end;
  87.  
  88. procedure TfrIBXDatabase.SetPropValue(Index: String; Value: Variant);
  89. begin
  90.   inherited SetPropValue(Index, Value);
  91.   Index := AnsiUpperCase(Index);
  92.   if Index = 'DATABASENAME' then
  93.     FDatabase.DatabaseName := Value
  94.   else if Index = 'LOGINPROMPT' then
  95.     FDatabase.LoginPrompt := Value
  96.   else if Index = 'CONNECTED' then begin
  97.     FDatabase.Connected := Value;
  98.     if Assigned(FDataBase.DefaultTransaction) then
  99.       FDataBase.DefaultTransaction.Active := Value;
  100.   end
  101.   else if Index = 'PARAMS' then
  102.     FDatabase.Params.Text := Value
  103.   else if Index = 'SQLDIALECT' then
  104.     FDatabase.SQLDialect := Value
  105. end;
  106.  
  107. function TfrIBXDatabase.GetPropValue(Index: String): Variant;
  108. begin
  109.   Index := AnsiUpperCase(Index);
  110.   Result := inherited GetPropValue(Index);
  111.   if Result <> Null then Exit;
  112.   if Index = 'DATABASENAME' then
  113.     Result := FDataBase.DatabaseName
  114.   else if Index = 'LOGINPROMPT' then
  115.     Result := FDataBase.LoginPrompt
  116.   else if Index = 'CONNECTED' then
  117.     Result := FDataBase.Connected
  118.   else if Index = 'PARAMS.COUNT' then
  119.     Result := FDatabase.Params.Count
  120.   else if Index = 'PARAMS' then
  121.     Result := FDatabase.Params.Text
  122.   else if Index = 'SQLDIALECT' then
  123.     Result := FDataBase.SQLDialect
  124. end;
  125.  
  126. function TfrIBXDataBase.DoMethod(MethodName: String; Par1, Par2, Par3: Variant): Variant;
  127. begin
  128.   Result := inherited DoMethod(MethodName, Par1, Par2, Par3);
  129.   if Result = Null then
  130.     Result := LinesMethod(FDataBase.Params, MethodName, 'PARAMS', Par1, Par2, Par3);
  131. end;
  132.  
  133. procedure TfrIBXDatabase.LoadFromStream(Stream: TStream);
  134. begin
  135.   inherited LoadFromStream(Stream);
  136.   FDatabase.DatabaseName := frReadString(Stream);
  137.   FDatabase.LoginPrompt := frReadBoolean(Stream);
  138.   if HVersion * 10 + LVersion > 20 then
  139.     FDatabase.SQLDialect := frReadInteger(Stream);
  140.   frReadMemo(Stream, FDatabase.Params);
  141.   FDatabase.Connected := frReadBoolean(Stream);
  142. end;
  143.  
  144. procedure TfrIBXDatabase.SaveToStream(Stream: TStream);
  145. begin
  146.   LVersion := 1;
  147.   inherited SaveToStream(Stream);
  148.   frWriteString(Stream, FDatabase.DatabaseName);
  149.   frWriteBoolean(Stream, FDatabase.LoginPrompt);
  150.   frWriteInteger(Stream, FDatabase.SQLDialect);
  151.   frWriteMemo(Stream, FDatabase.Params);
  152.   frWriteBoolean(Stream, FDatabase.Connected);
  153. end;
  154.  
  155. procedure TfrIBXDatabase.LinesEditor(Sender: TObject);
  156. var
  157.   sl: TStringList;
  158.   SaveConnected: Boolean;
  159. begin
  160.   sl := TStringList.Create;
  161.   with TfrLinesEditorForm.Create(nil) do
  162.   begin
  163.     if FDatabase.Params.Text = '' then
  164.       M1.Text := sl.Text else
  165.       M1.Text := FDatabase.Params.Text;
  166.     if (ShowModal = mrOk) and ((Restrictions and frrfDontModify) = 0) and
  167.       M1.Modified then
  168.     begin
  169.       SaveConnected := FDatabase.Connected;
  170.       FDatabase.Connected := False;
  171.       FDatabase.Params.Text := M1.Text;
  172.       FDatabase.Connected := SaveConnected;
  173.       frDesigner.Modified := True;
  174.     end;
  175.     Free;
  176.   end;
  177.   sl.Free;
  178. end;
  179.  
  180. procedure TfrIBXDatabase.ShowEditor;
  181. begin
  182.   DBNameEditor(nil);
  183. end;
  184.  
  185. procedure TfrIBXDatabase.DBNameEditor(Sender: TObject);
  186. var
  187.   SaveConnected: Boolean;
  188. begin
  189.   SaveConnected := FDatabase.Connected;
  190.   FDatabase.Connected := False;
  191.   with TOpenDialog.Create(nil) do
  192.   begin
  193.     InitialDir := GetCurrentDir();
  194.     Filter := {frLoadStr(SIBXDataBases); //}'Databases (*.gdb)|*.gdb|All files (*.*)|*.*';
  195.     if Execute then
  196.       FDatabase.DatabaseName := FileName;
  197.     Free;
  198.   end;
  199.   FDatabase.Connected := SaveConnected;
  200. end;
  201.  
  202.  
  203. var
  204.   Bmp: TBitmap;
  205.  
  206. initialization
  207.   Bmp := TBitmap.Create;
  208.   Bmp.LoadFromResourceName(hInstance, 'FR_IBXDBCONTROL');
  209.   frRegisterControl(TfrIBXDatabase, Bmp, SInsertDB);
  210.  
  211. finalization
  212.   frUnRegisterObject(TfrIBXDatabase);
  213.   Bmp.Free;
  214.  
  215. end.
  216.  
  217.