fixed win32 intf menu height from Wojciech

git-svn-id: trunk@4827 -

examples/dlgform.pp

@@ -25,7 +25,7 @@ unit DlgForm;
 
 interface
 
-uses Classes, Forms, Buttons, Dialogs, Graphics;
+uses Classes, Forms, Buttons, Dialogs, Graphics, StdCtrls;
 
 type
   TSampleDialogs = class(TForm)
@@ -37,6 +37,9 @@ type
     saveButton : TButton;
     colorButton : TButton;
     fontButton : TButton;
+    dirButton : TButton;
+    dirLabel : TLabel;
+    fileLabel : TLabel;
     constructor Create(AOwner: TComponent); override;
     procedure buttonClick(Sender : TObject);
     procedure FormDestroy(Sender : TObject);
@@ -51,11 +54,29 @@ constructor TSampleDialogs.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   Caption := 'Common Dialogs';
-  SetBounds(200, 200, 200, 200);
+  SetBounds(200, 200, 400, 230);
   Color := clTeal;
 
   OnDestroy := @FormDestroy;
 
+  dirLabel := TLabel.Create(Self);
+  with dirLabel do
+  begin
+    Parent := Self;
+    SetBounds(110, 40, 280, 35);
+    Caption := 'Directory';
+    Show;
+  end;
+
+  fileLabel := TLabel.Create(Self);
+  with fileLabel do
+  begin
+    Parent := Self;
+    SetBounds(110, 80, 280, 35);
+    Caption := 'File';
+    Show;
+  end;
+
   closeButton := TButton.Create(Self);
   with closeButton do
   begin
@@ -110,6 +131,17 @@ begin
     Tag := 5;
     Show;
   end;
+
+  dirButton := TButton.Create(Self);
+  with dirButton do
+  begin
+    Parent := Self;
+    OnClick := @buttonClick;
+    SetBounds(10, 178, 75, 32);
+    caption := 'Directory';
+    Tag := 6;
+    Show;
+  end;
 end;
 
 procedure TSampleDialogs.FormDestroy(Sender : TObject);
@@ -125,19 +157,19 @@ begin
     2 : with TOpenDialog.Create(Self) do
         begin
           Filter := '*.pp';
-          Execute;
+          if Execute then fileLabel.Caption := FileName;
           Free;
         end;
     3 : with TSaveDialog.Create(Self) do
         begin
           Filename := 'untitled.pp';
-          Execute;
+          if Execute then fileLabel.Caption := FileName;
           Free;
         end;
     4 : with TFontDialog.Create(Self) do
         begin
-          Font.Assign(Self.Font);
+          Font.Assign(fontButton.Font);
-          if Execute then Self.Font.Assign(Font);
+          if Execute then fontButton.Font.Assign(Font);
           Free;
         end;
     5 : with TColorDialog.Create(Self) do
@@ -146,6 +178,11 @@ begin
           if Execute then Self.Color := Color;
           Free;
         end;
+    6 : with TSelectDirectoryDialog.Create(Self) do
+        begin
+          if Execute then dirLabel.Caption := FileName;
+          Free;
+        end;
   end;
 
 end;

ide/project.pp

@@ -1262,6 +1262,8 @@ begin
         Add('program Project1;');
         Add('');
         Add('{$mode objfpc}{$H+}');
+        if fProjectType in [ptApplication] then
+          Add('{$AppType Gui} // for win32 applications');
         Add('');
         Add('uses');
         case fProjectType of
@@ -2736,6 +2738,9 @@ end.
 
 {
   $Log$
+  Revision 1.140  2003/11/22 23:56:33  mattias
+  fixed win32 intf menu height from Wojciech
+
   Revision 1.139  2003/10/15 18:01:10  mattias
   implemented extract proc, check lfm and convert delphi unit
 

lcl/interfaces/win32/win32object.inc

@@ -29,24 +29,11 @@
   Constructor for the class.
  ------------------------------------------------------------------------------}
 Constructor TWin32Object.Create;
-Var
-  R1,R2:TRect;
 Begin
   Inherited Create;
   FAccelGroup := 0;
   FTimerData  := TList.Create;
-  // Retrieves the height of a win32 menu
+  FWin32MenuHeight:= GetSystemMetrics(SM_CYMENU);
-  With R1 do
-  begin
-    left:=0;
-    right:=0;
-    right:=100;
-    bottom:=100;
-  end;
-  R2:=R1;
-  Windows.AdjustwindowRect(@R1,WS_OVERLAPPEDWINDOW,true);
-  Windows.AdjustwindowRect(@R2,WS_OVERLAPPEDWINDOW,false);
-  FWin32MenuHeight:= R2.Top - R1.Top;
   FNextControlId := 0;
 End;
 
@@ -143,8 +130,8 @@ Begin
   InitCommonControls;
 
   // Create parent of all windows, `button on taskbar'
-  FAppHandle := CreateWindow(@ClsName, 'AppTitle', WS_POPUP or WS_CLIPSIBLINGS or
+   FAppHandle := CreateWindow(@ClsName, PChar(Application.Title), WS_POPUP or
-    WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX or WS_VISIBLE,
+    WS_CLIPSIBLINGS or WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX or WS_VISIBLE,
     0, {Windows.GetSystemMetrics(SM_CXSCREEN) div 2,}
     0, {Windows.GetSystemMetrics(SM_CYSCREEN) div 2,}
     0, 0, HWND(nil), HMENU(nil), HInstance, nil);
@@ -1463,19 +1450,6 @@ Var
     If fdApplyButton In Options then Result := Result Or CF_APPLY;
   End;
 
-  function GetOwnerHandle: HWND;
-  begin
-    with Sender do
-    begin
-      if Owner Is TWinControl then
-        Result := TWinControl(Owner).Handle
-      else if Owner Is TApplication then
-        Result := TApplication(Owner).Handle
-      else
-        Result := FAppHandle;
-    end;
-  end;
-
   procedure ReplacePipe(var AFilter:string);
   var i:integer;
   begin
@@ -1534,7 +1508,7 @@ Begin
     With CC Do
     Begin
       LStructSize := SizeOf(TChooseColor);
-      HWndOwner := GetOwnerHandle;
+      HWndOwner := GetOwnerHandle(Sender);
       RGBResult := TColorDialog(Sender).Color;
       LPCustColors := @CustomColors;
       Flags := CC_FullOpen Or CC_RGBInit;
@@ -1561,7 +1535,7 @@ Begin
     With OpenFile Do
     Begin
       LStructSize := SizeOf(OpenFileName);
-      HWndOwner := GetOwnerHandle;
+      HWndOwner := GetOwnerHandle(Sender);
       LPStrFilter := PChar(FFilter);
       LPStrFile := FName;
       LPStrTitle := PChar(Title);
@@ -1605,7 +1579,7 @@ Begin
     With CF Do
     Begin
       LStructSize := SizeOf(TChooseFont);
-      HWndOwner := GetOwnerHandle;
+      HWndOwner := GetOwnerHandle(Sender);
       LPLogFont := @LF;
       Flags := GetFlagsFromOptions(Options);
       Flags := Flags Or CF_INITTOLOGFONTSTRUCT Or CF_BOTH;
@@ -1647,7 +1621,7 @@ Begin
 
   With bi do
   Begin
-    hwndOwner := 0;                  // should be owner handle
+    hwndOwner := GetOwnerHandle(Sender);
     pidlRoot := nil;
     pszDisplayName := Buffer;
     lpszTitle := PChar(Sender.Title);
@@ -2896,6 +2870,9 @@ End;
 
 {
   $Log$
+  Revision 1.133  2003/11/22 23:56:33  mattias
+  fixed win32 intf menu height from Wojciech
+
   Revision 1.132  2003/11/21 20:32:01  micha
   cleanups; wm_hscroll/wm_vscroll fix
 

lcl/interfaces/win32/win32proc.inc

@@ -508,6 +508,18 @@ Begin
     Assert (False, 'Trace:[ObjectToHWND]****** Warning: handle = 0 *******');
 End;
 
+function GetOwnerHandle(ADialog : TCommonDialog): HWND;
+begin
+  with ADialog do
+  begin
+    if Owner Is TWinControl then
+      Result := TWinControl(Owner).Handle
+    else if Owner Is TApplication then
+      Result := TApplication(Owner).Handle
+    else
+      Result := TWin32Object(InterfaceObject).FAppHandle;
+  end;
+end;
 
 (***********************************************************************
   Widget member Functions
@@ -704,6 +716,9 @@ End;
  { =============================================================================
 
   $Log$
+  Revision 1.30  2003/11/22 23:56:33  mattias
+  fixed win32 intf menu height from Wojciech
+
   Revision 1.29  2003/11/18 07:20:40  micha
   added "included by" notice at top of file