1 unit CocoaGDIObjects;
2 //todo: Remove MacOSAll unit to prevent Carbon framework linking.
3 //todo: Remove HIShape usage used in TCocoaRegion.
4
5 interface
6
7 {$mode objfpc}{$H+}
8 {$modeswitch objectivec1}
9
10 uses
11 SysUtils, MacOSAll, // for CGContextRef
12 LCLtype, LCLProc,
13 CocoaAll, CocoaUtils,
14 Classes, Types;
15
16 type
17 TCocoaBitmapAlignment = (
18 cbaByte, // each line starts at byte boundary.
19 cbaWord, // each line starts at word (16bit) boundary
20 cbaDWord, // each line starts at double word (32bit) boundary
21 cbaQWord, // each line starts at quad word (64bit) boundary
22 cbaDQWord // each line starts at double quad word (128bit) boundary
23 );
24
25 TCocoaBitmapType = (
26 cbtMono, // mask or mono bitmap
27 cbtGray, // grayscale bitmap
28 cbtRGB, // color bitmap 8-8-8 R-G-B
29 cbtARGB, // color bitmap with alpha channel first 8-8-8-8 A-R-G-B
30 cbtRGBA, // color bitmap with alpha channel last 8-8-8-8 R-G-B-A
31 cbtBGR, // color bitmap 8-8-8 B-G-R (windows compatible)
32 cbtBGRA // color bitmap with alpha channel 8-8-8-8 B-G-R-A (windows compatible)
33 );
34
35 const
36 cbtMask = cbtMono;
37
38 type
39 { TCocoaGDIObject }
40
41 TCocoaGDIObject = class(TObject)
42 public
43 RefCount: Integer;
44 procedure AddRef;
45 procedure Release;
46 end;
47
48 TCocoaRegionType = (crt_Empty, crt_Rectangle, crt_Complex);
49 TCocoaCombine = (cc_And, cc_Xor, cc_Or, cc_Diff, cc_Copy);
50
51 { TCocoaRegion }
52
53 //todo: Remove HIShape usage. HIShape is legacy
54 TCocoaRegion = class(TCocoaGDIObject)
55 private
56 FShape: HIShapeRef;
57 public
58 constructor Create;
59 constructor Create(const X1, Y1, X2, Y2: Integer);
60 constructor Create(Points: PPoint; NumPts: Integer; isAlter: Boolean);
61 destructor Destroy; override;
62
63 procedure Apply(cg: CGContextRef);
GetBoundsnull64 function GetBounds: TRect;
GetTypenull65 function GetType: TCocoaRegionType;
ContainsPointnull66 function ContainsPoint(const P: TPoint): Boolean;
67 procedure SetShape(AShape: HIShapeRef);
CombineWithnull68 function CombineWith(ARegion: TCocoaRegion; CombineMode: TCocoaCombine): Boolean;
69 public
70 property Shape: HIShapeRef read FShape write SetShape;
71 end;
72
73 { TCocoaBrush }
74
75 TCocoaBrush = class(TCocoaGDIObject)
76 R,G,B : Single;
77 procedure Apply(cg: CGContextRef);
78 end;
79
80 { TCocoaPen }
81
82 TCocoaPen = class(TCocoaGDIObject)
83 public
84 Style : Integer;
85 Width : Integer;
86 R,G,B : Single;
87 procedure Apply(cg: CGContextRef);
88 constructor Create;
89 end;
90
91 { TCocoaFont }
92
93 TCocoaFontStyle = set of (cfs_Bold, cfs_Italic, cfs_Underline, cfs_Strikeout);
94
95 TCocoaFont = class(TCocoaGDIObject)
96 Name : AnsiString;
97 Size : Integer;
98 Style : TCocoaFontStyle;
99 Antialiased: Boolean;
100 constructor CreateDefault;
101 end;
102
103 { TCocoaBitmap }
104
105 TCocoaBitmap = class(TCocoaGDIObject)
106 private
107 FData: Pointer;
108 FAlignment: TCocoaBitmapAlignment;
109 FFreeData: Boolean;
110 FDataSize: Integer;
111 FBytesPerRow: Integer;
112 FDepth: Byte;
113 FBitsPerPixel: Byte;
114 FWidth: Integer;
115 FHeight: Integer;
116 FType: TCocoaBitmapType;
117 // Cocoa information
118 FbitsPerSample: NSInteger; // How many bits in each color component
119 FsamplesPerPixel: NSInteger;// How many color components
120 public
121 image: NSImage;
122 imagerep: NSBitmapImageRep;
123 constructor Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
124 AAlignment: TCocoaBitmapAlignment; AType: TCocoaBitmapType;
125 AData: Pointer; ACopyData: Boolean = True);
126 destructor Destroy; override;
127 procedure SetInfo(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
128 AAlignment: TCocoaBitmapAlignment; AType: TCocoaBitmapType);
129 public
130 // property BitsPerComponent: Integer read GetBitsPerComponent;
131 property BitmapType: TCocoaBitmapType read FType;
132 // property BytesPerRow: Integer read FBytesPerRow;
133 // property CGImage: CGImageRef read FCGImage write SetCGImage;
134 // property ColorSpace: CGColorSpaceRef read GetColorSpace;
135 property Data: Pointer read FData;
136 property DataSize: Integer read FDataSize;
137 property Depth: Byte read FDepth;
138 // property Info: CGBitmapInfo read GetInfo;
139 property Width: Integer read FWidth;
140 property Height: Integer read FHeight;
141 end;
142
143 { TCocoaTextLayout }
144
145 TCocoaTextLayout = class(TObject)
146 public
147 constructor Create; virtual; abstract;
148 procedure SetFont(AFont: TCocoaFont); virtual; abstract;
149 procedure SetText(UTF8Text: PChar; ByteSize: Integer); virtual; abstract;
GetSizenull150 function GetSize: TSize; virtual; abstract;
151
152 procedure Draw(cg: CGContextRef; X, Y: Integer; DX: PInteger); virtual; abstract;
153 end;
154 TCocoaTextLayoutClass = class of TCocoaTextLayout;
155
156 { TASTUITextLayout }
157
158 // legacy layout used for Mac OS X 10.4
159 TASTUITextLayout = class(TCocoaTextLayout)
160 private
161 fBuffer : WideString;
162 fUTF8 : String;
163 FDX : PIntegerArray;
164
165 FLayout : ATSUTextLayout;
166 FStyle : ATSUStyle;
167
168 FTextBefore : ATSUTextMeasurement;
169 FTextAfter : ATSUTextMeasurement;
170 FAscent : ATSUTextMeasurement;
171 FDescent : ATSUTextMeasurement;
172
173 FValidSize : Boolean;
174 procedure RecountSize;
175 procedure DoJustify(iLineRef: ATSULineRef; var Handled: Boolean);
176 public
177 constructor Create; override;
178 destructor Destroy; override;
179 procedure SetFont(AFont: TCocoaFont); override;
180 procedure SetText(UTF8Text: PChar; ByteSize: Integer); override;
GetSizenull181 function GetSize: TSize; override;
182 procedure Draw(cg: CGContextRef; X, Y: Integer; DX: PInteger); override;
183 end;
184
185 { TCoreTextLayout }
186
187 //TCoreTextLayout = class(TCocoaTextLayout);
188
189 { TCocoaContext }
190
191 TCocoaContext = class(TObject)
192 private
193 fText : TCocoaTextLayout;
194 fBrush : TCocoaBrush;
195 fPen : TCocoaPen;
196 fFont : TCocoaFont;
197 fRegion : TCocoaRegion;
198 fBitmap : TCocoaBitmap;
199 procedure SetBitmap(const AValue: TCocoaBitmap);
200 procedure SetBrush(const AValue: TCocoaBrush);
201 procedure SetFont(const AValue: TCocoaFont);
202 procedure SetPen(const AValue: TCocoaPen);
203 procedure SetRegion(const AValue: TCocoaRegion);
204 public
205 ContextSize : TSize;
206 ctx : NSGraphicsContext;
207 cgctx : CGContextRef;
208 PenPos : TPoint;
209 Stack : Integer;
210 TR,TG,TB : Single;
211 constructor Create;
212 destructor Destroy; override;
InitDrawnull213 function InitDraw(width, height: Integer): Boolean;
214 procedure MoveTo(x,y: Integer);
215 procedure LineTo(x,y: Integer);
216 procedure Polygon(const Points: array of TPoint; NumPts: Integer; Winding: boolean);
217 procedure Polyline(const Points: array of TPoint; NumPts: Integer);
218 procedure Rectangle(X1, Y1, X2, Y2: Integer; FillRect: Boolean; UseBrush: TCocoaBrush);
219 procedure Ellipse(X1, Y1, X2, Y2: Integer);
220 procedure TextOut(X,Y: Integer; UTF8Chars: PChar; Count: Integer; CharsDelta: PInteger; BackgroundAlpha: Single);
GetTextExtentPointnull221 function GetTextExtentPoint(AStr: PChar; ACount: Integer; var Size: TSize): Boolean;
GetTextMetricsnull222 function GetTextMetrics(var TM: TTextMetric): Boolean;
223 procedure DrawBitmap(X,Y: Integer; ABitmap: TCocoaBitmap);
224 procedure SetOrigin(X,Y: Integer);
225 procedure GetOrigin(var X,Y: Integer);
CGContextnull226 function CGContext: CGContextRef; virtual;
227 property Brush: TCocoaBrush read fBrush write SetBrush;
228 property Pen: TCocoaPen read fPen write SetPen;
229 property Font: TCocoaFont read fFont write SetFont;
230 property Region: TCocoaRegion read fRegion write SetRegion;
231 property Bitmap: TCocoaBitmap read fBitmap write SetBitmap;
232 end;
233
CheckDCnull234 function CheckDC(dc: HDC): TCocoaContext;
CheckDCnull235 function CheckDC(dc: HDC; Str: string): Boolean;
CheckGDIOBJnull236 function CheckGDIOBJ(obj: HGDIOBJ): TCocoaGDIObject;
CheckBitmapnull237 function CheckBitmap(ABitmap: HBITMAP; AStr: string): Boolean;
238
239 implementation
240
241 //todo: a better check!
242
CheckDCnull243 function CheckDC(dc: HDC): TCocoaContext;
244 begin
245 Result:=TCocoaContext(dc);
246 end;
247
CheckDCnull248 function CheckDC(dc: HDC; Str: string): Boolean;
249 begin
250 Result:=dc<>0;
251 end;
252
CheckGDIOBJnull253 function CheckGDIOBJ(obj: HGDIOBJ): TCocoaGDIObject;
254 begin
255 Result:=TCocoaGDIObject(obj);
256 end;
257
CheckBitmapnull258 function CheckBitmap(ABitmap: HBITMAP; AStr: string): Boolean;
259 begin
260 Result := ABitmap <> 0;
261 end;
262
263 constructor TCocoaFont.CreateDefault;
264 begin
265 inherited Create({False});
266 end;
267
268 { TCocoaBitmap }
269
270 type
271 // The following dummy categories fix bugs in the Cocoa bindings available in FPC
272 // Remove them when the FPC binding parser is fixed.
273 // More details:
274 // http://wiki.freepascal.org/FPC_PasCocoa/Differences#Sending_messages_to_id
275 // http://wiki.lazarus.freepascal.org/FPC_PasCocoa#Category_declaration
276 NSBitmapImageRepFix = objccategory external(NSBitmapImageRep)
initWithBitmapDataPlanes_pixelsWide_pixelsHigh__colorSpaceName_bytesPerRow_bitsPerPixelnull277 function initWithBitmapDataPlanes_pixelsWide_pixelsHigh__colorSpaceName_bytesPerRow_bitsPerPixel(planes: PPByte; width: NSInteger; height: NSInteger; bps: NSInteger; spp: NSInteger; alpha: Boolean; isPlanar_: Boolean; colorSpaceName_: NSString; rBytes: NSInteger; pBits: NSInteger): id; message 'initWithBitmapDataPlanes:pixelsWide:pixelsHigh:bitsPerSample:samplesPerPixel:hasAlpha:isPlanar:colorSpaceName:bytesPerRow:bitsPerPixel:';
initWithBitmapDataPlanes_pixelsWide_pixelsHigh__colorSpaceName_bitmapFormat_bytesPerRow_bitsPerPixelnull278 function initWithBitmapDataPlanes_pixelsWide_pixelsHigh__colorSpaceName_bitmapFormat_bytesPerRow_bitsPerPixel(planes: PPByte; width: NSInteger; height: NSInteger; bps: NSInteger; spp: NSInteger; alpha: Boolean; isPlanar_: Boolean; colorSpaceName_: NSString; bitmapFormat_: NSBitmapFormat; rBytes: NSInteger; pBits: NSInteger): id; message 'initWithBitmapDataPlanes:pixelsWide:pixelsHigh:bitsPerSample:samplesPerPixel:hasAlpha:isPlanar:colorSpaceName:bitmapFormat:bytesPerRow:bitsPerPixel:';
279 end;
280
281 {------------------------------------------------------------------------------
282 Method: TCocoaBitmap.Create
283 Params: AWidth - Bitmap width
284 AHeight - Bitmap height
285 ADepth - Significant bits per pixel
286 ABitsPerPixel - The number of allocated bits per pixel (can be larger than depth)
287 // AAlignment - Alignment of the data for each row
288 // ABytesPerRow - The number of bytes between rows
289 ACopyData - Copy supplied bitmap data (OPTIONAL)
290
291 Creates Cocoa bitmap with the specified characteristics
292 ------------------------------------------------------------------------------}
293 constructor TCocoaBitmap.Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
294 AAlignment: TCocoaBitmapAlignment; AType: TCocoaBitmapType;
295 AData: Pointer; ACopyData: Boolean);
296 var
297 HasAlpha: Boolean;
298 BitmapFormat: NSBitmapFormat;
299 DataPointer: Pointer;
300 begin
301 {$ifdef VerboseBitmaps}
302 DebugLn(Format('[TCocoaBitmap.Create] AWidth=%d AHeight=%d ADepth=%d ABitsPerPixel=%d'
303 + ' AAlignment=%d AType=%d AData=? ACopyData=%d',
304 [AWidth, AHeight, ADepth, ABitsPerPixel, Integer(AAlignment), Integer(AType), Integer(ACopyData)]));
305 {$endif}
306 SetInfo(AWidth, AHeight, ADepth, ABitsPerPixel, AAlignment, AType);
307
308 // Copy the image data, if necessary
309 if ACopyData then
310 begin
311 System.GetMem(FData, FDataSize);
312 FFreeData := True;
313 if AData <> nil then
314 System.Move(AData^, FData^, FDataSize) // copy data
315 else
316 FillDWord(FData^, FDataSize shr 2, 0); // clear bitmap
317 DataPointer := @FData;
318 end
319 else if (AData = nil) then
320 begin
321 FData := AData;
322 FFreeData := False;
323 DataPointer := nil;
324 end
325 else
326 begin
327 FData := AData;
328 FFreeData := False;
329 DataPointer := @FData;
330 end;
331
332 HasAlpha := AType in [cbtARGB, cbtRGBA, cbtBGRA];
333 BitmapFormat := NSAlphaNonpremultipliedBitmapFormat;
334 if AType = cbtARGB then
335 BitmapFormat := BitmapFormat or NSAlphaFirstBitmapFormat;
336
337 {$ifdef VerboseBitmaps}
338 DebugLn(Format('[TCocoaBitmap.Create] NSBitmapImageRep.alloc HasAlpha=%d',
339 [Integer(HasAlpha)]));
340 {$endif}
341 // Create the associated NSImageRep
342 imagerep := NSBitmapImageRep(NSBitmapImageRep.alloc.initWithBitmapDataPlanes_pixelsWide_pixelsHigh__colorSpaceName_bitmapFormat_bytesPerRow_bitsPerPixel(
343 DataPointer, // planes, BitmapDataPlanes
344 FWidth, // width, pixelsWide
345 FHeight,// height, PixelsHigh
346 FbitsPerSample,// bitsPerSample, bps
347 FsamplesPerPixel, // samplesPerPixel, sps
348 HasAlpha, // hasAlpha
349 False, // isPlanar
350 NSCalibratedRGBColorSpace, // colorSpaceName
351 BitmapFormat, // bitmapFormat
352 FBytesPerRow, // bytesPerRow
353 FBitsPerPixel //bitsPerPixel
354 ));
355
356 // Create the associated NSImage
357 image := NSImage.alloc.initWithSize(NSMakeSize(AWidth, AHeight));
358 image.addRepresentation(imagerep);
359 end;
360
361 destructor TCocoaBitmap.Destroy;
362 begin
363 //CGImageRelease(FCGImage);
364 if FFreeData then System.FreeMem(FData);
365
366 inherited Destroy;
367 end;
368
369 procedure TCocoaBitmap.SetInfo(AWidth, AHeight, ADepth,
370 ABitsPerPixel: Integer; AAlignment: TCocoaBitmapAlignment;
371 AType: TCocoaBitmapType);
372 const
373 ALIGNBITS: array[TCocoaBitmapAlignment] of Integer = (0, 1, 3, 7, $F);
374 var
375 M: Integer;
376 begin
377 if AWidth < 1 then AWidth := 1;
378 if AHeight < 1 then AHeight := 1;
379 FWidth := AWidth;
380 FHeight := AHeight;
381 FDepth := ADepth;
382 FBitsPerPixel := ABitsPerPixel;
383 FType := AType;
384 FAlignment := AAlignment;
385
386 if (FType in [cbtMono, cbtGray]) and (FDepth=0) then
387 FDepth:=FBitsPerPixel;
388
389 FBytesPerRow := ((AWidth * ABitsPerPixel) + 7) shr 3;
390 M := FBytesPerRow and ALIGNBITS[AAlignment];
391 if M <> 0 then Inc(FBytesPerRow, ALIGNBITS[AAlignment] + 1 - M);
392
393 FDataSize := FBytesPerRow * FHeight;
394
395 // Cocoa information
396 case ABitsPerPixel of
397 // Strangely, this might appear
398 0:
399 begin
400 FbitsPerSample := 0;
401 FsamplesPerPixel := 0;
402 end;
403 // Mono
404 1:
405 begin
406 FbitsPerSample := 1;
407 FsamplesPerPixel := 1;
408 end;
409 // Gray scale
410 8:
411 begin
412 FbitsPerSample := 8;
413 FsamplesPerPixel := 1;
414 end;
415 // ARGB
416 32:
417 begin
418 FbitsPerSample := 8;
419 FsamplesPerPixel := 4;
420 end;
421 else
422 // Other RGB
423 FbitsPerSample := ABitsPerPixel div 3;
424 FsamplesPerPixel := 3;
425 end;
426 end;
427
428 { TASTUITextLayout }
429
IntToFixnull430 function IntToFix(i: integer): Integer; inline;
431 begin
432 Result:=i shl 16;
433 end;
434
FixToIntnull435 function FixToInt(f: Integer): Integer; inline;
436 begin
437 Result:=Round(Fix2X(F));
438 end;
439
440 procedure TASTUITextLayout.RecountSize;
441 begin
442 ATSUGetUnjustifiedBounds(FLayout, kATSUFromTextBeginning, kATSUToTextEnd,
443 FTextBefore, FTextAfter, FAscent, FDescent);
444 end;
445
446 constructor TASTUITextLayout.Create;
447 begin
448 // create text layout
449 ATSUCreateTextLayout(FLayout);
450 SetText(#0, 1);
451 ATSUSetTextLayoutRefCon(FLayout, URefCon(Self));
452
453 ATSUCreateStyle(FStyle);
454
455 // allow font substitution for exotic glyphs
456 ATSUSetTransientFontMatching(FLayout, True);
457 end;
458
459 destructor TASTUITextLayout.Destroy;
460 begin
461 ATSUDisposeTextLayout(FLayout);
462 ATSUDisposeStyle(FStyle);
463 inherited Destroy;
464 end;
465
466 const
467 DefaultFont = 'Lucida Grande';
468 DefaultSize = 13;
469
FindATSUFontIDnull470 function FindATSUFontID(const FontName: String): ATSUFontID;
471 var
472 fn : String;
473 begin
474 Result := 0;
475 if IsFontNameDefault(FontName) then fn:=DefaultFont else fn:=FontName;
476 if (fn <> '') then
477 ATSUFindFontFromName(@fn[1], Length(fn),
478 kFontFullName, kFontMacintoshPlatform, kFontRomanScript,
479 kFontEnglishLanguage, Result);
480 end;
481
482 procedure TASTUITextLayout.SetFont(AFont:TCocoaFont);
483 var
484 Attr: ATSUAttributeTag;
485 M: ATSUTextMeasurement;
486 O: ATSStyleRenderingOptions;
487 B: Boolean;
488 S: ByteCount;
489 A: ATSUAttributeValuePtr;
490 ID: ATSUFontID;
491 const
492 ATSStyleRenderingOption: array [Boolean] of ATSStyleRenderingOptions =
493 (kATSStyleNoAntiAliasing, kATSStyleApplyAntiAliasing);
494 begin
495 if not Assigned(AFont) then Exit;
496
497 ID := FindATSUFontID(AFont.Name);
498
499 if ID <> 0 then
500 begin
501 Attr := kATSUFontTag;
502 A := @ID;
503 S := SizeOf(ID);
504 ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
505 end;
506
507 Attr := kATSUSizeTag;
508 M := IntToFix(Abs(AFont.Size));
509 A := @M;
510 S := SizeOf(M);
511 ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
512
513 S := SizeOf(B);
514 Attr := kATSUQDBoldfaceTag;
515 B := cfs_Bold in AFont.Style;
516 A := @B;
517 ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
518
519 Attr := kATSUQDItalicTag;
520 B := cfs_Italic in AFont.Style;
521 A := @B;
522 ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
523
524 Attr := kATSUQDUnderlineTag;
525 B := cfs_Underline in AFont.Style;
526 A := @B;
527 ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
528
529 Attr := kATSUStyleStrikeThroughTag;
530 B := cfs_Strikeout in AFont.Style;
531 A := @B;
532 ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
533
534 Attr := kATSUStyleRenderingOptionsTag;
535 O := ATSStyleRenderingOption[AFont.Antialiased];
536 A := @O;
537 S := SizeOf(O);
538 ATSUSetAttributes(FStyle, 1, @Attr, @S, @A);
539
540 FValidSize:=False;
541 end;
542
543 procedure TASTUITextLayout.SetText(UTF8Text: PChar; ByteSize: Integer);
544 begin
545 if (ByteSize=length(fUTF8)) and (fUTF8<>'') and
546 (CompareChar(UTF8Text^, fUTF8[1], ByteSize)=0) then Exit; // same buffer, nothing to change!
547
548 SetLength(fUTF8, ByteSize);
549 if ByteSize>0 then
550 System.Move(UTF8Text^, fUTF8[1], ByteSize)
551 else
552 fUTF8:='';
553
554 fBuffer:=UTF8Decode(fUTF8);
555 if fBuffer='' then fBuffer:=#0;
556 ATSUSetTextPointerLocation(FLayout, @fBuffer[1], 0, length(fBuffer), length(fBuffer));
557 ATSUSetRunStyle(FLayout, FStyle, kATSUFromTextBeginning, kATSUToTextEnd);
558
559 FValidSize:=False;
560 end;
561
GetSizenull562 function TASTUITextLayout.GetSize:TSize;
563 begin
564 if not FValidSize then RecountSize;
565 Result.cx := FixToInt(FTextAfter - FTextBefore);
566 Result.cy := FixToInt(FDescent + FAscent);
567 end;
568
569 var
570 ATSUDirectUPP : ATSUDirectLayoutOperationOverrideUPP = nil; //NewATSUDirectLayoutOperationOverrideUPP(@ATSUCallback)
571
ATSUCallbacknull572 function ATSUCallback(iCurrentOperation: ATSULayoutOperationSelector; iLineRef: ATSULineRef; iRefCon: URefCon; iOperationCallbackParameterPtr: UnivPtr;
573 var oCallbackStatus: ATSULayoutOperationCallbackStatus ): OSStatus; {$ifdef DARWIN}mwpascal;{$endif}
574 var
575 Buffer : TASTUITextLayout;
576 Handled : Boolean;
577 begin
578 Result := noErr;
579 Buffer := TASTUITextLayout(iRefCon);
580 oCallbackStatus:=kATSULayoutOperationCallbackStatusHandled;
581
582 if Assigned(Buffer) then
583 Buffer.DoJustify(iLineRef, Handled);
584 end;
585
586 procedure TASTUITextLayout.DoJustify(iLineRef: ATSULineRef; var Handled: Boolean);
587 type
588 ATSLayoutRecord1 = packed record
589 glyphID: ATSGlyphRef;
590 flags: ATSGlyphInfoFlags;
591 originalOffset: ByteCount;
592 realPos: Fixed;
593 end;
594
595 type
596 TATSLayoutRecordArray = array [Word] of ATSLayoutRecord1;
597 PATSLayoutRecordArray = ^TATSLayoutRecordArray;
598 var
599 i, ofs : Integer;
600 Layouts : PATSLayoutRecordArray;
601 LayCount : ItemCount;
602 begin
603 if not Assigned(FDX) then Exit;
604 Laycount:=0;
605 ATSUDirectGetLayoutDataArrayPtrFromLineRef( iLineRef,
606 kATSUDirectDataLayoutRecordATSLayoutRecordVersion1, true, @Layouts, Laycount);
607 if Assigned(Layouts) and (Laycount>0) then
608 begin
609 ofs:=0;
610 for i:=0 to LayCount-1 do
611 begin
612 Layouts^[i].realPos:=Long2Fix(ofs);
613 inc(ofs, FDX^[i]);
614 end;
615 end;
616 ATSUDirectReleaseLayoutDataArrayPtr(iLineRef, kATSUDirectDataLayoutRecordATSLayoutRecordCurrent, @Layouts );
617 Handled:=True;
618 end;
619
620
621 procedure TASTUITextLayout.Draw(cg:CGContextRef;X,Y:Integer;DX:PInteger);
622 var
623 MX, MY : Integer;
624
625 Tag : ATSUAttributeTag;
626 Size : ByteCount;
627 Value : ATSUAttributeValuePtr;
628 OverSpec : ATSULayoutOperationOverrideSpecifier;
629 begin
630 if not Assigned(cg) then Exit;
631 if not FValidSize then RecountSize;
632
633 MX:=0;
634 MY:=0;
635 Tag := kATSUCGContextTag;
636 Size := sizeOf(CGContextRef);
637 Value := @cg;
638 ATSUSetLayoutControls(FLayout, 1, @Tag, @Size, @Value);
639
640 Tag := kATSULayoutOperationOverrideTag;
641 Size := sizeof (ATSULayoutOperationOverrideSpecifier);
642 Value := @OverSpec;
643 FillChar(OverSpec, sizeof(OverSpec), 0);
644 if Assigned(Dx) then begin
645 FDX := PIntegerArray(Dx);
646 OverSpec.operationSelector := kATSULayoutOperationPostLayoutAdjustment;
647 if not Assigned(ATSUDirectUPP) then ATSUDirectUPP:=NewATSUDirectLayoutOperationOverrideUPP(@ATSUCallback);
648 OverSpec.overrideUPP := ATSUDirectUPP;
649 end else
650 FDX:=nil;
651 ATSUSetLayoutControls (FLayout, 1, @Tag, @Size, @Value);
652
653 ATSUDrawText(FLayout, kATSUFromTextBeginning, kATSUToTextEnd,
654 IntToFix(X)- FTextBefore + MX, IntToFix(Y) - FAscent + MY);
655 end;
656
657 { TCocoaContext }
658
TCocoaContext.CGContextnull659 function TCocoaContext.CGContext:CGContextRef;
660 begin
661 if ctx = nil then Result := cgctx
662 else Result:=CGContextRef(ctx.graphicsPort);
663 end;
664
665 procedure TCocoaContext.SetBitmap(const AValue: TCocoaBitmap);
666 begin
667 fBitmap:=AValue;
668 end;
669
670 procedure TCocoaContext.SetBrush(const AValue: TCocoaBrush);
671 begin
672 fBrush:=AValue;
673 if Assigned(fBrush) then fBrush.Apply(CGContext);
674 end;
675
676 procedure TCocoaContext.SetFont(const AValue: TCocoaFont);
677 begin
678 fFont:=AValue;
679 end;
680
681 procedure TCocoaContext.SetPen(const AValue: TCocoaPen);
682 begin
683 fPen:=AValue;
684 if Assigned(fPen) then fPen.Apply(CGContext);
685 end;
686
687 procedure TCocoaContext.SetRegion(const AValue: TCocoaRegion);
688 begin
689 fRegion:=AValue;
690 end;
691
692 constructor TCocoaContext.Create;
693 begin
694 FFont := TCocoaFont.CreateDefault;
695 FFont.AddRef;
696 FText := TASTUITextLayout.Create;
697 end;
698
699 destructor TCocoaContext.Destroy;
700 begin
701 inherited Destroy;
702 end;
703
InitDrawnull704 function TCocoaContext.InitDraw(width,height:Integer): Boolean;
705 var
706 cg : CGContextRef;
707 begin
708 cg:=CGContext;
709 Result:=Assigned(cg);
710 if not Result then Exit;
711
712 ContextSize.cx:=width;
713 ContextSize.cy:=height;
714
715 CGContextTranslateCTM(cg, 0, height);
716 CGContextScaleCTM(cg, 1, -1);
717 PenPos.x:=0;
718 PenPos.y:=0;
719 end;
720
721 procedure TCocoaContext.MoveTo(x,y:Integer);
722 begin
723 PenPos.x:=x;
724 PenPos.y:=y;
725 end;
726
727 procedure TCocoaContext.LineTo(x,y:Integer);
728 var
729 cg : CGContextRef;
730 p : array [0..1] of CGPoint;
731 deltaX, deltaY, absDeltaX, absDeltaY: Integer;
732 clipDeltaX, clipDeltaY: Float32;
733 tx,ty:Float32;
734 begin
735 cg:=CGContext;
736 if not Assigned(cg) then Exit;
737
738 deltaX := X - PenPos.x;
739 deltaY := Y - PenPos.y;
740 if (deltaX=0) and (deltaY=0) then Exit;
741
742 absDeltaX := Abs(deltaX);
743 absDeltaY := Abs(deltaY);
744 if (absDeltaX<=1) and (absDeltaY<=1) then
745 begin
746 // special case for 1-pixel lines
747 tx := PenPos.x + 0.55;
748 ty := PenPos.y + 0.55;
749 end
750 else
751 begin
752 // exclude the last pixel from the line
753 if absDeltaX > absDeltaY then
754 begin
755 if deltaX > 0 then clipDeltaX := -1.0 else clipDeltaX := 1.0;
756 clipDeltaY := clipDeltaX * deltaY / deltaX;
757 end
758 else
759 begin
760 if deltaY > 0 then clipDeltaY := -1.0 else clipDeltaY := 1.0;
761 clipDeltaX := clipDeltaY * deltaX / deltaY;
762 end;
763 tx := X + clipDeltaX + 0.5;
764 ty := Y + clipDeltaY + 0.5;
765 end;
766
767 p[0].x:=PenPos.X+0.5;
768 p[0].y:=PenPos.Y+0.5;
769 p[1].x:=tx;
770 p[1].y:=ty;
771
772 CGContextBeginPath(cg);
773 CGContextAddLines(cg, @p, 2);
774 CGContextStrokePath(cg);
775
776 PenPos.x := X;
777 PenPos.y := Y;
778 end;
779
780 procedure CGContextAddLCLPoints(cg: CGContextRef; const Points: array of TPoint;NumPts:Integer);
781 var
782 cp : array of CGPoint;
783 i : Integer;
784 begin
785 SetLength(cp, NumPts);
786 for i:=0 to NumPts-1 do begin
787 cp[i].x:=Points[i].X+0.5;
788 cp[i].y:=Points[i].Y+0.5;
789 end;
790 CGContextAddLines(cg, @cp[0], NumPts);
791 end;
792
793 procedure CGContextAddLCLRect(cg: CGContextRef; x1, y1, x2, y2: Integer); overload;
794 var
795 r : CGRect;
796 begin
797 r.origin.x:=x1+0.5;
798 r.origin.y:=y1+0.5;
799 r.size.width:=x2-x1-1;
800 r.size.height:=y2-y1-1;
801 CGContextAddRect(cg, r);
802 end;
803
804 procedure CGContextAddLCLRect(cg: CGContextRef; const R: TRect); overload;
805 begin
806 CGContextAddLCLRect(cg, r.Left, r.Top, r.Right, r.Bottom);
807 end;
808
809 procedure TCocoaContext.Polygon(const Points:array of TPoint;NumPts:Integer;
810 Winding:boolean);
811 var
812 cg : CGContextRef;
813 begin
814 cg:=CGContext;
815 if not Assigned(cg) or (NumPts<=0) then Exit;
816
817 CGContextBeginPath(cg);
818 CGContextAddLCLPoints(cg, Points, NumPts);
819 CGContextClosePath(cg);
820
821 if Winding then
822 CGContextDrawPath(cg, kCGPathFillStroke)
823 else
824 CGContextDrawPath(cg, kCGPathEOFillStroke);
825 end;
826
827 procedure TCocoaContext.Polyline(const Points: array of TPoint; NumPts: Integer);
828 var
829 cg : CGContextRef;
830 begin
831 cg:=CGContext;
832 if not Assigned(cg) or (NumPts<=0) then Exit;
833
834 CGContextBeginPath(cg);
835 CGContextAddLCLPoints(cg, Points, NumPts);
836 CGContextStrokePath(cg);
837 end;
838
839 procedure TCocoaContext.Rectangle(X1,Y1,X2,Y2:Integer;FillRect:Boolean; UseBrush: TCocoaBrush);
840 var
841 cg : CGContextRef;
842 begin
843 cg:=CGContext;
844 if not Assigned(cg) then Exit;
845
846 CGContextBeginPath(cg);
847 CGContextAddLCLRect(cg, X1,Y1,X2,Y2);
848 if FillRect then begin
849 //using the brush
850 if Assigned(UseBrush) then UseBrush.Apply(cg);
851 CGContextFillPath(cg);
852 //restore the brush
853 if Assigned(UseBrush) and Assigned(fBrush) then fBrush.Apply(cg);
854 end else
855 CGContextStrokePath(cg);
856 end;
857
858 procedure TCocoaContext.Ellipse(X1,Y1,X2,Y2:Integer);
859 var
860 cg : CGContextRef;
861 r : CGRect;
862 begin
863 cg:=CGContext;
864 if not Assigned(cg) then Exit;
865 r.origin.x:=x1+0.5;
866 r.origin.y:=y1+0.5;
867 r.size.width:=x2-x1-1;
868 r.size.height:=y2-y1-1;
869 CGContextBeginPath(CGContext);
870 CGContextAddEllipseInRect(CGContext, R);
871 CGContextDrawPath(CGContext, kCGPathFillStroke);
872 end;
873
874 // for BackgroundAlpha 1 = opaque 0 = transparent
875 procedure TCocoaContext.TextOut(X,Y:Integer;UTF8Chars:PChar;Count:Integer;
876 CharsDelta:PInteger; BackgroundAlpha: Single);
877 var
878 cg: CGContextRef;
879 ns: NSString;
880 dic: NSDictionary;
881 begin
882 { // Text rendering with Cocoa only
883 ns:=NSStringUtf8(UTF8Chars);
884 // dic := NSDictionary.dictionary();
885 ns.drawAtPoint_withAttributes(GetNSPoint(10, 10), nil);
886 // dic.release;
887 ns.release;}
888
889 // Text rendering with Carbon mixed (but it doesn't seam to work because cg returns nil)
890 cg:=CGContext;
891 if not Assigned(cg) then Exit;
892
893 CGContextScaleCTM(cg, 1, -1);
894 CGContextTranslateCTM(cg, 0, -ContextSize.cy);
895
896 CGContextSetRGBFillColor(cg, TR, TG, TB, BackgroundAlpha);
897 fText.SetText(UTF8Chars, Count);
898 fText.Draw(cg, X, ContextSize.cy-Y, CharsDelta);
899
900 if Assigned(fBrush) then fBrush.Apply(cg);
901
902 CGContextTranslateCTM(cg, 0, ContextSize.cy);
903 CGContextScaleCTM(cg, 1, -1);
904 end;
905
906 {------------------------------------------------------------------------------
907 Method: GetTextExtentPoint
908 Params: Str - Text string
909 Count - Number of characters in string
910 Size - The record for the dimensions of the string
911 Returns: If the function succeeds
912
913 Computes the width and height of the specified string of text
914 ------------------------------------------------------------------------------}
GetTextExtentPointnull915 function TCocoaContext.GetTextExtentPoint(AStr: PChar; ACount: Integer;
916 var Size: TSize): Boolean;
917 var
918 LStr: String;
919 begin
920 Result := False;
921 Size.cx := 0;
922 Size.cy := 0;
923
924 if ACount = 0 then Exit(True);
925
926 if ACount < 0 then LStr := AStr
927 else LStr := Copy(AStr, 1, ACount);
928
929 fText.SetText(PChar(LStr), Length(LStr));
930 Size := fText.getSize();
931
932 Result := True;
933 end;
934
935 {------------------------------------------------------------------------------
936 Method: TCocoaContext.GetTextMetrics
937 Params: TM - The Record for the text metrics
938 Returns: If the function succeeds
939
940 Fills the specified buffer with the metrics for the currently selected font
941 ------------------------------------------------------------------------------}
GetTextMetricsnull942 function TCocoaContext.GetTextMetrics(var TM: TTextMetric): Boolean;
943 {var
944 TextStyle: ATSUStyle;
945 M: ATSUTextMeasurement;
946 B: Boolean;
947 TextLayout: TCarbonTextLayout;
948 const
949 SName = 'GetTextMetrics';
950 SGetAttrName = 'ATSUGetAttribute';}
951 begin
952 Result := False;
953
954 // TextStyle := CurrentFont.Style;
955
956 FillChar(TM, SizeOf(TM), 0);
957
958 { // According to the MSDN library, TEXTMETRIC:
959 // the average char width is generally defined as the width of the letter x
960 if not BeginTextRender('x', 1, TextLayout) then Exit;
961 try}
962
963 TM.tmAscent := 5;//RoundFixed(TextLayout.Ascent);
964 TM.tmDescent := 5;//RoundFixed(TextLayout.Descent);
965 TM.tmHeight := 15;//RoundFixed(TextLayout.Ascent + TextLayout.Descent);
966
967 // if OSError(ATSUGetAttribute(TextStyle, kATSULeadingTag, SizeOf(M), @M, nil),
968 // Self, SName, SGetAttrName, 'kATSULeadingTag', kATSUNotSetErr) then Exit;
969 // TM.tmInternalLeading := RoundFixed(M);
970 TM.tmExternalLeading := 0;
971
972 TM.tmAveCharWidth := 15;//RoundFixed(TextLayout.TextAfter - TextLayout.TextBefore);
973 // finally
974 // EndTextRender(TextLayout);
975 // end;
976
977 TM.tmMaxCharWidth := 15;//TM.tmAscent; // TODO: don't know how to determine this right
978 TM.tmOverhang := 0;
979 TM.tmDigitizedAspectX := 0;
980 TM.tmDigitizedAspectY := 0;
981 TM.tmFirstChar := 'a';
982 TM.tmLastChar := 'z';
983 TM.tmDefaultChar := 'x';
984 TM.tmBreakChar := '?';
985
986 // if OSError(ATSUGetAttribute(TextStyle, kATSUQDBoldfaceTag, SizeOf(B), @B, nil),
987 // Self, SName, SGetAttrName, 'kATSUQDBoldfaceTag', kATSUNotSetErr) then Exit;
988 { if B then} TM.tmWeight := FW_NORMAL;
989 // else TM.tmWeight := FW_BOLD;
990
991 { if OSError(ATSUGetAttribute(TextStyle, kATSUQDItalicTag, SizeOf(B), @B, nil),
992 Self, SName, SGetAttrName, 'kATSUQDItalicTag', kATSUNotSetErr) then Exit;
993 TM.tmItalic := Byte(B);}
994
995 { if OSError(ATSUGetAttribute(TextStyle, kATSUQDUnderlineTag, SizeOf(B), @B, nil),
996 Self, SName, SGetAttrName, 'kATSUQDUnderlineTag', kATSUNotSetErr) then Exit;
997 TM.tmUnderlined := Byte(B);
998
999 if OSError(ATSUGetAttribute(TextStyle, kATSUStyleStrikeThroughTag, SizeOf(B), @B, nil),
1000 Self, SName, SGetAttrName, 'kATSUStyleStrikeThroughTag', kATSUNotSetErr) then Exit;
1001 TM.tmStruckOut := Byte(B);}
1002
1003 // TODO: get these from font
1004 TM.tmPitchAndFamily := FIXED_PITCH or TRUETYPE_FONTTYPE;
1005 TM.tmCharSet := DEFAULT_CHARSET;
1006
1007 Result := True;
1008 end;
1009
1010 procedure TCocoaContext.DrawBitmap(X,Y:Integer; ABitmap: TCocoaBitmap);
1011 begin
1012 NSGraphicsContext.saveGraphicsState();
1013 NSGraphicsContext.setCurrentContext(ctx);
1014 ABitmap.imagerep.drawAtPoint(NSMakePoint(X, Y));
1015 NSGraphicsContext.restoreGraphicsState();
1016 end;
1017
1018 procedure TCocoaContext.SetOrigin(X,Y:Integer);
1019 var
1020 cg : CGContextRef;
1021 begin
1022 cg:=CGContext;
1023 if not Assigned(cg) then Exit;
1024 if Assigned(cg) then CGContextTranslateCTM(cg, X, Y);
1025 end;
1026
1027 procedure TCocoaContext.GetOrigin(var X,Y: Integer);
1028 var
1029 cg : CGContextRef;
1030 t : CGAffineTransform;
1031 begin
1032 cg:=CGContext;
1033 if not Assigned(cg) then Exit;
1034 t:=CGContextGetCTM(cg);
1035 X := Round(t.tx);
1036 Y := ContextSize.cy - Round(t.ty);
1037 end;
1038
1039
1040 { TCocoaRegion }
1041
1042 {------------------------------------------------------------------------------
1043 Method: TCocoaRegion.Create
1044
1045 Creates a new empty Cocoa region
1046 ------------------------------------------------------------------------------}
1047 constructor TCocoaRegion.Create;
1048 begin
1049 inherited Create;
1050
1051 FShape := HIShapeCreateEmpty;
1052 end;
1053
1054 {------------------------------------------------------------------------------
1055 Method: TCocoaRegion.Create
1056 Params: X1, Y1, X2, Y2 - Region bounding rectangle
1057
1058 Creates a new rectangular Cocoa region
1059 ------------------------------------------------------------------------------}
1060 constructor TCocoaRegion.Create(const X1, Y1, X2, Y2: Integer);
1061 begin
1062 inherited Create;
1063 FShape := HIShapeCreateWithRect(GetCGRect(X1, Y1, X2, Y2));
1064 end;
1065
1066 {------------------------------------------------------------------------------
1067 Method: TCocoaRegion.Create
1068 Params: Points - Pointer to array of polygon points
1069 NumPts - Number of points passed
1070 FillMode - Filling mode
1071
1072 Creates a new polygonal Cocoa region from the specified points
1073 ------------------------------------------------------------------------------}
1074 constructor TCocoaRegion.Create(Points: PPoint; NumPts: Integer; isAlter: Boolean);
1075 var
1076 Bounds: TRect;
1077 Context: CGContextRef;
1078 W, H: Integer;
1079 Data: Pointer;
1080 PData: PByte;
1081 P: PPoint;
1082 I: Integer;
1083 X, Y, SX: Integer;
1084 LC, C: Byte;
1085 //Line: String;
1086
GetPolygonBoundsnull1087 function GetPolygonBounds: TRect;
1088 var
1089 I: Integer;
1090 begin
1091 P := Points;
1092 Result := Classes.Rect(P^.X, P^.Y, P^.X, P^.Y);
1093 for I := 1 to NumPts - 1 do
1094 begin
1095 Inc(P);
1096 if P^.X < Result.Left then Result.Left := P^.X;
1097 if P^.X > Result.Right then Result.Right := P^.X;
1098 if P^.Y < Result.Top then Result.Top := P^.Y;
1099 if P^.Y > Result.Bottom then Result.Bottom := P^.Y;
1100 end;
1101 end;
1102
1103 procedure AddPart(X1, X2, Y: Integer);
1104 var
1105 R: HIShapeRef;
1106 begin
1107 //DebugLn('AddPart:' + DbgS(X1) + ' - ' + DbgS(X2) + ', ' + DbgS(Y));
1108
1109 R := HIShapeCreateWithRect(GetCGRect(X1, Y, X2, Y + 1));
1110 HIShapeUnion(FShape, R, FShape);
1111 CFRelease(R);
1112 end;
1113
1114 begin
1115 inherited Create;
1116
1117 (*
1118 The passed polygon is drawed into grayscale context, the region is constructed
1119 per rows from rectangles of drawed polygon parts.
1120 *)
1121
1122 FShape := HIShapeCreateMutable;
1123
1124 if (NumPts <= 2) or (Points = nil) then Exit;
1125 Bounds := GetPolygonBounds;
1126 W := Bounds.Right - Bounds.Left + 2;
1127 H := Bounds.Bottom - Bounds.Top + 2;
1128
1129 if (W <= 0) or (H <= 0) then Exit;
1130
1131 System.GetMem(Data, W * H);
1132 System.FillChar(Data^, W * H, 0); // clear bitmap context data to black
1133 try
1134 Context := CGBitmapContextCreate(Data, W, H, 8, W, CGColorSpaceCreateDeviceGray,
1135 kCGImageAlphaNone);
1136 try
1137 CGContextSetShouldAntialias(Context, 0); // disable anti-aliasing
1138 CGContextSetGrayFillColor(Context, 1.0, 1.0); // draw white polygon
1139
1140 P := Points;
1141 CGContextBeginPath(Context);
1142 CGContextMoveToPoint(Context, P^.X, P^.Y);
1143
1144 for I := 1 to NumPts - 1 do
1145 begin
1146 Inc(P);
1147 CGContextAddLineToPoint(Context, P^.X, P^.Y);
1148 end;
1149
1150 CGContextClosePath(Context);
1151
1152 if isAlter then
1153 CGContextEOFillPath(Context)
1154 else
1155 CGContextFillPath(Context);
1156
1157 //SetLength(Line, W);
1158
1159 PData := Data;
1160 for Y := 0 to Pred(H) do
1161 begin
1162 LC := 0; // edge is black
1163 for X := 0 to Pred(W) do
1164 begin
1165 C := PData^;
1166 //Line[X + 1] := Chr(Ord('0') + C div 255);
1167
1168 if (C = $FF) and (LC = 0) then
1169 SX := X; // start of painted row part
1170 if (C = 0) and (LC = $FF) then
1171 // end of painted row part (SX, X)
1172 AddPart(SX, X, Pred(H) - Y);
1173
1174 LC := C;
1175 Inc(PData);
1176 end;
1177 //DebugLn(DbgS(Pred(H) - Y) + ':' + Line);
1178 end;
1179
1180 finally
1181 CGContextRelease(Context);
1182 end;
1183 finally
1184 System.FreeMem(Data);
1185 end;
1186 end;
1187
1188 {------------------------------------------------------------------------------
1189 Method: TCocoaRegion.Destroy
1190
1191 Destroys Cocoa region
1192 ------------------------------------------------------------------------------}
1193 destructor TCocoaRegion.Destroy;
1194 begin
1195 CFRelease(FShape);
1196
1197 inherited Destroy;
1198 end;
1199
1200 {------------------------------------------------------------------------------
1201 Method: TCocoaRegion.Apply
1202 Params: ADC - Context to apply to
1203
1204 Applies region to the specified context
1205 Note: Clipping region is only reducing
1206 ------------------------------------------------------------------------------}
1207 procedure TCocoaRegion.Apply(cg: CGContextRef);
1208 begin
1209 if not Assigned(cg) then Exit;
1210 if HIShapeIsEmpty(FShape) or (HIShapeReplacePathInCGContext(FShape, cg)<>noErr) then
1211 Exit;
1212 CGContextClip(cg);
1213 end;
1214
1215 {------------------------------------------------------------------------------
1216 Method: TCocoaRegion.GetBounds
1217 Returns: The bounding box of Cocoa region
1218 ------------------------------------------------------------------------------}
TCocoaRegion.GetBoundsnull1219 function TCocoaRegion.GetBounds: TRect;
1220 var
1221 R: HIRect;
1222 begin
1223 if HIShapeGetBounds(FShape, R) = nil then begin
1224 System.FillChar(Result, sizeof(Result), 0);
1225 Exit;
1226 end;
1227
1228 Result := CGRectToRect(R);
1229 end;
1230
1231 {------------------------------------------------------------------------------
1232 Method: TCocoaRegion.GetType
1233 Returns: The type of Cocoa region
1234 ------------------------------------------------------------------------------}
TCocoaRegion.GetTypenull1235 function TCocoaRegion.GetType: TCocoaRegionType;
1236 begin
1237 if not Assigned(FShape) or HIShapeIsEmpty(FShape) then
1238 Result := crt_Empty
1239 else if HIShapeIsRectangular(FShape) then
1240 Result := crt_Rectangle
1241 else
1242 Result := crt_Complex;
1243 end;
1244
1245 {------------------------------------------------------------------------------
1246 Method: TCocoaRegion.ContainsPoint
1247 Params: P - Point
1248 Returns: If the specified point lies in Cocoa region
1249 ------------------------------------------------------------------------------}
TCocoaRegion.ContainsPointnull1250 function TCocoaRegion.ContainsPoint(const P: TPoint): Boolean;
1251 var
1252 cp : CGPoint;
1253 begin
1254 cp.x:=P.x+0.5;
1255 cp.y:=P.y+0.5;
1256 Result := HIShapeContainsPoint(FShape, cp);
1257 end;
1258
1259 procedure TCocoaRegion.SetShape(AShape: HIShapeRef);
1260 begin
1261 if Assigned(FShape) then CFRelease(FShape);
1262 FShape := AShape;
1263 end;
1264
CombineWithnull1265 function TCocoaRegion.CombineWith(ARegion: TCocoaRegion; CombineMode: TCocoaCombine): Boolean;
1266 var
1267 sh1, sh2: HIShapeRef;
1268 const
1269 MinCoord=-35000;
1270 MaxSize=65000;
1271 begin
1272 Result:=Assigned(ARegion);
1273 if not Assigned(ARegion) then Exit;
1274
1275 if (CombineMode in [cc_AND, cc_OR, cc_XOR]) and HIShapeIsEmpty(FShape) then
1276 CombineMode := cc_COPY;
1277
1278 case CombineMode of
1279 cc_AND: Shape:=HIShapeCreateIntersection(FShape, ARegion.Shape);
1280 cc_XOR:
1281 begin
1282 sh1 := HIShapeCreateUnion(FShape, ARegion.Shape);
1283 sh2 := HIShapeCreateIntersection(FShape, ARegion.Shape);
1284 Shape := HIShapeCreateDifference(sh1, sh2);
1285 CFRelease(sh1); CFRelease(sh2);
1286 end;
1287 cc_OR: Shape:=HIShapeCreateUnion(FShape, ARegion.Shape);
1288 cc_DIFF:
1289 begin
1290 if HIShapeIsEmpty(FShape) then
1291 {HIShapeCreateDifference doesn't work properly if original shape is empty}
1292 {to simulate "emptieness" very big shape is created }
1293 Shape:=HIShapeCreateWithRect(GetCGRect(MinCoord,MinCoord,MaxSize,MaxSize)); // create clip nothing.
1294
1295 Shape:=HIShapeCreateDifference(FShape, ARegion.Shape);
1296 end;
1297 cc_COPY: Shape:=HIShapeCreateCopy(ARegion.Shape);
1298 else
1299 Result := false;
1300 end;
1301 end;
1302
1303 { TCocoaPen }
1304
1305 procedure TCocoaPen.Apply(cg:CGContextRef);
1306 begin
1307 if not Assigned(cg) then Exit;
1308 CGContextSetRGBStrokeColor(cg, r, g, b, 1);
1309 CGContextSetLineWidth(cg, Width);
1310 //todo: style
1311 end;
1312
1313 constructor TCocoaPen.Create;
1314 begin
1315 inherited Create;
1316 Width:=1;
1317 end;
1318
1319 { TCocoaBrush }
1320
1321 procedure TCocoaBrush.Apply(cg:CGContextRef);
1322 begin
1323 if cg = nil then Exit;
1324 CGContextSetRGBFillColor(cg, R,G,B, 1);
1325 end;
1326
1327 { TCocoaGDIObject }
1328
1329 procedure TCocoaGDIObject.AddRef;
1330 begin
1331 if RefCount>=0 then inc(RefCount);
1332 end;
1333
1334 procedure TCocoaGDIObject.Release;
1335 begin
1336 if RefCount>0 then Dec(RefCount)
1337 else if RefCount=0 then Free;
1338 end;
1339
1340 end.
1341