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

Rewrites the LCL-CustomDrawn scrolling code to be Android compatible

Browse Source 
git-svn-id: trunk@34524 -
This commit is contained in:
sekelsenmat 2011-12-31 11:56:03 +00:00
parent 2a92924d26
commit 8e92a68084
3 changed files with 23 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/interfaces/customdrawn/cocoaprivate.pas
View File

@ -639,8 +639,6 @@ begin
Context.ctx:=ControlContext;
lWidth := Round(bounds.size.width);
lHeight := Round(bounds.size.height);
WindowHandle.FormRealSize := Types.Size(lWidth, lHeight);
lHeight := WindowHandle.GetFormBufferHeight(lHeight);
if Context.InitDraw(lWidth, lHeight) then
begin
// Prepare the non-native image and canvas
@ -655,7 +653,7 @@ begin
// Now render it into the control
WindowHandle.Image.GetRawImage(lRawImage);
Cocoa_RawImage_CreateBitmaps(lRawImage, lBitmap, lMask, True);
Context.DrawBitmap(0, WindowHandle.ScrollY, TCocoaBitmap(lBitmap));
Context.DrawBitmap(0, 0, TCocoaBitmap(lBitmap));
end;
{$IFDEF VerboseCDPaintProfiler}
DebugLn(Format('[TCocoaCustomControl.Draw] Paint duration: %d ms', [DateTimeToMilliseconds(NowUTC() - lTimeStart)]));

2
lcl/interfaces/customdrawn/customdrawnprivate.pas
View File

@ -176,7 +176,7 @@ begin
if AWindowHandle.IsScrolling then
begin
lOldScrollY := AWindowHandle.ScrollY;
AWindowHandle.ScrollY := lEventPos.Y - AWindowHandle.LastMousePos.Y;
AWindowHandle.ScrollY := AWindowHandle.LastMousePos.Y - lEventPos.Y;
AWindowHandle.SanityCheckScrollPos();
if AWindowHandle.ScrollY <> lOldScrollY then LCLIntf.InvalidateRect(HWND(AWindowHandle), nil, False);
end;

37
lcl/interfaces/customdrawn/customdrawnproc.pas
View File

@ -65,11 +65,10 @@ type
ScrollX, ScrollY: Integer;
LastMousePos: TPoint;
IsScrolling: Boolean;
FormRealSize: TSize; // the size in the screen
constructor Create; virtual;
procedure IncInvalidateCount;
function GetFocusedControl: TWinControl;
function GetFormBufferHeight(AScreenHeight: Integer): Integer;
function GetFormVirtualHeight(AScreenHeight: Integer): Integer;
procedure SanityCheckScrollPos();
end;
@ -120,11 +119,11 @@ procedure UpdateControlLazImageAndCanvas(var AImage: TLazIntfImage;
AFreeImageOnUpdate: Boolean = True; ADataOwner: Boolean = True);
procedure DrawFormBackground(var AImage: TLazIntfImage; var ACanvas: TLazCanvas);
procedure RenderChildWinControls(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; ACDControlsList: TFPList);
var ACanvas: TLazCanvas; ACDControlsList: TFPList; ACDForm: TCDForm);
function RenderWinControl(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl): Boolean;
var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl; ACDForm: TCDForm): Boolean;
procedure RenderWinControlAndChildren(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl);
var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl; ACDForm: TCDForm);
procedure RenderForm(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; AForm: TCustomForm);
function FindControlWhichReceivedEvent(AForm: TCustomForm;
@ -398,7 +397,7 @@ end;
// This does not render the win control itself, only it's children
// The WinControls themselves will render child TControls not descending from TWinControl
procedure RenderChildWinControls(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; ACDControlsList: TFPList);
var ACanvas: TLazCanvas; ACDControlsList: TFPList; ACDForm: TCDForm);
var
i, lChildrenCount: Integer;
lCDWinControl: TCDWinControl;
@ -417,14 +416,14 @@ begin
lCDWinControl := TCDWinControl(ACDControlsList.Items[i]);
RenderWinControlAndChildren(AImage, ACanvas, lCDWinControl);
RenderWinControlAndChildren(AImage, ACanvas, lCDWinControl, ACDForm);
end;
end;
// Renders a WinControl, but not it's children
// Returns if the control is visible and therefore if its children should be rendered
function RenderWinControl(var AImage: TLazIntfImage; var ACanvas: TLazCanvas;
ACDWinControl: TCDWinControl): Boolean;
ACDWinControl: TCDWinControl; ACDForm: TCDForm): Boolean;
var
lWinControl, lParentControl: TWinControl;
struct : TPaintStruct;
@ -453,12 +452,13 @@ begin
// lBaseWindowOrg makes debugging easier
// Iterate to find the appropriate BaseWindowOrg relative to the parent control
lBaseWindowOrg := FindControlPositionRelativeToTheForm(lWinControl);
ACanvas.BaseWindowOrg := lBaseWindowOrg;
ACanvas.BaseWindowOrg := Point(lBaseWindowOrg.X, lBaseWindowOrg.Y - ACDForm.ScrollY);
ACanvas.WindowOrg := Point(0, 0);
// Prepare the clippping relative to the form
ACanvas.Clipping := True;
ACDWinControl.Region.Rect := Bounds(lBaseWindowOrg.X, lBaseWindowOrg.Y, lWinControl.Width, lWinControl.Height);
ACDWinControl.Region.Rect := Bounds(lBaseWindowOrg.X, lBaseWindowOrg.Y - ACDForm.ScrollY,
lWinControl.Width, lWinControl.Height);
ACanvas.ClipRegion := ACDWinControl.Region;
// Special drawing for some native controls
@ -489,14 +489,14 @@ end;
// Render a WinControl and all it's children
procedure RenderWinControlAndChildren(var AImage: TLazIntfImage;
var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl);
var ACanvas: TLazCanvas; ACDWinControl: TCDWinControl; ACDForm: TCDForm);
begin
// Draw the control
if not RenderWinControl(AImage, ACanvas, ACDWinControl) then Exit;
if not RenderWinControl(AImage, ACanvas, ACDWinControl, ACDForm) then Exit;
// Now Draw all sub-controls
if ACDWinControl.Children <> nil then
RenderChildWinControls(AImage, ACanvas, ACDWinControl.Children);
RenderChildWinControls(AImage, ACanvas, ACDWinControl.Children, ACDForm);
end;
// Draws a form and all of its child controls
@ -504,12 +504,17 @@ procedure RenderForm(var AImage: TLazIntfImage; var ACanvas: TLazCanvas;
AForm: TCustomForm);
var
struct : TPaintStruct;
lWindowHandle: TCDForm;
begin
lWindowHandle := TCDForm(AForm.Handle);
DrawFormBackground(AImage, ACanvas);
FillChar(struct, SizeOf(TPaintStruct), 0);
struct.hdc := HDC(ACanvas);
// Consider the form scrolling
ACanvas.BaseWindowOrg := Point(0, - lWindowHandle.ScrollY);
// Send the paint message to the LCL
{$IFDEF VerboseCDForms}
DebugLn(Format('[RenderForm] OnPaint event started context: %x', [struct.hdc]));
@ -520,7 +525,7 @@ begin
{$ENDIF}
// Now paint all child win controls
RenderChildWinControls(AImage, ACanvas, GetCDWinControlList(AForm));
RenderChildWinControls(AImage, ACanvas, GetCDWinControlList(AForm), lWindowHandle);
end;
function FindControlWhichReceivedEvent(AForm: TCustomForm;
@ -731,7 +736,7 @@ begin
else Result := LCLForm;
end;
function TCDForm.GetFormBufferHeight(AScreenHeight: Integer): Integer;
function TCDForm.GetFormVirtualHeight(AScreenHeight: Integer): Integer;
var
i, lControlRequiredHeight: Integer;
lControl: TControl;
@ -748,7 +753,7 @@ end;
procedure TCDForm.SanityCheckScrollPos;
begin
ScrollY := Max(ScrollY, 0);
ScrollY := Min(ScrollY, Image.Height - FormRealSize.cy);
ScrollY := Min(ScrollY, GetFormVirtualHeight(Image.Height) - Image.Height);
end;
end.