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 năm trước cách đây
mục cha
commit
38bcdd51cf
5 tập tin đã thay đổi với 58 bổ sung27 xóa
  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>
           </CodeGeneration>
           <Linking>
+            <Debugging>
+              <UseHeaptrc Value="True"/>
+            </Debugging>
             <Options>
               <Win32>
                 <GraphicApplication Value="True"/>
@@ -57,6 +60,7 @@
             <CompilerMessages>
               <UseMsgFile Value="True"/>
             </CompilerMessages>
+            <CustomOptions Value="-dDEBUG"/>
             <CompilerPath Value="$(CompPath)"/>
           </Other>
         </CompilerOptions>
@@ -281,6 +285,7 @@
         <Filename Value="userpermissions.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="fmUserPermissions"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="UserPermissions"/>
       </Unit25>

+ 10 - 0
TurboBird.lpr

@@ -48,6 +48,16 @@ var
   IBaseLibraryHandle : TLibHandle;
 begin
   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);
 
   // search for all compatible FireBird libraries in Windows

+ 7 - 8
userpermissions.lfm

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

+ 19 - 18
userpermissions.lrs

@@ -1,23 +1,24 @@
+{ This is an automatically generated lazarus resource file }
+
 LazarusResources.Add('TfmUserPermissions','FORMDATA',[
   '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
   +'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
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
-  Grids, Buttons, StdCtrls;
+  Grids, Buttons, StdCtrls, LCLType;
 
 type
 
@@ -19,6 +19,7 @@ type
     StringGrid1: TStringGrid;
     procedure bbCloseClick(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
+    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   private
     { private declarations }
   public
@@ -38,6 +39,21 @@ begin
   CloseAction:= caFree;
 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);
 begin
   Close;