home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuISQL.pas < prev    next >
Pascal/Delphi Source File  |  2000-07-24  |  6KB  |  230 lines
  1. {
  2.  * The contents of this file are subject to the InterBase Public License
  3.  * Version 1.0 (the "License"); you may not use this file except in
  4.  * compliance with the License.
  5.  * 
  6.  * You may obtain a copy of the License at http://www.Inprise.com/IPL.html.
  7.  * 
  8.  * Software distributed under the License is distributed on an "AS IS"
  9.  * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
  10.  * the License for the specific language governing rights and limitations
  11.  * under the License.  The Original Code was created by Inprise
  12.  * Corporation and its predecessors.
  13.  * 
  14.  * Portions created by Inprise Corporation are Copyright (C) Inprise
  15.  * Corporation. All Rights Reserved.
  16.  * 
  17.  * Contributor(s): ______________________________________.
  18. }
  19.  
  20. unit frmuISQL;
  21.  
  22. interface
  23.  
  24. uses
  25.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  26.   ComCtrls, ToolWin, Menus, Grids, StdCtrls, DBGrids, ExtCtrls, ImgList,
  27.   Db, IBCustomDataSet;
  28.  
  29. type
  30.   TfrmISQL = class(TForm)
  31.     MainMenu1: TMainMenu;
  32.     File1: TMenuItem;
  33.     Edit1: TMenuItem;
  34.     Query1: TMenuItem;
  35.     Help1: TMenuItem;
  36.     Help2: TMenuItem;
  37.     Open1: TMenuItem;
  38.     SaveQuery1: TMenuItem;
  39.     SaveOutput1: TMenuItem;
  40.     N1: TMenuItem;
  41.     Close1: TMenuItem;
  42.     Cut1: TMenuItem;
  43.     Copy1: TMenuItem;
  44.     Paste1: TMenuItem;
  45.     N2: TMenuItem;
  46.     SelectAll1: TMenuItem;
  47.     ClearText1: TMenuItem;
  48.     Execute1: TMenuItem;
  49.     Next1: TMenuItem;
  50.     Last1: TMenuItem;
  51.     N3: TMenuItem;
  52.     Preferences1: TMenuItem;
  53.     Create1: TMenuItem;
  54.     Connect1: TMenuItem;
  55.     Properties1: TMenuItem;
  56.     N4: TMenuItem;
  57.     Extract1: TMenuItem;
  58.     stbISQL: TStatusBar;
  59.     CoolBar1: TCoolBar;
  60.     imgToolBarsDisabled: TImageList;
  61.     imgToolBarsEnabled: TImageList;
  62.     reSQLInput: TRichEdit;
  63.     Splitter1: TSplitter;
  64.     PageControl1: TPageControl;
  65.     TabSheet1: TTabSheet;
  66.     dbgData: TDBGrid;
  67.     TabSheet2: TTabSheet;
  68.     reSQLOutput: TMemo;
  69.     TabSheet3: TTabSheet;
  70.     StringGrid1: TStringGrid;
  71.     ControlBar2: TControlBar;
  72.     ControlBar1: TControlBar;
  73.     tlbISQL: TToolBar;
  74.     tbExecuteScript: TToolButton;
  75.     tbPreviousScript: TToolButton;
  76.     ToolBar1: TToolBar;
  77.     ToolButton1: TToolButton;
  78.     ToolButton2: TToolButton;
  79.     ToolButton3: TToolButton;
  80.     ToolButton4: TToolButton;
  81.     ToolButton5: TToolButton;
  82.     ToolButton6: TToolButton;
  83.     ToolButton7: TToolButton;
  84.     QryMenu: TPopupMenu;
  85.     IBDataSet1: TIBDataSet;
  86.     DataSource1: TDataSource;
  87.     procedure Open1Click(Sender: TObject);
  88.     procedure SaveOutput1Click(Sender: TObject);
  89.     procedure Execute1Click(Sender: TObject);
  90.     procedure reSQLInputKeyDown(Sender: TObject; var Key: Word;
  91.       Shift: TShiftState);
  92.     procedure reSQLInputSelectionChange(Sender: TObject);
  93.     procedure reSQLInputMouseUp(Sender: TObject; Button: TMouseButton;
  94.       Shift: TShiftState; X, Y: Integer);
  95.   private
  96.     { Private declarations }
  97.     procedure SetModified(IsModified: Boolean; IsReadOnly: boolean; StatusBar: TStatusBar);
  98.     procedure UpdateCursorPos(Editor: TRichEdit; StatusBar: TStatusBar);
  99.     procedure OpenFile(var Editor: TRichEdit; const sFileName: string);
  100.   public
  101.     { Public declarations }
  102.   end;
  103.  
  104. var
  105.   frmISQL: TfrmISQL;
  106.  
  107. implementation
  108.  
  109. {$R *.DFM}
  110.  
  111. uses
  112.   zluSQL, RichEdit, frmuDBCreate;
  113.  
  114. procedure TfrmISQL.Open1Click(Sender: TObject);
  115. var
  116.   lOpenDialog: TOpenDialog;
  117. begin
  118.   lOpenDialog := nil;
  119.   try
  120.   begin
  121.     lOpenDialog := TOpenDialog.Create(self);
  122.     lOpenDialog.DefaultExt := 'sql';
  123.     lOpenDialog.Filter := 'SQL Files (*.sql)|*.SQL|Text files (*.txt)|*.TXT|All files (*.*)|*.*';
  124.     if lOpenDialog.Execute then
  125.     begin
  126.       OpenFile(reSQLInput, lOpenDialog.FileName);
  127.     end;
  128.   end
  129.   finally
  130.     lOpenDialog.free;
  131.   end;
  132. end;
  133.  
  134. procedure TfrmISQL.SaveOutput1Click(Sender: TObject);
  135. var
  136.   lSaveDialog: TSaveDialog;
  137. begin
  138.   lSaveDialog := nil;
  139.   try
  140.   begin
  141.     lSaveDialog := TSaveDialog.Create(Self);
  142.     lSaveDialog.Title := 'Export to';
  143.     lSaveDialog.Filter := 'SQL (*.sql)|*.SQL|All files (*.*)|*.*';
  144.     lSaveDialog.DefaultExt := 'sql';
  145.  
  146.     if lSaveDialog.Execute then
  147.     begin
  148.       if FileExists(lSaveDialog.FileName) then
  149.         if MessageDlg(Format('OK to overwrite %s', [lSaveDialog.FileName]),
  150.           mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
  151.       reSQLOutput.Lines.SaveToFile(lSaveDialog.FileName);
  152.     end;
  153.   end
  154.   finally
  155.     lSaveDialog.free;
  156.   end;
  157. end;
  158.  
  159. procedure TfrmISQL.Execute1Click(Sender: TObject);
  160. begin
  161. { TODO : The second parameter should reflect any database currently attached to }
  162.   DoIsql (reSQlInput.LineS, nil);
  163. end;
  164.  
  165. procedure TfrmISQL.reSQLInputKeyDown(Sender: TObject; var Key: Word;
  166.   Shift: TShiftState);
  167. begin
  168.   SetModified(true,false,stbISQL);
  169. end;
  170.  
  171. procedure TfrmISQL.reSQLInputSelectionChange(Sender: TObject);
  172. begin
  173.   UpdateCursorPos(reSQLInput,stbISQL);
  174. end;
  175.  
  176. procedure TfrmISQL.reSQLInputMouseUp(Sender: TObject; Button: TMouseButton;
  177.   Shift: TShiftState; X, Y: Integer);
  178. begin
  179.   if Button = mbRight then
  180.   begin
  181.     reSQLInput.SetFocus;
  182.   end;
  183. end;
  184.  
  185. procedure TfrmISQL.UpdateCursorPos(Editor: TRichEdit; StatusBar: TStatusBar);
  186. var
  187.   CharPos: TPoint;
  188. begin
  189.   CharPos.Y := SendMessage(Editor.Handle, EM_EXLINEFROMCHAR, 0, Editor.SelStart);
  190.   CharPos.X := (Editor.SelStart - SendMessage(Editor.Handle, EM_LINEINDEX, CharPos.Y, 0));
  191.   Inc(CharPos.Y);
  192.   Inc(CharPos.X);
  193.   StatusBar.Panels[0].Text := Format('%3d: %3d', [CharPos.Y, CharPos.X]);
  194. end;
  195.  
  196. procedure TfrmISQL.SetModified(IsModified, IsReadOnly: boolean;
  197.   StatusBar: TStatusBar);
  198. begin
  199.   if IsModified then
  200.     StatusBar.Panels[1].Text := 'Modified'
  201.   else
  202.     StatusBar.Panels[1].Text := '';
  203.  
  204.   if IsReadOnly then
  205.     StatusBar.Panels[1].Text := 'Read Only';
  206. end;
  207.  
  208. procedure TfrmISQL.OpenFile(var Editor: TRichEdit;
  209.   const sFileName: string);
  210. begin
  211.   try
  212.     Screen.Cursor := crHourGlass;
  213.     try
  214.       Editor.Lines.LoadFromFile(sFileName);
  215.     except
  216.       on E:Exception do
  217.       begin
  218.         MessageDlg(E.Message + #10#13+
  219.         Format('Could not open file "%s"!',[sFileName]), mtError, [mbOK], 0);
  220.         Exit;
  221.       end;
  222.     end;
  223.     Editor.SetFocus;
  224.   finally
  225.     Screen.Cursor := crDefault;
  226.   end;
  227. end;
  228.  
  229. end.
  230.