home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 October / Chip_2002-10_cd1.bin / zkuste / delphi / kolekce / d56 / FLEXCEL.ZIP / Demo / UDbDump.pas < prev    next >
Pascal/Delphi Source File  |  2002-07-04  |  3KB  |  126 lines
  1. unit UDbDump;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ActnList, ComCtrls, ToolWin, ImgList, Db, DBTables,
  8.   UExcelAdapter, OLEAdapter, Grids, DBGrids, ExtCtrls, StdCtrls,
  9.   {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
  10.   UFlexcelReport;
  11.  
  12. type
  13.   TMain = class(TForm)
  14.     ImageList3: TImageList;
  15.     ImageList2: TImageList;
  16.     ImageList1: TImageList;
  17.     ToolBar: TToolBar;
  18.     btnGo: TToolButton;
  19.     btnClose: TToolButton;
  20.     ActionList: TActionList;
  21.     ActionExport: TAction;
  22.     ActionExit: TAction;
  23.     Ds: TQuery;
  24.     OLEAdapter: TOLEAdapter;
  25.     ToolButton1: TToolButton;
  26.     ActionRunSQL: TAction;
  27.     Panel1: TPanel;
  28.     Splitter1: TSplitter;
  29.     DataSource1: TDataSource;
  30.     DBGrid1: TDBGrid;
  31.     edSQL: TMemo;
  32.     Splitter2: TSplitter;
  33.     Panel2: TPanel;
  34.     LbAlias: TComboBox;
  35.     Label1: TLabel;
  36.     Label2: TLabel;
  37.     Report: TFlexCelReport;
  38.     procedure ActionExitExecute(Sender: TObject);
  39.     procedure ActionExportExecute(Sender: TObject);
  40.     procedure ActionRunSQLExecute(Sender: TObject);
  41.     procedure FormCreate(Sender: TObject);
  42.   private
  43.     function GetCurrentDate: variant;
  44.     function GetDsName: variant;
  45.     function GetCurrentSQL: variant;
  46.     { Private declarations }
  47.   public
  48.     { Public declarations }
  49.   published
  50.     property DsName: variant read GetDsName;
  51.     property CurrentDate: variant read GetCurrentDate;
  52.     property CurrentSQL: variant read GetCurrentSQL;
  53.   end;
  54.  
  55. var
  56.   Main: TMain;
  57.  
  58. implementation
  59.  
  60. {$R *.DFM}
  61. function SkipCR(const s: string): string;
  62. var
  63.   i:integer;
  64. begin
  65.   SetLength(Result, Length(s));
  66.   for i:=1 to length(s) do if s[i]<#32 then Result[i]:=' ' else Result[i]:=s[i];
  67. end;
  68.  
  69. procedure TMain.ActionExitExecute(Sender: TObject);
  70. begin
  71.   Close;
  72. end;
  73.  
  74. procedure TMain.ActionExportExecute(Sender: TObject);
  75. begin
  76.   ActionRunSQL.Execute;
  77.   Ds.DisableControls;
  78.   try
  79.     Report.Run;
  80.   finally
  81.     Ds.EnableControls;
  82.   end;
  83. end;
  84.  
  85. function TMain.GetCurrentDate: variant;
  86. begin
  87.   Result:= double(Now); //Dates should be passed as numbers, and the corresponding cell in excel have Date format.
  88. end;
  89.  
  90. function TMain.GetCurrentSQL: variant;
  91. begin
  92.   Result:= SkipCR(Ds.SQL.Text);
  93. end;
  94.  
  95. function TMain.GetDsName: variant;
  96. begin
  97.   Result:=Ds.Database.DatabaseName;
  98. end;
  99.  
  100. procedure TMain.ActionRunSQLExecute(Sender: TObject);
  101. begin
  102.   Ds.Close;
  103.   Ds.DatabaseName:= LbAlias.Text;
  104.   Ds.SQL:=edSQL.Lines;
  105.   Ds.Open;
  106. end;
  107.  
  108. procedure TMain.FormCreate(Sender: TObject);
  109. var
  110.   StrList: TStringList;
  111.   i: integer;
  112. begin
  113.   Session.Active:=true;
  114.   StrList:=TStringList.Create;
  115.   try
  116.     Session.GetDatabaseNames(StrList);
  117.     LbAlias.Items.Assign(StrList);
  118.     for i:=0 to LbAlias.Items.Count-1 do
  119.       if LbAlias.Items[i]='DBDEMOS' then LbAlias.ItemIndex:=i;
  120.   finally
  121.     FreeAndNil(StrList);
  122.   end; //finally
  123. end;
  124.  
  125. end.
  126.