paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 20:19:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed parts of the win32 intf size system

Browse Source 
git-svn-id: trunk@4490 -
This commit is contained in:
mattias 2003-08-17 12:26:00 +00:00
parent a11cc81501
commit a366802840
12 changed files with 304 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
lcl/Makefile
View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/06/05]
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/08/16]
#
default: all
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx
@ -932,6 +932,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -946,6 +947,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -960,6 +962,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -974,6 +977,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -988,6 +992,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -1351,6 +1356,32 @@ ifdef UNITDIR_LIBASYNC
override COMPILER_UNITDIR+=$(UNITDIR_LIBASYNC)
endif
endif
ifdef REQUIRE_PACKAGES_PTHREADS
PACKAGEDIR_PTHREADS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /pthreads/Makefile.fpc,$(PACKAGESDIR))))))
ifneq ($(PACKAGEDIR_PTHREADS),)
ifneq ($(wildcard $(PACKAGEDIR_PTHREADS)/$(OS_TARGET)),)
UNITDIR_PTHREADS=$(PACKAGEDIR_PTHREADS)/$(OS_TARGET)
else
UNITDIR_PTHREADS=$(PACKAGEDIR_PTHREADS)
endif
ifdef CHECKDEPEND
$(PACKAGEDIR_PTHREADS)/$(FPCMADE):
$(MAKE) -C $(PACKAGEDIR_PTHREADS) $(FPCMADE)
override ALLDEPENDENCIES+=$(PACKAGEDIR_PTHREADS)/$(FPCMADE)
endif
else
PACKAGEDIR_PTHREADS=
UNITDIR_PTHREADS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /pthreads/Package.fpc,$(UNITSDIR)))))
ifneq ($(UNITDIR_PTHREADS),)
UNITDIR_PTHREADS:=$(firstword $(UNITDIR_PTHREADS))
else
UNITDIR_PTHREADS=
endif
endif
ifdef UNITDIR_PTHREADS
override COMPILER_UNITDIR+=$(UNITDIR_PTHREADS)
endif
endif
ifdef REQUIRE_PACKAGES_FCL
PACKAGEDIR_FCL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl/Makefile.fpc,$(PACKAGESDIR))))))
ifneq ($(PACKAGEDIR_FCL),)

2
lcl/include/customlistbox.inc
View File

@ -390,7 +390,7 @@ begin
FItemIndex:=-1;
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
SetBounds(1, 1, 100, 80);
SetInitialBounds(0, 0, 100, 80);
end;
{------------------------------------------------------------------------------}

40
lcl/interfaces/win32/Makefile
View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/06/05]
# Don't edit, this file is generated by FPCMake Version 1.1 [2003/08/16]
#
default: all
MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx
@ -206,7 +206,7 @@ override PACKAGE_NAME=lazarus/lcl
override TARGET_UNITS+=interfaces
override TARGET_IMPLICITUNITS+=winext win32def win32int
override CLEAN_FILES+=$(wildcard ../../units/win32/*$(OEXT)) $(wildcard ../../units/win32/*$(PPUEXT)) $(wildcard ../../units/win32/*$(STATICLIBEXT))
override COMPILER_OPTIONS+=-gl -S2 -Sh
override COMPILER_OPTIONS+=-gl
override COMPILER_UNITDIR+=../../units .
override COMPILER_UNITTARGETDIR+=../../units/win32
ifdef REQUIRE_UNITSDIR
@ -887,6 +887,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -898,6 +899,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -909,6 +911,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -920,6 +923,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -931,6 +935,7 @@ REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_NETDB=1
REQUIRE_PACKAGES_LIBASYNC=1
REQUIRE_PACKAGES_PTHREADS=1
REQUIRE_PACKAGES_FCL=1
REQUIRE_PACKAGES_MYSQL=1
REQUIRE_PACKAGES_IBASE=1
@ -1243,6 +1248,32 @@ ifdef UNITDIR_LIBASYNC
override COMPILER_UNITDIR+=$(UNITDIR_LIBASYNC)
endif
endif
ifdef REQUIRE_PACKAGES_PTHREADS
PACKAGEDIR_PTHREADS:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /pthreads/Makefile.fpc,$(PACKAGESDIR))))))
ifneq ($(PACKAGEDIR_PTHREADS),)
ifneq ($(wildcard $(PACKAGEDIR_PTHREADS)/$(OS_TARGET)),)
UNITDIR_PTHREADS=$(PACKAGEDIR_PTHREADS)/$(OS_TARGET)
else
UNITDIR_PTHREADS=$(PACKAGEDIR_PTHREADS)
endif
ifdef CHECKDEPEND
$(PACKAGEDIR_PTHREADS)/$(FPCMADE):
$(MAKE) -C $(PACKAGEDIR_PTHREADS) $(FPCMADE)
override ALLDEPENDENCIES+=$(PACKAGEDIR_PTHREADS)/$(FPCMADE)
endif
else
PACKAGEDIR_PTHREADS=
UNITDIR_PTHREADS:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /pthreads/Package.fpc,$(UNITSDIR)))))
ifneq ($(UNITDIR_PTHREADS),)
UNITDIR_PTHREADS:=$(firstword $(UNITDIR_PTHREADS))
else
UNITDIR_PTHREADS=
endif
endif
ifdef UNITDIR_PTHREADS
override COMPILER_UNITDIR+=$(UNITDIR_PTHREADS)
endif
endif
ifdef REQUIRE_PACKAGES_FCL
PACKAGEDIR_FCL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl/Makefile.fpc,$(PACKAGESDIR))))))
ifneq ($(PACKAGEDIR_FCL),)
@ -1722,6 +1753,5 @@ ifneq ($(wildcard fpcmake.loc),)
include fpcmake.loc
endif
cleartarget:
$(DEL) $(wildcard ../../units/interfaces.*)
all: cleartarget
$(MAKE) -W interfaces.pp interfaces$(PPUEXT)
-$(DEL) $(wildcard ../../units/win32/interfaces.*) $(wildcard ../../units/interfaces.*)
all: cleartarget interfaces$(PPUEXT)

9
lcl/interfaces/win32/Makefile.fpc
View File

@ -14,7 +14,7 @@ units=interfaces
implicitunits=winext win32def win32int
[compiler]
options=-gl -S2 -Sh
options=-gl
unitdir=../../units .
unittargetdir=../../units/win32
@ -23,7 +23,8 @@ files=$(wildcard ../../units/win32/*$(OEXT)) $(wildcard ../../units/win32/*$(PPU
[rules]
cleartarget:
$(DEL) $(wildcard ../../units/interfaces.*)
-$(DEL) $(wildcard ../../units/win32/interfaces.*) $(wildcard ../../units/interfaces.*)
# touch $(wildcard ../../units/*$(OEXT)) $(wildcard ../../units/*$(PPUEXT))
all: cleartarget interfaces$(PPUEXT)
all: cleartarget
$(MAKE) -W interfaces.pp interfaces$(PPUEXT)

5
lcl/interfaces/win32/interfaces.pp
View File

@ -22,10 +22,9 @@
*****************************************************************************
}
Unit interfaces;
Unit Interfaces;
{$MODE OBJFPC}
{$LONGSTRINGS ON}
{$mode objfpc}{$H+}
Interface

117
lcl/interfaces/win32/win32callback.inc
View File

@ -86,10 +86,13 @@ Var
LMessage: TLMessage;
PLMsg: PLMessage;
R: TRect;
NewLeft, NewTop, NewWidth, NewHeight: integer;
NewClientWidth, NewClientHeight: integer;
OwnerObject: TObject;
TheWinControl: TWinControl;
WinProcess: Boolean;
PrevWndProc: Pointer;
LMInsertText: TLMInsertText; // used by CB_INSERTSTRING, LB_INSERTSTRING
LMScroll: TLMScroll; // used by WM_HSCROLL
LMKey: TLMKey; // used by WM_KEYDOWN WM_KEYUP
@ -406,27 +409,6 @@ Begin
UserData := Pointer(GetWindowLong(Window, GWL_USERDATA));
End;
End;
WM_MOVE:
Begin
PLMsg:=@LMMove;
With LMMove Do
Begin
Msg := LM_MOVE;
// MoveType := WParam; WParam is not defined!
MoveType := Move_SourceIsInterface;
//If OwnerObject Is TCustomForm then begin
If Windows.GetParent(Window) = 0 then begin
Windows.GetWindowRect(Window,@R);
XPos := R.Left;
YPos := R.Top;
end
Else begin
XPos := LoWord(LParam);
YPos := HiWord(LParam);
end;
Win32PosToLCLPos(OwnerObject, XPos, YPos);
End;
End;
//TODO:LM_MOVEPAGE,LM_MOVETOROW,LM_MOVETOCOLUMN
WM_NCLBUTTONDOWN:
Begin
@ -516,23 +498,6 @@ Begin
Status := LParam;
End;
End;
WM_SIZE:
Begin
With TLMSize(LMessage) Do
Begin
Msg := LM_SIZE;
SizeType := WParam or Size_SourceIsInterface;
if OwnerObject is TWinControl then
TWinControl(OwnerObject).InvalidateClientRectCache;
Width := LoWord(LParam);
Height := HiWord(LParam);
// adjust size for scrollbars
if (Windows.GetWindowLong(Window, GWL_STYLE) and WS_VSCROLL) <> 0 then
Width := Width - GetSystemMetrics(SM_CXVSCROLL);
if (Windows.GetWindowLong(Window, GWL_STYLE) and WS_HSCROLL) <> 0 then
Height := Height - GetSystemMetrics(SM_CYHSCROLL);
End;
End;
WM_SYSKEYDOWN:
Begin
PLMsg:=@LMKey;
@ -593,6 +558,77 @@ Begin
else
Result := CallWindowProc(PrevWndProc, Window, Msg, WParam, LParam);
end;
Case Msg Of
WM_MOVE:
Begin
PLMsg:=@LMMove;
With LMMove Do
Begin
Msg := LM_MOVE;
// MoveType := WParam; WParam is not defined!
MoveType := Move_SourceIsInterface;
If (Windows.GetParent(Window) = 0)
and (OwnerObject is TCustomForm)
and (TCustomForm(OwnerObject).Parent=nil) then begin
Windows.GetWindowRect(Window,@R);
XPos := R.Left;
YPos := R.Top;
end
Else begin
GetWindowRelativePosition(Window,NewLeft,NewTop);
XPos := NewLeft; //LoWord(LParam);
YPos := NewTop; //HiWord(LParam);
end;
Win32PosToLCLPos(OwnerObject, XPos, YPos);
if OwnerObject is TWinControl then begin
TheWinControl:=TWinControl(OwnerObject);
{writeln('Win32CallBack WM_MOVE ',TheWinControl.Name,':',TheWinControl.ClassName,
' NewPos=',XPos,',',YPos);}
if (TheWinControl.Left=XPos) and (TheWinControl.Top=YPos) then
exit;
end;
End;
End;
WM_SIZE:
Begin
With TLMSize(LMessage) Do
Begin
Msg := LM_SIZE;
SizeType := WParam or Size_SourceIsInterface;
GetWindowSize(Window,NewWidth,NewHeight);
Width:=NewWidth;
Height:=NewHeight;
{Width := LoWord(LParam);
Height := HiWord(LParam);
// adjust size for scrollbars
if (Windows.GetWindowLong(Window, GWL_STYLE) and WS_VSCROLL) <> 0 then
Width := Width + GetSystemMetrics(SM_CXVSCROLL);
if (Windows.GetWindowLong(Window, GWL_STYLE) and WS_HSCROLL) <> 0 then
Height := Height + GetSystemMetrics(SM_CYHSCROLL);}
if (OwnerObject is TWinControl) then begin
TheWinControl:=TWinControl(OwnerObject);
GetClientRect(Window,R);
NewClientWidth:=R.Right-R.Left;
NewClientHeight:=R.Bottom-R.Top;
{writeln('Win32Callback: WM_SIZE ',TheWinControl.Name,':',TheWinControl.ClassName,
' NewSize=',Width,',',Height,
' HasVScroll=',(Windows.GetWindowLong(Window, GWL_STYLE) and WS_VSCROLL) <> 0,
' HasHScroll=',(Windows.GetWindowLong(Window, GWL_STYLE) and WS_HSCROLL) <> 0,
' OldClientSize=',TheWinControl.ClientWidth,',',TheWinControl.ClientHeight,
' NewClientSize=',R.Right,',',R.Bottom);
}
if (TheWinControl.Width=Width)
and (TheWinControl.Height=Height)
and (TheWinControl.ClientWidth=R.Right)
and (TheWinControl.ClientHeight=R.Bottom) then
exit;
TheWinControl.InvalidateClientRectCache;
end;
End;
End;
end;
{$IFDEF VER1_1}
List := TMsgArray(GetProp(Window, 'MsgList'));
@ -654,6 +690,9 @@ end;
{
$Log$
Revision 1.52 2003/08/17 12:26:00 mattias
fixed parts of the win32 intf size system
Revision 1.51 2003/08/13 21:23:10 mattias
fixed log

6
lcl/interfaces/win32/win32def.pp
View File

@ -25,8 +25,7 @@
Unit Win32Def;
{$MODE OBJFPC}
{$LONGSTRINGS ON}
{$mode objfpc}{$H+}
Interface
@ -132,6 +131,9 @@ End.
{ =============================================================================
$Log$
Revision 1.6 2003/08/17 12:26:00 mattias
fixed parts of the win32 intf size system
Revision 1.5 2002/11/23 13:48:48 mattias
added Timer patch from Vincent Snijders

7
lcl/interfaces/win32/win32int.pp
View File

@ -23,14 +23,14 @@
Unit Win32Int;
{$H+}
{$mode objfpc}{$H+}
Interface
{$IFDEF Trace}
{$ASSERTIONS ON}
{$ENDIF}
{
When editing this unit list, be sure to keep Windows listed first to ensure
successful compilation.
@ -188,6 +188,9 @@ End.
{ =============================================================================
$Log$
Revision 1.30 2003/08/17 12:26:00 mattias
fixed parts of the win32 intf size system
Revision 1.29 2003/03/13 19:57:38 mattias
added identcompletion context information and fixed win32 intf

65
lcl/interfaces/win32/win32object.inc
View File

@ -369,13 +369,14 @@ Var
ListItemIndex: TListItem;
LVI: LV_ITEM;
PStr, PStr2: PChar;
R, R2: TRECT;
R, R2, NewRect: TRECT;
S: String;
//SelectionMode: DWORD; // currently only used for listboxes
TBB: TBBUTTON;
WindowStyle: Integer; //used by LM_SETTABPOSITION
OldPageIndex: Integer; //used by LM_SETITEMINDEX of a csNotebook
AMenu: TMenu;
TheWinControl: TWinControl;
Begin
Result := 0; //default value just in case nothing sets it
Assert(False, 'Trace:IntSendMessage3 - Start, Received (' + GetMessageName(LM_Message) + ')');
@ -636,36 +637,46 @@ activate_time : the time at which the activation event occurred.
Begin
If (Sender Is TWinControl) and TWinControl(Sender).HandleAllocated Then
begin
With PRect(Data)^ do
TheWinControl:=TWinControl(Sender);
NewRect := PRect(Data)^;
{Get the width and height for the form}
If TheWinControl.FCompStyle = csForm Then
begin
R := PRect(Data)^;
{Get the width and height for the form}
If TControl(Sender).FCompStyle = csForm Then
// the LCL defines the size of a form without border, win32 with
// adjust size
//writeln('win32 LM_SETSIZE before adjusting form: ',
// ' New=',NewRect.Left,',',NewRect.Top,',',NewRect.Right - NewRect.Left,',',NewRect.Bottom - NewRect.Top);
R:=NewRect;
Windows.AdjustWindowRect(@R,WS_OVERLAPPEDWINDOW,false);
// (Sender as TCustomForm).Menu<>nil);
NewRect.Right:=NewRect.Left+(R.Right-R.Left);
NewRect.Bottom:=NewRect.Top+(R.Bottom-R.Top);
//writeln('win32 LM_SETSIZE after adjusting form: ',
// ' New=',NewRect.Left,',',NewRect.Top,',',NewRect.Right - NewRect.Left,',',NewRect.Bottom - NewRect.Top);
end
else if TheWinControl.FCompStyle = csPage then
begin
if TheWinControl.Parent.HandleAllocated then
begin
Windows.AdjustWindowRect(@R,WS_OVERLAPPEDWINDOW, (Sender as TCustomForm).Menu<>nil);
Windows.SendMessage(TheWinControl.Parent.Handle,
TCM_AdjustRect, 0, LPARAM(@R));
end
else if TControl(Sender).FCompStyle = csPage then
end
else if TheWinControl.FCompStyle = csComboBox then
begin
if (Sender As TWinControl).Parent.HandleAllocated then
begin
Windows.SendMessage((Sender As TWinControl).Parent.Handle, TCM_AdjustRect, 0, LPARAM(@R));
Left := R.Left;
Top := R.Top;
end
end
else if TControl(Sender).FCompStyle = csComboBox then
begin
Windows.GetWindowRect(TWinControl(Sender).Handle,@R);
R.Right:=Right;
R.Left:=Left;
end;
{Adjust for scrollbar}
// the height of a combobox is fixed
Windows.GetWindowRect(TheWinControl.Handle,@R);
NewRect.Bottom:=NewRect.Top+(R.Bottom-R.Top);
end;
{Adjust for scrollbar}
// if (Windows.GetWindowLong(TWinControl(Sender).Handle, GWL_STYLE) and WS_VSCROLL) <> 0 then
// R.Right := R.Right + GetSystemMetrics(SM_CXVSCROLL);
// if (Windows.GetWindowLong(TWinControl(Sender).Handle, GWL_STYLE) and WS_HSCROLL) <> 0 then
// R.Bottom := R.Bottom + GetSystemMetrics(SM_CYHSCROLL);
ResizeChild(Sender, Left, Top, R.Right - R.Left, R.Bottom - R.Top);
end;
{writeln('win32: LM_SETSIZE ',TheWinControl.Name,':',TheWinControl.ClassName,
' New=',NewRect.Left,',',NewRect.Top,',',NewRect.Right - NewRect.Left,',',NewRect.Bottom - NewRect.Top);}
ResizeChild(Sender, NewRect.Left, NewRect.Top,
NewRect.Right - NewRect.Left, NewRect.Bottom - NewRect.Top);
end;
End;
LM_SHOWMODAL:
@ -1630,8 +1641,8 @@ Var
Begin
Handle := (Sender As TWinControl).Handle;
LCLBoundsToWin32Bounds(Sender, Left, Top, Width, Height);
If Handle <> HWND(Nil) Then
MoveWindow(Handle, Left, Top, Width, Height, True)
If Handle <> 0 Then
MoveWindow(Handle, Left, Top, Width, Height, True);
End;
{------------------------------------------------------------------------------
@ -1943,6 +1954,7 @@ Begin
Begin
Window := CreateWindow('BUTTON', StrTemp, Flags Or BS_GROUPBOX, Left, Top, Width, Height, Parent, HMENU(Nil), HInstance, Nil);
SetProp(Window, 'Lazarus', Sender);
TWinControl(Sender).InvalidateClientRectCache;
End;
{csHintWindow:
Begin
@ -2742,6 +2754,9 @@ End;
{
$Log$
Revision 1.88 2003/08/17 12:26:00 mattias
fixed parts of the win32 intf size system
Revision 1.87 2003/08/14 10:36:55 mattias
added TSelectDirectoryDialog

35
lcl/interfaces/win32/win32proc.inc
View File

@ -709,19 +709,26 @@ Begin
Result := GetProp(Control, 'AccelKey');
End;
Procedure LCLBoundsToWin32Bounds(Sender: TObject; var Left, Top, Width, Height: Integer);
Procedure LCLBoundsToWin32Bounds(Sender: TObject;
var Left, Top, Width, Height: Integer);
var
TM: TextMetricA;
DC: HDC;
Handle: HWND;
TheWinControl: TWinControl;
Begin
if Sender = nil then exit;
If (TControl(Sender).Parent Is TCustomGroupBox) Then
if (Sender = nil) or (not (Sender is TWinControl)) then exit;
TheWinControl:=TWinControl(Sender);
If (TheWinControl.Parent Is TCustomGroupBox) Then
Begin
Handle := TControl(Sender).Parent.Handle;
// The client area of a groupbox under win32 is the whole size, including
// the frame. The LCL defines the client area without the frame.
// -> Adjust the position
Handle := TheWinControl.Parent.Handle;
DC := GetDC(Handle);
GetTextMetrics(DC, TM);
Top := Top + TM.TMHeight;
inc(Top,TM.TMHeight); // add the upper frame with the caption
inc(Left,2); // add the left frame border
ReleaseDC(Handle, DC);
End;
End;
@ -731,15 +738,20 @@ var
TM: TextMetricA;
DC: HDC;
Handle: HWND;
TheWinControl: TWinControl;
Begin
if Sender = nil then exit;
// check for groupbox client pos
If (TControl(Sender).Parent Is TCustomGroupBox) Then
if (Sender = nil) or (not (Sender is TWinControl)) then exit;
TheWinControl:=TWinControl(Sender);
If (TheWinControl.Parent Is TCustomGroupBox) Then
Begin
Handle := TControl(Sender).Parent.Handle;
// The client area of a groupbox under win32 is the whole size, including
// the frame. The LCL defines the client area without the frame.
// -> Adjust the position
Handle := TheWinControl.Parent.Handle;
DC := GetDC(Handle);
GetTextMetrics(DC, TM);
Top := Top - TM.TMHeight;
dec(Top,TM.TMHeight); // subtract the upper frame with the caption
dec(Left,2); // subtract the left frame border
ReleaseDC(Handle, DC);
End;
End;
@ -752,6 +764,9 @@ End;
{ =============================================================================
$Log$
Revision 1.20 2003/08/17 12:26:00 mattias
fixed parts of the win32 intf size system
Revision 1.19 2003/08/13 21:23:10 mattias
fixed log

80
lcl/interfaces/win32/win32winapi.inc
View File

@ -1097,8 +1097,31 @@ End;
Retrieves the coordinates of a window's client area.
------------------------------------------------------------------------------}
Function TWin32Object.GetClientRect(Handle: HWND; Var Rect: TRect): Boolean;
var
OwnerObject: TObject;
TheWinControl: TWinControl;
TM: TextMetricA;
DC: HDC;
Begin
Result := Windows.GetClientRect(Handle, @Rect);
OwnerObject := TObject(GetProp(Handle, 'Lazarus'));
if OwnerObject is TWinControl then begin
TheWinControl:=TWinControl(OwnerObject);
if TheWinControl is TGroupBox then begin
// The client area of a groupbox under win32 is the whole size, including
// the frame. The LCL defines the client area without the frame.
// -> Adjust the client size
DC := GetDC(Handle);
GetTextMetrics(DC, TM);
dec(Rect.Bottom,TM.TMHeight+2); // subtract the top frame with the caption
// and subtract the bottom frame
dec(Rect.Right,2+2); // subtract the left and right frame border
ReleaseDC(Handle, DC);
{writeln('TWin32Object.GetClientRect ',TheWinControl.Name,':',TheWinControl.ClassName,
' ClientRect=',Rect.Right,',',Rect.Bottom,
' CurLCLBounds=',TheWinControl.Left,',',TheWinControl.Top,',',TheWinControl.Width,',',TheWinControl.Height);}
end;
end;
End;
{------------------------------------------------------------------------------
@ -1410,11 +1433,16 @@ End;
returns the current widget Left, Top, relative to the client origin of its
parent
------------------------------------------------------------------------------}
Function TWin32Object.GetWindowRelativePosition(Handle : HWND; var Left, Top:integer): boolean;
Function TWin32Object.GetWindowRelativePosition(Handle : HWND;
var Left, Top:integer): boolean;
var
LeftTop:TPoint;
R: TRect;
ParentHandle: THandle;
OwnerObject: TObject;
TheWinControl: TWinControl;
DC: HDC;
TM: TextMetricA;
begin
Result:=Windows.GetWindowRect(Handle,@R);
LeftTop.X:=R.Left;
@ -1425,17 +1453,56 @@ begin
Result:=False;
Left:=LeftTop.X;
Top:=LeftTop.Y;
OwnerObject := TObject(GetProp(Handle, 'Lazarus'));
if OwnerObject is TWinControl then begin
TheWinControl:=TWinControl(OwnerObject);
if TheWinControl is TGroupBox then begin
// The client area of a groupbox under win32 is the whole size, including
// the frame. The LCL defines the client area without the frame.
// -> Adjust the position
DC := GetDC(Handle);
GetTextMetrics(DC, TM);
dec(Left,TM.TMHeight+2); // subtract the top frame with the caption
// and subtract the bottom frame
dec(Top,2+2); // subtract the left and right frame border
ReleaseDC(Handle, DC);
{writeln('TWin32Object.GetClientRect ',TheWinControl.Name,':',TheWinControl.ClassName,
' ClientRect=',Rect.Right,',',Rect.Bottom,
' CurLCLBounds=',TheWinControl.Left,',',TheWinControl.Top,',',TheWinControl.Width,',',TheWinControl.Height);}
end;
end;
end;
Function TWin32Object.GetWindowSize(Handle : hwnd; var Width, Height: integer): boolean;
{------------------------------------------------------------------------------
Function: GetWindowSize
Params: Handle : hwnd;
Returns: true on success
Returns the current widget Width and Height
------------------------------------------------------------------------------}
Function TWin32Object.GetWindowSize(Handle : hwnd;
var Width, Height: integer): boolean;
var
R: TRect;
OwnerObject: TObject;
TheForm: TCustomForm;
begin
Result := GetClientRect(Handle, R);
Result := Windows.GetWindowRect(Handle,@R);
If (Windows.GetParent(Handle) = 0) then begin
OwnerObject := TObject(GetProp(Handle, 'Lazarus'));
if OwnerObject is TCustomForm then begin
// the LCL defines the size of a form without the borders.
// That means for the win32: The client area + menu
TheForm:=TCustomForm(OwnerObject);
Result:=GetClientRect(Handle,R);
// add menu
// ToDo
end;
end;
with R Do
begin
Width := right - left;
Height := bottom - top;
Width := Right - Left;
Height := Bottom - Top;
end;
end;
@ -2381,6 +2448,9 @@ end;
{ =============================================================================
$Log$
Revision 1.51 2003/08/17 12:26:00 mattias
fixed parts of the win32 intf size system
Revision 1.50 2003/08/13 21:23:10 mattias
fixed log

2
lcl/interfaces/win32/winext.pas
View File

@ -18,6 +18,8 @@
Unit WinExt;
{$mode objfpc}{$H+}
{$IFDEF TRACE}
{$ASSERTIONS ON}
{$ENDIF}