Pārlūkot izejas kodu

Ctrl-W/Ctrl-F4 close form button for database info

Reinier Olislagers 11 gadi atpakaļ
vecāks
revīzija
c5f3a03ba4
3 mainītis faili ar 44 papildinājumiem un 28 dzēšanām
  1. 1 1
      TurboBird.lpi
  2. 27 25
      dbinfo.lfm
  3. 16 2
      dbinfo.pas

+ 1 - 1
TurboBird.lpi

@@ -60,7 +60,7 @@
             <CompilerMessages>
               <UseMsgFile Value="True"/>
             </CompilerMessages>
-            <CustomOptions Value="-dDEBUG"/>
+            <CustomOptions Value="-dDEBUG -O-1"/>
             <CompilerPath Value="$(CompPath)"/>
           </Other>
         </CompilerOptions>

+ 27 - 25
dbinfo.lfm

@@ -6,20 +6,22 @@ object fmDBInfo: TfmDBInfo
   Caption = 'fmDBInfo'
   ClientHeight = 471
   ClientWidth = 701
+  KeyPreview = True
   OnClose = FormClose
+  OnKeyDown = FormKeyDown
   Position = poScreenCenter
-  LCLVersion = '1.0.4.0'
+  LCLVersion = '1.2.0.3'
   object Label1: TLabel
     Left = 15
-    Height = 18
+    Height = 13
     Top = 49
-    Width = 65
+    Width = 46
     Caption = 'Database'
     ParentColor = False
   end
   object edName: TEdit
     Left = 144
-    Height = 21
+    Height = 13
     Top = 46
     Width = 479
     Anchors = [akTop, akLeft, akRight]
@@ -33,15 +35,15 @@ object fmDBInfo: TfmDBInfo
   end
   object Label2: TLabel
     Left = 15
-    Height = 18
+    Height = 13
     Top = 79
-    Width = 84
+    Width = 59
     Caption = 'ODS Version'
     ParentColor = False
   end
   object edODSVer: TEdit
     Left = 144
-    Height = 21
+    Height = 13
     Top = 76
     Width = 88
     AutoSelect = False
@@ -54,15 +56,15 @@ object fmDBInfo: TfmDBInfo
   end
   object Label3: TLabel
     Left = 15
-    Height = 18
+    Height = 13
     Top = 110
-    Width = 54
+    Width = 39
     Caption = 'CharSet'
     ParentColor = False
   end
   object edCharset: TEdit
     Left = 144
-    Height = 21
+    Height = 13
     Top = 107
     Width = 88
     AutoSelect = False
@@ -75,15 +77,15 @@ object fmDBInfo: TfmDBInfo
   end
   object Label4: TLabel
     Left = 15
-    Height = 18
+    Height = 13
     Top = 142
-    Width = 94
+    Width = 67
     Caption = 'Creation Date'
     ParentColor = False
   end
   object edCreationDate: TEdit
     Left = 144
-    Height = 21
+    Height = 13
     Top = 139
     Width = 176
     AutoSelect = False
@@ -96,15 +98,15 @@ object fmDBInfo: TfmDBInfo
   end
   object Label5: TLabel
     Left = 15
-    Height = 18
+    Height = 13
     Top = 172
-    Width = 64
+    Width = 46
     Caption = 'Page Size'
     ParentColor = False
   end
   object edPageSize: TEdit
     Left = 144
-    Height = 21
+    Height = 13
     Top = 169
     Width = 88
     AutoSelect = False
@@ -117,7 +119,7 @@ object fmDBInfo: TfmDBInfo
   end
   object edDBSize: TEdit
     Left = 144
-    Height = 21
+    Height = 13
     Top = 201
     Width = 176
     AutoSelect = False
@@ -130,17 +132,17 @@ object fmDBInfo: TfmDBInfo
   end
   object Label6: TLabel
     Left = 15
-    Height = 18
+    Height = 13
     Top = 204
-    Width = 95
+    Width = 68
     Caption = 'Database Size'
     ParentColor = False
   end
   object Label7: TLabel
     Left = 16
-    Height = 18
+    Height = 13
     Top = 270
-    Width = 122
+    Width = 87
     Caption = 'Connected Clients'
     ParentColor = False
   end
@@ -178,7 +180,7 @@ object fmDBInfo: TfmDBInfo
   end
   object edConnections: TEdit
     Left = 144
-    Height = 21
+    Height = 13
     Top = 267
     Width = 112
     AutoSelect = False
@@ -426,15 +428,15 @@ object fmDBInfo: TfmDBInfo
   end
   object Label8: TLabel
     Left = 16
-    Height = 18
+    Height = 13
     Top = 237
-    Width = 78
+    Width = 55
     Caption = 'Server time'
     ParentColor = False
   end
   object edServerTime: TEdit
     Left = 144
-    Height = 21
+    Height = 13
     Top = 234
     Width = 176
     AutoSelect = False

+ 16 - 2
dbinfo.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  Buttons, ExtCtrls;
+  Buttons, ExtCtrls, LCLType;
 
 type
 
@@ -36,6 +36,7 @@ type
     procedure bbCloseClick(Sender: TObject);
     procedure bbRefreshClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   private
     { private declarations }
     fdbIndex: Integer;
@@ -71,6 +72,18 @@ begin
   CloseAction:= caFree;
 end;
 
+procedure TfmDBInfo.FormKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  if (ssCtrl in Shift) and
+    ((key=VK_F4) or (key=VK_W)) then
+  begin
+    // Close when pressing Ctrl-W or Ctrl-F4 (Cmd-W/Cmd-F4 on OSX)
+    Close;
+    Parent.Free;
+  end;
+end;
+
 procedure TfmDBInfo.Init(dbIndex: Integer);
 var
   dbName, CreationDate, ACharSet: string;
@@ -127,7 +140,8 @@ begin
     Show;
   end
   else
-    ShowMessage('Unable to get database information' + #10 + ErrorMsg);
+    ShowMessage('Unable to get database information' + LineEnding +
+      ErrorMsg);
 end;