paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 23:19:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

cocoa: Patch from bug #30796 Custom Draw functionality for TCocoaButton

Browse Source 
git-svn-id: trunk@53242 -
This commit is contained in:
sekelsenmat 2016-10-27 19:36:23 +00:00
parent 8df1188cc7
commit 29ffe756ca
2 changed files with 38 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lcl/interfaces/cocoa/cocoaprivate.pp
View File

@ -210,6 +210,7 @@ type
function acceptsFirstResponder: Boolean; override;
function becomeFirstResponder: Boolean; override;
function resignFirstResponder: Boolean; override;
procedure drawRect(dirtyRect: NSRect); override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
// mouse
@ -1750,6 +1751,14 @@ begin
callback.ResignFirstResponder;
end;
procedure TCocoaButton.drawRect(dirtyRect: NSRect);
var ctx: NSGraphicsContext;
begin
inherited drawRect(dirtyRect);
if CheckMainThread and Assigned(callback) then
callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
end;
function TCocoaButton.lclGetCallback: ICommonCallback;
begin
Result := callback;

30
lcl/interfaces/cocoa/cocoawsstdctrls.pp
View File

@ -31,7 +31,7 @@ uses
// Widgetset
WSStdCtrls, WSLCLClasses, WSControls, WSProc,
// LCL Cocoa
CocoaWSCommon, CocoaPrivate, CocoaUtils;
CocoaWSCommon, CocoaPrivate, CocoaUtils, CocoaGDIObjects;
type
@ -185,6 +185,7 @@ type
TLCLButtonCallback = class(TLCLCommonCallback, IButtonCallback)
public
procedure ButtonClick; virtual;
procedure Draw(ControlContext: NSGraphicsContext; const bounds, dirty: NSRect); override;
end;
TLCLButtonCallBackClass = class of TLCLButtonCallBack;
@ -373,6 +374,33 @@ begin
SendSimpleMessage(Target, LM_CLICKED);
end;
procedure TLCLButtonCallback.Draw(ControlContext: NSGraphicsContext;
const bounds, dirty: NSRect);
var
PS: PPaintStruct;
nsr:NSRect;
ctx: TCocoaContext;
begin
// todo: think more about draw call while previous draw still active
ctx := TCocoaContext.Create(ControlContext);
ctx.isControlDC := True;
try
nsr:=dirty;
nsr.origin.y:=bounds.size.height-dirty.origin.y-dirty.size.height;
New(PS);
try
FillChar(PS^, SizeOf(TPaintStruct), 0);
PS^.hdc := HDC(ctx);
PS^.rcPaint := NSRectToRect(nsr);
LCLSendPaintMsg(Target, HDC(ctx), PS);
finally
Dispose(PS);
end;
finally
FreeAndNil(ctx);
end;
end;
{ TLCLListBoxCallback }
procedure TLCLListBoxCallback.SelectionChanged;