From 6c5073cde1e6e46844c2b1b07d0350ecaf4a92de Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 31 Aug 2003 17:30:49 +0000 Subject: [PATCH] fixed TControl painting for win32 git-svn-id: trunk@4551 - --- lcl/include/customform.inc | 206 ++------------------------ lcl/include/interfacebase.inc | 8 +- lcl/include/winapih.inc | 5 +- lcl/include/wincontrol.inc | 25 +++- lcl/interfaces/win32/win32object.inc | 9 +- lcl/interfaces/win32/win32proc.inc | 78 ++++++---- lcl/interfaces/win32/win32winapi.inc | 113 +++++++++----- lcl/interfaces/win32/win32winapih.inc | 4 + 8 files changed, 184 insertions(+), 264 deletions(-) diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index fc5fb75e35..cab929fa0e 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -1308,16 +1308,19 @@ begin end else begin case Position of - //TODO:poDefault, poDefaultPosOnly, poDefaultSizeOnly - poScreenCenter, poDesktopCenter : begin + //TODO:poDefault, poDefaultPosOnly, poDefaultSizeOnly + poScreenCenter, poDesktopCenter : + begin X:= (Screen.Width - Width) div 2; Y:= (Screen.Height - Height) div 2; end; - poMainFormCenter : if (Self <> Application.MainForm) then begin + poMainFormCenter : + if (Self <> Application.MainForm) then begin X:= ((Application.MainForm.Width - Width) div 2) + Application.MainForm.Left; Y:= ((Application.MainForm.Height - Height) div 2) + Application.MainForm.Top; end; - poOwnerFormCenter : if (Owner is TCustomForm) then begin + poOwnerFormCenter : + if (Owner is TCustomForm) then begin X:= ((TCustomForm(Owner).Width - Width) div 2) + TCustomForm(Owner).Left; Y:= ((TCustomForm(Owner).Height - Height) div 2) + TCustomForm(Owner).Top; end; @@ -1426,6 +1429,9 @@ end; { ============================================================================= $Log$ + Revision 1.112 2003/08/31 17:30:49 mattias + fixed TControl painting for win32 + Revision 1.111 2003/08/28 12:08:30 mattias fixed register color prop edit @@ -1791,194 +1797,4 @@ end; Revision 1.1 2000/07/13 10:28:25 michael + Initial import - Revision 1.5 2000/05/09 02:07:40 lazarus - Replaced writelns with Asserts. CAW - - Revision 1.4 2000/05/03 17:19:29 lazarus - Added the TScreem forms code by hongli@telekabel.nl - Shane - - Revision 1.3 2000/04/10 14:03:07 lazarus - Added SetProp and GetProp winapi calls. - Added ONChange to the TEdit's published property list. - Shane - - Revision 1.2 2000/04/07 16:59:55 lazarus - Implemented GETCAPTURE and SETCAPTURE along with RELEASECAPTURE. - Shane - - Revision 1.1 2000/04/02 20:49:56 lazarus - MWE: - Moved lazarus/lcl/*.inc files to lazarus/lcl/include - - Revision 1.37 2000/03/30 18:07:53 lazarus - Added some drag and drop code - Added code to change the unit name when it's saved as a different name. Not perfect yet because if you are in a comment it fails. - - Shane - - Revision 1.36 2000/03/15 20:15:31 lazarus - MOdified TBitmap but couldn't get it to work - Shane - - Revision 1.35 2000/03/03 20:22:03 lazarus - Trying to add TBitBtn - Shane - - Revision 1.34 2000/03/01 00:41:02 lazarus - MWE: - Fixed updateshowing problem - Added some debug code to display the name of messages - Did a bit of cleanup in main.pp to get the code a bit more readable - (my editor does funny things with tabs if the indent differs) - - Revision 1.33 2000/02/28 19:16:04 lazarus - Added code to the FILE CLOSE to check if the file was modified. HAven't gotten the application.messagebox working yet though. It won't stay visible. - Shane - - Revision 1.32 2000/02/28 00:15:54 lazarus - MWE: - Fixed creation of visible componets at runtime. (when a new editor - was created it didn't show up) - Made the hiding/showing of controls more delphi compatible - - Revision 1.31 2000/02/24 21:15:30 lazarus - Added TCustomForm.GetClientRect and RequestAlign to try and get the controls to align correctly when a MENU is present. Not Complete yet. - - Fixed the bug in TEdit that caused it not to update it's text property. I will have to - look at TMemo to see if anything there was affected. - - Added SetRect to WinAPI calls - Added AdjustWindowRectEx to WINAPI calls. - Shane - - Revision 1.30 2000/02/23 14:19:09 lazarus - Fixed the conflicts caused when two people worked on the ShowModal method for CustomForm and CustomDialog at the same time. - Shane - - Revision 1.29 2000/02/22 22:19:49 lazarus - TCustomDialog is a descendant of TComponent. - Initial cuts a form's proper Close behaviour. - - Revision 1.28 2000/02/22 17:32:49 lazarus - Modified the ShowModal call. - For TCustomForm is simply sets the visible to true now and adds fsModal to FFormState. In gtkObject.inc FFormState is checked. If it contains fsModal then either gtk_grab_add or gtk_grab_remove is called depending on the value of VISIBLE. - - The same goes for TCustomDialog (open, save, font, color). - I moved the Execute out of the individual dialogs and moved it into TCustomDialog and made it virtual because FONT needs to set some stuff before calling the inherited execute. - Shane - - Revision 1.27 2000/02/19 18:11:59 lazarus - More work on moving, resizing, forms' border style etc. - - Revision 1.26 2000/02/18 19:38:52 lazarus - Implemented TCustomForm.Position - Better implemented border styles. Still needs some tweaks. - Changed TComboBox and TListBox to work again, at least partially. - Minor cleanups. - - Revision 1.25 2000/01/03 00:19:21 lazarus - MWE: - Added keyup and buttonup events - Added LM_MOUSEMOVE callback - Started with scrollbars in editor - - Revision 1.24 1999/12/22 01:16:03 lazarus - MWE: - Changed/recoded keyevent callbacks - We Can Edit! - Commented out toolbar stuff - - Revision 1.23 1999/12/14 00:16:43 lazarus - MWE: - Renamed LM... message handlers to WM... to be compatible and to - get more edit parts to compile - Started to implement GetSystemMetrics - Removed some Lazarus specific parts from mwEdit - - Revision 1.22 1999/12/10 00:47:01 lazarus - MWE: - Fixed some samples - Fixed Dialog parent is no longer needed - Fixed (Win)Control Destruction - Fixed MenuClick - - Revision 1.21 1999/12/08 00:56:07 lazarus - MWE: - Fixed menus. Events aren't enabled yet (dumps --> invalid typecast ??) - - Revision 1.20 1999/12/07 01:19:25 lazarus - MWE: - Removed some double events - Changed location of SetCallBack - Added call to remove signals - Restructured somethings - Started to add default handlers in TWinControl - Made some parts of TControl and TWinControl more delphi compatible - ... and lots more ... - - Revision 1.19 1999/11/23 22:06:27 lazarus - Minor changes to get it running again with the latest compiler. There is something wrong with the compiler that is preventing certain things from working. - Shane - - Revision 1.18 1999/11/04 21:52:08 lazarus - wndproc being used a little - Shane - - Revision 1.17 1999/11/02 16:02:34 lazarus - Added a bunch of wndproc stuff and a lot of functions that really don't do a thing at this point. - Shane - - Revision 1.16 1999/11/01 09:53:16 lazarus - MWE: Implemented HandleNeeded/CreateHandle/CreateWND - Now controls are created on demand. A call to CreateComponent shouldn't - be needed. It is now part of CreateWnd - - Revision 1.15 1999/10/28 23:48:57 lazarus - MWE: Added new menu classes and started to use handleneeded - - Revision 1.14 1999/10/28 20:37:34 lazarus - TCustomForm.ClientWndProc added. - Shane - - Revision 1.13 1999/10/27 17:27:07 lazarus - Added alot of changes and TODO: statements - shane - - Revision 1.12 1999/10/27 12:53:23 lazarus - Added LCLLinux.pp and removed Linux.pp - Also, added the TCustomForm.ISFORM function. - Shane - - Revision 1.11 1999/09/21 23:46:53 lazarus - *** empty log message *** - - Revision 1.10 1999/08/07 17:59:16 lazarus - - buttons.pp the DoLeave and DoEnter were connected to the wrong - event. - - The rest were modified to use the new CNSendMEssage function. MAH - - Revision 1.9 1999/08/02 01:13:32 lazarus - Added new colors and corrected BTNFACE - Need the TSCrollbar class to go further with the editor. - Mouse doesn't seem to be working correctly yet when I click on the editor window - - Revision 1.8 1999/08/01 21:46:24 lazarus - Modified the GETWIDTH and GETHEIGHT of TFOnt so you can use it to calculate the length in Pixels of a string. This is now used in the editor. - - Shane - - Revision 1.7 1999/07/31 06:39:20 lazarus - - Modified the IntCNSendMEssage3 to include a data variable. It isn't used - yet but will help in merging the Message2 and Message3 features. - - Adjusted TColor routines to match Delphi color format - - Added a TGdkColorToTColor routine in gtkproc.inc - - Finished the TColorDialog added to comDialog example. MAH - - } +} diff --git a/lcl/include/interfacebase.inc b/lcl/include/interfacebase.inc index 48f1a9686b..bba8384073 100644 --- a/lcl/include/interfacebase.inc +++ b/lcl/include/interfacebase.inc @@ -850,9 +850,10 @@ begin Result := False; end; -Function TInterfaceBase.GetClientBounds(handle : HWND; var Rect : TRect) : Boolean; +Function TInterfaceBase.GetClientBounds(Handle : HWND; + var ARect: TRect) : Boolean; begin - Result := False; + Result := false; end; Function TInterfaceBase.GetClientRect(handle : HWND; var Rect : TRect) : Boolean; @@ -1827,6 +1828,9 @@ end; { ============================================================================= $Log$ + Revision 1.103 2003/08/31 17:30:49 mattias + fixed TControl painting for win32 + Revision 1.102 2003/08/26 08:12:33 mattias applied listbox/combobox patch from Karl diff --git a/lcl/include/winapih.inc b/lcl/include/winapih.inc index d5deb96c75..10d59ef0d0 100644 --- a/lcl/include/winapih.inc +++ b/lcl/include/winapih.inc @@ -122,7 +122,7 @@ function GetBitmapRawImageDescription(Bitmap: HBITMAP; Desc: PRawImageDescriptio function GetCapture : HWND; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetCaretPos(var lpPoint: TPoint): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} function GetCaretRespondToFocus(handle: HWND; var ShowHideOnFocus: boolean): Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} -Function GetClientBounds(handle : HWND; var Rect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} +Function GetClientBounds(handle : HWND; var ARect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} Function GetClientRect(handle : HWND; var Rect: TRect) : Boolean; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} Function GetClipBox(DC : hDC; lpRect : PRect) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} Function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; {$IFDEF IF_BASE_MEMBER}virtual;{$ENDIF} @@ -397,6 +397,9 @@ procedure RaiseLastOSError; { ============================================================================= $Log$ + Revision 1.88 2003/08/31 17:30:49 mattias + fixed TControl painting for win32 + Revision 1.87 2003/08/26 08:12:33 mattias applied listbox/combobox patch from Karl diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 99d2c176e4..9c5f51c1cc 100644 --- a/lcl/include/wincontrol.inc +++ b/lcl/include/wincontrol.inc @@ -736,9 +736,9 @@ End; returns the screen coordinate of the topleft coordinate 0,0 of the client area Note that this value is the position as stored in the interface and is not - always consistent with the LCL. When a control is moved, the LCL sets the - bounds to the wanted position and sends a move message to the interface. It is - up to the interface to handle moves instantly or queued. + always in sync with the LCL. When a control is moved, the LCL sets the bounds + to the wanted position and sends a move message to the interface. It is up to + the interface to handle moves instantly or queued. -------------------------------------------------------------------------------} Function TWinControl.GetClientOrigin: TPoint; var @@ -2337,6 +2337,7 @@ var PS : TPaintStruct; MemWidth: Integer; MemHeight: Integer; + ClientBoundRect: TRect; begin //writeln('[TWinControl.WMPaint] ',Name,':',ClassName,' ',HexStr(Msg.DC,8)); if ([csDestroying,csLoading]*ComponentState<>[]) or (not HandleAllocated) then @@ -2368,15 +2369,26 @@ begin MemDC := CreateCompatibleDC(0); OldBitmap := SelectObject(MemDC, MemBitmap); try + // Fetch a DC of the whole Handle (including client area) DC := BeginPaint(Handle, PS); + if DC=0 then exit; + // erase background Include(FFlags,wcfEraseBackground); Perform(LM_ERASEBKGND, MemDC, 0); Exclude(FFlags,wcfEraseBackground); + // create a paint message to paint the child controls. + // WMPaint expects the DC origin to be equal to the client origin of its + // parent + // -> Move the DC Origin to the client origin + if not GetClientBounds(Handle,ClientBoundRect) then exit; + MoveWindowOrgEx(MemDC,ClientBoundRect.Left,ClientBoundRect.Top); + // handle the paint message Msg.DC := MemDC; WMPaint(Msg); Msg.DC := 0; - //TODO:bitblt - BitBlt(DC, 0, 0, MemWidth, MemHeight, MemDC, 0, 0, SRCCOPY); + // restore the DC origin + MoveWindowOrgEx(MemDC,-ClientBoundRect.Left,-ClientBoundRect.Top); + BitBlt(DC, 0,0, MemWidth, MemHeight, MemDC, 0, 0, SRCCOPY); EndPaint(Handle, PS); finally Exclude(FFlags,wcfEraseBackground); @@ -3064,6 +3076,9 @@ end; { ============================================================================= $Log$ + Revision 1.166 2003/08/31 17:30:49 mattias + fixed TControl painting for win32 + Revision 1.165 2003/08/27 11:01:10 mattias started TDockTree diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 73315a7faa..f1db24198a 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -445,7 +445,7 @@ Begin Begin if Sender=nil then Handle := GetDesktopWindow else Handle := ObjectToHwnd(Sender); - DC := GetDC(Handle); + DC := Windows.GetDC(Handle); //WriteLn('LM_SCREENINIT called --> should go to TWin32Object.Init'); //WriteLn('TODO: check this'); PLMScreenInit(Data)^.PixelsPerInchX := GetDeviceCaps(DC, LogPixelsX); @@ -1771,7 +1771,7 @@ Begin // Temphack to set backcolor, till better solution If HandleAllocated Then Begin - DC := GetDC(Handle); + DC := Windows.GetDC(Handle); SetBKColor(Handle, Color); ReleaseDC(Handle, DC); End; @@ -1931,7 +1931,7 @@ Begin End; csImage: Begin - DC := GetDC(Handle); + DC := Windows.GetDC(Handle); With TImage(Sender).Picture.Bitmap Do Window := CreateBitmap(Width, Height, GetDeviceCaps(DC, PLANES), BitsPerPixel[Monochrome], Nil); SetOwner(Window, Sender); @@ -2815,6 +2815,9 @@ End; { $Log$ + Revision 1.104 2003/08/31 17:30:49 mattias + fixed TControl painting for win32 + Revision 1.103 2003/08/31 14:48:15 mattias replaced some as from Micha diff --git a/lcl/interfaces/win32/win32proc.inc b/lcl/interfaces/win32/win32proc.inc index 88e8fcc4f4..96a52b4e6f 100644 --- a/lcl/interfaces/win32/win32proc.inc +++ b/lcl/interfaces/win32/win32proc.inc @@ -618,51 +618,76 @@ Begin Result := GetProp(Control, 'AccelKey'); End; -Procedure LCLBoundsToWin32Bounds(Sender: TObject; - var Left, Top, Width, Height: Integer); +{------------------------------------------------------------------------------- + function GetLCLClientOriginOffset(Sender: TObject; + var LeftOffset, TopOffset: integer): boolean; + + Returns the difference between the client origin of a win32 handle + and the definition of the LCL counterpart. + For example: + TGroupBox's client area is the area inside the groupbox frame. + Hence, the LeftOffset is the frame width and the TopOffset is the caption + height. +-------------------------------------------------------------------------------} +function GetLCLClientOriginOffset(Sender: TObject; + var LeftOffset, TopOffset: integer): boolean; var TM: TextMetricA; DC: HDC; Handle: HWND; TheWinControl: TWinControl; Begin + Result:=false; + LeftOffset:=0; + TopOffset:=0; if (Sender = nil) or (not (Sender is TWinControl)) then exit; TheWinControl:=TWinControl(Sender); - If (TheWinControl.Parent Is TCustomGroupBox) Then + if not TheWinControl.HandleAllocated then exit; + If (TheWinControl is TCustomGroupBox) 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 - Handle := TheWinControl.Parent.Handle; - DC := GetDC(Handle); + Handle := TheWinControl.Handle; + DC := Windows.GetDC(Handle); GetTextMetrics(DC, TM); - inc(Top,TM.TMHeight); // add the upper frame with the caption - inc(Left,2); // add the left frame border + inc(TopOffset,TM.TMHeight); // add the upper frame with the caption + inc(LeftOffset,2); // add the left frame border ReleaseDC(Handle, DC); End; + Result:=true; +end; + +function GetLCLClientOriginOffset(Handle: HWnd; + var LeftOffset, TopOffset: integer): boolean; +var + OwnerObject: TObject; +begin + OwnerObject := TObject(GetProp(Handle, 'Lazarus')); + Result:=GetLCLClientOriginOffset(OwnerObject,LeftOffset,TopOffset); +end; + +Procedure LCLBoundsToWin32Bounds(Sender: TObject; + var Left, Top, Width, Height: Integer); +var + LeftOffset: integer; + TopOffset: integer; +Begin + if (Sender=nil) or (not (Sender is TWinControl)) then exit; + GetLCLClientOriginOffset(TWinControl(Sender).Parent,LeftOffset,TopOffset); + inc(Left,LeftOffset); + inc(Top,TopOffset); End; Procedure Win32PosToLCLPos(Sender: TObject; var Left, Top: SmallInt); var - TM: TextMetricA; - DC: HDC; - Handle: HWND; - TheWinControl: TWinControl; + LeftOffset: integer; + TopOffset: integer; Begin - if (Sender = nil) or (not (Sender is TWinControl)) then exit; - TheWinControl:=TWinControl(Sender); - If (TheWinControl.Parent Is TCustomGroupBox) 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 - Handle := TheWinControl.Parent.Handle; - DC := GetDC(Handle); - GetTextMetrics(DC, TM); - dec(Top,TM.TMHeight); // subtract the upper frame with the caption - dec(Left,2); // subtract the left frame border - ReleaseDC(Handle, DC); - End; + if (Sender=nil) or (not (Sender is TWinControl)) then exit; + GetLCLClientOriginOffset(TWinControl(Sender).Parent,LeftOffset,TopOffset); + dec(Left,LeftOffset); + dec(Top,TopOffset); End; {$IFDEF ASSERT_IS_ON} @@ -673,6 +698,9 @@ End; { ============================================================================= $Log$ + Revision 1.25 2003/08/31 17:30:49 mattias + fixed TControl painting for win32 + Revision 1.24 2003/08/28 09:10:01 mattias listbox and comboboxes now set sort and selection at handle creation diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index aa944cc2ba..683bb05876 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -139,23 +139,46 @@ End; functions for the message. ------------------------------------------------------------------------------} Procedure TWin32Object.CallDefaultWndHandler(Sender: TObject; var Message); -var - Handle: HWND; - PrevWndProc: pointer; -begin - Handle := ObjectToHwnd(Sender); - case TLMessage(Message).Msg of - - LM_PAINT: - begin + + procedure CallWin32PaintHandler; + var + PaintMsg: TLMPaint; + Handle: HWND; + PrevWndProc: pointer; + ClientBoundRect: TRect; + begin + // the LCL creates paint messages, with a DC origin set to the client + // origin of the emitting control. The paint handler of win32 expects the + // DC origin at the origin of the control. + // -> move the windoworigin + Handle := ObjectToHwnd(Sender); + ClientBoundRect:=Rect(0,0,0,0); + if Sender is TWinControl then + if not GetClientBounds(Handle,ClientBoundRect) then exit; + PaintMsg:=TLMPaint(Message); + MoveWindowOrgEx(PaintMsg.DC,-ClientBoundRect.Left,-ClientBoundRect.Top); + try + // call win32 paint handler PrevWndProc := GetProp(Handle, 'DefWndProc'); if PrevWndProc = nil then - DefWindowProc(Handle, WM_PAINT, TLMessage(Message).WParam, TLMessage(Message).LParam) + DefWindowProc(Handle, WM_PAINT, TLMessage(Message).WParam, + TLMessage(Message).LParam) else CallWindowProc(PrevWndProc, Handle, WM_PAINT, TLMessage(Message).WParam, TLMessage(Message).LParam); + finally + // restore DC origin + MoveWindowOrgEx(PaintMsg.DC,ClientBoundRect.Left,ClientBoundRect.Top); end; end; + +begin + case TLMessage(Message).Msg of + + LM_PAINT: + CallWin32PaintHandler; + + end; end; {------------------------------------------------------------------------------ @@ -218,8 +241,15 @@ End; Converts client coordinates to screen coordinates ------------------------------------------------------------------------------} Function TWin32Object.ClientToScreen(Handle: HWND; Var P: TPoint): Boolean; +var + LeftOffset, TopOffset: integer; Begin Result := Windows.ClientToScreen(Handle, @P); + if (not Result) then exit; + Result := GetLCLClientOriginOffset(Handle,LeftOffset,TopOffset); + if not Result then exit; + inc(P.X,LeftOffset); + inc(P.X,TopOffset); End; {------------------------------------------------------------------------------ @@ -681,7 +711,7 @@ Begin End; If (Width <> 0) And (Height <> 0) Then Begin - hdcScreen := GetDC(GetDesktopWindow); + hdcScreen := Windows.GetDC(GetDesktopWindow); hdcBitmap := CreateCompatibleDC(hdcScreen); hbmBitmap := CreateCompatibleBitmap(hdcScreen, Width, Height); OldObject := SelectObject(hdcBitmap, hbmBitmap); @@ -1099,6 +1129,25 @@ End; Retrieves the coordinates of a window's client area. ------------------------------------------------------------------------------} +function TWin32Object.GetClientBounds(Handle: HWND; Var Rect: TRect): Boolean; +var + LeftOffset, TopOffset: integer; +begin + Result := GetClientRect(Handle, Rect); + if not Result then exit; + if not GetLCLClientOriginOffset(Handle,LeftOffset,TopOffset) then exit; + OffsetRect(Rect,LeftOffset,TopOffset); +end; + +{------------------------------------------------------------------------------ + Method: GetClientRect + Params: Handle - handle of window + Rect - record for client coordinates + Returns: If the function succeeds + + Retrieves the dimension of a window's client area. + Left and Top are always 0,0 + ------------------------------------------------------------------------------} Function TWin32Object.GetClientRect(Handle: HWND; Var Rect: TRect): Boolean; var OwnerObject: TObject; @@ -1107,6 +1156,7 @@ var DC: HDC; Begin Result := Windows.GetClientRect(Handle, @Rect); + if not Result then exit; OwnerObject := TObject(GetProp(Handle, 'Lazarus')); if OwnerObject is TWinControl then begin TheWinControl:=TWinControl(OwnerObject); @@ -1114,7 +1164,7 @@ 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); + DC := Windows.GetDC(Handle); GetTextMetrics(DC, TM); dec(Rect.Bottom,TM.TMHeight+2); // subtract the top frame with the caption // and subtract the bottom frame @@ -1190,9 +1240,15 @@ End; the specified window. ------------------------------------------------------------------------------} Function TWin32Object.GetDC(HWnd: HWND): HDC; +var + LeftOffset, TopOffset: integer; Begin Assert(False, Format('Trace:> [TWin32Object.GetDC] HWND: 0x%x', [HWnd])); Result := Windows.GetDC(HWnd); + if (Result<>0) and (HWnd<>0) + and GetLCLClientOriginOffset(HWnd,LeftOffset,TopOffset) then begin + MoveWindowOrgEx(Result,LeftOffset,TopOffset); + end; Assert(False, Format('Trace:< [TWin32Object.GetDC] Got 0x%x', [Result])); End; @@ -1448,36 +1504,24 @@ var LeftTop:TPoint; R: TRect; ParentHandle: THandle; - OwnerObject: TObject; - TheWinControl: TWinControl; - DC: HDC; - TM: TextMetricA; + LeftOffset, TopOffset: integer; begin - Result:=Windows.GetWindowRect(Handle,@R); + Result:=false; + if not Windows.GetWindowRect(Handle,@R) then exit; LeftTop.X:=R.Left; LeftTop.Y:=R.Top; ParentHandle:=Windows.GetParent(Handle); if ParentHandle<>0 then begin - Windows.ScreenToClient(ParentHandle,@LeftTop); - OwnerObject := TObject(GetProp(ParentHandle, 'Lazarus')); - if (OwnerObject<>nil) and (OwnerObject is TWinControl) then begin - TheWinControl:=TWinControl(OwnerObject); - if TheWinControl is TGroupBox then - begin - {$IFDEF VerboseSizeMsg} - writeln('TWin32Object.GetWindowRelativePosition A ',TheWinControl.Name,':',TheWinControl.ClassName,' Win32=',R.Left,',',R.Top,' Moved=',LeftTop.X,',',LeftTop.Y); - {$ENDIF} - DC := GetDC(ParentHandle); - GetTextMetrics(DC, TM); - dec(LeftTop.Y,TM.TMHeight); - dec(LeftTop.X,2); - ReleaseDC(ParentHandle, DC); - end; - end; + if not Windows.ScreenToClient(ParentHandle,@LeftTop) then exit; + if not GetLCLClientOriginOffset(ParentHandle,LeftOffset,TopOffset) then + exit; + dec(LeftTop.X,LeftOffset); + dec(LeftTop.Y,TopOffset); end; Left:=LeftTop.X; Top:=LeftTop.Y; + Result:=true; end; {------------------------------------------------------------------------------ @@ -2431,6 +2475,9 @@ end; { ============================================================================= $Log$ + Revision 1.59 2003/08/31 17:30:49 mattias + fixed TControl painting for win32 + Revision 1.58 2003/08/27 08:14:37 mattias fixed system fonts for win32 intf diff --git a/lcl/interfaces/win32/win32winapih.inc b/lcl/interfaces/win32/win32winapih.inc index 58cedcf7e2..e00b0afb19 100644 --- a/lcl/interfaces/win32/win32winapih.inc +++ b/lcl/interfaces/win32/win32winapih.inc @@ -83,6 +83,7 @@ Function GetActiveWindow: HWND; Override; Function GetCapture: HWND; Override; Function GetCaretPos(Var LPPoint: TPoint): Boolean; Override; Function GetCharABCWidths(DC: HDC; P2, P3: UINT; Const ABCStructs): Boolean; Override; +function GetClientBounds(Handle: HWND; Var Rect: TRect): Boolean; Override; Function GetClientRect(Handle: HWND; Var Rect: TRect): Boolean; Override; Function GetClipBox(DC : hDC; lpRect : PRect) : Longint; Override; Function GetClipRGN(DC : hDC; RGN : hRGN) : Longint; override; @@ -178,6 +179,9 @@ Procedure DeleteCriticalSection(var CritSection: TCriticalSection); Override; { ============================================================================= $Log$ + Revision 1.33 2003/08/31 17:30:49 mattias + fixed TControl painting for win32 + Revision 1.32 2003/08/18 19:24:18 mattias fixed TCanvas.Pie