mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-29 01:30:46 +02:00
cocoa: prepare infrastructure for Caret support
git-svn-id: trunk@34445 -
This commit is contained in:
paul
parent
d13b20b978
commit
548a38c43c
@ -25,18 +25,19 @@
|
||||
|
||||
unit CocoaCaret;
|
||||
{$mode objfpc}{$H+}
|
||||
{$modeswitch objectivec1}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
// Bindings
|
||||
MacOSAll,
|
||||
CocoaAll,
|
||||
// Free Pascal
|
||||
Classes, SysUtils, Types,
|
||||
// Widgetset
|
||||
CarbonDef, CarbonGDIObjects, CarbonInt,
|
||||
CocoaGDIObjects, CocoaInt, CocoaPrivate,
|
||||
// LCL
|
||||
LCLType, LCLIntf, LCLProc, Graphics, ExtCtrls, Forms;
|
||||
LCLType, LCLIntf, LCLProc, Graphics, Controls, ExtCtrls, Forms;
|
||||
|
||||
type
|
||||
{ TEmulatedCaret }
|
||||
@ -45,8 +46,8 @@ type
|
||||
private
|
||||
FTimer: TTimer;
|
||||
FOldRect: TRect;
|
||||
FWidget: TCarbonWidget;
|
||||
FBitmap: TCarbonBitmap;
|
||||
FView: NSView;
|
||||
FBitmap: TCocoaBitmap;
|
||||
FWidth, FHeight: Integer;
|
||||
FPos: TPoint;
|
||||
FVisible: Boolean;
|
||||
@ -60,7 +61,7 @@ type
|
||||
protected
|
||||
procedure DoTimer(Sender: TObject);
|
||||
procedure DrawCaret; virtual;
|
||||
procedure SetWidget(AWidget: TCarbonWidget);
|
||||
procedure SetView(AView: NSView);
|
||||
procedure UpdateCaret;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
@ -69,12 +70,12 @@ type
|
||||
procedure Lock;
|
||||
procedure UnLock;
|
||||
|
||||
function CreateCaret(AWidget: TCarbonWidget; Bitmap: PtrUInt; Width, Height: Integer): Boolean;
|
||||
function CreateCaret(AView: NSView; Bitmap: PtrUInt; Width, Height: Integer): Boolean;
|
||||
function DestroyCaret: Boolean;
|
||||
|
||||
function IsValid: Boolean;
|
||||
|
||||
function Show(AWidget: TCarbonWidget): Boolean;
|
||||
function Show(AView: NSView): Boolean;
|
||||
function Hide: Boolean;
|
||||
|
||||
property Timer: TTimer read FTimer;
|
||||
@ -82,9 +83,9 @@ type
|
||||
property RespondToFocus: Boolean read FRespondToFocus write FRespondToFocus;
|
||||
end;
|
||||
|
||||
function CreateCaret(Widget: TCarbonWidget; Bitmap: PtrUInt; Width, Height: Integer): Boolean; overload;
|
||||
function HideCaret(Widget: TCarbonWidget): Boolean;
|
||||
function ShowCaret(Widget: TCarbonWidget): Boolean;
|
||||
function CreateCaret(View: NSView; Bitmap: PtrUInt; Width, Height: Integer): Boolean; overload;
|
||||
function HideCaret(View: NSView): Boolean;
|
||||
function ShowCaret(View: NSView): Boolean;
|
||||
function SetCaretPos(X, Y: Integer): Boolean;
|
||||
function GetCaretPos(var P: TPoint): Boolean;
|
||||
function GetCarbonCaretRespondToFocus: Boolean;
|
||||
@ -92,13 +93,11 @@ procedure SetCarbonCaretRespondToFocus(Value: Boolean);
|
||||
function DestroyCaret: Boolean;
|
||||
procedure DrawCaret;
|
||||
procedure DestroyGlobalCaret;
|
||||
//todo: make a better solution for the Widgetset released before GlobalCaret
|
||||
procedure CaretWidgetSetReleased;
|
||||
//todo: make a better solution for the Viewset released before GlobalCaret
|
||||
procedure CaretViewSetReleased;
|
||||
|
||||
implementation
|
||||
|
||||
uses CocoaGDIObjects;
|
||||
|
||||
var
|
||||
GlobalCaret: TEmulatedCaret = nil;
|
||||
|
||||
@ -126,7 +125,7 @@ begin
|
||||
FreeAndNil(GlobalCaret);
|
||||
end;
|
||||
|
||||
function CreateCaret(Widget: TCarbonWidget; Bitmap: PtrUInt; Width, Height: Integer): Boolean;
|
||||
function CreateCaret(View: NSView; Bitmap: PtrUInt; Width, Height: Integer): Boolean;
|
||||
begin
|
||||
GlobalCaretNeeded;
|
||||
|
||||
@ -134,7 +133,7 @@ begin
|
||||
begin
|
||||
GlobalCaret.Lock;
|
||||
try
|
||||
Result := GlobalCaret.CreateCaret(Widget, Bitmap, Width, Height);
|
||||
Result := GlobalCaret.CreateCaret(View, Bitmap, Width, Height);
|
||||
finally
|
||||
GlobalCaret.UnLock;
|
||||
end;
|
||||
@ -147,7 +146,7 @@ begin
|
||||
Result := 600; // our default value
|
||||
end;
|
||||
|
||||
function HideCaret(Widget: TCarbonWidget): Boolean;
|
||||
function HideCaret(View: NSView): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
GlobalCaretNeeded;
|
||||
@ -163,7 +162,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function ShowCaret(Widget: TCarbonWidget): Boolean;
|
||||
function ShowCaret(View: NSView): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
GlobalCaretNeeded;
|
||||
@ -172,7 +171,7 @@ begin
|
||||
begin
|
||||
GlobalCaret.Lock;
|
||||
try
|
||||
Result := GlobalCaret.Show(Widget);
|
||||
Result := GlobalCaret.Show(View);
|
||||
finally
|
||||
GlobalCaret.UnLock;
|
||||
end;
|
||||
@ -280,16 +279,16 @@ begin
|
||||
System.LeaveCriticalsection(FCaretCS^);
|
||||
end;
|
||||
|
||||
function TEmulatedCaret.CreateCaret(AWidget: TCarbonWidget; Bitmap: PtrUInt;
|
||||
function TEmulatedCaret.CreateCaret(AView: NSView; Bitmap: PtrUInt;
|
||||
Width, Height: Integer): Boolean;
|
||||
begin
|
||||
DestroyCaret;
|
||||
SetWidget(AWidget);
|
||||
SetView(AView);
|
||||
|
||||
FWidth := Width;
|
||||
FHeight := Height;
|
||||
if Bitmap > 1 then
|
||||
FBitmap := TCarbonBitmap.Create(TCarbonBitmap(Bitmap))
|
||||
FBitmap := TCocoaBitmap.Create(TCocoaBitmap(Bitmap))
|
||||
else
|
||||
FBitmap := nil;
|
||||
|
||||
@ -304,9 +303,8 @@ begin
|
||||
FVisibleState := False;
|
||||
UpdateCaret;
|
||||
|
||||
if Assigned(FBitmap) then FBitmap.Free;
|
||||
FWidget := nil;
|
||||
FBitmap := nil;
|
||||
FreeAndNil(FBitmap);
|
||||
FView := nil;
|
||||
FWidth := 0;
|
||||
FHeight := 0;
|
||||
Result := not IsValid;
|
||||
@ -314,29 +312,29 @@ end;
|
||||
|
||||
procedure TEmulatedCaret.DrawCaret;
|
||||
begin
|
||||
//DebugLn('DrawCaret ' + DbgSName(FWidget.LCLObject) + ' ' + DbgS(FPos) + ' ' + DbgS(FVisible) + ' ' + DbgS(FVisibleState));
|
||||
if IsValid and FVisible and FVisibleState and FWidget.Painting then
|
||||
//DebugLn('DrawCaret ' + DbgSName(FView.LCLObject) + ' ' + DbgS(FPos) + ' ' + DbgS(FVisible) + ' ' + DbgS(FVisibleState));
|
||||
if IsValid and FVisible and FVisibleState and FView.lclIsPainting then
|
||||
begin
|
||||
if FBitmap = nil then
|
||||
(FWidget.Context as TCarbonDeviceContext).InvertRectangle(FPos.X, FPos.Y,
|
||||
FView.lclGetCallback.GetContext.InvertRectangle(FPos.X, FPos.Y,
|
||||
FPos.X + FWidth, FPos.Y + FHeight)
|
||||
else
|
||||
(FWidget.Context as TCarbonDeviceContext).DrawCGImage(FPos.X, FPos.Y,
|
||||
FBitmap.Width, FBitmap.Height, FBitmap.CGImage);
|
||||
FView.lclGetCallback.GetContext.DrawBitmap(FPos.X, FPos.Y,
|
||||
FBitmap);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TEmulatedCaret.Show(AWidget: TCarbonWidget): Boolean;
|
||||
function TEmulatedCaret.Show(AView: NSView): Boolean;
|
||||
begin
|
||||
Result := False;
|
||||
if AWidget = nil then Exit;
|
||||
if AView = nil then Exit;
|
||||
|
||||
//DebugLn('ShowCaret ' + DbgSName(AWidget.LCLObject));
|
||||
//DebugLn('ShowCaret ' + DbgSName(AView.LCLObject));
|
||||
|
||||
if FWidget <> AWidget then
|
||||
if FView <> AView then
|
||||
begin
|
||||
Hide;
|
||||
SetWidget(AWidget);
|
||||
SetView(AView);
|
||||
|
||||
UpdateCaret;
|
||||
end;
|
||||
@ -369,14 +367,14 @@ begin
|
||||
FTimer.Enabled := False;
|
||||
FVisible := False;
|
||||
UpdateCaret;
|
||||
FVisibleRealized := (FWidget = nil) or not FWidget.Painting;
|
||||
FVisibleRealized := (FView = nil) or not FView.lclIsPainting;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TEmulatedCaret.SetPos(const Value: TPoint);
|
||||
begin
|
||||
//DebugLn('SetCaretPos ' + DbgSName(FWidget.LCLObject));
|
||||
if FWidget = nil then
|
||||
//DebugLn('SetCaretPos ' + DbgSName(FView.LCLObject));
|
||||
if FView = nil then
|
||||
begin
|
||||
FPos.X := 0;
|
||||
FPos.Y := 0;
|
||||
@ -388,7 +386,7 @@ begin
|
||||
FPos := Value;
|
||||
FTimer.Enabled := False;
|
||||
FTimer.Enabled := True;
|
||||
if not FWidget.Painting then FVisibleState := True;
|
||||
if not FView.lclIsPainting then FVisibleState := True;
|
||||
UpdateCaret;
|
||||
end;
|
||||
end;
|
||||
@ -401,38 +399,37 @@ end;
|
||||
|
||||
function TEmulatedCaret.IsValid: Boolean;
|
||||
begin
|
||||
Result := (FWidth > 0) and (FHeight > 0) and (FWidget <> nil) and FWidget.IsVisible and
|
||||
not (csDestroying in FWidget.LCLObject.ComponentState);
|
||||
Result := (FWidth > 0) and (FHeight > 0) and (FView <> nil) and FView.lclIsVisible and
|
||||
not (csDestroying in TControl(FView.lclGetTarget).ComponentState);
|
||||
end;
|
||||
|
||||
procedure TEmulatedCaret.SetWidget(AWidget: TCarbonWidget);
|
||||
procedure TEmulatedCaret.SetView(AView: NSView);
|
||||
begin
|
||||
//DebugLn('SetCaretWidget ', DbgSName(AWidget.LCLObject));
|
||||
if FWidget <> nil then FWidget.HasCaret := False;
|
||||
if FView <> nil then FView.lclGetCallback.HasCaret := False;
|
||||
|
||||
FWidget := AWidget;
|
||||
if FWidget <> nil then FWidget.HasCaret := True;
|
||||
FView := AView;
|
||||
if FView <> nil then FView.lclGetCallback.HasCaret := True;
|
||||
FTimer.Enabled := False;
|
||||
FTimer.Enabled := FWidget <> nil;
|
||||
FTimer.Enabled := FView <> nil;
|
||||
end;
|
||||
|
||||
procedure TEmulatedCaret.UpdateCaret;
|
||||
var
|
||||
R: TRect;
|
||||
begin
|
||||
if (FWidget = nil) or FWidgetSetReleased then Exit;
|
||||
if FWidget.Painting then Exit;
|
||||
if (FView = nil) or FWidgetSetReleased then Exit;
|
||||
if FView.lclIsPainting then Exit;
|
||||
if not IsValid then Exit;
|
||||
|
||||
//DebugLn('UpdateCaret ' + DbgSName(FWidget.LCLObject) + ' ' + DbgS(FPos) + ' ' + DbgS(FVisible) + ' ' + DbgS(FVisibleState));
|
||||
//DebugLn('UpdateCaret ' + DbgSName(FView.LCLObject) + ' ' + DbgS(FPos) + ' ' + DbgS(FVisible) + ' ' + DbgS(FVisibleState));
|
||||
R.Left := FPos.x;
|
||||
R.Top := FPos.y;
|
||||
R.Right := R.Left + FWidth + 2;
|
||||
R.Bottom := R.Top + FHeight + 2;
|
||||
|
||||
if not EqualRect(FOldRect, R) then FWidget.Invalidate(@FOldRect);
|
||||
FWidget.Invalidate(@R);
|
||||
FWidget.Update;
|
||||
if not EqualRect(FOldRect, R) then FView.lclInvalidateRect(FOldRect);
|
||||
FView.lclInvalidateRect(R);
|
||||
FView.lclUpdate;
|
||||
|
||||
FOldRect := R;
|
||||
end;
|
||||
@ -442,9 +439,10 @@ begin
|
||||
UpdateCaret;
|
||||
end;
|
||||
|
||||
procedure CaretWidgetSetReleased;
|
||||
procedure CaretViewSetReleased;
|
||||
begin
|
||||
if Assigned(GlobalCaret) then begin
|
||||
if Assigned(GlobalCaret) then
|
||||
begin
|
||||
GlobalCaret.fTimer.Free;
|
||||
GlobalCaret.fTimer:=nil;
|
||||
GlobalCaret.FWidgetSetReleased:=True;
|
||||
|
||||
@ -187,7 +187,7 @@ type
|
||||
FAntialiased: Boolean;
|
||||
public
|
||||
constructor CreateDefault;
|
||||
constructor Create(const ALogFont: TLogFont; AFontName: String; AGlobal: Boolean = False);
|
||||
constructor Create(const ALogFont: TLogFont; AFontName: String; AGlobal: Boolean = False); reintroduce;
|
||||
class function CocoaFontWeightToWin32FontWeight(const CocoaFontWeight: Integer): Integer; static;
|
||||
property Font: NSFont read FFont;
|
||||
property Name: String read FName;
|
||||
@ -352,10 +352,11 @@ type
|
||||
function InitDraw(width, height: Integer): Boolean;
|
||||
|
||||
// drawing functions
|
||||
procedure DrawBitmap(X,Y: Integer; ABitmap: TCocoaBitmap);
|
||||
procedure DrawBitmap(X, Y: Integer; ABitmap: TCocoaBitmap);
|
||||
procedure DrawFocusRect(ARect: TRect);
|
||||
procedure MoveTo(x,y: Integer);
|
||||
procedure LineTo(x,y: Integer);
|
||||
procedure InvertRectangle(X1, Y1, X2, Y2: Integer);
|
||||
procedure MoveTo(X, Y: Integer);
|
||||
procedure LineTo(X, Y: Integer);
|
||||
procedure Polygon(const Points: array of TPoint; NumPts: Integer; Winding: boolean);
|
||||
procedure Polyline(const Points: array of TPoint; NumPts: Integer);
|
||||
procedure Rectangle(X1, Y1, X2, Y2: Integer; FillRect: Boolean; UseBrush: TCocoaBrush);
|
||||
@ -1279,13 +1280,27 @@ begin
|
||||
FPenPos.y := 0;
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.MoveTo(x, y: Integer);
|
||||
procedure TCocoaContext.InvertRectangle(X1, Y1, X2, Y2: Integer);
|
||||
begin
|
||||
FPenPos.x := x;
|
||||
FPenPos.y := y;
|
||||
// save dest context
|
||||
CGContextSaveGState(CGContext);
|
||||
try
|
||||
DefaultBrush.Apply(Self, False);
|
||||
CGContextSetBlendMode(CGContext, kCGBlendModeDifference);
|
||||
|
||||
CGContextFillRect(CGContext, GetCGRectSorted(X1, Y1, X2, Y2));
|
||||
finally
|
||||
CGContextRestoreGState(CGContext);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.LineTo(x, y: Integer);
|
||||
procedure TCocoaContext.MoveTo(X, Y: Integer);
|
||||
begin
|
||||
FPenPos.x := X;
|
||||
FPenPos.y := Y;
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.LineTo(X, Y: Integer);
|
||||
var
|
||||
cg: CGContextRef;
|
||||
p: array [0..1] of CGPoint;
|
||||
@ -1749,7 +1764,7 @@ begin
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
procedure TCocoaContext.DrawBitmap(X,Y:Integer; ABitmap: TCocoaBitmap);
|
||||
procedure TCocoaContext.DrawBitmap(X, Y: Integer; ABitmap: TCocoaBitmap);
|
||||
begin
|
||||
NSGraphicsContext.saveGraphicsState();
|
||||
NSGraphicsContext.setCurrentContext(ctx);
|
||||
|
||||
@ -138,6 +138,9 @@ var
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
CocoaCaret;
|
||||
|
||||
var
|
||||
ScreenContext : TCocoaContext = nil;
|
||||
|
||||
|
||||
@ -31,7 +31,7 @@ uses
|
||||
Types, Classes, SysUtils,
|
||||
CGGeometry,
|
||||
// Libs
|
||||
MacOSAll, CocoaAll, CocoaUtils,
|
||||
MacOSAll, CocoaAll, CocoaUtils, CocoaGDIObjects,
|
||||
// LCL
|
||||
LCLType;
|
||||
|
||||
@ -51,7 +51,14 @@ type
|
||||
function DeliverMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): LResult;
|
||||
procedure Draw(ctx: NSGraphicsContext; const bounds, dirty: NSRect);
|
||||
function GetPropStorage: TStringList;
|
||||
function GetContext: TCocoaContext;
|
||||
function GetTarget: TObject;
|
||||
function GetHasCaret: Boolean;
|
||||
procedure SetHasCaret(AValue: Boolean);
|
||||
function ResetCursorRects: Boolean;
|
||||
|
||||
// properties
|
||||
property HasCaret: Boolean read GetHasCaret write SetHasCaret;
|
||||
end;
|
||||
|
||||
{ LCLObjectExtension }
|
||||
@ -64,6 +71,7 @@ type
|
||||
|
||||
procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:';
|
||||
procedure lclInvalidate; message 'lclInvalidate';
|
||||
procedure lclUpdate; message 'lclUpdate';
|
||||
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::';
|
||||
procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::';
|
||||
procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::';
|
||||
@ -73,6 +81,7 @@ type
|
||||
function lclClientFrame: TRect; message 'lclClientFrame';
|
||||
function lclGetCallback: ICommonCallback; message 'lclGetCallback';
|
||||
function lclGetPropStorage: TStringList; message 'lclGetPropStorage';
|
||||
function lclGetTarget: TObject; message 'lclGetTarget';
|
||||
function lclDeliverMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; message 'lclDeliverMessage:::';
|
||||
end;
|
||||
|
||||
@ -80,8 +89,10 @@ type
|
||||
|
||||
LCLViewExtension = objccategory(NSView)
|
||||
function lclIsVisible: Boolean; message 'lclIsVisible'; reintroduce;
|
||||
function lclIsPainting: Boolean; message 'lclIsPainting';
|
||||
procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:'; reintroduce;
|
||||
procedure lclInvalidate; message 'lclInvalidate'; reintroduce;
|
||||
procedure lclUpdate; message 'lclUpdate'; reintroduce;
|
||||
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::'; reintroduce;
|
||||
procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::'; reintroduce;
|
||||
procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::'; reintroduce;
|
||||
@ -109,6 +120,7 @@ type
|
||||
function lclWindowState: Integer; message 'lclWindowState'; reintroduce;
|
||||
procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:'; reintroduce;
|
||||
procedure lclInvalidate; message 'lclInvalidate'; reintroduce;
|
||||
procedure lclUpdate; message 'lclUpdate'; reintroduce;
|
||||
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::'; reintroduce;
|
||||
procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::'; reintroduce;
|
||||
procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::'; reintroduce;
|
||||
@ -706,12 +718,14 @@ end;
|
||||
|
||||
procedure LCLObjectExtension.lclInvalidateRect(const r:TRect);
|
||||
begin
|
||||
|
||||
end;
|
||||
|
||||
procedure LCLObjectExtension.lclInvalidate;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure LCLObjectExtension.lclUpdate;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure LCLObjectExtension.lclRelativePos(var Left,Top:Integer);
|
||||
@ -762,6 +776,17 @@ begin
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function LCLObjectExtension.lclGetTarget: TObject;
|
||||
var
|
||||
Callback: ICommonCallback;
|
||||
begin
|
||||
Callback := lclGetCallback;
|
||||
if Assigned(Callback) then
|
||||
Result := Callback.GetTarget
|
||||
else
|
||||
Result := nil;
|
||||
end;
|
||||
|
||||
function LCLObjectExtension.lclDeliverMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): LResult;
|
||||
var
|
||||
Callback: ICommonCallback;
|
||||
@ -805,6 +830,11 @@ begin
|
||||
Result := not isHidden;
|
||||
end;
|
||||
|
||||
function LCLViewExtension.lclIsPainting: Boolean;
|
||||
begin
|
||||
Result := Assigned(lclGetCallback) and Assigned(lclGetCallback.GetContext);
|
||||
end;
|
||||
|
||||
procedure LCLViewExtension.lclInvalidateRect(const r:TRect);
|
||||
begin
|
||||
setNeedsDisplayInRect(RectToViewCoord(Self, r));
|
||||
@ -815,6 +845,11 @@ begin
|
||||
setNeedsDisplay_(True);
|
||||
end;
|
||||
|
||||
procedure LCLViewExtension.lclUpdate;
|
||||
begin
|
||||
display;
|
||||
end;
|
||||
|
||||
procedure LCLViewExtension.lclRelativePos(var Left, Top: Integer);
|
||||
begin
|
||||
with frame.origin do
|
||||
@ -929,6 +964,11 @@ begin
|
||||
contentView.lclInvalidate;
|
||||
end;
|
||||
|
||||
procedure LCLWindowExtension.lclUpdate;
|
||||
begin
|
||||
contentView.lclUpdate;
|
||||
end;
|
||||
|
||||
procedure LCLWindowExtension.lclRelativePos(var Left, Top: Integer);
|
||||
begin
|
||||
with frame.origin do
|
||||
|
||||
@ -851,7 +851,9 @@ end;
|
||||
|
||||
function TCocoaWidgetSet.UpdateWindow(Handle: HWND): Boolean;
|
||||
begin
|
||||
Result := InvalidateRect(Handle, nil, False);
|
||||
Result := Handle <> 0;
|
||||
if Result then
|
||||
NSObject(Handle).lclUpdate;
|
||||
end;
|
||||
|
||||
function TCocoaWidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer;
|
||||
|
||||
@ -26,13 +26,18 @@ type
|
||||
TLCLCommonCallback = class(TObject, ICommonCallBack)
|
||||
private
|
||||
FPropStorage: TStringList;
|
||||
FContext: TCocoaContext;
|
||||
FHasCaret: Boolean;
|
||||
function GetHasCaret: Boolean;
|
||||
procedure SetHasCaret(AValue: Boolean);
|
||||
public
|
||||
Owner: NSObject;
|
||||
Target: TWinControl;
|
||||
Context: TCocoaContext;
|
||||
constructor Create(AOwner: NSObject; ATarget: TWinControl); virtual;
|
||||
destructor Destroy; override;
|
||||
function GetPropStorage: TStringList;
|
||||
function GetContext: TCocoaContext;
|
||||
function GetTarget: TObject;
|
||||
procedure MouseDown(x,y: Integer); virtual;
|
||||
procedure MouseUp(x,y: Integer); virtual;
|
||||
procedure MouseClick(clickCount: Integer); virtual;
|
||||
@ -42,6 +47,8 @@ type
|
||||
function DeliverMessage(Msg: Cardinal; WParam: WParam; LParam: LParam): LResult; virtual;
|
||||
procedure Draw(ControlContext: NSGraphicsContext; const bounds, dirty: NSRect); virtual;
|
||||
function ResetCursorRects: Boolean; virtual;
|
||||
|
||||
property HasCaret: Boolean read GetHasCaret write SetHasCaret;
|
||||
end;
|
||||
|
||||
TLCLCommonCallBackClass = class of TLCLCommonCallBack;
|
||||
@ -114,11 +121,22 @@ end;
|
||||
|
||||
{ TLCLCommonCallback }
|
||||
|
||||
function TLCLCommonCallback.GetHasCaret: Boolean;
|
||||
begin
|
||||
Result := FHasCaret;
|
||||
end;
|
||||
|
||||
procedure TLCLCommonCallback.SetHasCaret(AValue: Boolean);
|
||||
begin
|
||||
FHasCaret := AValue;
|
||||
end;
|
||||
|
||||
constructor TLCLCommonCallback.Create(AOwner: NSObject; ATarget: TWinControl);
|
||||
begin
|
||||
inherited Create;
|
||||
Owner := AOwner;
|
||||
Target := ATarget;
|
||||
FContext := nil;
|
||||
FPropStorage := TStringList.Create;
|
||||
FPropStorage.Sorted := True;
|
||||
FPropStorage.Duplicates := dupAccept;
|
||||
@ -126,7 +144,7 @@ end;
|
||||
|
||||
destructor TLCLCommonCallback.Destroy;
|
||||
begin
|
||||
Context.Free;
|
||||
FContext.Free;
|
||||
FPropStorage.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
@ -136,6 +154,16 @@ begin
|
||||
Result := FPropStorage;
|
||||
end;
|
||||
|
||||
function TLCLCommonCallback.GetContext: TCocoaContext;
|
||||
begin
|
||||
Result := FContext;
|
||||
end;
|
||||
|
||||
function TLCLCommonCallback.GetTarget: TObject;
|
||||
begin
|
||||
Result := Target;
|
||||
end;
|
||||
|
||||
procedure TLCLCommonCallback.MouseDown(x, y: Integer);
|
||||
begin
|
||||
LCLSendMouseDownMsg(Target,x,y,mbLeft, []);
|
||||
@ -236,22 +264,19 @@ end;
|
||||
procedure TLCLCommonCallback.Draw(ControlContext: NSGraphicsContext;
|
||||
const bounds, dirty:NSRect);
|
||||
var
|
||||
struct : TPaintStruct;
|
||||
struct: TPaintStruct;
|
||||
begin
|
||||
if not Assigned(Context) then Context:=TCocoaContext.Create;
|
||||
|
||||
Context.ctx:=ControlContext;
|
||||
if Context.InitDraw(Round(bounds.size.width), Round(bounds.size.height)) then
|
||||
begin
|
||||
FillChar(struct, SizeOf(TPaintStruct), 0);
|
||||
struct.hdc := HDC(Context);
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn(Format('[TLCLCommonCallback.Draw] OnPaint event started context: %x', [HDC(context)]));
|
||||
{$ENDIF}
|
||||
LCLSendPaintMsg(Target, HDC(Context), @struct);
|
||||
{$IFDEF VerboseWinAPI}
|
||||
DebugLn('[TLCLCommonCallback.Draw] OnPaint event ended');
|
||||
{$ENDIF}
|
||||
FContext := TCocoaContext.Create;
|
||||
try
|
||||
FContext.ctx := ControlContext;
|
||||
if FContext.InitDraw(Round(bounds.size.width), Round(bounds.size.height)) then
|
||||
begin
|
||||
FillChar(struct, SizeOf(TPaintStruct), 0);
|
||||
struct.hdc := HDC(FContext);
|
||||
LCLSendPaintMsg(Target, HDC(FContext), @struct);
|
||||
end;
|
||||
finally
|
||||
FreeAndNil(FContext);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -119,7 +119,7 @@ end;"/>
|
||||
<License Value="modified LGPL-2
|
||||
"/>
|
||||
<Version Major="1" Release="1"/>
|
||||
<Files Count="391">
|
||||
<Files Count="392">
|
||||
<Item1>
|
||||
<Filename Value="carbon/agl.pp"/>
|
||||
<AddToUsesPkgSection Value="False"/>
|
||||
@ -1940,6 +1940,10 @@ end;"/>
|
||||
<Filename Value="customdrawn/customdrawntrayicon_x11.inc"/>
|
||||
<Type Value="Include"/>
|
||||
</Item391>
|
||||
<Item392>
|
||||
<Filename Value="cocoa/cocoacaret.pas"/>
|
||||
<UnitName Value="CocoaCaret"/>
|
||||
</Item392>
|
||||
</Files>
|
||||
<LazDoc Paths="../../docs/xml/lcl"/>
|
||||
<i18n>
|
||||
|
||||
@ -7,7 +7,7 @@ unit LCL;
|
||||
interface
|
||||
|
||||
uses
|
||||
AllLCLIntfUnits, LazarusPackageIntf;
|
||||
AllLCLIntfUnits, CocoaCaret, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user