Browse Source

Ctrl-W/Ctrl-F4 shortcut for user permissions overview window. Set up heap trace output in debug build mode for analysis with the LeakView tool.

Reinier Olislagers 11 years ago
parent
commit
38bcdd51cf
5 changed files with 58 additions and 27 deletions
  1. 5 0
      TurboBird.lpi
  2. 10 0
      TurboBird.lpr
  3. 7 8
      userpermissions.lfm
  4. 19 18
      userpermissions.lrs
  5. 17 1
      userpermissions.pas

+ 5 - 0
TurboBird.lpi

@@ -47,6 +47,9 @@
             </Optimizations>
             </Optimizations>
           </CodeGeneration>
           </CodeGeneration>
           <Linking>
           <Linking>
+            <Debugging>
+              <UseHeaptrc Value="True"/>
+            </Debugging>
             <Options>
             <Options>
               <Win32>
               <Win32>
                 <GraphicApplication Value="True"/>
                 <GraphicApplication Value="True"/>
@@ -57,6 +60,7 @@
             <CompilerMessages>
             <CompilerMessages>
               <UseMsgFile Value="True"/>
               <UseMsgFile Value="True"/>
             </CompilerMessages>
             </CompilerMessages>
+            <CustomOptions Value="-dDEBUG"/>
             <CompilerPath Value="$(CompPath)"/>
             <CompilerPath Value="$(CompPath)"/>
           </Other>
           </Other>
         </CompilerOptions>
         </CompilerOptions>
@@ -281,6 +285,7 @@
         <Filename Value="userpermissions.pas"/>
         <Filename Value="userpermissions.pas"/>
         <IsPartOfProject Value="True"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="fmUserPermissions"/>
         <ComponentName Value="fmUserPermissions"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="UserPermissions"/>
         <UnitName Value="UserPermissions"/>
       </Unit25>
       </Unit25>

+ 10 - 0
TurboBird.lpr

@@ -48,6 +48,16 @@ var
   IBaseLibraryHandle : TLibHandle;
   IBaseLibraryHandle : TLibHandle;
 begin
 begin
   Application.Initialize;
   Application.Initialize;
+  {$IFDEF DEBUG}
+  // Requires the build mode to set -dDEBUG in Project Options/Other and
+  // defining -gh/heaptrace on
+  // This avoids interference when running a production/default build without -gh
+
+  // Set up -gh output for the Leakview package:
+  if FileExists('heap.trc') then
+    DeleteFile('heap.trc');
+  SetHeapTraceOutput('heap.trc');
+  {$ENDIF DEBUG}
   IBaseLibraryHandle:= LoadLibrary(fbclib);
   IBaseLibraryHandle:= LoadLibrary(fbclib);
 
 
   // search for all compatible FireBird libraries in Windows
   // search for all compatible FireBird libraries in Windows

+ 7 - 8
userpermissions.lfm

@@ -7,9 +7,11 @@ object fmUserPermissions: TfmUserPermissions
   Caption = 'fmUserPermissions'
   Caption = 'fmUserPermissions'
   ClientHeight = 363
   ClientHeight = 363
   ClientWidth = 500
   ClientWidth = 500
+  KeyPreview = True
   OnClose = FormClose
   OnClose = FormClose
+  OnKeyDown = FormKeyDown
   Position = poScreenCenter
   Position = poScreenCenter
-  LCLVersion = '0.9.31'
+  LCLVersion = '1.2.0.3'
   object StringGrid1: TStringGrid
   object StringGrid1: TStringGrid
     Left = 0
     Left = 0
     Height = 331
     Height = 331
@@ -21,17 +23,14 @@ object fmUserPermissions: TfmUserPermissions
     Columns = <    
     Columns = <    
       item
       item
         Title.Caption = 'Obj Type'
         Title.Caption = 'Obj Type'
-        Title.PrefixOption = poNone
         Width = 100
         Width = 100
       end    
       end    
       item
       item
         Title.Caption = 'Object'
         Title.Caption = 'Object'
-        Title.PrefixOption = poNone
         Width = 200
         Width = 200
       end    
       end    
       item
       item
         Title.Caption = 'Permission'
         Title.Caption = 'Permission'
-        Title.PrefixOption = poNone
         Width = 200
         Width = 200
       end>
       end>
     FixedColor = 14539471
     FixedColor = 14539471
@@ -56,17 +55,17 @@ object fmUserPermissions: TfmUserPermissions
   end
   end
   object Label1: TLabel
   object Label1: TLabel
     Left = 3
     Left = 3
-    Height = 18
+    Height = 13
     Top = 12
     Top = 12
-    Width = 46
+    Width = 32
     Caption = 'Object'
     Caption = 'Object'
     ParentColor = False
     ParentColor = False
   end
   end
   object laObject: TLabel
   object laObject: TLabel
     Left = 62
     Left = 62
-    Height = 18
+    Height = 13
     Top = 11
     Top = 11
-    Width = 62
+    Width = 47
     Caption = 'laObject'
     Caption = 'laObject'
     Font.Style = [fsBold]
     Font.Style = [fsBold]
     ParentColor = False
     ParentColor = False

+ 19 - 18
userpermissions.lrs

@@ -1,23 +1,24 @@
+{ This is an automatically generated lazarus resource file }
+
 LazarusResources.Add('TfmUserPermissions','FORMDATA',[
 LazarusResources.Add('TfmUserPermissions','FORMDATA',[
   'TPF0'#18'TfmUserPermissions'#17'fmUserPermissions'#4'Left'#3'D'#2#6'Height'#3
   'TPF0'#18'TfmUserPermissions'#17'fmUserPermissions'#4'Left'#3'D'#2#6'Height'#3
   +'k'#1#3'Top'#3#205#0#5'Width'#3#244#1#13'ActiveControl'#7#11'StringGrid1'#7
   +'k'#1#3'Top'#3#205#0#5'Width'#3#244#1#13'ActiveControl'#7#11'StringGrid1'#7
   +'Caption'#6#17'fmUserPermissions'#12'ClientHeight'#3'k'#1#11'ClientWidth'#3
   +'Caption'#6#17'fmUserPermissions'#12'ClientHeight'#3'k'#1#11'ClientWidth'#3
-  +#244#1#7'OnClose'#7#9'FormClose'#8'Position'#7#14'poScreenCenter'#10'LCLVers'
-  +'ion'#6#6'0.9.31'#0#11'TStringGrid'#11'StringGrid1'#4'Left'#2#0#6'Height'#3
-  +'K'#1#3'Top'#2#31#5'Width'#3#221#1#7'Anchors'#11#5'akTop'#6'akLeft'#8'akBott'
-  +'om'#0#11'BorderStyle'#7#6'bsNone'#8'ColCount'#2#3#7'Columns'#14#1#13'Title.'
-  +'Caption'#6#8'Obj Type'#18'Title.PrefixOption'#7#6'poNone'#5'Width'#2'd'#0#1
-  +#13'Title.Caption'#6#6'Object'#18'Title.PrefixOption'#7#6'poNone'#5'Width'#3
-  +#200#0#0#1#13'Title.Caption'#6#10'Permission'#18'Title.PrefixOption'#7#6'poN'
-  +'one'#5'Width'#3#200#0#0#0#10'FixedColor'#4#207#218#221#0#9'FixedCols'#2#0#4
-  +'Flat'#9#7'Options'#11#15'goFixedVertLine'#15'goFixedHorzLine'#10'goVertLine'
-  +#10'goHorzLine'#11'goColSizing'#11'goRowSelect'#14'goSmoothScroll'#0#8'TabOr'
-  +'der'#2#0#14'UseXORFeatures'#9#0#0#7'TBitBtn'#7'bbClose'#4'Left'#3#218#1#6'H'
-  +'eight'#2#24#3'Top'#2#1#5'Width'#2#27#7'Anchors'#11#5'akTop'#7'akRight'#0#7
-  +'Caption'#6#4' X  '#5'Color'#4#219#242#247#0#10'Font.Style'#11#6'fsBold'#0#7
-  +'OnClick'#7#12'bbCloseClick'#10'ParentFont'#8#8'TabOrder'#2#1#0#0#6'TLabel'#6
-  +'Label1'#4'Left'#2#3#6'Height'#2#18#3'Top'#2#12#5'Width'#2'.'#7'Caption'#6#6
-  +'Object'#11'ParentColor'#8#0#0#6'TLabel'#8'laObject'#4'Left'#2'>'#6'Height'#2
-  +#18#3'Top'#2#11#5'Width'#2'>'#7'Caption'#6#8'laObject'#10'Font.Style'#11#6'f'
-  +'sBold'#0#11'ParentColor'#8#10'ParentFont'#8#0#0#0
+  +#244#1#10'KeyPreview'#9#7'OnClose'#7#9'FormClose'#9'OnKeyDown'#7#11'FormKeyD'
+  +'own'#8'Position'#7#14'poScreenCenter'#10'LCLVersion'#6#7'1.2.0.3'#0#11'TStr'
+  +'ingGrid'#11'StringGrid1'#4'Left'#2#0#6'Height'#3'K'#1#3'Top'#2#31#5'Width'#3
+  +#221#1#7'Anchors'#11#5'akTop'#6'akLeft'#8'akBottom'#0#11'BorderStyle'#7#6'bs'
+  +'None'#8'ColCount'#2#3#7'Columns'#14#1#13'Title.Caption'#6#8'Obj Type'#5'Wid'
+  +'th'#2'd'#0#1#13'Title.Caption'#6#6'Object'#5'Width'#3#200#0#0#1#13'Title.Ca'
+  +'ption'#6#10'Permission'#5'Width'#3#200#0#0#0#10'FixedColor'#4#207#218#221#0
+  +#9'FixedCols'#2#0#4'Flat'#9#7'Options'#11#15'goFixedVertLine'#15'goFixedHorz'
+  +'Line'#10'goVertLine'#10'goHorzLine'#11'goColSizing'#11'goRowSelect'#14'goSm'
+  +'oothScroll'#0#8'TabOrder'#2#0#14'UseXORFeatures'#9#0#0#7'TBitBtn'#7'bbClose'
+  +#4'Left'#3#218#1#6'Height'#2#24#3'Top'#2#1#5'Width'#2#27#7'Anchors'#11#5'akT'
+  +'op'#7'akRight'#0#7'Caption'#6#4' X  '#5'Color'#4#219#242#247#0#10'Font.Styl'
+  +'e'#11#6'fsBold'#0#7'OnClick'#7#12'bbCloseClick'#10'ParentFont'#8#8'TabOrder'
+  +#2#1#0#0#6'TLabel'#6'Label1'#4'Left'#2#3#6'Height'#2#13#3'Top'#2#12#5'Width'
+  +#2' '#7'Caption'#6#6'Object'#11'ParentColor'#8#0#0#6'TLabel'#8'laObject'#4'L'
+  +'eft'#2'>'#6'Height'#2#13#3'Top'#2#11#5'Width'#2'/'#7'Caption'#6#8'laObject'
+  +#10'Font.Style'#11#6'fsBold'#0#11'ParentColor'#8#10'ParentFont'#8#0#0#0
 ]);
 ]);

+ 17 - 1
userpermissions.pas

@@ -6,7 +6,7 @@ interface
 
 
 uses
 uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
-  Grids, Buttons, StdCtrls;
+  Grids, Buttons, StdCtrls, LCLType;
 
 
 type
 type
 
 
@@ -19,6 +19,7 @@ type
     StringGrid1: TStringGrid;
     StringGrid1: TStringGrid;
     procedure bbCloseClick(Sender: TObject);
     procedure bbCloseClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   private
   private
     { private declarations }
     { private declarations }
   public
   public
@@ -38,6 +39,21 @@ begin
   CloseAction:= caFree;
   CloseAction:= caFree;
 end;
 end;
 
 
+procedure TfmUserPermissions.FormKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  if (ssCtrl in Shift) and
+    ((Key=VK_F4) or (Key=VK_W)) then
+  begin
+    if (MessageDlg('Do you want to close this query window?', mtConfirmation, [mbNo, mbYes], 0) = mrYes) then
+    begin
+      // Close when pressing Ctrl-W or Ctrl-F4 (Cmd-W/Cmd-F4 on OSX)
+      Close;
+      Parent.Free;
+    end;
+  end;
+end;
+
 procedure TfmUserPermissions.bbCloseClick(Sender: TObject);
 procedure TfmUserPermissions.bbCloseClick(Sender: TObject);
 begin
 begin
   Close;
   Close;