paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-07 15:20:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

customdrawnws: Repairs the win32 backend

Browse Source 
git-svn-id: trunk@33758 -
This commit is contained in:
sekelsenmat 2011-11-24 13:32:18 +00:00
parent 26f56b8f61
commit e900ce2ba7
5 changed files with 106 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/interfaces/customdrawn/customdrawnobject_win.inc
View File

@ -160,8 +160,8 @@ var
DC: HDC;
// Flags : integer;
begin
{$ifdef VerboseWinCE}
DebugLn('TWinCEWidgetSet.AppInit');
{$ifdef VerboseCDApplication}
DebugLn('TCDWidgetSet.AppInit');
{$endif}
// WinRegister
@ -227,6 +227,9 @@ procedure TCDWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
var
AMessage: TMsg;
begin
{$ifdef VerboseCDApplication}
DebugLn('[TCDWidgetSet.AppRun]');
{$endif}
// inherited AppRun(ALoop);
while Windows.GetMessage(@AMessage, 0, 0, 0) do

7
lcl/interfaces/customdrawn/customdrawnwinapi_win.inc
View File

@ -2274,6 +2274,9 @@ var
end;
begin
{$ifdef VerboseWinAPI}
DebugLn(Format(':>[TCDWidgetSet.GetWindowSize] Handle=%x', [Handle]));
{$endif}
WP.length := SizeOf(WP);
Result := Boolean(Windows.GetWindowPlacement(Handle, WP));
@ -2342,6 +2345,10 @@ begin
end;
ExcludeCaption;
{$ifdef VerboseWinAPI}
DebugLn(Format(':<[TCDWidgetSet.GetWindowSize] Width=%d Height=%d', [Width, Height]));
{$endif}
end;
(*
function TWin32WidgetSet.GradientFill(DC: HDC; Vertices: PTriVertex;

2
lcl/interfaces/customdrawn/customdrawnwsforms.pp
View File

@ -90,6 +90,8 @@ type
class function CalcBorderStyleFlags(const AForm: TCustomForm): DWORD;
class function CalcBorderStyleFlagsEx(const AForm: TCustomForm): DWORD;
class procedure AdjustFormBounds(const AForm: TCustomForm; out SizeRect: TRect);
class procedure WSWinControl_SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
{$endif}
{$ifdef CD_X11}
class procedure UpdateMotifWMHints(const AWinControl: TWinControl; CanMaximize: Boolean);

71
lcl/interfaces/customdrawn/customdrawnwsforms_win.inc
View File

@ -140,6 +140,48 @@ begin
False, CalcBorderStyleFlagsEx(AForm) or CalcBorderIconsFlagsEx(AForm));
end;
class procedure TCDWSCustomForm.WSWinControl_SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
IntfLeft, IntfTop, IntfWidth, IntfHeight: integer;
suppressMove: boolean;
Handle: HWND;
WindowPlacement: TWINDOWPLACEMENT;
begin
{$ifdef VerboseCDForms}
DebugLn(Format('[TCDWSCustomForm.WSWinControl_SetBounds] AWinControl=%x'
+ ' ALeft=%d ATop=%d AWidth=%d AHeight=%d',
[PtrInt(AWinControl), ALeft, ATop, AWidth, AHeight]));
{$endif}
IntfLeft := ALeft;
IntfTop := ATop;
IntfWidth := AWidth;
IntfHeight := AHeight;
LCLBoundsToWin32Bounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight);
{$IFDEF VerboseCDForms}
DebugLn('[TCDWSCustomForm.WSWinControl_SetBounds] A ', dbgsName(AWinControl),
' LCL=',Format('%d, %d, %d, %d', [ALeft,ATop,AWidth,AHeight]),
' Win32=',Format('%d, %d, %d, %d', [IntfLeft,IntfTop,IntfWidth,IntfHeight])
);
{$ENDIF}
suppressMove := False;
AdaptBounds(AWinControl, IntfLeft, IntfTop, IntfWidth, IntfHeight, suppressMove);
if not suppressMove then
begin
Handle := AWinControl.Handle;
WindowPlacement.length := SizeOf(WindowPlacement);
if IsIconic(Handle) and GetWindowPlacement(Handle, @WindowPlacement) then
begin
WindowPlacement.rcNormalPosition := Bounds(IntfLeft, IntfTop, IntfWidth, IntfHeight);
SetWindowPlacement(Handle, @WindowPlacement);
end
else
Windows.SetWindowPos(Handle, 0, IntfLeft, IntfTop, IntfWidth, IntfHeight, SWP_NOZORDER or SWP_NOACTIVATE);
end;
LCLControlSizeNeedsUpdate(AWinControl, True);
end;
{------------------------------------------------------------------------------
Method: TCDWSCustomForm.CreateHandle
Params: None
@ -155,6 +197,11 @@ var
Bounds: TRect;
SystemMenu: HMenu;
begin
{$ifdef VerboseCDForms}
DebugLn(Format(':>[TCDWSCustomForm.CreateHandle] AWincontrol=%x left=%d Top=%d'
+ ' Width=%d Height=%d', [PtrInt(AWincontrol), AWinControl.Top, AWinControl.Left,
AParams.Width, AParams.Height]));
{$endif}
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
// customization of Params
@ -223,7 +270,12 @@ begin
// initialize all root windows with this message
if WindowsVersion >= wv2000 then
Windows.SendMessage(Result, WM_CHANGEUISTATE,
MakeWParam(UIS_INITIALIZE, UISF_HIDEFOCUS or UISF_HIDEACCEL), 0)
MakeWParam(UIS_INITIALIZE, UISF_HIDEFOCUS or UISF_HIDEACCEL), 0);
{$ifdef VerboseCDForms}
DebugLn(Format(':<[TCDWSCustomForm.CreateHandle] Result=%x',
[PtrInt(Result)]));
{$endif}
end;
(*var
Params: TCreateWindowExParams;
@ -361,6 +413,11 @@ var
CurRect, SizeRect: Windows.RECT;
L, T, W, H: Integer;
begin
{$ifdef VerboseCDForms}
DebugLn(Format('[TCDWSCustomForm.SetBounds] AWinControl=%x'
+ ' ALeft=%d ATop=%d AWidth=%d AHeight=%d',
[PtrInt(AWinControl), ALeft, ATop, AWidth, AHeight]));
{$endif}
// the LCL defines the size of a form without border, win32 with.
// -> adjust size according to BorderStyle
SizeRect := Bounds(ALeft, ATop, AWidth, AHeight);
@ -395,7 +452,7 @@ begin
end;
// rect adjusted, pass to inherited to do real work
TCDWSWinControl.SetBounds(AWinControl, L, T, W, H);
WSWinControl_SetBounds(AWinControl, L, T, W, H);
end;
(*var
SizeRect: Windows.RECT;
@ -476,8 +533,11 @@ begin
end;
class procedure TCDWSCustomForm.ShowHide(const AWinControl: TWinControl);
const
VisibilityToFlag: array[Boolean] of UINT = (SWP_HIDEWINDOW, SWP_SHOWWINDOW);
begin
TCDWSWinControl.ShowHide(AWinControl);
Windows.SetWindowPos(AWinControl.Handle, 0, 0, 0, 0, 0,
SWP_NOSIZE or SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE or VisibilityToFlag[AWinControl.HandleObjectShouldBeVisible])
end;
class function TCDWSCustomForm.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
@ -504,6 +564,11 @@ end;
class function TCDWSCustomForm.GetClientBounds(const AWincontrol: TWinControl; var ARect: TRect): Boolean;
begin
Result := LCLIntf.GetClientBounds(AWincontrol.Handle, ARect);
{$ifdef VerboseCDForms}
DebugLn(Format('[TCDWSCustomForm.GetClientBounds] AWincontrol=%x Rect.left=%d Rect.Top=%d'
+ ' Rect.Width=%d Rect.Height=%d', [PtrInt(AWincontrol), ARect.Top, ARect.Left,
ARect.Right-ARect.Left, ARect.Bottom-ARect.Top]));
{$endif}
end;
class function TCDWSCustomForm.GetClientRect(const AWincontrol: TWinControl; var ARect: TRect): Boolean;

58
lcl/interfaces/customdrawn/wincallback.inc
View File

@ -221,8 +221,8 @@ Var
begin
if lWinControl = nil then exit;
{$IFDEF DEBUG_WINCE_LABELS}
DebugLn(Format('[SendPaintMessage]: Control:%s', [lWinControl.Name]));
{$IFDEF VerboseCDMessages}
DebugLn(Format('[SendPaintMessage]: Control:%s:%s', [lWinControl.Name, lWinControl.ClassName]));
{$ENDIF}
// create a paint message
@ -260,7 +260,7 @@ Var
end;
if (WindowInfo^.Canvas = nil) then WindowInfo^.Canvas := TLazCanvas.Create(WindowInfo^.Image);
{$ifdef VerboseWinAPI}
{$ifdef VerboseCDMessages}
DebugLn(Format('[SendPaintMessage] WindowInfo^.Canvas=%s', [dbghex(PtrInt(WindowInfo^.Canvas))]));
{$endif}
@ -282,36 +282,26 @@ Var
PaintMsg.Msg := LM_PAINT;
PaintMsg.PaintStruct := @PS;
PaintMsg.DC := HDC(WindowInfo^.Canvas);
if not needParentPaint then
begin
// send through message to allow message override, moreover use SendMessage
// to allow subclass window proc override this message too
Include(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground);
Windows.SendMessageW(lWinControl.Handle, WM_ERASEBKGND, Windows.WPARAM(DC), 0);
Exclude(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground);
end;
if (ControlDC = 0) or not needParentPaint then
begin
//DCIndex := Windows.SaveDC(DC);
{$ifdef DEBUG_WINDOW_ORG}
LCLIntf.GetWindowOrgEx(DC, @WindowOrg);
DebugLn(
Format(':> [SendPaintMessage 2] Control=%s DC=%d Moving WindowOrg from %d,%d by DX=%d DY=%d',
[lWinControl.Name, PaintMsg.DC, WindowOrg.X, WindowOrg.Y, -parLeft, -parTop]));
{$endif}
// send through message to allow message override, moreover use SendMessage
// to allow subclass window proc override this message too
{ Include(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground);
Windows.SendMessageW(lWinControl.Handle, WM_ERASEBKGND, Windows.WPARAM(DC), 0);
Exclude(TWinControlAccess(lWinControl).FWinControlFlags, wcfEraseBackground);}
//MoveWindowOrgEx(DC, ORect.Left, ORect.Top); <- substitute with a non-native window org change
DeliverMessage(lWinControl, PaintMsg);
//Windows.RestoreDC(DC, DCIndex);
//DCIndex := Windows.SaveDC(DC);
{$ifdef DEBUG_WINDOW_ORG}
LCLIntf.GetWindowOrgEx(DC, @WindowOrg);
DebugLn(
Format(':> [SendPaintMessage 3] Control=%s DC=%d WindowOrg=%d,%d',
[lWinControl.Name, PaintMsg.DC, WindowOrg.X, WindowOrg.Y]));
{$endif}
end;
{$ifdef VerboseCDMessages}
DebugLn(Format(':> [SendPaintMessage 2] Before OnPaint Control=%s DC=%x', [lWinControl.Name, PaintMsg.DC]));
{$endif}
//MoveWindowOrgEx(DC, ORect.Left, ORect.Top); <- substitute with a non-native window org change
DeliverMessage(lWinControl, PaintMsg);
//Windows.RestoreDC(DC, DCIndex);
{$ifdef VerboseCDMessages}
DebugLn(':> [SendPaintMessage 3] After OnPaint');
{$endif}
// Now draw all child controls
RenderChildWinControls(WindowInfo^.Image, WindowInfo^.Canvas,
@ -329,7 +319,7 @@ Var
Windows.EndPaint(Window, @PS);
finally
end;
{$ifdef DEBUG_WINDOW_ORG}
{$ifdef VerboseCDMessages}
DebugLn(':< [SendPaintMessage] Finish');
{$endif}
end;
@ -502,9 +492,9 @@ begin
lWinControl := WindowInfo^.WinControl;
{$ifdef CD_MSG_DEBUG}
DebugLn('WindowProc lWinControl: ',DbgSName(lWinControl),' MSG=',WM_To_String(Msg));
{$endif}
{$ifdef VerboseCDMessages}
DebugLn('WindowProc lWinControl: ',DbgSName(lWinControl),' MSG=',WM_To_String(Msg));
{$endif}
if (IgnoreNextCharWindow <> 0) and ((Msg = WM_CHAR) or (Msg = WM_SYSCHAR)) then
begin
if IgnoreNextCharWindow = Window then