home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 October / PCWorld_2000-10_cd2.bin / Borland / interbase / IBConsole_src.ZIP / ibconsole / frmuTools.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-07-24  |  7.0 KB  |  253 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 frmuTools;
  21.  
  22. interface
  23.  
  24. uses
  25.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  26.   frmuDlgClass, StdCtrls, Buttons, ActnList;
  27.  
  28. type
  29.   TTool = class (TObject)
  30.   private
  31.     FAppTitle,
  32.     FProgName,
  33.     FWorkingDir,
  34.     FParams: String;
  35.     
  36.   published
  37.     property AppTitle: String read FAppTitle write FAppTitle;
  38.     property ProgName: String read FProgName write FProgName;
  39.     property WorkingDir: String  read FWorkingDir write FWorkingDir;
  40.     property Params: String read FParams write FParams;
  41.   end;
  42.  
  43.   TfrmTools = class(TDialog)
  44.     btnAdd: TButton;
  45.     btnDelete: TButton;
  46.     btnEdit: TButton;
  47.     Label1: TLabel;
  48.     lbTools: TListBox;
  49.     btnActions: TActionList;
  50.     ToolAdd: TAction;
  51.     ToolDelete: TAction;
  52.     ToolEdit: TAction;
  53.     ToolBtnUp: TAction;
  54.     ToolBtnDown: TAction;
  55.     Button1: TButton;
  56.     ToolBtnClose: TAction;
  57.     procedure ToolDeleteUpdate(Sender: TObject);
  58.     procedure lbToolsDrawItem(Control: TWinControl; Index: Integer;
  59.       Rect: TRect; State: TOwnerDrawState);
  60.     procedure ToolAddExecute(Sender: TObject);
  61.     procedure ToolEditExecute(Sender: TObject);
  62.     procedure FormShow(Sender: TObject);
  63.     procedure ToolDeleteExecute(Sender: TObject);
  64.   private
  65.     { Private declarations }
  66.   public
  67.     { Public declarations }
  68.   end;
  69.  
  70. implementation
  71.  
  72. {$R *.DFM}
  73.  
  74. uses registry, zluGlobal, frmuAddTool;
  75.  
  76. procedure TfrmTools.ToolDeleteUpdate(Sender: TObject);
  77. var
  78.   lcnt: integer;
  79. begin
  80.   inherited;
  81.  
  82.   for lCnt := 0 to lbTools.Items.Count - 1 do
  83.     if lbTools.Selected[lCnt] then
  84.     begin
  85.       (Sender as TAction).Enabled := true;
  86.       exit;
  87.     end;
  88.   (Sender as TAction).Enabled := false;
  89. end;
  90.  
  91. procedure TfrmTools.lbToolsDrawItem(Control: TWinControl; Index: Integer;
  92.   Rect: TRect; State: TOwnerDrawState);
  93. var
  94.   FontHeight: integer;
  95.   Flags: LongInt;
  96. begin
  97.   inherited;
  98.   with lbTools.Canvas do
  99.   begin
  100.     FillRect(Rect);
  101.     Font := Self.Font;
  102.  
  103.     if odSelected in State then
  104.       Font.Color := clHighlightText;
  105.  
  106.     FontHeight := TextHeight('W');
  107.     with Rect do
  108.     begin
  109.       Top := ((Bottom + Top) - FontHeight) div 2;
  110.       Bottom := Top + FontHeight;
  111.       Left := Left+TextWidth('W');
  112.     end;
  113.  
  114.     Flags := DT_EXPANDTABS or DT_VCENTER;
  115.     Flags := DrawTextBiDiModeFlags(Flags);
  116.     DrawText(Handle, PChar(lbTools.Items[Index]), -1, Rect, Flags);
  117.   end;
  118. end;
  119.  
  120. procedure TfrmTools.ToolAddExecute(Sender: TObject);
  121. var
  122.   toolDlg: TfrmAddTools;
  123.   Reg: TRegistry;
  124.   lPos: integer;
  125. begin
  126.   inherited;
  127.   toolDlg := TfrmAddTools.Create (self);
  128.   with toolDlg do
  129.   begin
  130.     if ShowModal = mrOK then
  131.     begin
  132.       Reg := TRegistry.Create;
  133.       with Reg do
  134.       begin
  135.         lbTools.Items.Add (edtTitle.text);
  136.         gExternalApps.Add (edtTitle.text);
  137.         OpenKey (gRegToolsKey, true);
  138.         if ValueExists('Count') then
  139.           lPos := ReadInteger('Count')
  140.         else
  141.           lPos := 0;
  142.         WriteString (Format('Title%d', [lPos]), edtTitle.text);
  143.         WriteString (Format('Path%d', [lPos]), edtProgram.text);
  144.         writeString (Format('WorkingDir%d', [lPos]), edtWorkingDir.text);
  145.         WriteString (Format('Params%d', [lPos]), edtParams.text);
  146.         Inc(lPos);
  147.         WriteInteger ('Count', lPos);
  148.         CloseKey;
  149.         Free;
  150.       end;
  151.     end;
  152.   end;
  153. end;
  154.  
  155. procedure TfrmTools.ToolEditExecute(Sender: TObject);
  156. var
  157.   toolDlg: TfrmAddTools;
  158.   Reg: TRegistry;
  159.   lPos: integer;
  160. begin
  161.   inherited;
  162.   toolDlg := TfrmAddTools.Create (self);
  163.   with toolDlg do
  164.   begin
  165.     Reg := TRegistry.Create;
  166.     with Reg do
  167.     begin
  168.       OpenKey (gRegToolsKey, false);
  169.       edtTitle.text := ReadString (Format('Title%d',[lbTools.ItemIndex]));
  170.       edtProgram.text := ReadString (Format('Path%d',[lbTools.ItemIndex]));
  171.       edtWorkingDir.text := ReadString (Format('WorkingDir%d',[lbTools.ItemIndex]));
  172.       edtParams.text := ReadString (Format('Params%d',[lbTools.ItemIndex]));
  173.       CloseKey;
  174.       Free;
  175.     end;
  176.     if ShowModal = mrOK then
  177.     begin
  178.       Reg := TRegistry.Create;
  179.       with Reg do
  180.       begin
  181.         lbTools.Items.BeginUpdate;
  182.         lbTools.Items.Strings[lbTools.ItemIndex] := edtTitle.Text;
  183.         lbTools.Items.EndUpdate;
  184.         gExternalApps.Strings[lbTools.ItemIndex] :=  edtTitle.text;
  185.         OpenKey (gRegToolsKey, true);
  186.         lPos := lbTools.ItemIndex;
  187.         WriteString (Format('Title%d', [lPos]), edtTitle.text);
  188.         WriteString (Format('Path%d', [lPos]), edtProgram.text);
  189.         writeString (Format('WorkingDir%d', [lPos]), edtWorkingDir.text);
  190.         WriteString (Format('Params%d', [lPos]), edtParams.text);
  191.         CloseKey;
  192.         Free;
  193.       end;
  194.     end;
  195.   end;
  196. end;
  197.  
  198. procedure TfrmTools.FormShow(Sender: TObject);
  199. begin
  200.   inherited;
  201.   lbTools.Items.AddStrings(gExternalApps);
  202. end;
  203.  
  204. procedure TfrmTools.ToolDeleteExecute(Sender: TObject);
  205. var
  206.   Reg:  TRegistry;
  207.   lPos, idx: integer;
  208.   str:  TstringList;
  209.   value: String;
  210. begin
  211.   inherited;
  212.   Reg := TRegistry.Create;
  213.   Str := TStringList.Create;
  214.   with Reg do
  215.   begin
  216.     OpenKey (gRegToolsKey, true);
  217.     lPos := lbTools.ItemIndex;
  218.     DeleteValue (Format('Title%d', [lPos]));
  219.     DeleteValue (Format('Path%d', [lPos]));
  220.     DeleteValue (Format('WorkingDir%d', [lPos]));
  221.     DeleteValue (Format('Params%d', [lPos]));
  222.     GetValueNames (Str);
  223.     Str.Delete (Str.IndexOf('Count'));
  224.  
  225.     for lPos := 0 to Str.Count-1 do
  226.     begin
  227.       Value := Str.Strings[lPos];
  228.       idx := lPos div 4;  { 4 is the number of entries }
  229.       if Pos ('Title', Value) = 1 then
  230.         RenameValue (Value, Format('Title%d', [idx]));
  231.       if Pos ('Path', Value) = 1 then
  232.         RenameValue (Value, Format('Path%d', [idx]));
  233.       if Pos ('WorkingDir', Value) = 1 then
  234.         RenameValue (Value, Format('WorkingDir%d', [idx]));
  235.       if Pos ('Params', Value) = 1 then
  236.         RenameValue (Value, Format('Params%d', [idx]));
  237.     end;
  238.     gExternalApps.Clear;
  239.     for lPos := 0 to lbTools.Items.Count-2 do
  240.       gExternalApps.Add (ReadString (Format('Title%d', [lPos])));
  241.     lbTools.Items.BeginUpdate;
  242.     lbTools.Items.Clear;
  243.     lbTools.Items.AddStrings(gExternalApps);
  244.     lbTools.Items.EndUpdate;
  245.     WriteInteger('Count', lbTools.Items.Count);    
  246.     CloseKey;
  247.     Free;
  248.   end;
  249.   Str.Free;
  250. end;
  251.  
  252. end.
  253.