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

Merged revision(s) 61617 #b79e2dd90e, 61648 #2e83444e6f, 61675 #17237b6c07, 61692-61696 #cd175cddac-#cd175cddac, 61704-61705 #1437ddef5a-#1437ddef5a, 61709-61710 #013971d96c-#013971d96c, 61731 #3b11854e5c, 61741 #aedf865eae, 61760-61766 #e768107d9c-#e768107d9c, 61768 #462398fd23, 61770-61772 #ea3cda9791-#ea3cda9791, 62052-62054 #bbe61721bd-#bbe61721bd, 62060-62061 #53c619e833-#53c619e833, 62145 #5800bed098, 62155-62161 #636869401c-#636869401c, 62180 #546b5cedd7, 62183 #13ce80945c, 62187 #4f6399d3ef, 62198-62199 #0f2e400fb5-#0f2e400fb5, 62203-62205 #2616af5061-#2616af5061, 62213-62216 #3318764632-#3318764632, 62227-62228 #ffc0a1fef3-#ffc0a1fef3, 62250-62252 #e4c13cf957-#e4c13cf957, 62279-62280 #7edf0a44bc-#7edf0a44bc, 62351-62352 #79faff4c47-#79faff4c47, 62355 #4213fd0677, 62373-62374 #8535bb2ac4-#8535bb2ac4, 62407 #a21894d597, 62413-62414 #810d3c4e27-#810d3c4e27, 62433-62435 #c620145935-#c620145935, 62437-62439 #16d8971fa2-#16d8971fa2, 62452 #03d28dad0f from trunk:

Browse Source 
cocoa: drawedge implementation
........
cocoa: softer color selection for shadows and pseudo 3d for 10.14, rather than deprecated methods call
........
cocoa: extending the list of patreons for August pledge
........
cocoa: nice look for status bar
........
cocoa: calling default NSView lclSetEnabled for tabcontrol
........
cocoa: placing a customcontrol manualscrollview into manualscrollhost. The host itself is a scrollview. But it is not used for Scroll, but rather for the feature of drawing the border. bug 
........
cocoa: adding support for ownerData checkbox values on TListView
........
cocoa: adding forced mouse up for buttons bug 
........
cocoa: adding window content invalidation on hidding of window
........
cocoa: update ScreenToLocal to support flipped controls
........
cocoa: (re)creating a scrollbar with the dimensions matching the desired kind. If kind is changed in runtime - recreating the scrollbar. bug 
........
cocoa: returning alpha multiplied colors in NSColorToRGB
........
cocoa: removing extra null-character from the clipboard text. Patch by Zoë Peterson. bug 
........
cocoa: making ManualScrollHost to pass the methods to the hosted ManualScrollView
........
cocoa: clearing selection of ListBox is itemIndex is set to negative index
........
cocoa: restoring pen and brush states for DrawEdge call. bug 
........
cocoa: resolve the position corruption on bringToFront call. bug 
........
cocoa: replacing use of GetNSObjectView with lclContentView
........
cocoa: replacing use of GetNSObjectView with lclContentView
........
cocoa: replacing use of GetNSObjectView with lclContentView
........
cocoa: getting rid of GetNSObjectView
........
cocoa: don't change buttons font, if a custom font has been selected
........
cocoa: correct horizontal scrollWheel. macOS and LCL are using reversed delta values
........
cocoa: preventing double scrollWheel message for the pair of manualHost+manualScrollView bug 
........
cocoa: not sending onSelectionChange notification while clearing TListBox stringlist
........
cocoa: range check errors resolution, modified patch by C Western. bug 
........
cocoa: updating numerical value of the spin edit on every text change notification. bug 
........
cocoa: changed the way MaxLength is being passed to cocoa interface (adding new method, instead of direct field access). Implemented ontextchange event for password field. bug 
........
cocoa: restoring the window style changes notification. patch by Zoë Peterson. bug 
........
cocoa: fix client frame coordinates for NSBox (groupbox). bug 
........
cocoa: scrollwheel events for textedit fields. bug 
........
cocoa: disabling main menu, while showing application modal message
........
cocoa: using scrollingDeltaAXIS methods as suggested my macOS docs for scroll method. Updated the basis of delta to LCL 120 as suggested in bug  by C Western
........
cocoa: implementing customlistview.ItemGetState for lisSelected. bug 
........
cocoa: implementing the event to call filetypechanged for a file dialog. bug 
........
cocoa: implementing folderChanged and selectionChanged for opensavefile dialogs
........
cocoa: adding support for close event of a filedialog
........
cocoa: preventing sending of setFocus message to a control already focused. bug 
........
cocoa: revert the change of not sending focus notification for LCL focused control
........
cocoa: forcing the constant scroll step
........
cocoa: changing how date conversion utilities work. Currently following the system calendar. bug 
........
cocoa: prevent all windows from being enabled if modal session is active
........
cocoa: proper handling of cancel (escape) action on a prompt dialog
........
cocoa: renaming of the SaveOpenDialog delegate class. update the use of file filtering
........
cocoa: interrupting mouse event handling (by cocoa), if modal window is shown. bug 
........
cocoa: removing the method that is using macOS 10.9 declaration (NSErrorPointer). The method does not need to be implemented. bug 
........
cocoa: fix open dialog file type empty filter. bug 
........
cocoa: imlpementing gridlines property for tableview. bug 
........
cocoa: adding menu hijack specific handling of quite menu command. bug 
........
cocoa: making file related dialogs modal (blocking menu)
........
cocoa: update the code to be compatible fpc-trunk headers. patch by noname012
........
cocoa: corrections of NSAppKitVersionNumber10_14 to match the current Xcode headers bug 
........
cocoa: making togglebox consistent with the standard button. Providing configuration to make the cocoa run in backwards compatible manner
........
cocoa: update change text edit font color. bug 
........
cocoa: setting the default system font to a text edit on allocation
........
cocoa: making font configuration to be selector based, rather than class based
........
cocoa: checking for the rectangle to have some size before drawing
........
cocoa: supporting additional bmp formats. Patch by TK. bug 
........
cocoa: making mainpool lazy initialization - moving to AppInit, to prevent conflicts with dynlib loading. bug 
........
cocoa: making menu captions resource strings. Patch by Zoë Peterson. bug 
........
cocoa: using brush color for FrameRect. bug 
........
lcl: cocoa: fixed compile
........
cocoa: forcing focus set on Showing window through WS ShowHide method
........
cocoa: restoring the use of CocoaLoopOverride for a better control of the message loop. bug 
........
cocoa: sanitizing temp url selection in a dialog selection
........
cocoa: calling finishLaunching explicitly on AppInit rather than from run loop
........
cocoa: updating lclRelativePos function, based on the patch by David Jenkins. bug 
........
cocoa: removing unused function. related to bug 
........
cocoa: using the primary display (index 0) as a base for screen coordinates. Patch by David Jenkins. bug 
........
cocoa: changing the way undo manager is allocated. Changing handling of the text assignment to a memo. Patch by Zoë Peterson. bug 
........
cocoa: sanity check for undomanager reversal
........
cocoa: properly cleaning up the callback interface for the calendar
........

git-svn-id: branches/fixes_2_0@62458 -
This commit is contained in:
dmitry 2019-12-29 20:57:29 +00:00
parent 7846210f02
commit 81bb1a5151
26 changed files with 981 additions and 276 deletions

10
lcl/interfaces/cocoa/cocoa_extra.pas
View File

@ -74,7 +74,7 @@ type
procedure setEnabled_(aenabled: ObjCBool); message 'setEnabled:';
end;
{$if FPC_FULLVERSION < 30300}
{$if FPC_FULLVERSION < 30301}
NSAppearance = objcclass external(NSObject)
function name: NSString; message 'name';
class function currentAppearance: NSAppearance; message 'currentAppearance';
@ -159,6 +159,10 @@ type
NSEventFix = objccategory external (NSEvent)
class function modifierFlags_: NSUInteger; message 'modifierFlags';
// available in 10.7+
function hasPreciseScrollingDeltas: LCLObjCBoolean; message 'hasPreciseScrollingDeltas';
function scrollingDeltaX: CGFloat; message 'scrollingDeltaX';
function scrollingDeltaY: CGFloat; message 'scrollingDeltaY';
end;
NSWindowTabbingMode = NSInteger;
@ -235,7 +239,9 @@ const
NSAppKitVersionNumber10_11 = 1404;
NSAppKitVersionNumber10_12 = 1504;
NSAppKitVersionNumber10_13 = 1561;
NSAppKitVersionNumber10_14 = 1641.10;
//NSAppKitVersionNumber10_14 = 1641.10; // Mojave's beta?
NSAppKitVersionNumber10_14 = 1671;
function NSNormalWindowLevel: NSInteger; inline;

2
lcl/interfaces/cocoa/cocoabuttons.pas
View File

@ -421,6 +421,8 @@ begin
// We need to call the inherited regardless of the result of the call to
// MouseUpDownEvent otherwise mouse clicks don't work, see bug 30131
inherited mouseDown(event);
if Assigned(callback) then
callback.MouseUpDownEvent(event, true);
end;
end;

10
lcl/interfaces/cocoa/cocoadatepicker.pas
View File

@ -20,6 +20,7 @@ type
retainAspectRatio: boolean;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure mouseDown(event: NSEvent); override;
procedure mouseUp(event: NSEvent); override;
@ -56,13 +57,13 @@ begin
// After mouse event, has our date changed
newDate:= NSDateToDateTime(Self.dateValue);
if oldDate <> newDate then
if (oldDate <> newDate) and Assigned(callback) then
callback.SendOnChange;
// This also calls OnClick....
if Assigned(Callback) then
callback.MouseUpDownEvent(event, true);
end;
end;
end;
end;
@ -83,6 +84,11 @@ begin
Result := callback;
end;
procedure TCocoaDatePicker.lclClearCallback;
begin
callback := nil;
end;
procedure TCocoaDatePicker.setFrame(aframe: NSRect);
var
fsz : NSSize;

2
lcl/interfaces/cocoa/cocoadefines.inc
View File

@ -20,7 +20,7 @@
// the first request to process an event, and run LCL loop from there.
// Such approach is some what an ugly solution, yet it's reliable, in a sense
// that Cocoa performs ALL of this methods.
{.$define COCOALOOPOVERRIDE}
{$define COCOALOOPOVERRIDE}
// Not override "run" method. Catch any FPC exception
// The biggest problem of the Native approach - LCL "runloop" method is not called

104
lcl/interfaces/cocoa/cocoagdiobjects.pas
View File

@ -31,7 +31,9 @@ type
cbtGray, // grayscale bitmap
cbtRGB, // color bitmap 8-8-8 R-G-B
cbtARGB, // color bitmap with alpha channel first 8-8-8-8 A-R-G-B
cbtRGBA // color bitmap with alpha channel last 8-8-8-8 R-G-B-A
cbtRGBA, // color bitmap with alpha channel last 8-8-8-8 R-G-B-A
cbtABGR, // color bitmap with alpha channel first 8-8-8-8 A-B-G-R
cbtBGRA // color bitmap with alpha channel last 8-8-8-8 B-G-R-A
);
const
@ -142,6 +144,7 @@ type
AGlobal: Boolean = False);
destructor Destroy; override;
procedure Apply(ADC: TCocoaContext; UseROP2: Boolean = True);
procedure ApplyAsPenColor(ADC: TCocoaContext; UseROP2: Boolean = True);
// for brushes created by NCColor
property Color: NSColor read FColor write SetColor;
@ -446,6 +449,13 @@ type
procedure SetPixel(X,Y:integer; AColor:TColor); virtual;
procedure Polygon(const Points: array of TPoint; NumPts: Integer; Winding: boolean);
procedure Polyline(const Points: array of TPoint; NumPts: Integer);
// draws a rectangle by given LCL coordinates.
// always outlines rectangle
// if FillRect is set to true, then fills with either Context brush
// OR with "UseBrush" brush, if provided
// if FillRect is set to false, draws outlines only.
// if "UseBrush" is not provided, uses the current pen
// if "useBrush" is provided, uses the color from the defined brush
procedure Rectangle(X1, Y1, X2, Y2: Integer; FillRect: Boolean; UseBrush: TCocoaBrush);
procedure BackgroundFill(dirtyRect:NSRect);
procedure Ellipse(X1, Y1, X2, Y2: Integer);
@ -870,6 +880,43 @@ end;
constructor TCocoaBitmap.Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
AAlignment: TCocoaBitmapAlignment; AType: TCocoaBitmapType;
AData: Pointer; ACopyData: Boolean);
type
TColorEntry = packed record
C1, C2, C3, C4: Byte;
end;
PColorEntry = ^TColorEntry;
TColorEntryArray = array[0..MaxInt div SizeOf(TColorEntry) - 1] of TColorEntry;
PColorEntryArray = ^TColorEntryArray;
procedure CopySwappedColorComponents(ASrcData, ADestData: PColorEntryArray; ADataSize: Integer; AType: TCocoaBitmapType);
var
I: Integer;
begin
//switch B and R components
for I := 0 to ADataSize div SizeOf(TColorEntry) - 1 do
begin
case AType of
cbtABGR:
begin
ADestData^[I].C1 := ASrcData^[I].C1;
ADestData^[I].C2 := ASrcData^[I].C4;
ADestData^[I].C3 := ASrcData^[I].C3;
ADestData^[I].C4 := ASrcData^[I].C2;
end;
cbtBGRA:
begin
ADestData^[I].C1 := ASrcData^[I].C3;
ADestData^[I].C2 := ASrcData^[I].C2;
ADestData^[I].C3 := ASrcData^[I].C1;
ADestData^[I].C4 := ASrcData^[I].C4;
end;
end;
end;
end;
begin
inherited Create(False);
{$ifdef VerboseBitmaps}
@ -885,7 +932,15 @@ begin
System.GetMem(FData, FDataSize);
FFreeData := True;
if AData <> nil then
System.Move(AData^, FData^, FDataSize) // copy data
begin
if AType in [cbtABGR, cbtBGRA] then
begin
Assert(AWidth * AHeight * SizeOf(TColorEntry) = FDataSize);
CopySwappedColorComponents(AData, FData, FDataSize, AType);
end
else
System.Move(AData^, FData^, FDataSize) // copy data
end
else
FillDWord(FData^, FDataSize shr 2, 0); // clear bitmap
end
@ -982,14 +1037,14 @@ var
HasAlpha: Boolean;
BitmapFormat: NSBitmapFormat;
begin
HasAlpha := FType in [cbtARGB, cbtRGBA];
HasAlpha := FType in [cbtARGB, cbtRGBA, cbtABGR, cbtBGRA];
// Non premultiplied bitmaps can't be used for bitmap context
// So we need to pre-multiply ourselves, but only if we were allowed
// to copy the data, otherwise we might corrupt the original
if FFreeData then
PreMultiplyAlpha();
BitmapFormat := 0;
if FType in [cbtARGB, cbtRGB] then
if FType in [cbtARGB, cbtABGR, cbtRGB] then
BitmapFormat := BitmapFormat or NSAlphaFirstBitmapFormat;
//WriteLn('[TCocoaBitmap.Create] FSamplesPerPixel=', FSamplesPerPixel,
@ -2015,10 +2070,14 @@ end;
procedure TCocoaContext.Rectangle(X1, Y1, X2, Y2: Integer; FillRect: Boolean; UseBrush: TCocoaBrush);
var
cg: CGContextRef;
resetPen: Boolean;
begin
if (X1=X2) or (Y1=Y2) then Exit;
cg := CGContext;
if not Assigned(cg) then Exit;
resetPen := false;
CGContextBeginPath(cg);
if FillRect then
@ -2033,11 +2092,25 @@ begin
FBrush.Apply(Self);
end
else
begin
CGContextAddLCLRect(cg, X1, Y1, X2, Y2, true);
// this is a "special" case, when UseBrush is provided
// but "FillRect" is set to false. Use for FrameRect() function
// (it deserves a redesign)
if Assigned(UseBrush) then
begin
UseBrush.Apply(Self);
UseBrush.ApplyAsPenColor(Self);
resetPen := true;
end;
end;
CGContextStrokePath(cg);
AttachedBitmap_SetModified();
if resetPen and Assigned(fPen) then // pen was modified by brush. Setting it back
fPen.Apply(Self);
end;
procedure TCocoaContext.BackgroundFill(dirtyRect:NSRect);
@ -3279,6 +3352,29 @@ begin
end;
end;
procedure TCocoaBrush.ApplyAsPenColor(ADC: TCocoaContext; UseROP2: Boolean);
var
AR, AG, AB, AA: CGFloat;
AROP2: Integer;
ADashes: array [0..15] of CGFloat;
ADashLen: Integer;
StatDash: PCocoaStatDashes;
isCosm : Boolean;
WidthMul : array [Boolean] of CGFloat;
begin
if ADC = nil then Exit;
if ADC.CGContext = nil then Exit;
if UseROP2 then
AROP2 := ADC.ROP2
else
AROP2 := R2_COPYPEN;
GetRGBA(AROP2, AR, AG, AB, AA);
CGContextSetRGBStrokeColor(ADC.CGContext, AR, AG, AB, AA);
end;
{ TCocoaGDIObject }
constructor TCocoaGDIObject.Create(AGlobal: Boolean);

44
lcl/interfaces/cocoa/cocoaint.pas
View File

@ -39,7 +39,7 @@ uses
// LCL
LCLStrConsts, LMessages, LCLMessageGlue, LCLProc, LCLIntf, LCLType,
Controls, Forms, Themes, Menus,
IntfGraphics, Graphics, CocoaWSFactory;
IntfGraphics, Graphics, CocoaWSFactory, Interfaces, CocoaWSDialogs;
type
@ -120,7 +120,7 @@ type
TCocoaWidgetSet = class(TWidgetSet)
private
FTerminating: Boolean;
FNSApp: NSApplication;
FNSApp: TCocoaApplication;
FNSApp_Delegate: TAppDelegate;
FCurrentCursor: HCursor;
FCaptureControl: HWND;
@ -171,6 +171,9 @@ type
// modal session
CurModalForm: NSWindow;
Modals : TList;
ModalCounter: Integer; // the cheapest way to determine if modal window was called
// used in mouse handling (in callbackobject)
// Might not be needed, if native Modality used
MainMenuEnabled: Boolean; // the latest main menu status
PrevMenu : NSMenu;
PrevLCLMenu : TMenu;
@ -206,6 +209,7 @@ type
procedure SetMainMenu(const AMenu: HMENU; const ALCLMenu: TMenu);
function StartModal(awin: NSWindow; hasMenu: Boolean): Boolean;
procedure EndModal(awin: NSWindow);
function isTopModalWin(awin: NSWindow): Boolean;
function isModalSession: Boolean;
{todo:}
@ -220,7 +224,7 @@ type
function RawImage_DescriptionToBitmapType(ADesc: TRawImageDescription; out bmpType: TCocoaBitmapType): Boolean;
function GetImagePixelData(AImage: CGImageRef; out bitmapByteCount: PtrUInt): Pointer;
class function Create32BitAlphaBitmap(ABitmap, AMask: TCocoaBitmap): TCocoaBitmap;
property NSApp: NSApplication read FNSApp;
property NSApp: TCocoaApplication read FNSApp;
property CurrentCursor: HCursor read FCurrentCursor write FCurrentCursor;
property CaptureControl: HWND read FCaptureControl;
// the winapi compatibility methods
@ -238,6 +242,14 @@ var
// if set to true, then WS would not assign icons via TCocoaWSForm SetIcon
// The icon would have to be changed manually. By default LCL behaviour is used
CocoaIconUse: Boolean = false;
CocoaToggleBezel : NSBezelStyle = NSRoundedBezelStyle;
CocoaToggleType : NSButtonType = NSPushOnPushOffButton;
{$ifdef COCOALOOPHIJACK}
// The flag is set to true once hi-jacked loop is finished (at the end of app)
// The flag is checked in Menus to avoid "double" Cmd+Q menu
LoopHiJackEnded : Boolean = false;
{$endif}
function CocoaScrollBarSetScrollInfo(bar: TCocoaScrollBar; const ScrollInfo: TScrollInfo): Integer;
function CocoaScrollBarGetScrollInfo(bar: TCocoaScrollBar; var ScrollInfo: TScrollInfo): Boolean;
@ -593,6 +605,7 @@ begin
Result := nil;
aloop();
stop(nil); // this should stop the main loop
LoopHiJackEnded := true;
exit;
end;
{$endif}
@ -660,6 +673,13 @@ begin
end;
procedure InternalInit;
begin
// MacOSX 10.6 reports a lot of warnings during initialization process
// adding the autorelease pool for the whole Cocoa widgetset
MainPool := NSAutoreleasePool.alloc.init;
end;
procedure InternalFinal;
begin
if Assigned(MainPool) then
@ -676,13 +696,6 @@ end;
// the implementation of the extra LCL interface methods
{$I cocoalclintf.inc}
procedure InternalInit;
begin
// MacOSX 10.6 reports a lot of warnings during initialization process
// adding the autorelease pool for the whole Cocoa widgetset
MainPool := NSAutoreleasePool.alloc.init;
end;
procedure TCocoaWidgetSet.DoSetMainMenu(AMenu: NSMenu; ALCLMenu: TMenu);
var
i: Integer;
@ -775,6 +788,7 @@ begin
Modals.Add( TModalSession.Create(awin, sess, PrevMenuEnabled, PrevMenu, PrevLCLMenu));
Result := true;
inc(ModalCounter);
end;
procedure TCocoaWidgetSet.EndModal(awin: NSWindow);
@ -796,6 +810,15 @@ begin
Modals.Delete(Modals.Count-1);
end;
function TCocoaWidgetSet.isTopModalWin(awin: NSWindow): Boolean;
begin
if not isModalSession then begin
Result := false;
Exit;
end;
Result := TModalSession(Modals[Modals.Count-1]).window = awin;
end;
function TCocoaWidgetSet.isModalSession: Boolean;
begin
Result := Assigned(Modals) and (Modals.Count > 0);
@ -827,7 +850,6 @@ end;
initialization
// {$I Cocoaimages.lrs}
InternalInit;
finalization
InternalFinal;

4
lcl/interfaces/cocoa/cocoalclintf.inc
View File

@ -328,7 +328,11 @@ begin
begin
ctrl := TCocoaAlertController(TCocoaAlertController.alloc).initWithWindow(AnAlert.window);
try
ToggleAppMenu(false);
Result := AnAlert.runModal;
if Result = NSCancelButton then
Result := EscapeResult;
ToggleAppMenu(true); // modal menu doesn't have a window, disabling it
finally
ctrl.release;
end;

42
lcl/interfaces/cocoa/cocoaobject.inc
View File

@ -31,14 +31,19 @@ begin
{$IFDEF VerboseObject}
DebugLn('TCocoaWidgetSet.AppInit');
{$ENDIF}
InternalInit;
WakeMainThread := @OnWakeMainThread;
ScreenInfo.PixelsPerInchX := CocoaBasePPI;
ScreenInfo.PixelsPerInchY := CocoaBasePPI;
{ Creates the application NSApp object }
FNSApp := TCocoaApplication.sharedApplication;
FNSApp := TCocoaApplication(TCocoaApplication.sharedApplication);
FNSApp_Delegate := TAppDelegate.alloc.init;
FNSApp.setDelegate(FNSApp_Delegate);
{$ifdef COCOALOOPOVERRIDE}
FNSApp.finishLaunching;
{$endif}
// Sandboxing
lDict := NSProcessInfo.processInfo.environment;
@ -67,9 +72,6 @@ end;
------------------------------------------------------------------------------}
procedure TCocoaWidgetSet.AppRun(const ALoop: TApplicationMainLoop);
begin
{$ifdef COCOALOOPOVERRIDE}
NSApp.finishLaunching;
{$endif}
if Assigned(ALoop) then
begin
TCocoaApplication(NSApp).aloop:=ALoop;
@ -775,11 +777,23 @@ begin
and (ADesc.BlueShift = 0 )
then bmpType := cbtARGB
else
if (ADesc.AlphaShift = 0)
if (ADesc.AlphaShift = 24)
and (ADesc.RedShift = 0 )
and (ADesc.GreenShift = 8 )
and (ADesc.BlueShift = 16)
then bmpType := cbtABGR
else
if (ADesc.AlphaShift = 0 )
and (ADesc.RedShift = 24)
and (ADesc.GreenShift = 16 )
and (ADesc.GreenShift = 16)
and (ADesc.BlueShift = 8 )
then bmpType := cbtRGBA
else
if (ADesc.AlphaShift = 0 )
and (ADesc.RedShift = 8 )
and (ADesc.GreenShift = 16)
and (ADesc.BlueShift = 24)
then bmpType := cbtBGRA
else Exit;
end
else begin
@ -789,11 +803,23 @@ begin
and (ADesc.BlueShift = 24)
then bmpType := cbtARGB
else
if (ADesc.AlphaShift = 24 )
if (ADesc.AlphaShift = 0 )
and (ADesc.RedShift = 24)
and (ADesc.GreenShift = 16)
and (ADesc.BlueShift = 8 )
then bmpType := cbtABGR
else
if (ADesc.AlphaShift = 24)
and (ADesc.RedShift = 0 )
and (ADesc.GreenShift = 8)
and (ADesc.GreenShift = 8 )
and (ADesc.BlueShift = 16)
then bmpType := cbtRGBA
else
if (ADesc.AlphaShift = 24)
and (ADesc.RedShift = 16)
and (ADesc.GreenShift = 8 )
and (ADesc.BlueShift = 0 )
then bmpType := cbtBGRA
else Exit;
end;
end

52
lcl/interfaces/cocoa/cocoaprivate.pas
View File

@ -127,6 +127,10 @@ type
procedure lclInvalidateRect(const r: TRect); message 'lclInvalidateRect:';
procedure lclInvalidate; message 'lclInvalidate';
procedure lclUpdate; message 'lclUpdate';
// Returns the position of the view or window, in the immediate
// parent (view or screen), relative to its client coordinates system
// Left and Top are always returned in LCL coordinate system.
procedure lclRelativePos(var Left, Top: Integer); message 'lclRelativePos::';
procedure lclLocalToScreen(var X, Y: Integer); message 'lclLocalToScreen::';
procedure lclScreenToLocal(var X, Y: Integer); message 'lclScreenToLocal::';
@ -477,7 +481,10 @@ begin
if not Assigned(v) then
Result := inherited lclClientFrame
else
Result := NSRectToRect( v.frame );
if v.isFlipped then
Result := NSRectToRect( v.frame )
else
NSToLCLRect(v.frame, frame.size.height, Result);
end;
function TCocoaGroupBox.lclContentView: NSView;
@ -910,7 +917,7 @@ var
begin
p := nil;
if (AParams.WndParent <> 0) then
p := CocoaUtils.GetNSObjectView(NSObject(AParams.WndParent));
p := NSView(AParams.WndParent).lclContentView;
if Assigned(p) then
LCLToNSRect(Types.Bounds(AParams.X, AParams.Y, AParams.Width, AParams.Height),
@ -1021,9 +1028,19 @@ begin
end;
procedure LCLViewExtension.lclRelativePos(var Left, Top: Integer);
var
sv : NSView;
fr : NSRect;
begin
Left := Round(frame.origin.x);
Top := Round(frame.origin.y);
sv := superview;
if Assigned(sv) and (not sv.isFlipped) then
begin
fr := frame;
Top := Round(sv.frame.size.height - fr.origin.y - fr.size.height);
end
else
Top := Round(frame.origin.y);
end;
procedure LCLViewExtension.lclLocalToScreen(var X, Y:Integer);
@ -1032,18 +1049,22 @@ var
begin
// 1. convert to window base
// Convert from View-lcl to View-cocoa
P.x := X;
if isFlipped then
p.y := Y
else
P.y := frame.size.height-y; // convert to Cocoa system
// Convert from View-cocoa to Window-cocoa
P := convertPoint_ToView(P, nil);
// Convert from Window-cocoa to Window-lcl
X := Round(P.X);
Y := Round(window.frame.size.height-P.Y); // convert to LCL system
// 2. convert window to screen
// Use window function to convert fomr Window-lcl to Screen-lcl
window.lclLocalToScreen(X, Y);
end;
@ -1052,15 +1073,22 @@ var
P: NSPoint;
begin
// 1. convert from screen to window
// use window function to onvert from Screen-lcl to Window-lcl
window.lclScreenToLocal(X, Y);
// Convert from Window-lcl to Window-cocoa
P.x := X;
P.y := Round(window.frame.size.height-Y); // convert to Cocoa system
// 2. convert from window to local
// Convert from Window-cocoa to View-cocoa
P := convertPoint_FromView(P, nil);
// Convert from View-cocoa to View-lcl
X := Round(P.x);
Y := Round(frame.size.height-P.y); // convert to Cocoa system
if isFlipped then
Y := Round(p.y)
else
Y := Round(frame.size.height-P.y); // convert to Cocoa system
end;
function LCLViewExtension.lclParent:id;
@ -1073,7 +1101,7 @@ var
v: NSView;
begin
v := superview;
if Assigned(v) then
if Assigned(v) and not v.isFlipped then
NSToLCLRect(frame, v.frame.size.height, Result)
else
Result := NSRectToRect(frame);
@ -1152,6 +1180,7 @@ var
i : Integer;
cs : NSString;
nr : NSRect;
dr : NSRect;
al : TAlignment;
x : Integer;
txt : string;
@ -1180,15 +1209,22 @@ begin
if not barcallback.GetBarItem(i, txt, w, al) then Continue;
if i = cnt - 1 then w := r.Right - x;
nr.size.width := w;
nr.origin.x := x;
// dr - draw rect. should be 1 pixel wider
// and 1 pixel taller, than the actual rect.
// to produce a better visual effect
dr := nr;
dr.size.width := dr.size.width + 1;
dr.size.height := dr.size.height + 1;
dr.origin.y := dr.origin.y-1;
cs := NSStringUtf8(txt);
panelCell.setTitle(cs);
panelCell.setAlignment(CocoaAlign[al]);
panelCell.drawWithFrame_inView(nr, Self);
panelCell.drawWithFrame_inView(dr, Self);
cs.release;
barcallback.DrawPanel(i, NSRectToRect(nr));
inc(x, w);

43
lcl/interfaces/cocoa/cocoascrollers.pas
View File

@ -67,6 +67,7 @@ type
fhscroll : NSScroller;
fvscroll : NSScroller;
public
isHosted: Boolean;
callback: ICommonCallback;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
@ -141,6 +142,14 @@ type
end;
{ TCocoaManualScrollHost }
TCocoaManualScrollHost = objcclass(TCocoaScrollView)
procedure setDocumentView(aview: NSView); override;
function lclContentView: NSView; override;
function lclClientFrame: TRect; override;
end;
function isMouseEventInScrollBar(host: TCocoaManualScrollView; event: NSEvent): Boolean;
// These settings are set by a user in "System Preferences"
@ -281,6 +290,32 @@ begin
end;
end;
{ TCocoaManualScrollHost }
procedure TCocoaManualScrollHost.setDocumentView(aview: NSView);
begin
inherited setDocumentView(aview);
if Assigned(aview) and (aview.isKindOfClass(TCocoaManualScrollView)) then
TCocoaManualScrollView(aview).isHosted := true;
end;
function TCocoaManualScrollHost.lclContentView: NSView;
begin
if Assigned(documentView) then
Result := documentView.lclContentView
else
Result := inherited lclContentView;
end;
function TCocoaManualScrollHost.lclClientFrame: TRect;
begin
if Assigned(documentView) then
begin
Result:=documentView.lclClientFrame;
end
else Result:=inherited lclClientFrame;
end;
{ TCocoaManualScrollView }
function TCocoaManualScrollView.lclGetCallback: ICommonCallback;
@ -656,8 +691,12 @@ end;
procedure TCocoaManualScrollView.scrollWheel(event: NSEvent);
begin
if isMouseEventInScrollBar(self, event) or not Assigned(callback) or not callback.scrollWheel(event) then
inherited scrollWheel(event);
// when hosted, the processing of scrollWheel is duplciated
if not isHosted then
begin
if isMouseEventInScrollBar(self, event) or not Assigned(callback) or not callback.scrollWheel(event) then
inherited scrollWheel(event);
end;
end;

1
lcl/interfaces/cocoa/cocoatabcontrols.pas
View File

@ -425,6 +425,7 @@ end;
procedure TCocoaTabControl.lclSetEnabled(AEnabled: Boolean);
begin
lclEnabled := AEnabled;
inherited lclSetEnabled(AEnabled);
end;
function TCocoaTabControl.lclGetCallback: ICommonCallback;

14
lcl/interfaces/cocoa/cocoatables.pas
View File

@ -59,7 +59,11 @@ type
procedure Changed; override;
public
Owner: NSTableView;
// some notificaitons (i.e. selection change)
// should not be passed to LCL while clearing
isClearing: Boolean;
constructor Create(AOwner: NSTableView);
procedure Clear; override;
end;
{ TCocoaTableListView }
@ -841,6 +845,16 @@ begin
inherited Create;
end;
procedure TCocoaStringList.Clear;
begin
isClearing := true;
try
inherited Clear;
finally
isClearing := false;
end;
end;
{ TCellCocoaTableListView }
procedure TCellCocoaTableListView.tableView_setObjectValue_forTableColumn_row(

96
lcl/interfaces/cocoa/cocoatextedits.pas
View File

@ -55,9 +55,13 @@ type
TCocoaFieldEditor = objcclass;
NSTextField_LCLExt = objcprotocol
procedure lclSetMaxLength(amax: integer); message 'lclSetMaxLength:';
end;
{ TCocoaTextField }
TCocoaTextField = objcclass(NSTextField)
TCocoaTextField = objcclass(NSTextField, NSTextField_LCLExt)
callback: ICommonCallback;
maxLength: Integer;
function acceptsFirstResponder: LCLObjCBoolean; override;
@ -75,18 +79,23 @@ type
procedure otherMouseUp(event: NSEvent); override;
procedure mouseDragged(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
procedure scrollWheel(event: NSEvent); override;
procedure lclSetMaxLength(amax: integer);
end;
{ TCocoaSecureTextField }
TCocoaSecureTextField = objcclass(NSSecureTextField)
TCocoaSecureTextField = objcclass(NSSecureTextField, NSTextField_LCLExt)
public
maxLength: Integer;
callback: ICommonCallback;
function acceptsFirstResponder: LCLObjCBoolean; override;
procedure resetCursorRects; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
// key
procedure textDidChange(notification: NSNotification); override;
// mouse
procedure mouseDown(event: NSEvent); override;
procedure mouseUp(event: NSEvent); override;
@ -96,6 +105,9 @@ type
procedure otherMouseUp(event: NSEvent); override;
procedure mouseDragged(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
procedure scrollWheel(event: NSEvent); override;
procedure lclSetMaxLength(amax: integer);
end;
{ TCocoaTextView }
@ -112,7 +124,6 @@ type
procedure dealloc; override;
function acceptsFirstResponder: LCLObjCBoolean; override;
function undoManager: NSUndoManager; override;
function lclGetCallback: ICommonCallback; override;
procedure lclClearCallback; override;
procedure resetCursorRects; override;
@ -141,6 +152,7 @@ type
// delegate methods
procedure textDidChange(notification: NSNotification); message 'textDidChange:';
procedure lclExpectedKeys(var wantTabs, wantArrows, wantReturn, wantAll: Boolean); override;
function undoManagerForTextView(view: NSTextView): NSUndoManager; message 'undoManagerForTextView:';
end;
{ TCococaFieldEditorExt }
@ -175,6 +187,7 @@ type
procedure otherMouseUp(event: NSEvent); override;
procedure mouseDragged(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
procedure scrollWheel(event: NSEvent); override;
end;
const
@ -394,6 +407,7 @@ type
procedure lclReleaseSubcontrols; message 'lclReleaseSubcontrols';
procedure PositionSubcontrols(const ALeft, ATop, AWidth, AHeight: Integer); message 'PositionSubcontrols:ATop:AWidth:AHeight:';
procedure StepperChanged(sender: NSObject); message 'StepperChanged:';
procedure textDidChange(notification: NSNotification); override;
procedure textDidEndEditing(notification: NSNotification); message 'textDidEndEditing:'; override;
// NSTextFieldDelegateProtocol
procedure controlTextDidChange(obj: NSNotification); override;
@ -418,7 +432,6 @@ type
procedure otherMouseDragged(event: NSEvent); override;
procedure mouseDragged(event: NSEvent); override;
procedure mouseMoved(event: NSEvent); override;
procedure scrollWheel(event: NSEvent); override;
end;
{$ENDIF}
@ -891,6 +904,19 @@ begin
inherited mouseMoved(event);
end;
procedure TCocoaFieldEditor.scrollWheel(event: NSEvent);
var
v : NSView;
begin
v := GetEditBox(Self);
if Assigned(v) then
begin
if Assigned(v.lclGetCallback) and not v.lclGetCallback.scrollWheel(event) then
inherited mouseMoved(event);
end else
inherited scrollWheel(event);
end;
{ TCocoaTextField }
function TCocoaTextField.acceptsFirstResponder: LCLObjCBoolean;
@ -980,6 +1006,17 @@ begin
inherited mouseMoved(event);
end;
procedure TCocoaTextField.scrollWheel(event: NSEvent);
begin
if Assigned(callback) and not callback.scrollWheel(event) then
inherited scrollWheel(event);
end;
procedure TCocoaTextField.lclSetMaxLength(amax: integer);
begin
maxLength := amax;
end;
{ TCocoaTextView }
procedure TCocoaTextView.changeColor(sender: id);
@ -1000,18 +1037,6 @@ begin
Result := NSViewCanFocus(Self);
end;
function TCocoaTextView.undoManager: NSUndoManager;
begin
if allowsUndo then
begin
if not Assigned(FUndoManager) then
FUndoManager := NSUndoManager.alloc.init;
Result := FUndoManager;
end
else
Result := nil;
end;
function TCocoaTextView.lclGetCallback: ICommonCallback;
begin
Result := callback;
@ -1150,6 +1175,13 @@ begin
wantAll := true;
end;
function TCocoaTextView.undoManagerForTextView(view: NSTextView): NSUndoManager;
begin
if not Assigned(FUndoManager) then
FUndoManager := NSUndoManager.alloc.init;
Result := FUndoManager;
end;
{ TCocoaSecureTextField }
function TCocoaSecureTextField.acceptsFirstResponder: LCLObjCBoolean;
@ -1173,6 +1205,15 @@ begin
callback := nil;
end;
procedure TCocoaSecureTextField.textDidChange(notification: NSNotification);
begin
inherited;
if (maxLength>0) and Assigned(stringValue) and (stringValue.length > maxLength) then
setStringValue(stringValue.substringWithRange(NSMakeRange(0,maxLength)));
if callback <> nil then
callback.SendOnTextChanged;
end;
procedure TCocoaSecureTextField.mouseDown(event: NSEvent);
begin
if Assigned(callback) and not callback.MouseUpDownEvent(event) then
@ -1226,6 +1267,17 @@ begin
inherited mouseMoved(event);
end;
procedure TCocoaSecureTextField.scrollWheel(event: NSEvent);
begin
if Assigned(callback) and not callback.scrollWheel(event) then
inherited scrollWheel(event);
end;
procedure TCocoaSecureTextField.lclSetMaxLength(amax: integer);
begin
MaxLength := amax;
end;
{ TCocoaEditComboBoxList }
procedure TCocoaEditComboBoxList.InsertItem(Index: Integer; const S: string;
@ -1962,6 +2014,12 @@ begin
if callback <> nil then callback.SendOnTextChanged();
end;
procedure TCocoaSpinEdit.textDidChange(notification: NSNotification);
begin
updateStepper;
inherited textDidChange(notification);
end;
procedure TCocoaSpinEdit.textDidEndEditing(notification: NSNotification);
begin
updateStepper;
@ -2123,12 +2181,6 @@ begin
inherited mouseMoved(event);
end;
procedure TCocoaSpinEdit.scrollWheel(event: NSEvent);
begin
if not Assigned(callback) or not callback.scrollWheel(event) then
inherited scrollWheel(event);
end;
{$ENDIF}
end.

80
lcl/interfaces/cocoa/cocoautils.pas
View File

@ -42,13 +42,14 @@ function NSRectToRect(const NS: NSRect): TRect;
procedure NSToLCLRect(const ns: NSRect; ParentHeight: Single; out lcl: TRect);
procedure LCLToNSRect(const lcl: TRect; ParentHeight: Single; out ns: NSRect);
function NSScreenZeroHeight: CGFloat;
function CreateParamsToNSRect(const params: TCreateParams): NSRect;
function NSStringUtf8(s: PChar): NSString;
function NSStringUtf8(const s: String): NSString;
function NSStringToString(ns: NSString): String;
function GetNSObjectView(obj: NSObject): NSView;
function GetNSObjectWindow(obj: NSObject): NSWindow;
procedure SetNSText(text: NSText; const s: String); inline;
@ -365,9 +366,14 @@ begin
end;
function NSColorToRGB(const Color: NSColor): TColorRef; inline;
var
alpha: CGFloat;
begin
// TColorRef doesn't bear an alpha channel information.
// Thus RGB needs to be multiplied by it.
alpha := Color.alphaComponent;
with Color do
Result := RGBToColorFloat(redComponent, greenComponent, blueComponent);
Result := RGBToColorFloat(redComponent*alpha, greenComponent*alpha, blueComponent*alpha);
end;
function NSColorToColorRef(const Color: NSColor): TColorRef;
@ -444,36 +450,14 @@ begin
result:=CFStringToStr(AString);
end;
// Return the content view of a given non-view or
// for a view. For Window and Box and similar containers
// it returns the content view
function GetNSObjectView(obj: NSObject): NSView;
begin
Result := nil;
if not Assigned(obj) then Exit;
if obj.isKindOfClass_(NSBox) then
Result := NSBox(obj).contentView
else if obj.isKindOfClass_(NSView) then
Result := NSView(obj)
else if obj.isKindOfClass_(NSWindow) then
Result := NSWindow(obj).contentView
else if obj.isKindOfClass_(NSTabViewItem) then
Result := NSTabViewItem(obj).view;
end;
function GetNSObjectWindow(obj: NSObject): NSWindow;
var
lView: NSView;
begin
Result := nil;
if not Assigned(obj) then Exit;
if obj.isKindOfClass_(NSWindow) then
Result := NSWindow(obj)
else
begin
lView := GetNSObjectView(obj);
if lView <> nil then Result := lView.window;
end;
else if obj.isKindOfClass_(NSView) then
Result := NSView(obj).window;
end;
function GetNSSize(width, height: CGFloat): NSSize; inline;
@ -591,6 +575,11 @@ begin
ns.size.height:=lcl.Bottom-lcl.Top;
end;
function NSScreenZeroHeight: CGFloat;
begin
Result := NSScreen(NSScreen.screens.objectAtIndex(0)).frame.size.height;
end;
function CreateParamsToNSRect(const params: TCreateParams): NSRect;
begin
with params do Result:=GetNSRect(X,Y,Width,Height);
@ -629,6 +618,8 @@ begin
ns := NSStringUTF8(s);
text.setString(ns);
ns.release;
if Assigned(text.undoManager) then
text.undoManager.removeAllActions;
end;
end;
@ -962,23 +953,50 @@ begin
end;
function DateTimeToNSDate(const aDateTime : TDateTime): NSDate;
var
{var
ti : NSTimeInterval;
d : NSDate;
begin
ti := (aDateTime - EncodeDate(2001, 1, 1)) * SecsPerDay;
d := NSDate.alloc.init;
Result:= d.dateWithTimeIntervalSinceReferenceDate(ti);
ti := ti - double(NSTimeZone.localTimeZone.secondsFromGMT);
Result := NSDate.dateWithTimeIntervalSinceReferenceDate(ti);}
var
cmp : NSDateComponents;
y,m,d: Word;
h,s,z: Word;
begin
cmp := NSDateComponents.alloc.init;
DecodeDate(ADateTime, y,m,d);
cmp.setYear(y);
cmp.setMonth(m);
cmp.setDay(d);
DecodeTime(ADateTime, h, m, s,z);
cmp.setHour(h);
cmp.setMinute(m);
cmp.setSecond(s);
Result := NSCalendar.currentCalendar.dateFromComponents(cmp);
end;
function NSDateToDateTime(const aDateTime: NSDate): TDateTime;
var
cmp : NSDateComponents;
mn : TdateTime;
const
convFlag = NSYearCalendarUnit
or NSMonthCalendarUnit
or NSDayCalendarUnit
or NSHourCalendarUnit
or NSMinuteCalendarUnit
or NSSecondCalendarUnit;
begin
if aDateTime = nil then
begin
Result:= 0.0;
Exit;
end;
Result:= aDateTime.timeIntervalSince1970 / SecsPerDay + EncodeDate(1970, 1, 1);
cmp := NSCalendar.currentCalendar.components_fromDate(convFlag, aDateTime);
TryEncodeDate(cmp.year, cmp.month, cmp.day, Result);
TryEncodeTime(cmp.hour, cmp.minute, cmp.second, 0, mn);
Result := Result + mn;
end;
function ControlTitleToStr(const ATitle: string): String;

180
lcl/interfaces/cocoa/cocoawinapi.inc
View File

@ -254,6 +254,12 @@ begin
{$ENDIF}
end;
function TCocoaWidgetSet.ClipboardFormatNeedsNullByte(
const AFormat: TPredefinedClipboardFormat): Boolean;
begin
Result := False
end;
function TCocoaWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint;
begin
Result := LCLType.Error;
@ -558,6 +564,93 @@ begin
end;
end;
procedure DrawEdgeRect(dst: TCocoaContext; const r: TRect; flags: Cardinal;
LTColor, BRColor: TColor);
begin
dst.Pen.SetColor(LTColor, true);
dst.Pen.Apply(dst);
if flags and BF_LEFT > 0 then
begin
dst.MoveTo(r.Left, r.Bottom);
dst.LineTo(r.Left, r.Top);
end;
if flags and BF_TOP > 0 then
begin
dst.MoveTo(r.Left, r.Top);
dst.LineTo(r.Right, r.Top);
end;
dst.Pen.SetColor(BRColor, true);
dst.Pen.Apply(dst);
if flags and BF_RIGHT > 0 then
begin
dst.MoveTo(r.Right, r.Top);
dst.LineTo(r.Right, r.Bottom);
end;
if flags and BF_BOTTOM > 0 then
begin
dst.MoveTo(r.Right, r.Bottom);
// there's a missing pixel. Seems like it's accumulating an offset
dst.LineTo(r.Left-1, r.Bottom);
end;
end;
function TCocoaWidgetSet.DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal;
grfFlags: Cardinal): Boolean;
var
ctx: TCocoaContext;
r: TRect;
keepPen : TCocoaPen;
edgePen : TCocoaPen;
keepBrush : TCocoaBrush;
edgeBrush : TCocoaBrush;
const
OutLT = cl3DLight; // the next to hilight
OutBR = cl3DDkShadow; // the darkest (almost black)
InnLT = cl3DHiLight; // the lightest (almost white)
InnBR = cl3DShadow; // darker than light, lighter than dark shadow
begin
ctx := CheckDC(DC);
Result := Assigned(ctx);
if not Result then Exit;
keepPen := ctx.Pen;
keepBrush := ctx.Brush;
try
edgePen := TCocoaPen.Create($FFFFFF, psSolid, false, 1, pmCopy, pecRound, pjsRound);
edgeBrush := TCocoaBrush.Create(NSColor.whiteColor, false);
edgeBrush.Solid := false;
ctx.Pen := edgePen;
ctx.Brush := edgeBrush;
r := Rect;
if (edge and BDR_OUTER > 0) then
begin
if edge and BDR_RAISEDOUTER > 0 then
DrawEdgeRect(ctx, r, grfFlags, OutLT, OutBR)
else
DrawEdgeRect(ctx, r, grfFlags, InnBR, InnLT);
InflateRect(r, -1, -1);
end;
if (edge and BDR_INNER > 0) then
begin
if edge and BDR_RAISEDINNER > 0 then
DrawEdgeRect(ctx, r, grfFlags, InnLT, InnBR)
else
DrawEdgeRect(ctx, r, grfFlags, OutBR, OutLT);
end;
finally
ctx.Pen := keepPen;
ctx.Brush := keepBrush;
edgeBrush.Free;
edgePen.Free;
end;
Result := true;
end;
function TCocoaWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
var
ctx: TCocoaContext;
@ -569,10 +662,27 @@ begin
end;
function TCocoaWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
var
obj : NSObject;
begin
Result := hWnd <> 0;
if Result then
NSObject(hWnd).lclSetEnabled(bEnable)
begin
obj := NSObject(hWnd);
// The following check is actually a hack. LCL enables all windows disabled
// during ShowModal form. No matter if the windows are on the stack of the modality or not.
// Since Cocoa doesn't do much of the "modal" control over the windows
// (runWindowModal isn't used... maybe it should be?)
// It's possible that windows "disabled" by a another model window would be
// re-enabled. This check verifies that only a window on the top of the modal stack
// will be brought back active... what about other windows?
if bEnable and isModalSession and (obj.isKindOfClass(TCocoaWindowContent)) then begin
if not (TCocoaWindowContent(obj).isembedded)
and not isTopModalWin(TCocoaWindowContent(obj).window) then Exit;
end;
obj.lclSetEnabled(bEnable)
end;
end;
function TCocoaWidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer;
@ -914,8 +1024,8 @@ begin
SPI_GETWHEELSCROLLLINES: PDword(pvPAram)^ := 3;
SPI_GETWORKAREA:
begin
NSToLCLRect(NSScreen.mainScreen.visibleFrame
, NSScreen.mainScreen.frame.size.height
NSToLCLRect(NSScreen(NSScreen.screens.objectAtIndex(0)).visibleFrame
, NSScreenZeroHeight
, TRect(pvParam^));
end;
else
@ -1013,7 +1123,7 @@ begin
begin
lpPoint.x := Round(x);
// cocoa returns cursor with inverted y coordinate
lpPoint.y := Round(NSScreen.mainScreen.frame.size.height-y);
lpPoint.y := Round(NSScreenZeroHeight-y);
end;
//debugln('GetCursorPos='+DbgS(lpPoint));
Result := True;
@ -1021,6 +1131,7 @@ end;
function TCocoaWidgetSet.GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
var
Scr0Height: CGFloat;
ScreenID: NSScreen;
idx : NSUInteger;
begin
@ -1030,9 +1141,10 @@ begin
Result := (idx < NSScreen.screens.count);
if not Result then Exit;
Scr0Height := NSScreenZeroHeight;
ScreenID := NSScreen(NSScreen.screens.objectAtIndex(idx));
lpmi^.rcMonitor := NSRectToRect(ScreenID.frame);
NSToLCLRect(ScreenID.visibleFrame, ScreenID.frame.size.height, lpmi^.rcWork);
NSToLCLRect(ScreenID.frame, Scr0Height, lpmi^.rcMonitor);
NSToLCLRect(ScreenID.visibleFrame, Scr0Height, lpmi^.rcWork);
// according to the documentation the primary (0,0 coord screen)
// is always and index 0
if idx = 0 then
@ -1208,12 +1320,7 @@ function TCocoaWidgetSet.GetWindowRelativePosition(Handle: hwnd; var Left, Top:
begin
Result := Handle <> 0;
if Result then
begin
if TCocoaWindowContent(handle).isembedded then
TCocoaWindowContent(handle).lclRelativePos(Left, Top)
else
TCocoaWindowContent(handle).window.lclRelativePos(Left, Top);
end
NSObject(handle).lclRelativePos(Left, Top);
end;
function TCocoaWidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: Integer): boolean;
@ -1397,7 +1504,7 @@ begin
begin
window:=windows.objectAtIndex(win);
p.x:=Point.X;
p.y:=window.screen.frame.size.height-Point.Y;
p.y:=NSScreenZeroHeight-Point.Y;
winnr:=NSWindow.windowNumberAtPoint_belowWindowWithWindowNumber(p,0);
windowbelowpoint:=NSWindow(NSApp.windowWithWindowNumber(winnr));
if windowbelowpoint=window then
@ -1501,6 +1608,9 @@ begin
Result := Assigned(obj);
if not Result then Exit;
if obj.isKindOfClass(TCocoaManualScrollHost) then
obj := TCocoaManualScrollHost(obj).documentView;
if obj.isKindOfClass(NSScrollView) then
begin
sc := NSScrollView(obj);
@ -1535,6 +1645,9 @@ begin
Result := Assigned(obj);
if not Result then Exit;
if obj.isKindOfClass(TCocoaManualScrollHost) then
obj := TCocoaManualScrollHost(obj).documentView;
if obj.isKindOfClass(TCocoaScrollBar) then
Result := CocoaScrollBarGetScrollInfo(TCocoaScrollBar(obj), ScrollInfo)
else
@ -1625,18 +1738,30 @@ begin
Result := NSColor.scrollBarColor;
COLOR_BTNFACE:
Result := NSColor.controlBackgroundColor;
COLOR_BTNSHADOW:
Result := NSColor.controlShadowColor;
COLOR_BTNSHADOW: // COLOR_3DSHADOW
if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
Result := NSColor.controlColor.shadowWithLevel(0.5)
else
Result := NSColor.controlShadowColor;
COLOR_BTNHIGHLIGHT:
Result := NSColor.controlLightHighlightColor;//controlHighlightColor has no contrast with COLOR_BTNFACE which affects TBevel. In Win32 this has value white
if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
Result := NSColor.controlColor.shadowWithLevel(0.0)
else
Result := NSColor.controlLightHighlightColor;//controlHighlightColor has no contrast with COLOR_BTNFACE which affects TBevel. In Win32 this has value white
COLOR_BTNTEXT:
Result := NSColor.controlTextColor;
COLOR_GRAYTEXT:
Result := NSColor.disabledControlTextColor;
COLOR_3DDKSHADOW:
Result := NSColor.controlDarkShadowColor;
if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
Result := NSColor.controlColor.shadowWithLevel(0.75)
else
Result := NSColor.controlDarkShadowColor;
COLOR_3DLIGHT:
Result := NSColor.controlHighlightColor;// makes a more consistent result (a very light gray) than controlLightHighlightColor (which is white)
if NSAppKitVersionNumber >= NSAppKitVersionNumber10_14 then
Result := NSColor.controlColor.shadowWithLevel(0.25)
else
Result := NSColor.controlHighlightColor;// makes a more consistent result (a very light gray) than controlLightHighlightColor (which is white)
// macOS doesn't provide any API to get the hint window colors.
// default = macosx10.4 yellow color. (See InitInternals below)
@ -1713,11 +1838,19 @@ var
f : NSSize;
sz : NSSize;
flg : NSUInteger;
hosted: Boolean;
begin
obj := NSObject(Handle);
Result := 0;
if not Assigned(obj) then Exit;
if obj.isKindOfClass(TCocoaManualScrollHost) then
begin
hosted := true;
obj := TCocoaManualScrollHost(obj).documentView;
end else
hosted := false;
if obj.isKindOfClass(TCocoaScrollView) then
begin
sc:=TCocoaScrollView(obj);
@ -1769,6 +1902,9 @@ begin
else
Result := 0;
if hosted then
NSView(obj).lclInvalidate;
end else if obj.isKindOfClass(TCocoaScrollBar) then
begin
Result := CocoaScrollBarSetScrollInfo(TCocoaScrollBar(obj), ScrollInfo);
@ -1787,6 +1923,9 @@ begin
Result := Assigned(obj);
if not Result then Exit;
if obj.isKindOfClass(TCocoaManualScrollHost) then
obj := TCocoaManualScrollHost(obj).documentView;
if obj.isKindOfClass(TCocoaScrollView)
then begin
Result := true;
@ -1871,6 +2010,8 @@ begin
end;
end;
{$push}
{$rangechecks off}
function TCocoaWidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean;
var
ctx: TCocoaContext;
@ -1890,6 +2031,7 @@ begin
if Result then
ctx.Polyline(PPointArray(Points)^, NumPts);
end;
{$pop}
type
TLCLEventMessage = objcclass(NSObject)
@ -2415,7 +2557,7 @@ begin
end
else
begin
lView := GetNSObjectView(Obj);
lView := obj.lclContentView;
if lView <> nil then
begin
if lView.window <> nil then

2
lcl/interfaces/cocoa/cocoawinapih.inc
View File

@ -42,6 +42,7 @@ function ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean; override;
function ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat; override;
function ClipboardFormatNeedsNullByte(const AFormat: TPredefinedClipboardFormat): Boolean; override;
function CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint; override;
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP; override;
@ -63,6 +64,7 @@ function DestroyCaret(Handle : HWND): Boolean; override;
function DestroyIcon(Handle: HICON): Boolean; override;
function DPtoLP(DC: HDC; var Points; Count: Integer): BOOL; override;
function DrawFocusRect(DC: HDC; const Rect: TRect): boolean; override;
function DrawEdge(DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal): Boolean; override;
function Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean; override;
{function EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean; override;}

60
lcl/interfaces/cocoa/cocoawindows.pas
View File

@ -195,6 +195,7 @@ type
public
overlay: NSView;
wincallback: IWindowCallback;
function lclWindowState: Integer; override;
procedure didAddSubview(aview: NSView); override;
procedure setNeedsDisplay_(aflag: LCLObjCBoolean); override;
procedure setNeedsDisplayInRect(arect: NSRect); override;
@ -220,7 +221,7 @@ type
function lclOwnWindow: NSWindow; message 'lclOwnWindow';
procedure lclSetFrame(const r: TRect); override;
function lclFrame: TRect; override;
function lclWindowState: Integer; override;
procedure lclRelativePos(var Left, Top: Integer); override;
procedure viewDidMoveToSuperview; override;
procedure viewDidMoveToWindow; override;
procedure viewWillMoveToWindow(newWindow: CocoaAll.NSWindow); override;
@ -231,9 +232,6 @@ type
function stringValue: NSString; message 'stringValue';
end;
procedure NSScreenGetRect(sc: NSScreen; out r: TRect);
procedure NSScreenGetRect(sc: NSScreen; mainScreenHeight: double; out r: TRect);
implementation
{ TCocoaDesignOverlay }
@ -267,6 +265,14 @@ end;
{ TCocoaWindowContent }
function TCocoaWindowContentDocument.lclWindowState: Integer;
begin
if window.lclGetCallback = wincallback then // not embedded
Result := window.lclWindowState
else
Result := inherited lclWindowState
end;
procedure TCocoaWindowContentDocument.didAddSubview(aview: NSView);
const
mustHaveSizing = (NSViewWidthSizable or NSViewHeightSizable);
@ -437,19 +443,19 @@ begin
begin
//Window bounds should return "client rect" in screen coordinates
if Assigned(window.screen) then
NSToLCLRect(window.frame, window.screen.frame.size.height, wfrm)
NSToLCLRect(window.frame, NSScreenZeroHeight, wfrm)
else
wfrm := NSRectToRect(frame);
OffsetRect(Result, -Result.Left+wfrm.Left, -Result.Top+wfrm.Top);
end;
end;
function TCocoaWindowContent.lclWindowState: Integer;
procedure TCocoaWindowContent.lclRelativePos(var Left, Top: Integer);
begin
if isembedded then
Result := inherited lclWindowState
inherited lclRelativePos(Left, Top)
else
Result := window.lclWindowState;
window.lclRelativePos(Left, Top);
end;
procedure TCocoaWindowContent.viewDidMoveToSuperview;
@ -1147,7 +1153,7 @@ begin
begin
f:=frame;
Left := Round(f.origin.x);
Top := Round(screen.frame.size.height - f.size.height - f.origin.y);
Top := Round(NSScreenZeroHeight - f.size.height - f.origin.y);
//debugln('Top:'+dbgs(Top));
end;
end;
@ -1160,7 +1166,7 @@ begin
begin
f := frame;
inc(X, Round(f.origin.x));
inc(Y, Round(screen.frame.size.height - f.size.height - f.origin.y));
inc(Y, Round(NSScreenZeroHeight - f.size.height - f.origin.y));
end;
end;
@ -1183,7 +1189,7 @@ begin
else
begin
if Assigned(screen) then
NSToLCLRect(frame, screen.frame.size.height, Result)
NSToLCLRect(frame, NSScreenZeroHeight, Result)
else
Result := NSRectToRect(frame);
end;
@ -1219,42 +1225,12 @@ begin
NSScreenGetRect(sc, NSScreen.mainScreen.frame.size.height, r);
end;
function GetScreenForPoint(x,y: Integer): NSScreen;
var
scarr : NSArray;
sc : NSScreen;
r : TRect;
h : double;
p : TPoint;
i : Integer;
begin
p.x := x;
p.y := y;
scarr := NSScreen.screens;
h := NSScreen.mainScreen.frame.size.height;
sc := NSScreen(scarr.objectAtIndex(0));
for i:=0 to scarr.count-1 do begin
sc:=NSScreen(scarr.objectAtIndex(i));
NSScreenGetRect(sc, h, r);
if Types.PtInRect(r, p) then begin
Result := sc;
Exit;
end;
end;
Result := NSScreen.mainScreen;
end;
procedure LCLWindowExtension.lclSetFrame(const r: TRect);
var
ns : NSRect;
h : integer;
sc : NSScreen;
srect : NSRect;
begin
sc := GetScreenForPoint(r.Left, r.Top);
srect := sc.frame;
LCLToNSRect(r, srect.size.height, ns);
LCLToNSRect(r, NSScreenZeroHeight, ns);
// add topbar height
h:=lclGetTopBarHeight;

3
lcl/interfaces/cocoa/cocoawsclipboard.pas
View File

@ -347,7 +347,8 @@ begin
begin
DataStream.Position := 0;
SetLength(lText, DataStream.Size);
DataStream.Read(lText[1], DataStream.Size);
if DataStream.Size > 0 then
DataStream.Read(lText[1], DataStream.Size);
lNSText := NSStringUtf8(lText);
pasteboard.setString_forType(lNSText, lCurFormat.CocoaFormat);

48
lcl/interfaces/cocoa/cocoawscomctrls.pas
View File

@ -115,6 +115,7 @@ type
isSetTextFromWS: Integer; // allows to suppress the notifation about text change
// when initiated by Cocoa itself.
checkedIdx : NSMutableIndexSet;
ownerData : Boolean;
constructor Create(AOwner: NSObject; ATarget: TWinControl; AHandleView: NSView); override;
destructor Destroy; override;
@ -192,7 +193,7 @@ type
//carbon//class procedure SetHoverTime(const ALV: TCustomListView; const AValue: Integer); override;
class procedure SetImageList(const ALV: TCustomListView; const {%H-}AList: TListViewImageList; const {%H-}AValue: TCustomImageListResolution); override;
class procedure SetItemsCount(const ALV: TCustomListView; const Avalue: Integer); override;
(*class procedure SetOwnerData(const ALV: TCustomListView; const {%H-}AValue: Boolean); override;*)
class procedure SetOwnerData(const ALV: TCustomListView; const {%H-}AValue: Boolean); override;
class procedure SetProperty(const ALV: TCustomListView; const AProp: TListViewProperty; const AIsSet: Boolean); override;
class procedure SetProperties(const ALV: TCustomListView; const AProps: TListViewProperties); override;
class procedure SetScrollBars(const ALV: TCustomListView; const AValue: TScrollStyle); override;
@ -1196,7 +1197,7 @@ begin
Result := false;
Exit;
end;
Result:=lclcb.checkedIdx.containsIndex(AIndex);
Result := lclcb.checkedIdx.containsIndex(AIndex);
end;
class function TCocoaWSCustomListView.ItemGetPosition(
@ -1219,8 +1220,21 @@ end;
class function TCocoaWSCustomListView.ItemGetState(const ALV: TCustomListView;
const AIndex: Integer; const AItem: TListItem; const AState: TListItemState;
out AIsSet: Boolean): Boolean;
var
lCocoaLV: TCocoaListView;
lTableLV: TCocoaTableListView;
lclcb: TLCLListViewCallback;
begin
Result:=inherited ItemGetState(ALV, AIndex, AItem, AState, AIsSet);
case AState of
lisSelected: begin
Result := false;
if not CheckParamsCb(lCocoaLV, lTableLV, lclcb, ALV) then Exit;
Result := (AIndex>=0) and (AIndex <= lTableLV.numberOfRows);
AIsSet := lTableLV.isRowSelected(AIndex);
end;
else
Result := inherited ItemGetState(ALV, AIndex, AItem, AState, AIsSet);
end;
end;
class procedure TCocoaWSCustomListView.ItemInsert(const ALV: TCustomListView;
@ -1442,11 +1456,28 @@ begin
lTableLV.noteNumberOfRowsChanged();
end;
class procedure TCocoaWSCustomListView.SetOwnerData(const ALV: TCustomListView;
const AValue: Boolean);
var
lCocoaLV : TCocoaListView;
lTableLV : TCocoaTableListView;
cb : TLCLListViewCallback;
begin
if not CheckParamsCb(lCocoaLV, lTableLV, cb, ALV) then Exit;
cb.ownerData := AValue;
if cb.ownerData then cb.checkedIdx.removeAllIndexes; // releasing memory
end;
class procedure TCocoaWSCustomListView.SetProperty(const ALV: TCustomListView;
const AProp: TListViewProperty; const AIsSet: Boolean);
var
lCocoaLV: TCocoaListView;
lTableLV: TCocoaTableListView;
const
GridStyle : array [boolean] of NSUInteger = (
NSTableViewGridNone,
NSTableViewSolidHorizontalGridLineMask or NSTableViewSolidVerticalGridLineMask
);
begin
if not CheckParams(lCocoaLV, lTableLV, ALV) then Exit;
case AProp of
@ -1454,9 +1485,9 @@ begin
lvpCheckboxes: lTableLV.lclSetFirstColumCheckboxes(AIsSet);
lvpColumnClick: lTableLV.setAllowsColumnSelection(AIsSet);
{ lvpFlatScrollBars,
lvpFullDrag,
lvpGridLines,
lvpHideSelection,
lvpFullDrag,}
lvpGridLines: lTableLV.setGridStyleMask(GridStyle[AIsSet]);
{lvpHideSelection,
lvpHotTrack,}
lvpMultiSelect: lTableLV.setAllowsMultipleSelection(AIsSet);
{lvpOwnerDraw,}
@ -1638,7 +1669,10 @@ function TLCLListViewCallback.GetItemCheckedAt(ARow, ACol: Integer;
var
BoolState : array [Boolean] of Integer = (NSOffState, NSOnState);
begin
IsChecked := BoolState[checkedIdx.containsIndex(ARow)];
if ownerData and Assigned(listView) and (ARow>=0) and (ARow < listView.Items.Count) then
IsChecked := BoolState[listView.Items[ARow].Checked]
else
IsChecked := BoolState[checkedIdx.containsIndex(ARow)];
Result := true;
end;

163
lcl/interfaces/cocoa/cocoawscommon.pas
View File

@ -147,12 +147,15 @@ type
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetBorderStyle(const AWinControl: TWinControl;
const ABorderStyle: TBorderStyle); override;
end;
// Utility WS functions. todo: it makes sense to put them into CocoaScollers
function EmbedInScrollView(AView: NSView; AReleaseView: Boolean = true): TCocoaScrollView;
function EmbedInManualScrollView(AView: NSView): TCocoaManualScrollView;
function EmbedInManualScrollHost(AView: TCocoaManualScrollView): TCocoaManualScrollHost;
function HWNDToTargetObject(AFormHandle: HWND): TObject;
@ -170,7 +173,7 @@ procedure DebugDumpParents(fromView: NSView);
implementation
uses
CocoaInt;
Math, CocoaInt;
var
LastMouse: TLastMouseInfo;
@ -275,6 +278,38 @@ begin
TCocoaCustomControl(AView).auxMouseByParent := true;
end;
function EmbedInManualScrollHost(AView: TCocoaManualScrollView
): TCocoaManualScrollHost;
var
r: TRect;
p: NSView;
begin
if not Assigned(AView) then
Exit(nil);
r := AView.lclFrame;
p := AView.superview;
Result := TCocoaManualScrollHost.alloc.initWithFrame(NSNullRect);
if Assigned(p) then p.addSubView(Result);
Result.lclSetFrame(r);
{$ifdef BOOLFIX}
Result.setHidden_(Ord(AView.isHidden));
{$else}
Result.setHidden(AView.isHidden);
{$endif}
Result.setDocumentView(AView);
Result.setDrawsBackground(false); // everything is covered anyway
Result.contentView.setAutoresizesSubviews(true);
AView.setAutoresizingMask(NSViewWidthSizable or NSViewHeightSizable);
AView.release;
{$ifdef BOOLFIX}
AView.setHidden_(Ord(false));
{$else}
AView.setHidden(false);
{$endif}
SetViewDefaults(Result);
end;
{ TLCLCommonCallback }
function TLCLCommonCallback.GetHasCaret: Boolean;
@ -437,7 +472,7 @@ begin
Result := nil;
if CocoaWidgetSet.CaptureControl = 0 then Exit;
obj := NSObject(CocoaWidgetSet.CaptureControl);
lCaptureView := GetNSObjectView(obj);
lCaptureView := obj.lclContentView;
if (obj <> Owner) and (lCaptureView <> Owner) and not FIsEventRouting then
begin
Result := lCaptureView.lclGetCallback;
@ -874,6 +909,7 @@ var
bndPt, clPt, srchPt: TPoint; // clPt - is the one to send to LCL
// srchPt - is the one to use for each chidlren (clPt<>srchPt for TScrollBox)
menuHandled : Boolean;
mc: Integer; // modal counter
begin
if Assigned(Owner) and not NSObjectIsLCLEnabled(Owner) then
begin
@ -919,6 +955,7 @@ begin
lEventType := NSLeftMouseUp;
Result := Result or (BlockCocoaUpDown and not AOverrideBlock);
mc := CocoaWidgetSet.ModalCounter;
case lEventType of
NSLeftMouseDown,
NSRightMouseDown,
@ -962,6 +999,14 @@ begin
end;
end;
if mc <> CocoaWidgetSet.ModalCounter then
begin
// showing of a modal window is causing "mouse" event to be lost.
// so, preventing Cocoa from handling it
Result := true;
Exit;
end;
//debugln('MouseUpDownEvent:'+DbgS(Msg.Msg)+' Target='+Target.name+);
if not Result then
//Result := Result or (BlockCocoaUpDown and not AOverrideBlock);
@ -1053,7 +1098,7 @@ begin
if not targetControl.HandleAllocated then Exit; // Fixes crash due to events being sent after ReleaseHandle
FIsEventRouting:=true;
//debugln(Target.name+' -> '+targetControl.Name+'- is parent:'+dbgs(targetControl=Target.Parent)+' Point: '+dbgs(br)+' Rect'+dbgs(rect));
obj := GetNSObjectView(NSObject(targetControl.Handle));
obj := NSObject(targetControl.Handle).lclContentView;
if obj = nil then Exit;
callback := obj.lclGetCallback;
if callback = nil then Exit; // Avoids crashes
@ -1092,6 +1137,11 @@ var
MousePos: NSPoint;
MButton: NSInteger;
bndPt, clPt, srchPt: TPoint;
dx,dy: double;
const
WheelDeltaToLCLY = 1200; // the basic (one wheel-click) is 0.1 on cocoa
WheelDeltaToLCLX = 1200; // the basic (one wheel-click) is 0.1 on cocoa
LCLStep = 120;
begin
Result := False; // allow cocoa to handle message
@ -1114,19 +1164,32 @@ begin
Msg.Y := round(clPt.Y);
Msg.State := CocoaModifiersToShiftState(Event.modifierFlags, NSEvent.pressedMouseButtons);
if NSAppKitVersionNumber >= NSAppKitVersionNumber10_7 then
begin
dx := event.scrollingDeltaX;
dy := event.scrollingDeltaY;
end else
begin
dx := event.deltaX;
dy := event.deltaY;
end;
// Some info on event.deltaY can be found here:
// https://developer.apple.com/library/mac/releasenotes/AppKit/RN-AppKitOlderNotes/
// It says that deltaY=1 means 1 line, and in the LCL 1 line is 120
if event.deltaY <> 0 then
if dy <> 0 then
begin
Msg.Msg := LM_MOUSEWHEEL;
Msg.WheelDelta := round(event.deltaY * 120);
Msg.WheelDelta := sign(dy) * LCLStep;
end
else
if event.deltaX <> 0 then
if dx <> 0 then
begin
Msg.Msg := LM_MOUSEHWHEEL;
Msg.WheelDelta := round(event.deltaX * 120);
// see "deltaX" documentation.
// on macOS: -1 = right, +1 = left
// on LCL: -1 = left, +1 = right
Msg.WheelDelta := sign(-dx) * LCLStep;
end
else
// Filter out empty events - See bug 28491
@ -1194,8 +1257,8 @@ begin
// then send a LM_SIZE message
if Resized or ClientResized then
begin
LCLSendSizeMsg(Target, NewBounds.Right - NewBounds.Left,
NewBounds.Bottom - NewBounds.Top, Owner.lclWindowState, True);
LCLSendSizeMsg(Target, Max(NewBounds.Right - NewBounds.Left,0),
Max(NewBounds.Bottom - NewBounds.Top,0), Owner.lclWindowState, True);
end;
// then send a LM_MOVE message
@ -1215,7 +1278,11 @@ end;
procedure TLCLCommonCallback.BecomeFirstResponder;
begin
LCLSendSetFocusMsg(Target);
if not Assigned(Target) then Exit;
// LCL is unable to determine the "already focused" message
// thus Cocoa related code is doing that.
//if not Target.Focused then
LCLSendSetFocusMsg(Target);
end;
procedure TLCLCommonCallback.ResignFirstResponder;
@ -1376,7 +1443,7 @@ var
cr:TCocoaCursor;
begin
Result := False;
View := CocoaUtils.GetNSObjectView(Owner);
View := HandleFrame.lclContentView;
if View = nil then Exit;
if not Assigned(Target) then Exit;
if not (csDesigning in Target.ComponentState) then
@ -1572,10 +1639,7 @@ var
begin
if not AWinControl.HandleAllocated then Exit;
//todo: GetNSObjectView must be replaced with oop approach
// note that client rect might be smaller than the bounds of TWinControl itself
// thus extra size should be adapted
lView := CocoaUtils.GetNSObjectView(NSObject(AWinControl.Handle));
lView := NSObject(AWinControl.Handle).lclContentView;
if lView = nil then Exit;
//todo: using fittingSize is wrong - it's based on constraints of the control solely.
@ -1623,48 +1687,33 @@ begin
end;
end;
type
NSFontSetter = objccategory external(NSObject)
procedure setFont(afont: NSFont); message 'setFont:';
procedure setTextColor(clr: NSColor); message 'setTextColor:';
end;
class procedure TCocoaWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont);
var
Obj: NSObject;
Cell: NSCell;
Str: NSAttributedString;
NewStr: NSMutableAttributedString;
Dict: NSDictionary;
Range: NSRange;
begin
if (AWinControl.HandleAllocated) then
if not (AWinControl.HandleAllocated) then Exit;
Obj := NSObject(AWinControl.Handle).lclContentView;
if Obj.respondsToSelector(ObjCSelector('setFont:')) then
Obj.setFont(TCocoaFont(AFont.Reference.Handle).Font);
if Obj.respondsToSelector(ObjCSelector('setTextColor:')) then
begin
Obj := NSObject(AWinControl.Handle);
if Obj.isKindOfClass(NSScrollView) then
Obj := NSScrollView(Obj).documentView;
if Obj.isKindOfClass(NSControl) then
begin
Cell := NSCell(NSControl(Obj).cell);
Cell.setFont(TCocoaFont(AFont.Reference.Handle).Font);
// try to assign foreground color?
Str := Cell.attributedStringValue;
if Assigned(Str) then
begin
NewStr := NSMutableAttributedString.alloc.initWithAttributedString(Str);
Range.location := 0;
Range.length := NewStr.length;
if AFont.Color = clDefault then
NewStr.removeAttribute_range(NSForegroundColorAttributeName, Range)
else
NewStr.addAttribute_value_range(NSForegroundColorAttributeName, ColorToNSColor(ColorToRGB(AFont.Color)), Range);
Cell.setAttributedStringValue(NewStr);
NewStr.release;
end;
end
if AFont.Color = clDefault then
Obj.setTextColor(nil)
else
if Obj.isKindOfClass(NSText) then
begin
NSText(Obj).setFont(TCocoaFont(AFont.Reference.Handle).Font);
if AFont.Color = clDefault then
NSText(Obj).setTextColor(nil)
else
NSText(Obj).setTextColor(ColorToNSColor(ColorToRGB(AFont.Color)));
end;
Obj.setTextColor(ColorToNSColor(ColorToRGB(AFont.Color)));
end;
end;
@ -1709,7 +1758,7 @@ var
begin
if (not AWinControl.HandleAllocated) or (not AChild.HandleAllocated) then Exit;
pr:=NSView(AWinControl.Handle);
pr := NSView(AWinControl.Handle).lclContentView;
//todo: sorting might be a better option than removing / adding a view
// (whenever a focused (firstrepsonder view) is moved to front, focus is lost.
@ -1783,7 +1832,9 @@ class function TCocoaWSCustomControl.CreateHandle(const AWinControl: TWinControl
var
ctrl : TCocoaCustomControl;
sl : TCocoaManualScrollView;
hs : TCocoaManualScrollHost;
lcl : TLCLCommonCallback;
begin
ctrl := TCocoaCustomControl(TCocoaCustomControl.alloc.lclInitWithCreateParams(AParams));
lcl := TLCLCommonCallback.Create(ctrl, AWinControl);
@ -1793,9 +1844,21 @@ begin
sl := EmbedInManualScrollView(ctrl);
sl.callback := ctrl.callback;
lcl.HandleFrame:=sl;
Result := TLCLIntfHandle(sl);
hs := EmbedInManualScrollHost(sl);
hs.callback := ctrl.callback;
lcl.HandleFrame:=hs;
ScrollViewSetBorderStyle(hs, TCustomControl(AWinControl).BorderStyle );
Result := TLCLIntfHandle(hs);
end;
class procedure TCocoaWSCustomControl.SetBorderStyle(
const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
begin
if not Assigned(AWinControl) or not (AWinControl.HandleAllocated) then Exit;
ScrollViewSetBorderStyle( TCocoaManualScrollHost(AWinControl.Handle), ABorderStyle );
end;
function HWNDToTargetObject(AFormHandle: HWND): TObject;

152
lcl/interfaces/cocoa/cocoawsdialogs.pas
View File

@ -33,7 +33,7 @@ uses
WSForms, WSLCLClasses, WSProc, WSDialogs, LCLMessageGlue,
// LCL Cocoa
CocoaPrivate, CocoaUtils, CocoaWSCommon, CocoaWSStdCtrls, CocoaGDIObjects
,Cocoa_Extra;
,Cocoa_Extra, CocoaWSMenus;
type
@ -132,7 +132,7 @@ type
procedure setDialogFilter(ASelectedFilterIndex: Integer); message 'setDialogFilter:';
procedure comboboxAction(sender: id); message 'comboboxAction:';
// NSOpenSavePanelDelegateProtocol
function panel_shouldEnableURL(sender: id; url: NSURL): Boolean; message 'panel:shouldEnableURL:';
function panel_shouldEnableURL(sender: id; url: NSURL): LCLObjCBoolean; message 'panel:shouldEnableURL:';
end;
implementation
@ -151,6 +151,96 @@ begin
UpdateOptions(TOpenDialog(src), dst);
end;
type
{ TOpenSaveDelegate }
TOpenSaveDelegate = objcclass(NSObject, NSOpenSavePanelDelegateProtocol)
FileDialog: TFileDialog;
OpenDialog: TOpenDialog;
selUrl: NSURL;
filter: NSOpenSavePanelDelegateProtocol;
procedure dealloc; override;
function panel_shouldEnableURL(sender: id; url: NSURL): LCLObjCBoolean;
procedure panel_didChangeToDirectoryURL(sender: id; url: NSURL);
function panel_userEnteredFilename_confirmed(sender: id; filename: NSString; okFlag: LCLObjCBoolean): NSString;
procedure panel_willExpand(sender: id; expanding: LCLObjCBoolean);
procedure panelSelectionDidChange(sender: id);
end;
{ TOpenSaveDelegate }
procedure TOpenSaveDelegate.dealloc;
begin
if Assigned(selUrl) then selURL.release;
inherited dealloc;
end;
function TOpenSaveDelegate.panel_shouldEnableURL(sender: id; url: NSURL
): LCLObjCBoolean;
begin
if Assigned(filter) then
Result := filter.panel_shouldEnableURL(sender, url)
else
Result := true;
end;
procedure TOpenSaveDelegate.panel_didChangeToDirectoryURL(sender: id; url: NSURL);
begin
if Assigned(OpenDialog) then
OpenDialog.DoFolderChange;
end;
function TOpenSaveDelegate.panel_userEnteredFilename_confirmed(sender: id;
filename: NSString; okFlag: LCLObjCBoolean): NSString;
begin
Result := filename;
end;
procedure TOpenSaveDelegate.panel_willExpand(sender: id; expanding: LCLObjCBoolean);
begin
end;
procedure TOpenSaveDelegate.panelSelectionDidChange(sender: id);
var
sp : NSSavePanel;
ch : Boolean; // set to true, if actually getting a new file name
begin
// it only matters for Open or Save dialogs
if not Assigned(OpenDialog) then Exit;
sp := NSSavePanel(sender);
ch := false;
if not Assigned(sp.URL) then begin
if Assigned(selUrl) then
begin
selURL.release;
selURL := nil;
end;
ch := true;
end
else if not Assigned(selUrl) then
begin
ch := true;
selURL := NSURL(sp.URL.copy)
end
else begin
ch := not selURL.isEqualTo(sp.URL);
if ch then
begin
selURL.release;
selURL := sp.URL.copy;
end;
end;
if ch then
begin
OpenDialog.FileName := NSStringToString(sp.URL.path);
OpenDialog.DoSelectionChange;
end;
end;
{ TCocoaWSFileDialog }
{------------------------------------------------------------------------------
@ -172,6 +262,7 @@ var
// filter accessory view
accessoryView: NSView;
lFilter: TCocoaFilterComboBox;
callback: TOpenSaveDelegate;
// setup panel and its accessory view
procedure CreateAccessoryView(AOpenOwner: NSOpenPanel; ASaveOwner: NSSavePanel);
@ -313,47 +404,54 @@ begin
// accessory view
CreateAccessoryView(openDlg, openDlg);
end;
openDlg.setTitle(NSStringUtf8(FileDialog.Title));
openDlg.setDirectoryURL(NSURL.fileURLWithPath(NSStringUtf8(InitDir)));
UpdateOptions(FileDialog, openDlg);
if openDlg.runModal = NSOKButton then
begin
FileDialog.FileName := NSStringToString(openDlg.URL.path);
FileDialog.Files.Clear;
for i := 0 to openDlg.filenames.Count - 1 do
FileDialog.Files.Add(NSStringToString(
NSURL(openDlg.URLs.objectAtIndex(i)).path));
FileDialog.UserChoice := mrOk;
if lFilter <> nil then
FileDialog.FilterIndex := lFilter.lastSelectedItemIndex+1;
end;
saveDlg := openDlg;
end
else if FileDialog.FCompStyle = csSaveFileDialog then
begin
saveDlg := NSSavePanel.savePanel;
saveDlg.setCanCreateDirectories(True);
saveDlg.setTitle(NSStringUtf8(FileDialog.Title));
saveDlg.setDirectoryURL(NSURL.fileURLWithPath(NSStringUtf8(InitDir)));
saveDlg.setNameFieldStringValue(NSStringUtf8(InitName));
UpdateOptions(FileDialog, saveDlg);
// accessory view
CreateAccessoryView(nil, saveDlg);
openDlg := nil;
end;
callback:=TOpenSaveDelegate.alloc;
callback.autorelease;
callback.FileDialog := FileDialog;
if FileDialog is TOpenDialog then
callback.OpenDialog := TOpenDialog(FileDialog);
callback.filter := lFilter;
saveDlg.setDelegate(callback);
saveDlg.setTitle(NSStringUtf8(FileDialog.Title));
saveDlg.setDirectoryURL(NSURL.fileURLWithPath(NSStringUtf8(InitDir)));
UpdateOptions(FileDialog, saveDlg);
ToggleAppMenu(false);
try
if saveDlg.runModal = NSOKButton then
begin
FileDialog.FileName := NSStringToString(saveDlg.URL.path);
FileDialog.Files.Clear;
if Assigned(openDlg) then
for i := 0 to openDlg.filenames.Count - 1 do
FileDialog.Files.Add(NSStringToString(
NSURL(openDlg.URLs.objectAtIndex(i)).path));
FileDialog.UserChoice := mrOk;
if lFilter <> nil then
FileDialog.FilterIndex := lFilter.lastSelectedItemIndex+1;
end;
FileDialog.DoClose;
// release everything
LocalPool.Release;
finally
ToggleAppMenu(true);
end;
// release everything
LocalPool.Release;
end; {TCocoaWSFileDialog.ShowModal}
{ TCocoaWSColorDialog }
@ -759,11 +857,15 @@ end;
procedure TCocoaFilterComboBox.comboboxAction(sender: id);
begin
if (indexOfSelectedItem <> lastSelectedItemIndex) then
begin
setDialogFilter(indexOfSelectedItem);
if Assigned(Owner) then
Owner.IntfFileTypeChanged(lastSelectedItemIndex);
end;
lastSelectedItemIndex := indexOfSelectedItem;
end;
function TCocoaFilterComboBox.panel_shouldEnableURL(sender: id; url: NSURL): Boolean;
function TCocoaFilterComboBox.panel_shouldEnableURL(sender: id; url: NSURL): LCLObjCBoolean;
var
lPath, lExt, lCurExt: NSString;
lExtStr, lCurExtStr: String;

28
lcl/interfaces/cocoa/cocoawsforms.pas
View File

@ -331,9 +331,20 @@ end;
{ TLCLWindowCallback }
type
TWinControlAccess = class(TWinControl)
end;
function TLCLWindowCallback.CanActivate: Boolean;
begin
Result := Enabled;
// it's possible that a Modal window requests this (target) window
// to become visible (i.e. when modal is closing)
// All other Windows are disabled while modal is active.
// Thus must check wcfUpdateShowing flag (which set when changing window visibility)
// And if it's used, then we allow the window to become Key window
if not Result and (Target is TWinControl) then
Result := wcfUpdateShowing in TWinControlAccess(Target).FWinControlFlags;
end;
constructor TLCLWindowCallback.Create(AOwner: NSObject; ATarget: TWinControl; AHandleView: NSView);
@ -457,7 +468,7 @@ var
begin
Bounds := HandleFrame.lclFrame;
LCLSendSizeMsg(Target, Bounds.Right - Bounds.Left, Bounds.Bottom - Bounds.Top,
HandleFrame.lclWindowState, True);
Owner.lclWindowState, True);
end;
function TLCLWindowCallback.GetEnabled: Boolean;
@ -568,11 +579,11 @@ begin
if lList.Count>0 then
begin
prevControl := TWinControl(lList.Items[lList.Count-1]);
lPrevView := GetNSObjectView(NSObject(prevControl.Handle));
lPrevView := NSObject(prevControl.Handle).lclContentView;
for i := 0 to lList.Count-1 do
begin
curControl := TWinControl(lList.Items[i]);
lCurView := GetNSObjectView(NSObject(curControl.Handle));
lCurView := NSObject(curControl.Handle).lclContentView;
if (lCurView <> nil) and (lPrevView <> nil) then
lPrevView.setNextKeyView(lCurView);
@ -793,7 +804,7 @@ begin
begin
if AParams.WndParent <> 0 then
begin
lDestView := GetNSObjectView(NSObject(AParams.WndParent));
lDestView := NSObject(AParams.WndParent).lclContentView;
lDestView.addSubView(cnt);
//cnt.setAutoresizingMask(NSViewMaxXMargin or NSViewMinYMargin);
if cnt.window <> nil then
@ -1101,15 +1112,22 @@ begin
end
else
begin
w := TCocoaWindowContent(AWinControl.Handle).lclOwnWindow;
if not lShow then
begin
// macOS 10.6. If a window with a parent window is hidden, then parent is also hidden.
// Detaching from the parent first!
w := TCocoaWindowContent(AWinControl.Handle).lclOwnWindow;
if Assigned(w) and Assigned(w.parentWindow) then
w.parentWindow.removeChildWindow(w);
// if the same control needs to be shown again, it will be redrawn
// without this invalidation, Cocoa might should the previously cached contents
TCocoaWindowContent(AWinControl.Handle).documentView.setNeedsDisplay_(true);
end;
TCocoaWSWinControl.ShowHide(AWinControl);
// ShowHide() also actives (sets focus to) the window
if lShow and Assigned(w) then
w.makeKeyWindow;
end;
if (lShow) then

28
lcl/interfaces/cocoa/cocoawsmenus.pas
View File

@ -18,6 +18,7 @@ unit CocoaWSMenus;
{$mode objfpc}{$H+}
{$modeswitch objectivec2}
{$include cocoadefines.inc}
interface
@ -29,7 +30,7 @@ uses
sysutils,
// LCL
Controls, Forms, Menus, Graphics, LCLType, LMessages, LCLProc, Classes,
LCLMessageGlue,
LCLMessageGlue, LCLStrConsts,
// Widgetset
WSMenus, WSLCLClasses,
// LCL Cocoa
@ -342,33 +343,33 @@ begin
submenu.insertItem_atIndex(NSMenuItem.separatorItem, submenu.itemArray.count);
// Services
item := LCLMenuItemInit( TCocoaMenuItem.alloc, 'Services');
item := LCLMenuItemInit( TCocoaMenuItem.alloc, rsMacOSMenuServices);
item.setTarget(nil);
item.setAction(nil);
submenu.insertItem_atIndex(item, submenu.itemArray.count);
item.setSubmenu(NSMenu.alloc.initWithTitle( NSSTR('Services')));
item.setSubmenu(NSMenu.alloc.initWithTitle( ControlTitleToNSStr(rsMacOSMenuServices)));
NSApplication(NSApp).setServicesMenu(item.submenu);
// Separator
submenu.insertItem_atIndex(NSMenuItem.separatorItem, submenu.itemArray.count);
// Hide App Meta-H
item := LCLMenuItemInit( TCocoaMenuItem_HideApp.alloc, 'Hide ' + Application.Title, VK_H, [ssMeta]);
item := LCLMenuItemInit( TCocoaMenuItem_HideApp.alloc, Format(rsMacOSMenuHide, [Application.Title]), VK_H, [ssMeta]);
submenu.insertItem_atIndex(item, submenu.itemArray.count);
// Hide Others Meta-Alt-H
item := LCLMenuItemInit( TCocoaMenuItem_HideOthers.alloc, 'Hide Others', VK_H, [ssMeta, ssAlt]);
item := LCLMenuItemInit( TCocoaMenuItem_HideOthers.alloc, rsMacOSMenuHideOthers, VK_H, [ssMeta, ssAlt]);
submenu.insertItem_atIndex(item, submenu.itemArray.count);
// Show All
item := LCLMenuItemInit( TCocoaMenuItem_ShowAllApp.alloc, 'Show All');
item := LCLMenuItemInit( TCocoaMenuItem_ShowAllApp.alloc, rsMacOSMenuShowAll);
submenu.insertItem_atIndex(item, submenu.itemArray.count);
// Separator
submenu.insertItem_atIndex(NSMenuItem.separatorItem, submenu.itemArray.count);
// Quit Meta-Q
item := LCLMenuItemInit( TCocoaMenuItem_Quit.alloc, 'Quit '+Application.Title, VK_Q, [ssMeta]);
item := LCLMenuItemInit( TCocoaMenuItem_Quit.alloc, Format(rsMacOSMenuQuit, [Application.Title]), VK_Q, [ssMeta]);
submenu.insertItem_atIndex(item, submenu.itemArray.count);
attachedAppleMenuItems := True;
@ -440,6 +441,12 @@ end;
procedure TCocoaMenuItem_Quit.lclItemSelected(sender: id);
begin
{$ifdef COCOALOOPHIJACK}
// see bug #36265. if hot-key (Cmd+Q) is used the menu item
// would be called once. 1) in LCL controlled loop 2) after the loop finished
// The following if statement prevents "double" form close
if LoopHiJackEnded then Exit;
{$endif}
// Should be used instead of Application.Terminate to allow events to be sent, see bug 32148
Application.MainForm.Close;
end;
@ -804,13 +811,6 @@ end;
{ TCocoaWSPopupMenu }
function LCLCoordsToCocoa(AControl: TControl; X, Y: Integer): NSPoint;
begin
Result.x := X;
Result.y := NSScreen.mainScreen.frame.size.height - Y;
if AControl <> nil then Result.y := Result.y - AControl.Height;
end;
{------------------------------------------------------------------------------
Method: TCocoaWSPopupMenu.Popup
Params: APopupMenu - LCL popup menu

78
lcl/interfaces/cocoa/cocoawsstdctrls.pas
View File

@ -27,7 +27,7 @@ uses
// Libs
MacOSAll, CocoaAll, Classes, sysutils,
// LCL
Controls, StdCtrls, Graphics, LCLType, LMessages, LCLProc, LCLMessageGlue,
Controls, StdCtrls, Graphics, LCLType, LMessages, LCLProc, LCLMessageGlue, Forms,
// LazUtils
LazUTF8, LazUTF8Classes, TextStrings,
// Widgetset
@ -258,6 +258,7 @@ type
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class function GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
end;
{ TLCLCheckBoxCallback }
@ -345,6 +346,9 @@ procedure ControlSetTextWithChangeEvent(ctrl: NSControl; const text: string);
implementation
uses
CocoaInt;
const
VerticalScrollerVisible: array[TScrollStyle] of boolean = (
{ssNone } false,
@ -404,6 +408,7 @@ begin
Result := TCocoaTextField.alloc.lclInitWithCreateParams(AParams);
if Assigned(Result) then
begin
Result.setFont(NSFont.systemFontOfSize(NSFont.systemFontSize));
Result.callback := TLCLCommonCallback.Create(Result, ATarget);
SetNSControlValue(Result, AParams.Caption);
end;
@ -414,6 +419,7 @@ begin
Result := TCocoaSecureTextField.alloc.lclInitWithCreateParams(AParams);
if Assigned(Result) then
begin
Result.setFont(NSFont.systemFontOfSize(NSFont.systemFontSize));
TCocoaSecureTextField(Result).callback := TLCLCommonCallback.Create(Result, ATarget);
SetNSText(Result.currentEditor, AParams.Caption);
end;
@ -597,6 +603,8 @@ end;
procedure TLCLListBoxCallback.tableSelectionChange(ARow: Integer; Added,
Removed: NSIndexSet);
begin
// do not notify about selection changes while clearing
if Assigned(strings) and (strings.isClearing) then Exit;
SendSimpleMessage(Target, LM_SELCHANGE);
end;
@ -743,6 +751,15 @@ begin
Result := false;
end;
class procedure TCocoaWSButton.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
begin
if not (AWinControl.HandleAllocated) then Exit;
TCocoaWSWinControl.SetFont(AWinControl, AFont);
TCocoaButton(AWinControl.Handle).adjustFontToControlSize := (AFont.Name = 'default')
and (AFont.Size = 0);
end;
{ TCocoaWSCustomCheckBox }
{------------------------------------------------------------------------------
@ -995,11 +1012,14 @@ end;
class procedure TCocoaWSCustomEdit.SetMaxLength(const ACustomEdit: TCustomEdit;
NewLength: integer);
var
field: TCocoaTextField;
field: NSTextField;
begin
field := GetTextField(ACustomEdit);
if not (ACustomEdit.HandleAllocated) then Exit;
field := NSTextField(ACustomEdit.Handle);
if not Assigned(field) then Exit;
field.maxLength := NewLength;
if NSObject(field).respondsToSelector( ObjCSelector('lclSetMaxLength:') ) then
{%H-}NSTextField_LCLExt(field).lclSetMaxLength(NewLength);
end;
class procedure TCocoaWSCustomEdit.SetPasswordChar(const ACustomEdit: TCustomEdit; NewChar: char);
@ -1153,12 +1173,8 @@ begin
end;
procedure TCocoaMemoStrings.SetTextStr(const Value: string);
var
ns: NSString;
begin
ns := NSStringUtf8(LineBreaksToUnix(Value));
FTextView.setString(ns);
ns.release;
SetNSText(FTextView, LineBreaksToUnix(Value));
FTextView.textDidChange(nil);
end;
@ -1281,6 +1297,8 @@ begin
FTextView.insertText( NSString.stringWithUTF8String( LFSTR ));
if not ro then FTextView.setEditable(ro);
FTextView.undoManager.removeAllActions;
end;
procedure TCocoaMemoStrings.LoadFromFile(const FileName: string);
@ -1451,9 +1469,7 @@ begin
txt.callback := lcl;
txt.setDelegate(txt);
ns := NSStringUtf8(AParams.Caption);
txt.setString(ns);
ns.release;
SetNSText(txt, AParams.Caption);
scr.callback := txt.callback;
@ -1664,13 +1680,10 @@ end;
class procedure TCocoaWSCustomMemo.SetText(const AWinControl:TWinControl;const AText:String);
var
txt: TCocoaTextView;
ns: NSString;
begin
txt := GetTextView(AWinControl);
if not Assigned(txt) then Exit;
ns := NSStringUtf8(LineBreaksToUnix(AText));
txt.setString(ns);
ns.release;
SetNSText(txt, LineBreaksToUnix(AText));
end;
class function TCocoaWSCustomMemo.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
@ -1885,7 +1898,7 @@ var
btn: NSButton;
cl: NSButtonCell;
begin
btn := AllocButton(AWinControl, TLCLButtonCallBack, AParams, NSTexturedRoundedBezelStyle, NSToggleButton);
btn := AllocButton(AWinControl, TLCLButtonCallBack, AParams, CocoaToggleBezel, CocoaToggleType);
cl := NSButtonCell(NSButton(btn).cell);
cl.setShowsStateBy(cl.showsStateBy or NSContentsCellMask);
Result := TLCLIntfHandle(btn);
@ -1897,8 +1910,22 @@ class function TCocoaWSScrollBar.CreateHandle(const AWinControl:TWinControl;
const AParams:TCreateParams):TLCLIntfHandle;
var
scr : TCocoaScrollBar;
prm : TCreateParams;
const
ScrollBase = 15; // the shorter size of the scroller. There's a NSScroller class method for that
begin
scr:=NSView(TCocoaScrollBar.alloc).lclInitWithCreateParams(AParams);
prm := AParams;
// forcing the initial size to follow the designated kind of the scroll
if (TCustomScrollBar(AWinControl).Kind = sbVertical) then begin
prm.Width:=ScrollBase;
prm.Height:=ScrollBase*4;
end else
begin
prm.Width:=ScrollBase*4;
prm.Height:=ScrollBase;
end;
scr:=NSView(TCocoaScrollBar.alloc).lclInitWithCreateParams(prm);
scr.callback:=TLCLCommonCallback.Create(scr, AWinControl);
// OnChange (scrolling) event handling
@ -1910,13 +1937,17 @@ begin
scr.pageInt:=TCustomScrollBar(AWinControl).PageSize;
Result:=TLCLIntfHandle(scr);
scr.lclSetFrame( Bounds(AParams.X, AParams.Y, AParams.Width, AParams.Height));
end;
// vertical/horizontal in Cocoa is set automatically according to
// the geometry of the scrollbar, it cannot be forced to an unusual value
class procedure TCocoaWSScrollBar.SetKind(const AScrollBar: TCustomScrollBar; const AIsHorizontal: Boolean);
begin
// do nothing
// the scroll type can be changed when creating a scroll.
// since the size got changed, we have to create the handle
RecreateWnd(AScrollBar);
end;
class procedure TCocoaWSScrollBar.SetParams(const AScrollBar:TCustomScrollBar);
@ -2176,8 +2207,13 @@ begin
list := GetListBox(ACustomListBox);
if not Assigned(list) then Exit();
list.selectRowIndexes_byExtendingSelection(NSIndexSet.indexSetWithIndex(AIndex), false);
list.scrollRowToVisible(AIndex);
if (AIndex < 0) then
list.deselectAll(nil)
else
begin
list.selectRowIndexes_byExtendingSelection(NSIndexSet.indexSetWithIndex(AIndex), false);
list.scrollRowToVisible(AIndex);
end;
end;
class procedure TCocoaWSCustomListBox.SetSelectionMode(const ACustomListBox: TCustomListBox; const AExtendedSelect, AMultiSelect: boolean);

2
lcl/interfaces/cocoa/patrons.txt
View File

@ -9,6 +9,7 @@ Active (in alphabetical order):
Esteban Vignolo
Frederick Vollmer
Johannes W. Dietrich
Jonas Maebe
Marc Hanisch
Marcus Fernstrom
Siegfried Rohdewald
@ -16,3 +17,4 @@ Active (in alphabetical order):
Former:
Andrea Mauri
Mike Margerum

9
lcl/lclstrconsts.pas
View File

@ -89,7 +89,14 @@ resourceString
rsPostRecordHint = 'Post';
rsCancelRecordHint = 'Cancel';
rsRefreshRecordsHint = 'Refresh';
// macOS (cocoa) interface
rsMacOSMenuHide = 'Hide %s';
rsMacOSMenuHideOthers = 'Hide Others';
rsMacOSMenuQuit = 'Quit %s';
rsMacOSMenuServices = 'Services';
rsMacOSMenuShowAll = 'Show All';
// gtk interface
rsWarningUnremovedPaintMessages = ' WARNING: There are %s unremoved LM_'
+'PAINT/LM_GtkPAINT message links left.';