paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-15 23:00:40 +01:00
Code Issues Packages Projects Releases Wiki Activity
3b93e012cb
lazarus/lcl/interfaces/cocoa/cocoawinapi.inc

2737 lines
74 KiB
PHP
Raw Blame History

{%MainUnit cocoaint.pas}
{ $Id: cocoawinapi.inc 15525 2008-06-23 06:39:58Z paul $ }
{******************************************************************************
All Cocoa Winapi implementations.
This are the implementations of the overrides of the Cocoa Interface for the
methods defined in the
lcl/include/winapi.inc
******************************************************************************
Implementation
******************************************************************************
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
//##apiwiz##sps## // Do not remove, no wizard declaration before this line
function CocoaCombineMode(ACombineMode: Integer): TCocoaCombine;
begin
case ACombineMode of
RGN_AND: Result:=cc_And;
RGN_OR: Result:=cc_Or;
RGN_XOR: Result:=cc_Xor;
RGN_DIFF: Result:=cc_Diff;
else
Result:=cc_Copy;
end;
end;
const
CocoaRegionTypeToWin32Map: array[TCocoaRegionType] of Integer = (
{ crt_Error } ERROR,
{ crt_Empty } NULLREGION,
{ crt_Rectangle } SIMPLEREGION,
{ crt_Complex } COMPLEXREGION
);
function TCocoaWidgetSet.Arc(DC: HDC; Left, Top, Right, Bottom, angle1,
angle2: Integer): Boolean;
begin
Result:=inherited Arc(DC, Left, Top, Right, Bottom, angle1, angle2);
end;
function TCocoaWidgetSet.AngleChord(DC: HDC; x1, y1, x2, y2, angle1,
angle2: Integer): Boolean;
begin
Result:=inherited AngleChord(DC, x1, y1, x2, y2, angle1, angle2);
end;
function TCocoaWidgetSet.BeginPaint(Handle: hWnd; var PS: TPaintStruct): hdc;
begin
Result := inherited BeginPaint(Handle, PS);
PS.hdc := Result;
end;
function TCocoaWidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
var
SrcCtx, DestCtx: TCocoaContext;
Bmp: TCocoaBitmap;
begin
SrcCtx := CheckDC(SrcDC);
DestCtx := CheckDC(DestDC);
Result := Assigned(SrcCtx) and Assigned(DestCtx);
if not Result then
Exit;
if not (SrcCtx is TCocoaBitmapContext) then
begin
DebugLn('StretchMaskBlt Error - invalid source device context ', SrcCtx.ClassName,
', expected TCocoaBitmapContext!');
Exit(False);
end;
Bmp := TCocoaBitmapContext(SrcCtx).Bitmap;
if not Assigned(Bmp) then
Exit(False);
// Width and Height should not be greater than bitmap width
Width := Min(Width, Bmp.Width);
Height := Min(Height, Bmp.Height);
Result := DestCtx.StretchDraw(X, Y, Width, Height,
TCocoaBitmapContext(SrcCtx), XSrc, YSrc, Width, Height,
nil, 0, 0, Rop);
end;
function TCocoaWidgetSet.ClientToScreen(Handle: HWND; var P: TPoint): Boolean;
begin
Result := Handle <> 0;
if Result then
// must use lclContentView! - it's client view
NSObject(Handle).lclContentView.lclLocalToScreen(P.X, P.Y);
end;
{------------------------------------------------------------------------------
Method: ClipboardFormatToMimeType
Params: FormatID - A registered format identifier (0 is invalid)
Returns: The corresponding mime type as string
------------------------------------------------------------------------------}
function TCocoaWidgetSet.ClipboardFormatToMimeType(FormatID: TClipboardFormat): string;
var
lFormat: TCocoaClipboardData;
begin
{$IFDEF VerboseClipboard}
DebugLn('TCocoaWidgetSet.ClipboardFormatToMimeType FormatID: ' + DbgS(FormatID));
{$ENDIF}
lFormat := GetClipboardDataForFormat(FormatID);
if lFormat = nil then Exit;
Result := lFormat.MimeType;
end;
{------------------------------------------------------------------------------
Method: ClipboardGetData
Params: ClipboardType - Clipboard type
FormatID - A registered format identifier (0 is invalid)
Stream - If format is available, it will be appended to this
stream
Returns: If the function succeeds
------------------------------------------------------------------------------}
function TCocoaWidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
FormatID: TClipboardFormat; Stream: TStream): boolean;
var
pasteboard: NSPasteboard;
lFormat: TCocoaClipboardData;
lNSStr: NSString;
// for text
lStr: String;
// for standard
lNSData: NSData;
lNSbytes: PByte;
i: Integer;
// for bitmap
image: TFPCustomImage;
lTmpStream: TMemoryStream;
reader: TFPCustomImageReader;
writer: TFPCustomImageWriter;
begin
Result := False;
{$IFDEF VerboseClipboard}
DebugLn('TCocoaWidgetSet.ClipboardGetData ClipboardType=' +
ClipboardTypeName[ClipboardType] + ' FormatID: ' + DbgS(FormatID));
{$ENDIF}
case ClipboardType of
ctPrimarySelection: pasteboard := PrimarySelection;
ctSecondarySelection: pasteboard := SecondarySelection;
ctClipboard: pasteboard := NSPasteboard.generalPasteboard;
end;
lFormat := GetClipboardDataForFormat(FormatID);
if lFormat = nil then Exit;
case lFormat.DataType of
ccdtText:
begin
lNSStr := pasteboard.stringForType(lFormat.CocoaFormat);
if lNSStr = nil then Exit;
lStr := NSStringToString(lNSStr);
Stream.Write(lStr[1], Length(lStr));
{$IFDEF VerboseClipboard}
DebugLn('TCocoaWidgetSet.ClipboardGetData IsText Result=' + lStr);
{$ENDIF}
end;
ccdtCocoaStandard, ccdtNonStandard:
begin
lNSData := pasteboard.dataForType(lFormat.CocoaFormat);
if lNSData = nil then Exit;
lNSbytes := lNSData.bytes;
for i := 0 to lNSData.length-1 do
Stream.WriteByte(lNSbytes[i]);
end;
// In Cocoa images are stored as PNG, convert to BMP for LCL app usage
ccdtBitmap:
begin
lNSData := pasteboard.dataForType(lFormat.CocoaFormat);
if lNSData = nil then Exit;
lNSbytes := lNSData.bytes;
Image := TFPMemoryImage.Create(10, 10);
Reader := TFPReaderPNG.Create;
Writer := TFPWriterBMP.Create;
lTmpStream := TMemoryStream.Create;
try
for i := 0 to lNSData.length-1 do
lTmpStream.WriteByte(lNSbytes[i]);
lTmpStream.Position := 0;
Image.LoadFromStream(lTmpStream, Reader);
Image.SaveToStream(Stream, Writer);
finally
Image.Free;
Reader.Free;
Writer.Free;
lTmpStream.Free;
end;
end;
end;
Result := True;
end;
{------------------------------------------------------------------------------
Method: ClipboardGetFormats
Params: ClipboardType - The type of clipboard operation
Count - The number of clipboard formats
List - Pointer to an array of supported formats
(you must free it yourself)
Returns: If the function succeeds
------------------------------------------------------------------------------}
function TCocoaWidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
var Count: integer; var List: PClipboardFormat): boolean;
var
ListDataSize, ListCount: Integer;
i: Integer;
begin
Result := False;
{$IFDEF VerboseClipboard}
DebugLn('TCocoaWidgetSet.ClipboardGetFormats ClipboardType' +
ClipboardTypeName[ClipboardType]);
{$ENDIF}
ListCount := Min(ClipboardFormats.Count, Count);
ListDataSize := SizeOf(Pointer) * ListCount;
List := GetMem(ListDataSize);
for i := 0 to ListCount - 1 do
begin
List[i] := PtrUInt(ClipboardFormats.Items[i]);
end;
Result := True;
end;
{------------------------------------------------------------------------------
Method: ClipboardGetOwnerShip
Params: ClipboardType - Type of clipboard
OnRequestProc - TClipboardRequestEvent is defined in LCLType.pp
If OnRequestProc is nil the onwership will end.
FormatCount - Number of formats
Formats - Array of TClipboardFormat. The supported formats the
owner provides.
Returns: If the function succeeds
Sets the supported formats and requests ownership for the clipboard.
The OnRequestProc is used to get the data from the LCL and to put it on the
clipboard.
If someone else requests the ownership, the OnRequestProc will be executed
with the invalid FormatID 0 to notify the old owner of the lost of ownership.
------------------------------------------------------------------------------}
function TCocoaWidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
OnRequestProc: TClipboardRequestEvent; FormatCount: integer;
Formats: PClipboardFormat): boolean;
var
pasteboard: NSPasteboard;
i: Integer;
lCurFormat: TCocoaClipboardData;
DataStream: TMemoryStream;
FormatToOwn: NSString;
FormatToOwnArray: NSArray;
// text format
lText: string;
lNSText: NSString;
// non-text
lNSData: NSData;
// for bitmap
image: TFPCustomImage;
lTmpStream: TMemoryStream;
reader: TFPCustomImageReader;
writer: TFPCustomImageWriter;
begin
Result := False;
{$IFDEF VerboseClipboard}
DebugLn('TCocoaWidgetSet.ClipboardGetOwnerShip ClipboardType=' +
ClipboardTypeName[ClipboardType] + ' FormatCount: ' + DbgS(FormatCount));
{$ENDIF}
case ClipboardType of
ctPrimarySelection: pasteboard := PrimarySelection;
ctSecondarySelection: pasteboard := SecondarySelection;
ctClipboard: pasteboard := NSPasteboard.generalPasteboard;
end;
DataStream := TMemoryStream.Create;
try
for i := 0 to FormatCount-1 do
begin
lCurFormat := TCocoaClipboardData(Formats[i]);
if lCurFormat = nil then Continue;
DataStream.Position := 0;
DataStream.Size := 0;
OnRequestProc(Formats[i], DataStream);
case lCurFormat.DataType of
ccdtText:
begin
FormatToOwn := lCurFormat.CocoaFormat;
FormatToOwnArray := NSArray.arrayWithObjects_count(@FormatToOwn, 1);
DataStream.Position := 0;
SetLength(lText, DataStream.Size);
DataStream.Read(lText[1], DataStream.Size);
lNSText := NSStringUtf8(lText);
pasteboard.declareTypes_owner(FormatToOwnArray, nil);
pasteboard.setString_forType(lNSText, lCurFormat.CocoaFormat);
end;
ccdtCocoaStandard, ccdtNonStandard:
begin
FormatToOwn := lCurFormat.CocoaFormat;
FormatToOwnArray := NSArray.arrayWithObjects_count(@FormatToOwn, 1);
DataStream.Position := 0;
lNSData := NSData.dataWithBytes_length(DataStream.Memory, DataStream.Size);
pasteboard.declareTypes_owner(FormatToOwnArray, nil);
pasteboard.setData_forType(lNSData, lCurFormat.CocoaFormat);
//lNSData.release; // this causes a crash
end;
ccdtBitmap:
begin
FormatToOwn := lCurFormat.CocoaFormat;
FormatToOwnArray := NSArray.arrayWithObjects_count(@FormatToOwn, 1);
Image := TFPMemoryImage.Create(10, 10);
Reader := TFPReaderBMP.Create;
Writer := TFPWriterPNG.Create;
lTmpStream := TMemoryStream.Create;
try
DataStream.Position := 0;
Image.LoadFromStream(DataStream, Reader);
Image.SaveToStream(lTmpStream, Writer);
lTmpStream.Position := 0;
lNSData := NSData.dataWithBytes_length(lTmpStream.Memory, lTmpStream.Size);
pasteboard.declareTypes_owner(FormatToOwnArray, nil);
pasteboard.setData_forType(lNSData, lCurFormat.CocoaFormat);
//lNSData.release;
finally
Image.Free;
Reader.Free;
Writer.Free;
lTmpStream.Free;
end;
end;
end;
end;
finally
DataStream.Free;
end;
Result := True;
end;
{------------------------------------------------------------------------------
Method: ClipboardRegisterFormat
Params: AMimeType - A string (usually a MIME type) identifying a new format
type to register
Returns: The registered Format identifier (TClipboardFormat)
------------------------------------------------------------------------------}
function TCocoaWidgetSet.ClipboardRegisterFormat(const AMimeType: string): TClipboardFormat;
var
i: Integer;
lCurData: TCocoaClipboardData;
lNSStr: NSString = nil;
lDataType: TCocoaClipboardDataType;
begin
Result := 0;
// Check first if it was already registered
for i := 0 to ClipboardFormats.Count-1 do
begin
lCurData := TCocoaClipboardData(ClipboardFormats.Items[i]);
if lCurData.MimeType = AMimeType then
begin
Result := TClipboardFormat(lCurData);
{$IFDEF VerboseClipboard}
DebugLn('TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=' + AMimeType
+ ' Result='+DbgS(Result));
{$ENDIF}
Exit;
end;
end;
// if none was found, we need to register it
lDataType := ccdtNonStandard;
// See PredefinedClipboardMimeTypes for the most common mime-types
case AMimeType of
'text/plain':
begin
lNSStr := NSPasteboardTypeString;
lNSStr.retain;
lDataType := ccdtText;
end;
'image/png':
begin
lNSStr := NSPasteboardTypePNG;
lNSStr.retain;
lDataType := ccdtCocoaStandard;
end;
'image/bmp':
begin
lNSStr := NSPasteboardTypePNG;
lDataType := ccdtBitmap;
end;
else
lNSStr := NSStringUtf8(AMimeType);
lDataType := ccdtNonStandard;
end;
if lNSStr <> nil then
begin
lCurData := TCocoaClipboardData.Create(AMimeType, lNSStr, lDataType);
ClipboardFormats.Add(lCurData);
Result := TClipboardFormat(lCurData);
end;
{$IFDEF VerboseClipboard}
DebugLn('TCocoaWidgetSet.ClipboardRegisterFormat AMimeType=' + AMimeType
+ ' Result='+DbgS(Result));
{$ENDIF}
end;
function TCocoaWidgetSet.CombineRgn(Dest, Src1, Src2: HRGN; fnCombineMode: Longint): Longint;
begin
Result := LCLType.Error;
if (Dest = 0) or (Src1 = 0) or (fnCombineMode<RGN_AND) or (fnCombineMode>RGN_COPY) then Exit;
if (fnCombineMode <> RGN_COPY) and (Src2 = 0) then Exit;
Result := CocoaRegionTypeToWin32Map[TCocoaRegion(Dest).CombineWith(TCocoaRegion(Src1), cc_Copy)];
if fnCombineMode <> RGN_COPY then
Result := CocoaRegionTypeToWin32Map[TCocoaRegion(Dest).CombineWith(TCocoaRegion(Src2), CocoaCombineMode(fnCombineMode))];
end;
{------------------------------------------------------------------------------
Method: CreateBitmap
Params: Width - Bitmap width, in pixels
Height - Bitmap height, in pixels
Planes - Number of color planes
BitCount - Number of bits required to identify a color (TODO)
BitmapBits - Pointer to array containing color data (TODO)
Returns: A handle to a bitmap
Creates a bitmap with the specified width, height and color format
------------------------------------------------------------------------------}
function TCocoaWidgetSet.CreateBitmap(Width, Height: Integer;
Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
var
bmpType: TCocoaBitmapType;
begin
// WORKAROUND: force context supported depths
if BitmapBits = nil then
begin
if BitCount = 24 then BitCount := 32;
// if BitCount = 1 then BitCount := 8;
end;
case BitCount of
1: bmpType := cbtMono;
8: bmpType := cbtGray;
32: bmpType := cbtARGB;
else
bmpType := cbtRGB;
end;
// winapi Bitmaps are on a word boundary
Result := HBITMAP(TCocoaBitmap.Create(Width, Height, BitCount, BitCount, cbaWord, bmpType, BitmapBits));
end;
function TCocoaWidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH;
begin
Result := HBrush(TCocoaBrush.Create(LogBrush));
end;
function TCocoaWidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; Width,
Height: Integer): Boolean;
var
Obj: NSObject;
View: NSView;
begin
Result := (Handle <> 0);
if Result then
begin
Obj := NSObject(Handle);
View := GetNSObjectView(Obj);
if View <> nil then
Result := CocoaCaret.CreateCaret(View, Bitmap, Width, Height)
else
Result := False;
end;
end;
function TCocoaWidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
begin
Result := HBITMAP(TCocoaBitmap.Create(Width, Height, 32, 32, cbaDQWord, cbtARGB, nil));
end;
{------------------------------------------------------------------------------
Method: CreateCompatibleDC
Params: DC - Handle to memory device context
Returns: Handle to a memory device context
Creates a memory device context (DC) compatible with the specified device
------------------------------------------------------------------------------}
function TCocoaWidgetSet.CreateCompatibleDC(DC: HDC): HDC;
begin
Result := HDC(TCocoaBitmapContext.Create);
end;
//todo:
//function TCocoaWidgetSet.CreateEllipticRgn(p1, p2, p3, p4: Integer): HRGN;
//begin
//end;
function TCocoaWidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT;
begin
Result := HFont(TCocoaFont.Create(LogFont, LogFont.lfFaceName));
end;
function TCocoaWidgetSet.CreateFontIndirectEx(const LogFont: TLogFont;
const LongFontName: string): HFONT;
begin
Result := HFont(TCocoaFont.Create(LogFont, LongFontName));
end;
class function TCocoaWidgetSet.Create32BitAlphaBitmap(ABitmap, AMask: TCocoaBitmap): TCocoaBitmap;
var
ARawImage: TRawImage;
Desc: TRawImageDescription absolute ARawimage.Description;
ImgHandle, ImgMaskHandle: HBitmap;
ImagePtr: PRawImage;
DevImage: TRawImage;
DevDesc: TRawImageDescription;
SrcImage, DstImage: TLazIntfImage;
W, H: Integer;
begin
Result := nil;
if not LCLIntf.RawImage_FromBitmap(ARawImage, HBITMAP(ABitmap), HBITMAP(AMask)) then
Exit;
ImgMaskHandle := 0;
W := Desc.Width;
if W < 1 then W := 1;
H := Desc.Height;
if H < 1 then H := 1;
QueryDescription(DevDesc, [riqfRGB, riqfAlpha], W, H);
if DevDesc.IsEqual(Desc)
then begin
// image is compatible, so use it
DstImage := nil;
ImagePtr := @ARawImage;
end
else begin
// create compatible copy
SrcImage := TLazIntfImage.Create(ARawImage, False);
DstImage := TLazIntfImage.Create(0,0,[]);
DstImage.DataDescription := DevDesc;
DstImage.CopyPixels(SrcImage);
SrcImage.Free;
DstImage.GetRawImage(DevImage);
ImagePtr := @DevImage;
end;
try
if not LCLIntf.RawImage_CreateBitmaps(ImagePtr^, ImgHandle, ImgMaskHandle, True) then Exit;
Result := TCocoaBitmap(ImgHandle);
finally
ARawImage.FreeData;
DstImage.Free;
end;
end;
function TCocoaWidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
var
ABitmap: TCocoaBitmap;
begin
Result := 0;
if IconInfo^.hbmColor = 0 then Exit;
ABitmap := Create32BitAlphaBitmap(TCocoaBitmap(IconInfo^.hbmColor), TCocoaBitmap(IconInfo^.hbmMask));
if IconInfo^.fIcon then
Result := HICON(ABitmap)
else
Result := HICON(TCocoaCursor.CreateFromBitmap(ABitmap, GetNSPoint(IconInfo^.xHotSpot, IconInfo^.yHotSpot)));
end;
function TCocoaWidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN;
begin
Result := HPen(TCocoaPen.Create(LogPen));
end;
{------------------------------------------------------------------------------
Method: CreatePolygonRgn
Params: Points - Pointer to array of polygon points
NumPts - Number of points passed
FillMode - Filling mode
Returns: The new polygonal region
Creates a new polygonal region from the specified points
------------------------------------------------------------------------------}
function TCocoaWidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer;
FillMode: integer): HRGN;
begin
{$IFDEF VerboseWinAPI}
DebugLn('TCocoaWidgetSet.CreatePolygonRgn NumPts: ' + DbgS(NumPts) +
' FillMode: ' + DbgS(FillMode));
{$ENDIF}
Result := HRGN(TCocoaRegion.Create(Points, NumPts, FillMode=ALTERNATE));
end;
function TCocoaWidgetSet.CreateRectRgn(X1, Y1, X2, Y2: Integer): HRGN;
begin
{$IFDEF VerboseWinAPI}
DebugLn('TCocoaWidgetSet.CreateRectRgn R: ' + DbgS(Classes.Rect(X1, Y1, X2, Y2)));
{$ENDIF}
Result := HRGN(TCocoaRegion.Create(X1, Y1, X2, Y2));
end;
function TCocoaWidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
const
SName = 'TCocoaWidgetSet.DeleteObject';
var
gdi: TCocoaGDIObject;
begin
Result := False;
if GDIObject = 0 then
Exit(True);
gdi := CheckGDIOBJ(GdiObject);
if not Assigned(gdi) then
begin
DebugLn(SName, ' Error - GDIObject: ' + DbgSName(gdi) + ' is unknown!');
Exit;
end;
if gdi.Global then
begin
// global brushes can be cached, so just exit here since we will free the resource later on
//DebugLn(SName, ' Error - GDIObject: ' + DbgSName(gdi) + ' is global!');
Exit;
end;
if gdi.RefCount <> 1 then
begin
DebugLn(SName, 'Error - GDIObject: ' + DbgSName(gdi) + ' is still selected!');
Exit;
end;
gdi.Destroy;
Result := True;
end;
function TCocoaWidgetSet.DestroyCaret(Handle: HWND): Boolean;
begin
Result := CocoaCaret.DestroyCaret;
end;
function TCocoaWidgetSet.DestroyIcon(Handle: HICON): Boolean;
var
Ico: TObject;
begin
Result := Handle <> 0;
if not Result then
Exit;
Ico := TObject(Handle);
Result := (Ico is TCocoaBitmap) or (Ico is TCocoaCursor);
if Result then
Ico.Destroy;
end;
function TCocoaWidgetSet.DPtoLP(DC: HDC; var Points; Count: Integer): BOOL;
var
ctx: TCocoaContext;
P: PPoint;
begin
Result := False;
ctx := CheckDC(DC);
if not Assigned(ctx) then Exit;
P := @Points;
with ctx.GetLogicalOffset do
while Count > 0 do
begin
Dec(Count);
dec(P^.X, X);
dec(P^.Y, Y);
inc(P);
end;
Result := True;
end;
function TCocoaWidgetSet.DrawFocusRect(DC: HDC; const Rect: TRect): boolean;
var
ctx: TCocoaContext;
p: Integer;
pn: TCocoaPen;
opn: TCocoaPen;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx);
if Result then
begin
//ctx.DrawFocusRect(Rect);
// drawing in Windows compatible XOR style
p:=ctx.ROP2;
opn:=ctx.Pen;
pn:=TCocoaPen.Create(clDkGray, psSolid, true, 2, pmCopy, pecFlat, pjsRound, false );
try
ctx.Pen:=pn;
ctx.ROP2:=R2_NOTXORPEN;
ctx.Pen.Apply(ctx, true);
ctx.Frame(Rect);
finally
ctx.ROP2:=p;
ctx.Pen:=opn;
pn.Free;
end;
end;
end;
function TCocoaWidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx);
if Result then
ctx.Ellipse(x1, y1, x2, y2);
end;
function TCocoaWidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
begin
Result := hWnd <> 0;
if Result then
NSObject(hWnd).lclSetEnabled(bEnable)
end;
function TCocoaWidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer;
begin
Result:=inherited EndPaint(Handle, PS);
end;
function TCocoaWidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
Callback: FontEnumExProc; Lparam: LParam; Flags: dword): longint;
var
fname: NSString;
ELogFont: TEnumLogFontEx;
Metric: TNewTextMetricEx;
FontName: AnsiString;
begin
Result := 0;
if not Assigned(Callback) then Exit;
for fname in NSFontManager.sharedFontManager.availableFontFamilies do
begin
try
FontName := NSStringToString(fname);
FillChar(ELogFont, SizeOf(ELogFont), #0);
FillChar(Metric, SizeOf(Metric), #0);
ELogFont.elfLogFont.lfFaceName := FontName;
ELogFont.elfFullName := FontName;
//todo: read the data from all fonts of the fontfamily
Result := CallBack(ELogFont, Metric, TRUETYPE_FONTTYPE, lparam);
if Result = 0 then Break;
except
Break;
end;
end;
end;
function TCocoaWidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
var
i: integer;
begin
Result := True;
for i := 0 to NSScreen.screens.count - 1 do
begin
Result := Result and lpfnEnum(HMONITOR(NSScreen.screens.objectAtIndex(i)), 0, nil, dwData);
if not Result then break;
end;
end;
function TCocoaWidgetSet.ExtSelectClipRGN(dc: hdc; rgn: hrgn; Mode: Longint): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
Result := CocoaRegionTypeToWin32Map[ctx.SetClipRegion(TCocoaRegion(rgn), CocoaCombineMode(Mode))]
else
Result := ERROR;
end;
function TCocoaWidgetSet.ExtCreatePen(dwPenStyle, dwWidth: DWord;
const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN;
begin
Result := HPEN(TCocoaPen.Create(dwPenStyle, dwWidth, lplb, dwStyleCount, lpStyle));
end;
function TCocoaWidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx);
if Assigned(ctx) then
ctx.TextOut(X, Y, Options, Rect, Str, Count, Dx);
end;
function TCocoaWidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean;
var
ctx: TCocoaContext;
br: TCocoaGDIObject;
begin
ctx := CheckDC(DC);
br := CheckGDIOBJ(Brush);
Result := Assigned(ctx) and (not Assigned(br) or (br is TCocoaBrush));
if not Result then Exit;
ctx.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, True, TCocoaBrush(br));
end;
function TCocoaWidgetSet.FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool;
var
OldRgn: TCocoaRegion;
R: TRect;
Clipped: Boolean;
ctx: TCocoaContext;
br: TCocoaGDIObject;
I: Integer;
begin
ctx := CheckDC(DC);
br := CheckGDIOBJ(hbr);
Result := Assigned(ctx) and (not Assigned(br) or (br is TCocoaBrush));
if not Result then Exit;
Clipped := ctx.Clipped;
I := ctx.SaveDC;
if Clipped then
OldRgn := TCocoaRegion.CreateDefault;
try
if Clipped then
ctx.CopyClipRegion(OldRgn);
if SelectClipRgn(DC, RegionHnd) <> ERROR then
begin
R := TCocoaRegion(RegionHnd).GetBounds;
with R do
ctx.Rectangle(Left, Top, Right, Bottom, True, TCocoaBrush(br));
if Clipped then
SelectClipRgn(DC, HRGN(OldRgn));
Result := True;
end;
finally
if Clipped then
OldRgn.Free;
ctx.RestoreDC(I);
end;
end;
function TCocoaWidgetSet.Frame3d(DC: HDC; var ARect: TRect;
const FrameWidth: integer; const Style: TBevelCut): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx) and (FrameWidth > 0);
if Result then
ctx.Frame3d(ARect, FrameWidth, Style);
end;
function TCocoaWidgetSet.FrameRect(DC: HDC; const ARect: TRect; hBr: HBRUSH): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
begin
ctx.FrameRect(ARect, TCocoaBrush(hBr));
Result := -1;
end
else
Result := 0;
end;
function TCocoaWidgetSet.GetActiveWindow: HWND;
begin
// return the currect application active window
Result := HWND(NSApp.keyWindow);
end;
function TCocoaWidgetSet.GetBkColor(DC: HDC): TColorRef;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
Result := ctx.BkColor
else
Result := CLR_INVALID;
end;
function TCocoaWidgetSet.GetCapture: HWND;
begin
Result:=FCaptureControl;
end;
function TCocoaWidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean;
begin
Result := CocoaCaret.GetCaretPos(lpPoint);
end;
function TCocoaWidgetSet.GetCaretRespondToFocus(handle: HWND;
var ShowHideOnFocus: boolean): Boolean;
begin
Result := inherited GetCaretRespondToFocus(handle, ShowHideOnFocus);
end;
{------------------------------------------------------------------------------
function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
nCmdShow:
SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED
------------------------------------------------------------------------------}
function TCocoaWidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
var
win: NSWindow;
lCocoaWin: TCocoaWindow = nil;
lWinContent: TCocoaWindowContent = nil;
begin
{$ifdef VerboseCocoaWinAPI}
DebugLn('TCocoaWidgetSet.ShowWindow');
{$endif}
//todo: should a call to lclShowWindow (to be added) be made instead?
if (NSObject(hWnd).isKindOfClass(TCocoaWindowContent)) and (not TCocoaWindowContent(hWnd).isembedded) then
begin
lWinContent := TCocoaWindowContent(hWnd);
win := lWinContent.window;
if win.isKindOfClass(TCocoaWindow) then
lCocoaWin := TCocoaWindow(win);
case nCmdShow of
SW_SHOW, SW_SHOWNORMAL:
win.orderFront(nil);
SW_HIDE:
win.orderOut(nil);
SW_MINIMIZE:
win.miniaturize(nil);
SW_MAXIMIZE:
win.zoom(nil);
end;
// Fullscreen status change
if (nCmdShow <> SW_MINIMIZE) and (nCmdShow <> SW_HIDE) then
begin
// getting out of fullscreen
if (nCmdShow <> SW_SHOWFULLSCREEN) and lWinContent.isInFullScreenMode() then
begin
// lWinContent.exitFullScreenModeWithOptions(nil); <-- THIS CAUSES A CRASH!!!
end
// getting into fullscreen mode
else if (nCmdShow = SW_SHOWFULLSCREEN) and not lWinContent.isInFullScreenMode() then
begin
lWinContent.enterFullScreenMode_withOptions(NSScreen.mainScreen, nil);
end;
end;
end
else
NSObject(hWnd).lclSetVisible(nCmdSHow <> SW_HIDE);
Result:=true;
end;
function TCocoaWidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal
): Boolean;
begin
Result := StretchMaskBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc,
SrcWidth, SrcHeight, 0, 0, 0, Rop);
end;
function TCocoaWidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width,
Height: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
Mask: HBITMAP; XMask, YMask: Integer; Rop: DWORD): Boolean;
var
SrcCtx, DestCtx: TCocoaContext;
begin
DestCtx := CheckDC(DestDC);
SrcCtx := CheckDC(SrcDC);
Result := Assigned(DestCtx) and Assigned(SrcCtx);
if not Result then
Exit;
if not (SrcCtx is TCocoaBitmapContext) then
begin
DebugLn('StretchMaskBlt Error - invalid source device context ', SrcCtx.ClassName,
', expected TCocoaBitmapContext!');
Exit;
end;
Result := DestCtx.StretchDraw(X, Y, Width, Height,
TCocoaBitmapContext(SrcCtx), XSrc, YSrc, SrcWidth, SrcHeight,
TCocoaBitmap(Mask), XMask, YMask, Rop);
end;
function TCocoaWidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
pvParam: Pointer; fWinIni: DWord): LongBool;
begin
Result := True;
case uiAction of
SPI_GETWHEELSCROLLLINES: PDword(pvPAram)^ := 3;
SPI_GETWORKAREA:
TRect(pvParam^) := Bounds(GetSystemMetrics(SM_XVIRTUALSCREEN),
GetSystemMetrics(SM_YVIRTUALSCREEN),
GetSystemMetrics(SM_CXVIRTUALSCREEN),
GetSystemMetrics(SM_CYVIRTUALSCREEN));
else
Result := False;
end
end;
{------------------------------------------------------------------------------
Method: GetWindowRect
Params: Handle - Handle of window
Rect - Record for window coordinates
Returns: if the function succeeds, the return value is nonzero; if the
function fails, the return value is zero
Retrieves the screen bounding rectangle of the specified window
------------------------------------------------------------------------------}
function TCocoaWidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect): Integer;
var
dx, dy: Integer;
begin
if Handle <> 0 then
begin
ARect := NSObject(Handle).lclFrame;
if not NSObject(Handle).isKindOfClass_(NSWindow) then
begin
dx := 0;
dy := 0;
NSObject(Handle).lclLocalToScreen(dx, dx);
MoveRect(ARect, dx, dy);
end;
Result := 1;
end else
Result := 0;
end;
function TCocoaWidgetSet.IsWindowEnabled(Handle: HWND): boolean;
begin
if Handle<>0
then Result:=NSObject(Handle).lclIsEnabled
else Result:=False;
end;
function TCocoaWidgetSet.IsWindowVisible(Handle: HWND): boolean;
begin
if Handle<>0
then Result:=NSObject(Handle).lclIsVisible
else Result:=False;
end;
function TCocoaWidgetSet.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
begin
Result := Handle <> 0;
if Result then
ARect := NSObject(handle).lclClientFrame;
end;
function TCocoaWidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
begin
Result := Handle <> 0;
if Result then
begin
ARect := NSObject(handle).lclClientFrame;
OffsetRect(ARect, -ARect.Left, -ARect.Top);
end;
end;
function TCocoaWidgetSet.GetClipBox(DC: hDC; lpRect: PRect): Longint;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) and Assigned(lpRect) then
begin
lpRect^ := ctx.GetClipRect;
Result := COMPLEXREGION;
end
else
Result := ERROR;
end;
function TCocoaWidgetSet.GetClipRGN(DC: hDC; RGN: hRGN): Longint;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) and (RGN <> 0) then
Result := CocoaRegionTypeToWin32Map[ctx.CopyClipRegion(TCocoaRegion(RGN))]
else
Result := ERROR;
end;
function TCocoaWidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
begin
with NSEvent.mouseLocation do
begin
lpPoint.x := Round(x);
// cocoa returns cursor with inverted y coordinate
lpPoint.y := Round(NSScreen.mainScreen.frame.size.height-y);
end;
//debugln('GetCursorPos='+DbgS(lpPoint));
Result := True;
end;
function TCocoaWidgetSet.GetMonitorInfo(hMonitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
var
ScreenID: NSScreen absolute hMonitor;
begin
Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo));
if not Result then Exit;
lpmi^.rcMonitor := NSRectToRect(ScreenID.frame);
lpmi^.rcWork := NSRectToRect(ScreenID.visibleFrame);
if ScreenID = NSScreen.mainScreen then
lpmi^.dwFlags := MONITORINFOF_PRIMARY
else
lpmi^.dwFlags := 0;
end;
function TCocoaWidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
var
AObject: TCocoaGDIObject;
DIB: TDIBSection;
Width, Height, RequiredSize, i: Integer;
Traits: NSFontTraitMask;
APen: TCocoaPen absolute AObject;
ALogPen: PLogPen absolute Buf;
AExtLogPen: PExtLogPen absolute Buf;
AFont: TCocoaFont absolute AObject;
ALogFont: PLogFont absolute Buf;
const
DPI = 96;
begin
Result := 0;
AObject := CheckGDIObj(GDIObj);
if AObject is TCocoaBitmap then
begin
if Buf = nil then
begin
Result := SizeOf(TDIBSection);
Exit;
end;
Width := TCocoaBitmap(AObject).Width;
Height := TCocoaBitmap(AObject).Height;
FillChar(DIB, SizeOf(TDIBSection), 0);
{dsBM - BITMAP}
DIB.dsBm.bmType := $4D42;
DIB.dsBm.bmWidth := Width;
DIB.dsBm.bmHeight := Height;
DIB.dsBm.bmWidthBytes := 0;
DIB.dsBm.bmPlanes := 1;
DIB.dsBm.bmBitsPixel := 32;
DIB.dsBm.bmBits := nil;
{dsBmih - BITMAPINFOHEADER}
DIB.dsBmih.biSize := 40;
DIB.dsBmih.biWidth := Width;
DIB.dsBmih.biHeight := Height;
DIB.dsBmih.biPlanes := DIB.dsBm.bmPlanes;
DIB.dsBmih.biCompression := 0;
DIB.dsBmih.biSizeImage := 0;
DIB.dsBmih.biXPelsPerMeter := 0;
DIB.dsBmih.biYPelsPerMeter := 0;
DIB.dsBmih.biClrUsed := 0;
DIB.dsBmih.biClrImportant := 0;
DIB.dsBmih.biBitCount := 32;
if BufSize >= SizeOf(TDIBSection) then
begin
PDIBSection(Buf)^ := DIB;
Result := SizeOf(TDIBSection);
end
else
if BufSize > 0 then
begin
System.Move(DIB, Buf^, BufSize);
Result := BufSize;
end;
end
else
if AObject is TCocoaPen then
begin
if APen.IsExtPen then
begin
RequiredSize := SizeOf(TExtLogPen);
if Length(APen.Dashes) > 1 then
inc(RequiredSize, (Length(APen.Dashes) - 1) * SizeOf(DWord));
if Buf = nil then
Result := RequiredSize
else
if BufSize >= RequiredSize then
begin
Result := RequiredSize;
AExtLogPen^.elpPenStyle := APen.Style;
if APen.IsGeometric then
begin
case APen.JoinStyle of
kCGLineJoinRound:
AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_ROUND;
kCGLineJoinBevel:
AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_BEVEL;
kCGLineJoinMiter:
AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_JOIN_MITER;
end;
case APen.CapStyle of
kCGLineCapRound:
AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_ROUND;
kCGLineCapSquare:
AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_SQUARE;
kCGLineCapButt:
AExtLogPen^.elpPenStyle := AExtLogPen^.elpPenStyle or PS_ENDCAP_FLAT;
end;
AExtLogPen^.elpWidth := APen.Width;
end
else
AExtLogPen^.elpWidth := 1;
AExtLogPen^.elpBrushStyle := BS_SOLID;
AExtLogPen^.elpColor := APen.ColorRef;
AExtLogPen^.elpHatch := 0;
AExtLogPen^.elpNumEntries := Length(APen.Dashes);
if AExtLogPen^.elpNumEntries > 0 then
begin
for i := 0 to AExtLogPen^.elpNumEntries - 1 do
PDword(@AExtLogPen^.elpStyleEntry)[i] := Trunc(APen.Dashes[i]);
end
else
AExtLogPen^.elpStyleEntry[0] := 0;
end;
end
else
begin
if Buf = nil then
Result := SizeOf(TLogPen)
else
if BufSize >= SizeOf(TLogPen) then
begin
Result := SizeOf(TLogPen);
ALogPen^.lopnStyle := APen.Style;
ALogPen^.lopnWidth := Types.Point(APen.Width, 0);
ALogPen^.lopnColor := APen.ColorRef;
end;
end;
end;
if AObject is TCocoaFont then
begin
if Buf = nil then
Result := SizeOf(TLogFont)
else
if BufSize >= SizeOf(TLogFont) then
begin
Result := SizeOf(TLogFont);
FillChar(ALogFont^, SizeOf(ALogFont^), 0);
ALogFont^.lfFaceName := AFont.Name;
ALogFont^.lfHeight := -Round( AFont.Size * DPI / 72);
Traits := NSFontManager.sharedFontManager.traitsOfFont(AFont.Font);
if (Traits and NSFontBoldTrait) <> 0 then
ALogFont^.lfWeight := FW_BOLD
else
ALogFont^.lfWeight := FW_NORMAL;
if (Traits and NSFontItalicTrait) <> 0 then
ALogFont^.lfItalic := 1
else
ALogFont^.lfItalic := 0;
end;
end;
end;
function TCocoaWidgetSet.GetParent(Handle : HWND): HWND;
begin
if Handle<>0 then
Result:=HWND(NSObject(Handle).lclParent)
else
Result:=0;
end;
function TCocoaWidgetSet.GetWindowRelativePosition(Handle: hwnd; var Left, Top: Integer): boolean;
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
end;
function TCocoaWidgetSet.GetWindowSize(Handle: hwnd; var Width, Height: Integer): boolean;
var
r: TRect;
lView: NSView;
begin
Result := Handle <> 0;
if not Result then Exit;
r := NSObject(Handle).lclFrame;
Width := R.Right - R.Left;
Height := R.Bottom - R.Top;
end;
function TCocoaWidgetSet.InitStockFont(AFont: TObject; AStockFont: TStockFont): Boolean;
var
Font: TFont absolute AFont;
CTFont: CTFontRef;
CTFontName: CFStringRef;
CTFontSize: CGFloat;
CTFontType: CTFontUIFontType;
begin
Result := False;
case AStockFont of
sfSystem: // stock system font
CTFontType := kCTFontSystemFontType;
sfHint: // stock hint font
CTFontType := kCTFontToolTipFontType;
sfIcon: // stock icon font
CTFontType := kCTFontViewsFontType;
sfMenu: // stock menu font
CTFontType := kCTFontMenuItemFontType;
end;
CTFont := CTFontCreateUIFontForLanguage(CTFontType, 0, nil);
try
CTFontName := CTFontCopyFamilyName(CTFont);
try
Font.Name := CFStringToStr(CTFontName);
finally
CFRelease(CTFontName);
end;
CTFontSize := CTFontGetSize(CTFont);
Font.Size := Round(CTFontSize);
finally
CFRelease(CTFont);
end;
Result := True;
end;
function TCocoaWidgetSet.HideCaret(Handle: HWND): Boolean;
var
Obj: NSObject;
lView: NSView;
begin
Result := (Handle <> 0);
if Result then
begin
Obj := NSObject(Handle);
lView := GetNSObjectView(Obj);
if lView <> nil then
Result := CocoaCaret.HideCaret(lView)
else
Result := False;
end;
end;
function TCocoaWidgetSet.InvalidateRect(aHandle: HWND; Rect: pRect; bErase: Boolean): Boolean;
begin
Result := aHandle <> 0;
if Result then
begin
if Assigned(Rect) then
NSObject(aHandle).lclInvalidateRect(Rect^)
else
NSObject(aHandle).lclInvalidate;
end;
end;
function TCocoaWidgetSet.UpdateWindow(Handle: HWND): Boolean;
begin
Result := Handle <> 0;
if Result then
NSObject(Handle).lclUpdate;
end;
function TCocoaWidgetSet.GetProp(Handle: hwnd; Str: PChar): Pointer;
var
PropStorage: TStringList;
I: Integer;
begin
if Handle <> 0 then
begin
PropStorage := NSObject(Handle).lclGetPropStorage;
if Assigned(PropStorage) then
begin
I := PropStorage.IndexOf(Str);
if I <> -1 then
Result := PropStorage.Objects[I]
else
Result := nil;
end
else
Result := nil;
end;
end;
function TCocoaWidgetSet.IsWindow(handle: HWND): boolean;
begin
if handle <> 0 then
begin
Result := NSObject(handle).lclIsHandle;
end
else
Result := False;
end;
function ViewFromPoint(view: NSView;Point: TPoint): HWND;
var rect: TRect;
p:TPoint;
begin
Result:=0;
if not assigned(view) then
exit;
if view.lclIsHandle then
begin
p:=Point;
view.lclScreenToLocal(p.X,p.Y);
rect:=view.lclClientFrame;
if PtInRect(rect, p) then
Result:=HWND(view);
//debugln('Point:'+DbgS(p)+' Rect:'+DbgS(rect)+' Result:'+dbgS(Result));
end
//else
// debugln('No lcl');
end;
function RecurseSubviews(view: NSView;Point: TPoint):HWND;
var sv:integer;
begin
// first check views subview if there is a embedded view
Result:=0;
sv:=0;
while (Result=0) and (sv<view.subviews.count) do
begin
Result:=RecurseSubviews(view.subviews.objectAtIndex(sv),Point);
inc(sv)
end;
if Result=0 then
Result:=ViewFromPoint(view,Point);
end;
function TCocoaWidgetSet.WindowFromPoint(Point: TPoint): HWND;
var
winrect: TRect;
windows: NSArray;
win: integer;
window, windowbelowpoint: NSWindow;
p:NSPoint;
winnr:NSInteger;
pool:NSAutoReleasePool;
begin
Result := 0;
if not assigned(NSApp) then
Exit;
pool := NSAutoreleasePool.alloc.init;
windows := NSApp.windows;
for win := 0 to windows.count - 1 do
begin
window:=windows.objectAtIndex(win);
p.x:=Point.X;
p.y:=window.screen.frame.size.height-Point.Y;
winnr:=NSWindow.windowNumberAtPoint_belowWindowWithWindowNumber(p,0);
windowbelowpoint:=NSApp.windowWithWindowNumber(winnr);
if windowbelowpoint=window then
begin
Result:=RecurseSubviews(window.contentView, Point);
if Result<>0 then
begin
pool.release;
exit;
end;
end;
end;
pool.release;
end;
function TCocoaWidgetSet.GetRgnBox(RGN: HRGN; lpRect: PRect): Longint;
begin
Result := ERROR;
if Assigned(lpRect) then
lpRect^ := Types.Rect(0, 0, 0, 0);
if not (TObject(RGN) is TCocoaRegion) then
Exit;
if Assigned(lpRect) then
begin
lpRect^ := TCocoaRegion(RGN).GetBounds;
Result := CocoaRegionTypeToWin32Map[TCocoaRegion(RGN).GetType];
end;
end;
function TCocoaWidgetSet.GetROP2(DC: HDC): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
Result := ctx.ROP2
else
Result := 0;
end;
function TCocoaWidgetSet.SetProp(Handle: hwnd; Str: PChar; Data: Pointer): Boolean;
var
PropStorage: TStringList;
begin
Result := Handle <> 0;
if Result then
begin
PropStorage := NSObject(Handle).lclGetPropStorage;
Result := Assigned(PropStorage);
if Result then
PropStorage.AddObject(Str, TObject(Data));
end;
end;
function TCocoaWidgetSet.SetROP2(DC: HDC; Mode: Integer): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
begin
Result := ctx.ROP2;
ctx.ROP2 := Mode;
end
else
Result := 0;
end;
{----------------------------- WINDOWS SCROLLING ------------------------------}
function TCocoaWidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer): integer;
var
sc : NSScrollView;
obj : NSObject;
begin
obj := HandleToNSObject(Handle);
Result := 0;
if not Assigned(obj) then Exit;
if obj.isKindOfClass(NSScrollView) then
begin
if (BarKind = SB_Vert) and Assigned(NSScrollView(obj).verticalScroller) then
Result:=round(NSScrollView(obj).verticalScroller.frame.size.width)
else if (BarKind = SB_Horz) and Assigned(NSScrollView(obj).horizontalScroller) then
Result:=round(NSScrollView(obj).verticalScroller.frame.size.height)
else
Result := Round(NSScroller.scrollerWidth);
end
else
Result := Round(NSScroller.scrollerWidth);
end;
function TCocoaWidgetSet.GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean;
var
obj : NSObject;
sc : NSScrollView;
mn : TCocoaManualScrollView;
begin
obj := HandleToNSObject(Handle);
Result := Assigned(obj);
if not Result then Exit;
if obj.isKindOfClass(NSScrollView) then
begin
sc := NSScrollView(obj);
case SBStyle of
SB_Vert: Result := sc.hasVerticalScroller;
SB_Horz: Result := sc.hasHorizontalScroller;
else
Result := sc.hasHorizontalScroller and sc.hasVerticalScroller;
end;
end
else if obj.isKindOfClass(TCocoaManualScrollView) then
begin
mn := TCocoaManualScrollView(obj);
case SBStyle of
SB_Vert: Result := mn.hasVerticalScroller;
SB_Horz: Result := mn.hasHorizontalScroller;
else
Result := mn.hasHorizontalScroller and mn.hasVerticalScroller;
end;
end
else
Result := False;
end;
function TCocoaWidgetSet.GetScrollInfo(Handle: HWND; BarFlag: Integer;
var ScrollInfo: TScrollInfo): Boolean;
var
sc : NSScrollView;
obj : NSObject;
begin
obj := HandleToNSObject(Handle);
Result := Assigned(obj);
if not Result then Exit;
if obj.isKindOfClass(TCocoaScrollBar) then
Result := CocoaScrollBarGetScrollInfo(TCocoaScrollBar(obj), ScrollInfo)
else
if obj.isKindOfClass(TCocoaManualScrollView) then
begin
if BarFlag = SB_Vert then
Result := CocoaScrollBarGetScrollInfo( TCocoaScrollBar(TCocoaManualScrollView(obj).verticalScroller), ScrollInfo)
else
Result := CocoaScrollBarGetScrollInfo( TCocoaScrollBar(TCocoaManualScrollView(obj).horizontalScroller), ScrollInfo);
end else if obj.isKindOfClass(NSScrollView) then
NSScrollViewGetScrollInfo(NSScrollView(obj), BarFlag, ScrollInfo)
else
Result := False;
end;
function TCocoaWidgetSet.GetStockObject(Value: Integer): THandle;
begin
Result := 0;
case Value of
BLACK_BRUSH: // Black brush.
Result := FStockBlackBrush;
DKGRAY_BRUSH: // Dark gray brush.
Result := FStockDKGrayBrush;
GRAY_BRUSH: // Gray brush.
Result := FStockGrayBrush;
LTGRAY_BRUSH: // Light gray brush.
Result := FStockLtGrayBrush;
NULL_BRUSH: // Null brush (equivalent to HOLLOW_BRUSH).
Result := FStockNullBrush;
WHITE_BRUSH: // White brush.
Result := FStockWhiteBrush;
BLACK_PEN: // Black pen.
Result := FStockBlackPen;
NULL_PEN: // Null pen.
Result := FStockNullPen;
WHITE_PEN: // White pen.
Result := FStockWhitePen;
DEFAULT_GUI_FONT, SYSTEM_FONT:
Result := FStockSystemFont;
SYSTEM_FIXED_FONT:
Result := FStockFixedFont;
end;
end;
function SysColorToNSColor(nIndex: Integer): NSColor;
begin
case NIndex of
COLOR_GRADIENTACTIVECAPTION, COLOR_ACTIVECAPTION,
COLOR_WINDOWFRAME, COLOR_ACTIVEBORDER:
Result := NSColor.windowFrameColor;
COLOR_GRADIENTINACTIVECAPTION, COLOR_INACTIVECAPTION, COLOR_INACTIVEBORDER:
Result := NSColor.windowBackgroundColor;
COLOR_CAPTIONTEXT,
COLOR_INACTIVECAPTIONTEXT:
Result := NSColor.windowFrameTextColor;
COLOR_WINDOW:
Result := NSColor.textBackgroundColor;
COLOR_BACKGROUND,
COLOR_FORM:
Result := NSColor.windowBackgroundColor;
COLOR_MENU:
Result := NSColor.controlBackgroundColor;
COLOR_MENUTEXT:
Result := NSColor.controlTextColor;
COLOR_MENUBAR:
Result := NSColor.selectedTextBackgroundColor;
COLOR_MENUHILIGHT:
Result := NSColor.selectedMenuItemColor;
COLOR_INFOTEXT, COLOR_WINDOWTEXT:
Result := NSColor.controlTextColor;
COLOR_APPWORKSPACE:
Result := NSColor.windowBackgroundColor;
COLOR_HIGHLIGHT:
Result := NSColor.selectedControlColor;
COLOR_HOTLIGHT:
Result := NSColor.alternateSelectedControlColor;
COLOR_HIGHLIGHTTEXT:
Result := NSColor.selectedControlTextColor;
COLOR_SCROLLBAR:
Result := NSColor.scrollBarColor;
COLOR_BTNFACE:
Result := NSColor.controlColor;
COLOR_BTNSHADOW:
Result := NSColor.controlShadowColor;
COLOR_BTNHIGHLIGHT:
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;
COLOR_3DLIGHT:
Result := NSColor.controlHighlightColor;// makes a more consistent result (a very light gray) than controlLightHighlightColor (which is white)
COLOR_INFOBK:
Result := NSColor.colorWithCalibratedRed_green_blue_alpha(249 / $FF, 252 / $FF, 201 / $FF, 1);
else
Result := nil;
end;
end;
function TCocoaWidgetSet.GetSysColor(nIndex: Integer): DWORD;
var
Color: NSColor;
SysBrush: HBrush;
begin
// 1. get the system brush - it has a NSColor reference
SysBrush := GetSysColorBrush(nIndex);
if SysBrush = 0 then
begin
Result := 0;
Exit;
end;
Color := TCocoaBrush(SysBrush).Color;
if Assigned(Color) then
Result := NSColorToColorRef(Color)
else
Result := 0;
end;
function TCocoaWidgetSet.GetSysColorBrush(nIndex: Integer): HBRUSH;
begin
if (nIndex < 0) or (nIndex > MAX_SYS_COLORS) then
begin
Result := 0;
Exit;
end;
if (FSysColorBrushes[nIndex] = 0) then
FSysColorBrushes[nIndex] := HBrush(TCocoaBrush.Create(SysColorToNSColor(nIndex), True));
Result := FSysColorBrushes[nIndex]
end;
function TCocoaWidgetSet.SetScrollInfo(Handle : HWND; SBStyle : Integer; ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer;
var
si : TScrollInfo;
obj : NSObject;
sc : TCocoaScrollView;
bar : TCocoaScrollBar;
f : NSSize;
sz : NSSize;
flg : NSUInteger;
begin
obj := HandleToNSObject(Handle);
Result := 0;
if not Assigned(obj) then Exit;
if obj.isKindOfClass(TCocoaScrollView) then
begin
sc:=TCocoaScrollView(obj);
if sc.isCustomRange and (ScrollInfo.fMask and SIF_RANGE>0) then begin
f:=sc.frame.size;
sz:=NSView(sc.documentView).frame.size; // type casting is here for the compiler. for i386 it messes up types
flg:=sc.documentView.autoresizingMask;
if SBStyle=SB_Horz then begin
if ScrollInfo.nMax>f.width then begin
sz.width := ScrollInfo.nMax;
flg:=flg and not NSViewWidthSizable;
end else begin
sz.width := f.width;
flg:=flg or NSViewWidthSizable;
end;
end else if SBStyle=SB_Vert then begin
if ScrollInfo.nMax>f.height then begin
sz.height := ScrollInfo.nMax;
flg:=flg and not NSViewHeightSizable;
end else begin
sz.height := f.height;
flg:=flg or NSViewHeightSizable;
end;
end;
sc.documentView.setAutoresizingMask(flg);
sc.documentView.setFrameSize( sz );
end;
NSScrollViewSetScrollInfo(NSScrollView(obj), SBStyle, ScrollInfo);
FillChar(si, sizeof(si), 0);
si.cbSize:=sizeof(si);
NSScrollViewGetScrollInfo(NSScrollView(obj), SBStyle, si);
Result:=si.nPos;
end else if obj.isKindOfClass(TCocoaManualScrollView) then
begin
bar:=nil;
if SBStyle=SB_Vert then
bar:= TCocoaScrollBar(TCocoaManualScrollView(obj).allocVerticalScroller(false))
else if SBStyle=SB_Horz then
bar:= TCocoaScrollBar(TCocoaManualScrollView(obj).allocHorizontalScroller(false));
if Assigned(bar) then
begin
Result := CocoaScrollBarSetScrollInfo(bar, ScrollInfo);
ShowScrollBar(Handle, SBStyle, bar.pageInt < bar.maxInt-bar.minInt);
end
else
Result := 0;
end else if obj.isKindOfClass(TCocoaScrollBar) then
begin
Result := CocoaScrollBarSetScrollInfo(TCocoaScrollBar(obj), ScrollInfo);
end
else
Result := 0;
end;
function TCocoaWidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer; bShow: Boolean): Boolean;
var
obj : NSObject;
sc : TCocoaScrollView;
mn : TCocoaManualScrollView;
begin
obj := NSObject(HandleToNSObject(Handle));
Result := Assigned(obj);
if not Result then Exit;
if obj.isKindOfClass(TCocoaScrollView)
then begin
Result := true;
sc := TCocoaScrollView(obj);
if wBar in [SB_Vert, SB_Both] then
sc.setHasVerticalScroller(bShow);
if wBar in [SB_Horz, SB_Both] then
sc.setHasHorizontalScroller(bShow);
end
else if obj.isKindOfClass(TCocoaManualScrollView)
then begin
mn := TCocoaManualScrollView(obj);
if wBar in [SB_Vert, SB_Both] then
mn.setHasVerticalScroller(bShow);
if wBar in [SB_Horz, SB_Both] then
mn.setHasHorizontalScroller(bShow);
Result := true;
end else
Result := false;
end;
{----------------------------------- DRAWING ----------------------------------}
type
TPointArray = array [word] of TPoint;
PPointArray = ^TPointArray;
function TCocoaWidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx);
if Result then
ctx.LineTo(X, Y);
end;
function TCocoaWidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL;
var
ctx: TCocoaContext;
P: PPoint;
begin
Result := False;
ctx := CheckDC(DC);
if not Assigned(ctx) then Exit;
P := @Points;
with ctx.GetLogicalOffset do
while Count > 0 do
begin
Dec(Count);
inc(P^.X, X);
inc(P^.Y, Y);
inc(P);
end;
Result := True;
end;
function TCocoaWidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer;
begin
if not (TObject(RGN) is TCocoaRegion) then
Exit(ERROR);
TCocoaRegion(RGN).Offset(nXOffset, nYOffset);
Result := CocoaRegionTypeToWin32Map[TCocoaRegion(RGN).GetType];
end;
function TCocoaWidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx);
if Result then
begin
if Assigned(OldPoint) then
OldPoint^ := ctx.PenPos;
ctx.MoveTo(X, Y);
end;
end;
function TCocoaWidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer; Winding: boolean): boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx) and Assigned(Points) and (NumPts >= 2);
if Result then
ctx.Polygon(PPointArray(Points)^, NumPts, Winding);
end;
function TCocoaWidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx) and Assigned(Points) and (NumPts > 0);
if Result then
ctx.Polyline(PPointArray(Points)^, NumPts);
end;
function TCocoaWidgetSet.PostMessage(Handle: HWND; Msg: Cardinal;
wParam: WParam; lParam: LParam): Boolean;
var
Info: NSDictionary;
Event: NSEvent;
begin
Result := Handle <> 0;
if Result then
begin
Info := NewUserEventInfo(Handle, Msg, WParam, LParam);
// if we will want a postmessage using notification center
// NSDistributedNotificationCenter.defaultCenter.postNotificationName_object_userInfo_deliverImmediately(NSMessageNotification, nil, Info, False);
Event := PrepareUserEvent(Handle, Info, False);
NSApp.postEvent_atStart(Event, False);
end;
end;
function TCocoaWidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx);
if Result then
begin
// rectangle must be filled using current brush
ctx.Rectangle(X1, Y1, X2, Y2, True, ctx.Brush);
// and outlined by current pen
ctx.Rectangle(X1, Y1, X2, Y2, False, nil);
end;
end;
{------------------------------- SYNC OBJECTS ---------------------------------}
procedure TCocoaWidgetSet.InitializeCriticalSection(var CritSection: TCriticalSection);
begin
CritSection:=TCriticalSection(NSRecursiveLock.alloc);
end;
procedure TCocoaWidgetSet.DeleteCriticalSection(var CritSection: TCriticalSection);
begin
if CritSection=0 then Exit;
NSRecursiveLock(CritSection).release;
CritSection:=0;
end;
function TCocoaWidgetSet.DeleteDC(hDC: HDC): Boolean;
begin
Result := hDC <> 0;
if Result then
TCocoaContext(hDC).Free;
end;
procedure TCocoaWidgetSet.EnterCriticalSection(var CritSection: TCriticalSection);
begin
if CritSection=0 then Exit;
NSRecursiveLock(CritSection).lock;
end;
procedure TCocoaWidgetSet.LeaveCriticalSection(var CritSection: TCriticalSection);
begin
if CritSection=0 then Exit;
NSRecursiveLock(CritSection).unlock;
end;
{------------------------------- DEVICE CONTEXT -------------------------------}
function TCocoaWidgetSet.GetDC(hWnd: HWND): HDC;
var
ctx: TCocoaContext = nil;
lCallback: ICommonCallback;
begin
if hWnd = 0 then
Result := HDC(ScreenContext)
else
begin
lCallback := NSObject(hWnd).lclGetCallback;
if lCallback <> nil then
ctx := lCallback.GetContext;
if ctx = nil then
begin
ctx := TCocoaContext.Create(DefaultContext.ctx);
ctx.InitDraw(DefaultContext.size.cx, DefaultContext.size.cy);
end;
Result := HDC(ctx);
end;
{$IFDEF VerboseWinAPI}
DebugLn('[TCocoaWidgetSet.GetDC] hWnd: %x Result: %x', [hWnd, Result]);
{$ENDIF}
end;
function TCocoaWidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if not Assigned(ctx) then
Exit(0);
// todo: change implementation for printers
case Index of
HORZSIZE:
Result := Round(NSScreen.mainScreen.frame.size.width / 72 * 25.4);
VERTSIZE:
Result := Round(NSScreen.mainScreen.frame.size.height / 72 * 25.4);
HORZRES:
Result := Round(NSScreen.mainScreen.frame.size.width);
BITSPIXEL:
Result := CGDisplayBitsPerPixel(CGMainDisplayID);
PLANES:
Result := 1;
SIZEPALETTE:
Result := 0;
LOGPIXELSX:
Result := 72;
LOGPIXELSY:
Result := 72;
VERTRES:
Result := Round(NSScreen.mainScreen.frame.size.height);
NUMRESERVED:
Result := 0;
else
DebugLn('TCocoaWidgetSet.GetDeviceCaps TODO Index: ' + DbgS(Index));
end;
end;
function TCocoaWidgetSet.GetDeviceSize(DC: HDC; var P: TPoint): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx);
if Result then
with ctx.Size do
begin
P.X := cx;
P.Y := cy;
end;
end;
function TCocoaWidgetSet.GetFocus: HWND;
var
Obj: NSObject;
begin
Result := HWND(NSApp.keyWindow);
if Result <> 0 then
begin
Obj := NSWindow(Result).firstResponder;
if Assigned(Obj) and Obj.isKindOfClass(NSView) then
Result := HWND(Obj);
end;
end;
function TCocoaWidgetSet.GetForegroundWindow: HWND;
//var
// App: NSRunningApplication;
begin
// return the currect active window in the system
{ this is not possible because we can't access another application NSApplication
for App in NSWorkSpace.sharedWorkspace.runningApplications do
if App.isActive then
begin
Result := HWND(App.keyWindow);
Exit;
end;
}
if NSApp.isActive then
Result := HWND(NSApp.keyWindow)
else
Result := 0;
end;
function TCocoaWidgetSet.GetKeyState(nVirtKey: Integer): Smallint;
const
StateDown = SmallInt($FF80);
StateToggled = SmallInt($0001);
DownMap: array[Boolean] of SmallInt = (0, StateDown);
ToggleMap: array[Boolean] of SmallInt = (0, StateToggled);
var
Modifiers: NSUInteger;
begin
// NSApp.currentEvent.modifierFlags doesn't work before events start coming,
// see bug 29272 and http://lists.apple.com/archives/cocoa-dev/2010/Feb/msg00105.html
Modifiers := NSEvent.modifierFlags_();
case nVirtKey of
VK_MENU,
VK_LMENU:
// the ssAlt/VK_MENU is mapped to optionKey under MacOS
Result := DownMap[(Modifiers and NSAlternateKeyMask) <> 0];
VK_SHIFT,
VK_LSHIFT:
Result := DownMap[(Modifiers and NSShiftKeyMask) <> 0];
VK_CONTROL,
VK_LCONTROL:
Result := DownMap[(Modifiers and NSControlKeyMask) <> 0];
VK_LWIN, VK_RWIN:
Result := DownMap[(Modifiers and NSCommandKeyMask) <> 0];
VK_CAPITAL:
Result := ToggleMap[(Modifiers and NSAlphaShiftKeyMask) <> 0];
VK_LBUTTON:
Result := DownMap[(NSEvent.pressedMouseButtons() and $1) <> 0];
VK_RBUTTON:
Result := DownMap[(NSEvent.pressedMouseButtons() and $2) <> 0];
VK_MBUTTON:
Result := DownMap[(NSEvent.pressedMouseButtons() and $3) <> 0];
VK_XBUTTON1:
Result := DownMap[(NSEvent.pressedMouseButtons() and $4) <> 0];
VK_XBUTTON2:
Result := DownMap[(NSEvent.pressedMouseButtons() and $5) <> 0];
else
Result := 0;
end;
end;
function TCocoaWidgetSet.SelectObject(ADC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
var
dc: TCocoaContext;
gdi: TCocoaGDIObject;
const
SName = 'TCocoaWidgetSet.SelectObject';
begin
{$IFDEF VerboseWinAPI}
DebugLn(Format('TCocoaWidgetSet.SelectObject DC: %x GDIObj: %x', [ADC, GDIObj]));
{$ENDIF}
Result := 0;
dc:=CheckDC(ADC);
gdi:=CheckGDIOBJ(GDIObj);
if not Assigned(dc) then Exit;
if not Assigned(gdi) then Exit;
if gdi is TCocoaBrush then
begin // select brush
Result := HBRUSH(dc.Brush);
dc.Brush := TCocoaBrush(gdi);
end else if gdi is TCocoaPen then
begin // select pen
Result := HPEN(dc.Pen);
dc.Pen := TCocoaPen(gdi);
end else if gdi is TCocoaFont then
begin // select font
Result := HFONT(dc.Font);
dc.Font := TCocoaFont(gdi);
end else if gdi is TCocoaRegion then
begin // select region
Result := HRGN(dc.Region);
dc.Region := TCocoaRegion(gdi);
end else if gdi is TCocoaBitmap then
begin // select bitmap
if not (dc is TCocoaBitmapContext) then
begin
DebugLn(SName + ' Error - The specified device context is not bitmap context!');
Exit;
end;
Result := HBITMAP(TCocoaBitmapContext(dc).Bitmap);
TCocoaBitmapContext(dc).Bitmap := TCocoaBitmap(gdi);
end
else
begin
DebugLn(SName + ' Error - Unknown Object Type ' + DbgSName(gdi));
Exit;
end;
{$IFDEF VerboseWinAPI}
DebugLn(Format('TCocoaWidgetSet.SelectObject Result: %x', [Result]));
{$ENDIF}
end;
function TCocoaWidgetSet.SendMessage(Handle: HWND; Msg: Cardinal;
WParam: WParam; LParam: LParam): LResult;
var
Info: NSDictionary;
Event: NSEvent;
begin
if Handle <> 0 then
begin
Info := NewUserEventInfo(Handle, Msg, WParam, LParam);
Event := PrepareUserEvent(Handle, Info, True);
NSApp.sendEvent(Event);
Result := NSNumber(Info.objectForKey(NSMessageResult)).integerValue;
Info.Release;
end;
end;
function TCocoaWidgetSet.SetActiveWindow(Handle: HWND): HWND;
var
Obj: NSObject;
lView: NSView;
begin
Obj := NSObject(Handle);
if Assigned(Obj) and NSApp.isActive then
begin
Result := HWND(NSApp.keyWindow);
if Obj.isKindOfClass(NSWindow) then
NSwindow(Obj).makeKeyWindow
else
begin
lView := GetNSObjectView(Obj);
if lView <> nil then
lView.window.makeKeyWindow
else
Result := 0;
end;
end;
end;
function TCocoaWidgetSet.SetBKColor(DC: HDC; Color: TColorRef): TColorRef;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
begin
Result := ctx.BkColor;
ctx.BkColor := TColor(Color);
end
else
Result := CLR_INVALID;
end;
function TCocoaWidgetSet.SetBkMode(DC: HDC; bkMode: Integer): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
begin
Result := ctx.BkMode;
ctx.BkMode := bkMode;
end
else
Result := 0;
end;
function TCocoaWidgetSet.SetCapture(AHandle: HWND): HWND;
begin
Result := FCaptureControl;
FCaptureControl := AHandle;
end;
function TCocoaWidgetSet.SetCaretPos(X, Y: Integer): Boolean;
begin
Result := CocoaCaret.SetCaretPos(X, Y);
end;
function TCocoaWidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean;
begin
Result := CocoaCaret.SetCaretPos(X, Y);
end;
function TCocoaWidgetSet.SetCaretRespondToFocus(handle: HWND;
ShowHideOnFocus: boolean): Boolean;
begin
Result:=inherited SetCaretRespondToFocus(handle, ShowHideOnFocus);
end;
function TCocoaWidgetSet.RectVisible(dc: HDC; const ARect: TRect): Boolean;
var
ClipBox: CGRect;
ctx : TCocoaContext;
R: TRect;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx) and (ARect.Right > ARect.Left) and (ARect.Bottom > ARect.Top);
if not Result then Exit;
// In Quartz 2D there is no direct access to clipping path of CGContext,
// therefore we can only test bounding box of the clipping path.
ClipBox := CGContextGetClipBoundingBox(ctx.CGContext);
Result := IntersectRect(R, ARect, CGRectToRect(ClipBox));
end;
function TCocoaWidgetSet.ReleaseCapture : Boolean;
begin
FCaptureControl:=0;
Result := True;
end;
function TCocoaWidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
var
ctx: TCocoaContext;
begin
Result := 0;
ctx := CheckDC(DC);
if not Assigned(ctx) then
Exit;
if (ctx <> DefaultContext) and (ctx<>ScreenContext) and (not ctx.isControlDC) then
ctx.Free;
Result := 1;
end;
function TCocoaWidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(dc);
if not Assigned(ctx) then
Exit(0);
if Assigned(P) then
P^ := ctx.WindowOfs;
Result:=1;
end;
function TCocoaWidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
begin
if ACursor = 0 then Result := 0 else
Result := HCURSOR(TCocoaCursor(ACursor).Install);
end;
function TCocoaWidgetSet.SetCursorPos(X, Y: Integer): Boolean;
var
CursorPos: CGPoint;
begin
Result := False;
CursorPos.X := X;
CursorPos.Y := Y;
if CGWarpMouseCursorPosition(CursorPos) <> noErr then Exit;
Result := True;
end;
function TCocoaWidgetSet.SetFocus(Handle: HWND): HWND;
var
Obj: NSObject;
lView: NSView;
begin
if Handle <> 0 then
begin
Result := GetFocus;
if Result = Handle then
Exit;
Obj := NSObject(Handle);
if Obj.isKindOfClass(NSWindow) then
begin
NSWindow(Obj).makeKeyWindow;
NSWindow(Obj).makeFirstResponder(nil);
end
else
begin
lView := GetNSObjectView(Obj);
if lView <> nil then
begin
if lView.window <> nil then
begin
lView.window.makeKeyWindow;
lView.window.makeFirstResponder(lView.lclContentView);
end;
end;
end;
end
else
Result := 0;
end;
function TCocoaWidgetSet.SetForegroundWindow(HWnd: HWND): boolean;
var
Obj: NSObject;
lWin: NSWindow;
pool: NSAutoreleasePool;
begin
Result := HWnd <> 0;
if Result then
begin
pool := NSAutoreleasePool.alloc.init;
NSApp.activateIgnoringOtherApps(True);
Obj := NSObject(HWnd);
lWin := GetNSObjectWindow(Obj);
if lWin <> nil then
lWin.makeKeyAndOrderFront(NSApp)
else
Result := False;
pool.release;
end;
end;
function TCocoaWidgetSet.SetMenu(AWindowHandle: HWND; AMenuHandle: HMENU): Boolean;
var
lWin: NSWindow;
begin
Result := False;
lWin := GetNSObjectWindow(NSObject(AWindowHandle));
if (lWin <> nil) and lWin.isKindOfClass(TCocoaWindow) and
(TCocoaWindow(lWin).LCLForm.Menu.Handle = AMenuHandle) then
begin
if lWin.isKeyWindow or lWin.isMainWindow then
SetMainMenu(AMenuHandle, TCocoaWindow(lWin).LCLForm.Menu);
Result := True;
end;
end;
{------------------------------- FONT AND TEXT --------------------------------}
function TCocoaWidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
begin
Result := ctx.TextColor;
ctx.TextColor := TColor(Color);
end
else
Result := CLR_INVALID;
end;
function TCocoaWidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer;
OldPoint: PPoint): Boolean;
var
ctx: TCocoaContext;
begin
Result := False;
ctx := CheckDC(DC);
if not Assigned(ctx) then Exit;
if Assigned(OldPoint) then
OldPoint^ := ctx.ViewportOfs;
ctx.ViewportOfs := Types.Point(NewX, NewY);
Result := True;
end;
function TCocoaWidgetSet.SetWindowOrgEx(DC: HDC; NewX, NewY: Integer;
OldPoint: PPoint): Boolean;
var
ctx: TCocoaContext;
begin
Result := False;
ctx := CheckDC(DC);
if not Assigned(ctx) then Exit;
if Assigned(OldPoint) then
OldPoint^ := ctx.WindowOfs;
ctx.WindowOfs := Types.Point(NewX, NewY);
Result := True;
end;
function TCocoaWidgetSet.ShowCaret(Handle: HWND): Boolean;
var
Obj: NSObject;
lView: NSView;
begin
Result := (Handle <> 0);
if Result then
begin
Obj := NSObject(Handle);
lView := GetNSObjectView(Obj);
if lView <> nil then
Result := CocoaCaret.ShowCaret(lView)
else
Result := False;
end;
end;
{------------------------------------------------------------------------------
Method: GetSystemMetrics
Params: NIndex - System metric to retrieve
Returns: The requested system metric value
Retrieves various system metrics.
------------------------------------------------------------------------------}
function TCocoaWidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
begin
Result := 0;
{$IFDEF VerboseWinAPI}
DebugLn('TCocoaWidgetSet.GetSystemMetrics NIndex: ' + DbgS(NIndex));
{$ENDIF}
case NIndex of
SM_CXHSCROLL,
SM_CYHSCROLL,
SM_CXVSCROLL,
SM_CYVSCROLL:
Result := Round(NSScroller.scrollerWidthForControlSize(NSRegularControlSize));
SM_CXSCREEN,
SM_CXVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.size.width);
SM_CYSCREEN,
SM_CYVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.size.height);
SM_XVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.x);
SM_YVIRTUALSCREEN: Result := Round(NSScreen.mainScreen.frame.origin.y);
SM_CXSMICON,
SM_CYSMICON:
Result := 16;
SM_CXICON,
SM_CYICON:
Result := 128;
SM_CXCURSOR,
SM_CYCURSOR:
begin
{ if TCarbonCursor.HardwareCursorsSupported then
Result := 64 else}
Result := 16;
end;
SM_CXHTHUMB, SM_CYVTHUMB:
Result := Round(NSScroller.scrollerWidthForControlSize(NSRegularControlSize));
SM_SWSCROLLBARSPACING:
Result := 0;
SM_LCLHasFormAlphaBlend:
Result := 1;
else
DebugLn('TCocoaWidgetSet.GetSystemMetrics TODO ', DbgS(NIndex));;
end;
{$IFDEF VerboseWinAPI}
DebugLn('TCocoaWidgetSet.GetSystemMetrics Result: ' + DbgS(Result));
{$ENDIF}
end;
function TCocoaWidgetSet.GetTextColor(DC: HDC) : TColorRef;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
Result := ctx.TextColor
else
Result := CLR_INVALID;
end;
{------------------------------------------------------------------------------
Method: GetTextExtentPoint
Params: DC - Handle of device context
Str - Text string
Count - Number of characters in string
Size - The record for the dimensions of the string
Returns: If the function succeeds
Computes the width and height of the specified string of text
------------------------------------------------------------------------------}
function TCocoaWidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer; var Size: TSize): Boolean;
var
ctx : TCocoaContext;
begin
{$IFDEF VerboseWinAPI}
DebugLn('[TCocoaWidgetSet.GetTextExtentPoint] DC: %x Str: %s Count: %d', [DC, Str, Count]);
{$ENDIF}
ctx:=CheckDC(DC);
Result:=Assigned(ctx);
if not Assigned(ctx) then Exit(False);
Result := ctx.GetTextExtentPoint(Str, Count, Size);
{$IFDEF VerboseWinAPI}
DebugLn('[TCocoaWidgetSet.GetTextExtentPoint] Size: %d,%d', [Size.cx, Size.cy]);
{$ENDIF}
end;
{------------------------------------------------------------------------------
Method: GetTextMetrics
Params: DC - Handle of device context
TM - The Record for the text metrics
Returns: If the function succeeds
Fills the specified buffer with the metrics for the currently selected font
TODO: get exact max. and av. char width, pitch and charset
------------------------------------------------------------------------------}
function TCocoaWidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
Result := Assigned(ctx) and ctx.GetTextMetrics(TM);
end;
function TCocoaWidgetSet.GetViewPortOrgEx(DC: HDC; P: PPoint): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(dc);
if not Assigned(ctx) then
Exit(0);
if Assigned(P) then
P^ := ctx.ViewportOfs;
Result:=1;
end;
function TCocoaWidgetSet.TextOut(DC: HDC; X,Y: Integer; Str: Pchar; Count: Integer) : Boolean;
begin
Result := ExtTextOut(DC, X, Y, 0, nil, Str, Count, nil);
end;
function TCocoaWidgetSet.SaveDC(DC: HDC): Integer;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
Result := ctx.SaveDC
else
Result:=0;
end;
function TCocoaWidgetSet.ScreenToClient(Handle: HWND; var P: TPoint): Integer;
begin
Result := Ord(Handle <> 0);
if Result = 1 then
NSObject(Handle).lclScreenToLocal(P.X, P.Y);
end;
function TCocoaWidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer; prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT): Boolean;
var
obj: NSOBject;
v : NSView;
begin
obj:=NSObject(HandleToNSObject(hWnd));
Result:=Assigned(obj) and (obj.isKindOfClass(NSView));
if not Result then Exit;
v:=NSView(obj).lclContentView;
// todo: parse the passed parameters.
// the content of the window could be already prepared
// thus not entire control should be invalided
v.setNeedsDisplay_(true);
end;
function TCocoaWidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
begin
Result := ExtSelectClipRgn(DC, RGN, RGN_COPY);
end;
function TCocoaWidgetSet.SetSysColors(cElements: Integer; const lpaElements; const lpaRgbValues): Boolean;
var
n: Integer;
Element: LongInt;
Color: NSColor;
begin
Result := False;
if cElements > MAX_SYS_COLORS then Exit;
for n := 0 to cElements - 1 do
begin
Element := PInteger(@lpaElements)[n];
if (Element > MAX_SYS_COLORS) or (Element < 0) then
Exit;
Color := ColorToNSColor(PDWord(@lpaRgbValues)[n]);
if (FSysColorBrushes[Element] <> 0) then
TCocoaBrush(FSysColorBrushes[Element]).Color := Color
else
FSysColorBrushes[Element] := HBrush(TCocoaBrush.Create(Color, True));
end;
Result := True;
end;
function TCocoaWidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
var
ctx: TCocoaContext;
begin
ctx := CheckDC(DC);
if Assigned(ctx) then
Result := ctx.RestoreDC(SavedDC)
else
Result := False;
end;
function TCocoaWidgetSet.RoundRect(DC: HDC; X1, Y1, X2, Y2: Integer; RX,
RY: Integer): Boolean;
begin
Result:=inherited RoundRect(DC, X1, Y1, X2, Y2, RX, RY);
end;
//##apiwiz##eps## // Do not remove, no wizard declaration after this line
Reference in New Issue View Git Blame Copy Permalink