mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-07 22:58:14 +02:00
fixed win32 intf menu height from Wojciech
git-svn-id: trunk@4827 -
This commit is contained in:
mattias
parent
ac30a1f0ee
commit
7b213bc79f
@ -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);
|
||||
if Execute then Self.Font.Assign(Font);
|
||||
Font.Assign(fontButton.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;
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
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;
|
||||
FWin32MenuHeight:= GetSystemMetrics(SM_CYMENU);
|
||||
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
|
||||
WS_CAPTION or WS_SYSMENU or WS_MINIMIZEBOX or WS_VISIBLE,
|
||||
FAppHandle := CreateWindow(@ClsName, PChar(Application.Title), WS_POPUP or
|
||||
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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user