home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 April A / Pcwk4a98.iso / PROGRAM / DELPHI16 / EXCEL / EXCELTOP.PAS < prev   
Pascal/Delphi Source File  |  1997-11-19  |  7KB  |  287 lines
  1. {*******************************************************}
  2. {       TExcel Component Demo for Delphi 1.0 .. 3.0     }
  3. {                                                       }
  4. {       Copyright (c) 1996, 1997 Tibor F. Liska         }
  5. {       Tel/Fax:    00-36-1-165-2019                    }
  6. {       Office:     00-36-1-209-5284                    }
  7. {       E-mail: liska@sztaki.hu                         }
  8. {*******************************************************}
  9. unit ExcelTop;
  10.  
  11. interface
  12.  
  13. uses
  14.   Messages, SysUtils, Classes, Graphics, Controls, Forms,
  15.   Dialogs, StdCtrls, ExtCtrls, Spin, Buttons, Excels;
  16.  
  17. type
  18.   TForm1 = class(TForm)
  19.     Panel2: TPanel;
  20.     cmCommand: TBitBtn;
  21.     cbCommand: TComboBox;
  22.     Label5: TLabel;
  23.     cmClose: TBitBtn;
  24.     Timer1: TTimer;
  25.     Panel3: TPanel;
  26.     cmRun: TBitBtn;
  27.     Label7: TLabel;
  28.     cbMacro: TComboBox;
  29.     Panel4: TPanel;
  30.     cmRequest: TBitBtn;
  31.     Label6: TLabel;
  32.     cbItem: TComboBox;
  33.     Panel5: TPanel;
  34.     cmGetData: TBitBtn;
  35.     Label9: TLabel;
  36.     Label8: TLabel;
  37.     GroupBox1: TGroupBox;
  38.     Memo: TMemo;
  39.     Panel1: TPanel;
  40.     cmTable: TBitBtn;
  41.     tbLeft: TComboBox;
  42.     tbRight: TComboBox;
  43.     gdRow: TComboBox;
  44.     gdCol: TComboBox;
  45.     tbMode: TRadioGroup;
  46.     Label1: TLabel;
  47.     tbNew: TCheckBox;
  48.     tbTime: TLabel;
  49.     tbSpeed: TLabel;
  50.     Label2: TLabel;
  51.     gdRange: TCheckBox;
  52.     tbTop: TComboBox;
  53.     tbBottom: TComboBox;
  54.     Label3: TLabel;
  55.     Label4: TLabel;
  56.     Label10: TLabel;
  57.     Label11: TLabel;
  58.     procedure FormCreate(Sender: TObject);
  59.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  60.     procedure Timer1Timer(Sender: TObject);
  61.     procedure ExcelOpen (Sender: TObject);
  62.     procedure ExcelClose(Sender: TObject);
  63.     procedure ClearReply(Sender: TObject);
  64.     procedure cmCommandClick(Sender: TObject);
  65.     procedure cmRequestClick(Sender: TObject);
  66.     procedure cmGetDataClick(Sender: TObject);
  67.     procedure cmTableClick(Sender: TObject);
  68.     procedure cmRunClick(Sender: TObject);
  69.     procedure cmCloseClick(Sender: TObject);
  70.     procedure CheckBuff(Sender: TObject);
  71.   public
  72. {$IFNDEF INSTALLED}
  73.      Excel : TExcel;
  74. {$ENDIF}
  75.   end;
  76.  
  77. var
  78.   Form1: TForm1;
  79.  
  80. implementation
  81.  
  82. {$R *.DFM}
  83.  
  84. procedure TForm1.FormCreate(Sender: TObject);
  85. begin
  86. {$IFNDEF INSTALLED}
  87.   Excel := TExcel.Create(Self);
  88. {$ENDIF}
  89.   cbMacro.ItemIndex := 0;
  90.   Timer1.Enabled := True;          { Delayed Connect }
  91. end;
  92.  
  93. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  94. begin
  95.   if Excel.Connected then Excel.CloseMacroFile;
  96.   Excel.OnClose := nil;
  97. end;
  98.  
  99. procedure TForm1.Timer1Timer(Sender: TObject);
  100. begin
  101.   Screen.Cursor := crHourGlass;
  102. try
  103.   Timer1.Enabled := False;
  104.   Excel.OnOpen  := ExcelOpen;
  105.   Excel.OnClose := ExcelClose;
  106.   Excel.Connect;   { Same as Excel.Connected := True; }
  107. finally
  108.   Screen.Cursor := crDefault;
  109. end; end;
  110.  
  111. procedure TForm1.ExcelOpen(Sender: TObject);
  112.   var
  113.       MacroFile : TFileName;
  114. begin
  115.   cmTable  .Enabled := True;
  116.   cmCommand.Enabled := True;
  117.   cmRequest.Enabled := True;
  118.   cmGetData.Enabled := True;
  119.   MacroFile := ExtractFilePath(ParamStr(0))+'Excel.xls';
  120.   if FileExists(Macrofile) then
  121.   begin
  122.     Excel.OpenMacroFile(MacroFile, True);
  123.     cmRun.Enabled := True;
  124.   end;
  125. end;
  126.  
  127. procedure TForm1.ExcelClose(Sender: TObject);
  128. begin
  129.   cmTable  .Enabled := False;
  130.   cmCommand.Enabled := False;
  131.   cmRequest.Enabled := False;
  132.   cmGetData.Enabled := False;
  133.   cmRun    .Enabled := False;
  134.   ShowMessage('Excel closed');
  135. end;
  136.  
  137. procedure TForm1.ClearReply(Sender: TObject);
  138. begin
  139.   Memo.Lines.Clear;
  140. end;
  141.  
  142. procedure TForm1.CheckBuff(Sender: TObject);
  143.   var
  144.       Rows, Cols : Integer;
  145.       RowSize : Longint;
  146.       Over64KB : Boolean;
  147. begin
  148.   Rows := StrToInt(tbBottom.Text) - StrToInt(tbTop.Text) + 1;
  149.   Cols := StrToInt(tbRight.Text) - StrToInt(tbLeft.Text) + 1;
  150.   if (Rows < 0) or (Cols < 0) then
  151.     ShowMessage('Invalid values');
  152.   if tbMode.ItemIndex = 0 then Exit;           { Execute }
  153.   RowSize := Longint(Length(tbBottom.Text) + 5) * Cols;
  154.   Over64KB := 65535 < RowSize * Rows;          { Prepared batch }
  155.   if tbMode.ItemIndex = 1 then                 { Normal batch }
  156.     with Excel do Over64KB := Over64KB and
  157.              (65535 < RowSize * (BatchMax mod BatchMin + BatchMin));
  158.   if Over64KB then
  159.     ShowMessage('Data will be lost.  Transfer buffer exceeds 64 KB')
  160. {$IFNDEF WIN32}
  161.   else if RowSize > 255 then
  162.     ShowMessage('Data will be lost.  Line buffer exceeds 255')
  163. {$ENDIF}
  164. end;
  165.  
  166. procedure TForm1.cmCommandClick(Sender: TObject);
  167. begin
  168.   Excel.Exec(cbCommand.Text);
  169. end;
  170.  
  171. procedure TForm1.cmRequestClick(Sender: TObject);
  172.   var
  173.       i : Integer;
  174.       Reply : string;
  175. begin
  176.   Memo.Lines.Clear;
  177.   Reply := Excel.Request(cbItem.Text);
  178.   i := Pos(#9, Reply);
  179.   while i > 0 do
  180.   begin
  181.     Memo.Lines.Add(Copy(Reply, 1, i-1));
  182.     Delete(Reply, 1, i);
  183.     i := Pos(#9, Reply);
  184.   end;
  185.   Memo.Lines.Add(Reply);
  186. end;
  187.  
  188. procedure TForm1.cmGetDataClick(Sender: TObject);
  189.   var
  190.       Row, Col : Integer;
  191.       Range : TStringList;
  192. begin
  193.   Row := StrToInt(gdRow.Text);
  194.   Col := StrToInt(gdCol.Text);
  195.   Screen.Cursor := crHourGlass;
  196. try
  197.   Memo.Lines.Clear;
  198.   if gdRange.Checked then
  199.   try
  200.     Range := TStringList.Create;
  201.     Excel.GetRange(Rect(1, 1, Col, Row), Range);
  202.     Memo.Lines.AddStrings(Range);
  203.   finally
  204.     Range.Free;
  205.   end
  206.   else
  207.     Memo.Lines.Add(Excel.GetCell(Row, Col));
  208. finally
  209.   Screen.Cursor := crDefault;
  210. end; end;
  211.  
  212. procedure TForm1.cmTableClick(Sender: TObject);
  213.   var
  214.       Top, Left, Bottom, Right : Integer;
  215.  
  216.   procedure Normal;
  217.     var
  218.         i, j : Longint;
  219.   begin
  220.     for i:=Top to Bottom do
  221.       for j:=Left to Right do
  222.         Excel.PutInt(i, j, i*10000+j);
  223.   end;
  224.  
  225.   procedure Prepared;
  226.     var
  227.         i, j : Longint;
  228.         Line : string;
  229.   begin
  230.     Excel.LastCol := Right;         { Need to set LastCol }
  231.     for i:=Top to Bottom do
  232.     begin
  233.       Line := IntToStr(i*10000+Left);
  234.       for j:=Left+1 to Right do
  235.         Line := Line + #9 + IntToStr(i*10000+j);
  236.       Excel.Lines.Add(Line);
  237.     end;
  238.   end;
  239.  
  240.   var
  241.       t, t0 : TDateTime;
  242.       n : Longint;
  243. begin                              { cmTableClick }
  244.   tbTime.Caption := ' RUNNING';
  245.   tbSpeed.Caption := '';
  246.   Refresh;
  247.   try
  248.     if tbNew.Checked then Excel.Exec('[NEW(1)]');      { New table }
  249.     Top    := StrToInt(tbTop   .Text);
  250.     Left   := StrToInt(tbLeft  .Text);
  251.     Bottom := StrToInt(tbBottom.Text);
  252.     Right  := StrToInt(tbRight .Text);
  253.     n := (Bottom - Top + 1)*(Right - Left + 1);
  254.     Screen.Cursor := crHourGlass;
  255.     Enabled := False;
  256.     t0 := Time;                    { Start time }
  257.     try
  258.       if tbMode.ItemIndex > 0 then Excel.BatchStart(Top, Left);
  259.       if tbMode.ItemIndex = 2 then Prepared
  260.                               else Normal;
  261.       if tbMode.ItemIndex > 0 then Excel.BatchSend;
  262.     finally
  263.       Excel.BatchCancel;
  264.       Enabled := True;
  265.       Screen.Cursor := crDefault;
  266.     end;
  267.   except
  268.     tbTime.Caption := '';
  269.     raise
  270.   end;
  271.   t := Time - t0;                  { End time }
  272.   tbTime.Caption := TimeToStr(t);
  273.   tbSpeed.Caption := Format('%.1f', [0.000001 * n / t]);
  274. end;
  275.  
  276. procedure TForm1.cmRunClick(Sender: TObject);
  277. begin
  278.   Excel.Run(cbMacro.Text);
  279. end;
  280.  
  281. procedure TForm1.cmCloseClick(Sender: TObject);
  282. begin
  283.   Close;
  284. end;
  285.  
  286. end.
  287.