paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-17 03:29:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

Patch from issue #27813

Browse Source 
git-svn-id: trunk@49607 -
This commit is contained in:
sekelsenmat 2015-08-07 06:02:46 +00:00
parent db48d14794
commit 31f2f10cc2
7 changed files with 38 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lcl/interfaces/cocoa/cocoacaret.pas
View File

@ -82,8 +82,8 @@ 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;
procedure SetCarbonCaretRespondToFocus(Value: Boolean);
function GetCocoaCaretRespondToFocus: Boolean;
procedure SetCocoaCaretRespondToFocus(Value: Boolean);
function DestroyCaret: Boolean;
procedure DrawCaret;
procedure DestroyGlobalCaret;
@ -208,12 +208,12 @@ begin
end;
end;
function GetCarbonCaretRespondToFocus: Boolean;
function GetCocoaCaretRespondToFocus: Boolean;
begin
Result := GlobalCaret.RespondToFocus;
end;
procedure SetCarbonCaretRespondToFocus(Value: Boolean);
procedure SetCocoaCaretRespondToFocus(Value: Boolean);
begin
GlobalCaret.RespondToFocus := Value;
end;

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

@ -2147,9 +2147,10 @@ begin
ctx := nil;
end;
// ToDo: Should we free the old FBitmap???
FBitmap := AValue;
if FBitmap <> nil then
begin
FBitmap := AValue;
pool:=NSAutoreleasePool.alloc.init;
ctx := NSGraphicsContext.graphicsContextWithBitmapImageRep(Bitmap.ImageRep);
ctx.retain; // extend live beyond NSAutoreleasePool

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

@ -1,8 +1,8 @@
{%MainUnit cocoaint.pas}
{******************************************************************************
All Carbon interface communication implementations.
This are the implementation of the overrides of the Carbon Interface for the
All Cocoa interface communication implementations.
This is the implementation of the overrides of the Cocoa Interface for the
methods defined in the
lcl/include/lclintf.inc
@ -24,7 +24,7 @@
{------------------------------------------------------------------------------
Method: CreateStandardCursor
Params: ACursor - Cursor type
Returns: Cursor object in Carbon for the specified cursor type
Returns: Cursor object in Cocoa for the specified cursor type
------------------------------------------------------------------------------}
function TCocoaWidgetSet.CreateStandardCursor(ACursor: SmallInt): HCursor;
begin
@ -45,6 +45,10 @@ begin
crHandPoint : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.pointingHandCursor));
crDrag : Result := HCursor(TCocoaCursor.CreateStandard(NSCursor.dragCopyCursor));
else
// We answer with Result=0 for crHourGlass because Cocoa does not provide any API
// to set the wait cursor. As a compromise to make cross-platform LCL apps written
// in Windows/Linux behave as expected without change, we answer 0 here and
// a non-native wait cursor will be utilized
Result := 0;
end;
end;
@ -231,7 +235,7 @@ begin
begin
if (Buttons[I] < Low(ButtonCaption)) or (Buttons[I] > High(ButtonCaption)) then
begin
DebugLn('TCarbonWidgetSet.PromptUser Invalid button ID: ' + DbgS(Buttons[I]));
DebugLn('TCocoaWidgetSet.PromptUser Invalid button ID: ' + DbgS(Buttons[I]));
Continue;
end;
@ -264,7 +268,7 @@ begin
end;
{$IFDEF VerboseLCLIntf}
DebugLn('TCarbonWidgetSet.PromptUser Result: ' + DbgS(Result));
DebugLn('TCocoaWidgetSet.PromptUser Result: ' + DbgS(Result));
{$ENDIF}
end; {TCocoaWidgetSet.PromptUser}
@ -304,7 +308,7 @@ end;
ADesc:
Returns:
Describes the inner format utilized by Carbon and specific information
Describes the inner format utilized by Cocoa and specific information
for the specified bitmap
------------------------------------------------------------------------------}
function TCocoaWidgetSet.RawImage_DescriptionFromBitmap(ABitmap: HBITMAP; out ADesc: TRawImageDescription): Boolean;
@ -320,7 +324,7 @@ end;
ADesc: - Pointer to raw image description
Returns: True if success
Retrieves the standard image format utilized by Carbon
Retrieves the standard image format utilized by Cocoa
------------------------------------------------------------------------------}
function TCocoaWidgetSet.RawImage_DescriptionFromDevice(ADC: HDC; out ADesc: TRawImageDescription): Boolean;
begin

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

@ -1,7 +1,7 @@
{%MainUnit cocoaint.pas}
{******************************************************************************
All utility method implementations of the TCarbonWidgetSet class are here.
All utility method implementations of the TCocoaWidgetSet class are here.
******************************************************************************
@ -22,7 +22,7 @@
Method: TCocoaWidgetSet.AppInit
Params: ScreenInfo
Initialize Carbon Widget Set
Initialize Cocoa Widget Set
------------------------------------------------------------------------------}
procedure TCocoaWidgetSet.AppInit(var ScreenInfo: TScreenInfo);
var
@ -153,7 +153,7 @@ end;
{------------------------------------------------------------------------------
Method: TCocoaWidgetSet.AppTerminate
Tells Carbon to halt the application
Tells Cocoa to halt the application
------------------------------------------------------------------------------}
procedure TCocoaWidgetSet.AppTerminate;
begin
@ -509,9 +509,9 @@ begin
end;
{------------------------------------------------------------------------------
Method: TCarbonWidgetSet.RawImage_DescriptionFromCarbonBitmap
Method: TCocoaWidgetSet.RawImage_DescriptionFromCocoaBitmap
Creates a rawimage description for a carbonbitmap
Creates a rawimage description for a cocoabitmap
------------------------------------------------------------------------------}
function TCocoaWidgetSet.RawImage_DescriptionFromCocoaBitmap(out ADesc: TRawImageDescription; ABitmap: TCocoaBitmap): Boolean;
var
@ -631,7 +631,7 @@ begin
if AMask.Depth > 1
then begin
DebugLn('[WARNING] RawImage_FromCarbonBitmap: AMask.Depth > 1');
DebugLn('[WARNING] RawImage_FromCocoaBitmap: AMask.Depth > 1');
Exit;
end;

19
lcl/interfaces/cocoa/cocoaproc.pas
View File

@ -2,8 +2,8 @@
cocoaproc.pp - Cocoa interface procs
----------------------------------------
This unit contains procedures/functions needed for the Carbon <-> LCL interface
Common carbon untilities (usable by other projects) go to CarbonUtils
This unit contains procedures/functions needed for the Cocoa <-> LCL interface
Common cocoa untilities (usable by other projects) go to CocoaUtils
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
@ -47,11 +47,11 @@ function OSError(AResult: OSStatus; const AMethodName, ACallName: String;
CarbonDefaultFont : AnsiString = '';
CarbonDefaultFontSize : Integer = 0;}
{ $I mackeycodes.inc}
{$I mackeycodes.inc}
{function VirtualKeyCodeToMac(AKey: Word): Word;
function VirtualKeyCodeToMac(AKey: Word): Word;
function GetBorderWindowAttrs(const ABorderStyle: TFormBorderStyle;
{function GetBorderWindowAttrs(const ABorderStyle: TFormBorderStyle;
const ABorderIcons: TBorderIcons): WindowAttributes;
function GetCarbonMouseButton(AEvent: EventRef): Integer;
@ -74,7 +74,7 @@ function CreateCustomHIView(const ARect: HIRect; ControlStyle: TControlStyle = [
procedure SetControlViewStyle(Control: ControlRef; TinySize, SmallSize, NormalSize: Integer; ControlHeight: Boolean = True);
function CarbonHitTest(Control: ControlRef; const X,Y: integer; var part: ControlPartCode): Boolean;
}
const
DEFAULT_CFSTRING_ENCODING = kCFStringEncodingUTF8;
@ -84,6 +84,7 @@ procedure FreeCFString(var AString: CFStringRef);
function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): String;
function CFStringToData(AString: CFStringRef; Encoding: CFStringEncoding = DEFAULT_CFSTRING_ENCODING): CFDataRef;
{
function StringsToCFArray(S: TStrings): CFArrayRef;
function RoundFixed(const F: Fixed): Integer;
@ -242,6 +243,7 @@ begin
' ' + AText + ' failed with result ' + DbgS(AResult));
end;
end;
*)
{------------------------------------------------------------------------------
Name: VirtualKeyCodeToMac
@ -323,6 +325,7 @@ begin
end;
end;
(*
{------------------------------------------------------------------------------
Name: GetBorderWindowAttrs
Returns: Converts the form border style and icons to Carbon window attributes
@ -583,7 +586,7 @@ end;*)
Name: FillStandardDescription
Params: Desc - Raw image description
Fills the raw image description with standard Carbon internal image storing
Fills the raw image description with standard Cocoa internal image storing
description
------------------------------------------------------------------------------}
procedure FillStandardDescription(out Desc: TRawImageDescription);
@ -715,6 +718,7 @@ begin
Result:=GetEventParameter(event, kEventParamControlPart, typeControlPartCode, nil, sizeof(part), nil, @part)=noErr;
ReleaseEvent(event);
end;
*)
{------------------------------------------------------------------------------
Name: CreateCFString
@ -819,6 +823,7 @@ begin
Result := CFDataCreate(nil, nil, 0);
end;
(*
{------------------------------------------------------------------------------
Name: StringsToCFArray
Params: S - Strings

4
lcl/interfaces/cocoa/cocoathemes.pas
View File

@ -64,7 +64,7 @@ implementation
{ TCocoaThemeServices }
{------------------------------------------------------------------------------
Method: TCarbonThemeServices.GetDrawState
Method: TCocoaThemeServices.GetDrawState
Params: Details - Details for themed element
Returns: Draw state of the themed element passed
------------------------------------------------------------------------------}
@ -569,7 +569,7 @@ end;
*)
{------------------------------------------------------------------------------
Method: TCocoaThemeServices.DrawElement
Params: DC - Carbon device context
Params: DC - Cocoa device context
Details - Details for themed element
R - Bounding rectangle
ClipRect - Clipping rectangle

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

@ -2026,6 +2026,7 @@ end;
function TCocoaWidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
begin
if ACursor = 0 then Result := 0 else
Result := HCURSOR(TCocoaCursor(ACursor).Install);
end;