← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/interfaces/cocoa/cocoagdiobjects.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/interfaces/cocoa/cocoagdiobjects.pas
9
9
 
10
10
uses
11
11
  MacOSAll, // for CGContextRef
 
12
  LCLtype, LCLProc, Graphics, Controls,
12
13
  CocoaAll, CocoaUtils,
13
 
  Classes, Types;
14
 
 
15
 
type
 
14
  SysUtils, Classes, Contnrs, Types, Math;
 
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
  TCocoaBitmap = class;
 
40
  TCocoaContext = class;
 
41
 
16
42
  { TCocoaGDIObject }
17
43
 
18
44
  TCocoaGDIObject = class(TObject)
 
45
  strict private
 
46
    FRefCount: Integer;
 
47
    FGlobal: Boolean;
19
48
  public
20
 
    RefCount: Integer;
 
49
    constructor Create(AGlobal: Boolean); virtual;
 
50
 
21
51
    procedure AddRef;
22
52
    procedure Release;
 
53
    property Global: Boolean read FGlobal write FGlobal;
 
54
    property RefCount: Integer read FRefCount;
23
55
  end;
24
56
 
25
 
  TCocoaRegionType = (crt_Empty, crt_Rectangle, crt_Complex);
26
 
  TCocoaCombine = (cc_And, cc_Xor, cc_Or, cc_Diff, cc_Copy);
 
57
  TCocoaRegionType = (
 
58
    crt_Error,
 
59
    crt_Empty,
 
60
    crt_Rectangle,
 
61
    crt_Complex);
 
62
 
 
63
  TCocoaCombine = (
 
64
    cc_And,
 
65
    cc_Xor,
 
66
    cc_Or,
 
67
    cc_Diff,
 
68
    cc_Copy);
27
69
 
28
70
  { TCocoaRegion }
29
71
 
30
72
  //todo: Remove HIShape usage. HIShape is legacy
31
73
  TCocoaRegion = class(TCocoaGDIObject)
32
 
  private
 
74
  strict private
33
75
    FShape: HIShapeRef;
34
76
  public
35
 
    constructor Create;
 
77
    constructor CreateDefault;
36
78
    constructor Create(const X1, Y1, X2, Y2: Integer);
37
79
    constructor Create(Points: PPoint; NumPts: Integer; isAlter: Boolean);
38
80
    destructor Destroy; override;
39
81
 
40
 
    procedure Apply(cg: CGContextRef);
 
82
    procedure Apply(ADC: TCocoaContext);
41
83
    function GetBounds: TRect;
42
84
    function GetType: TCocoaRegionType;
43
85
    function ContainsPoint(const P: TPoint): Boolean;
44
86
    procedure SetShape(AShape: HIShapeRef);
 
87
    procedure Clear;
45
88
    function CombineWith(ARegion: TCocoaRegion; CombineMode: TCocoaCombine): Boolean;
46
89
  public
47
90
    property Shape: HIShapeRef read FShape write SetShape;
48
91
  end;
49
92
 
 
93
  { TCocoaColorObject }
 
94
 
 
95
  TCocoaColorObject = class(TCocoaGDIObject)
 
96
  strict private
 
97
    FR, FG, FB: Byte;
 
98
    FA: Boolean; // alpha: True - solid, False - clear
 
99
    function GetColorRef: TColorRef;
 
100
  public
 
101
    constructor Create(const AColor: TColor; ASolid, AGlobal: Boolean); reintroduce;
 
102
    procedure SetColor(const AColor: TColor; ASolid: Boolean);
 
103
    procedure GetRGBA(AROP2: Integer; out AR, AG, AB, AA: Single);
 
104
    function CreateNSColor: NSColor;
 
105
 
 
106
    property Red: Byte read FR write FR;
 
107
    property Green: Byte read FG write FG;
 
108
    property Blue: Byte read FB write FB;
 
109
    property Solid: Boolean read FA write FA;
 
110
    property ColorRef: TColorRef read GetColorRef;
 
111
  end;
 
112
 
50
113
  { TCocoaBrush }
51
114
 
52
 
  TCocoaBrush = class(TCocoaGDIObject)
53
 
    R,G,B : Single;
54
 
    procedure Apply(cg: CGContextRef);
 
115
  TCocoaBrush = class(TCocoaColorObject)
 
116
  strict private
 
117
    FCGPattern: CGPatternRef;
 
118
    FColored: Boolean;
 
119
    FBitmap: TCocoaBitmap;
 
120
    FColor: NSColor;
 
121
  private
 
122
    FImage: CGImageRef;
 
123
  strict protected
 
124
    procedure Clear;
 
125
 
 
126
    procedure SetHatchStyle(AHatch: PtrInt);
 
127
    procedure SetBitmap(ABitmap: TCocoaBitmap);
 
128
    procedure SetImage(AImage: NSImage);
 
129
    procedure SetColor(AColor: NSColor); overload;
 
130
  public
 
131
    constructor CreateDefault(const AGlobal: Boolean = False);
 
132
    constructor Create(const ALogBrush: TLogBrush; const AGlobal: Boolean = False);
 
133
    constructor Create(const AColor: NSColor; const AGlobal: Boolean = False);
 
134
    destructor Destroy; override;
 
135
    procedure Apply(ADC: TCocoaContext; UseROP2: Boolean = True);
 
136
 
 
137
    // for brushes created by NCColor
 
138
    property Color: NSColor read FColor write SetColor;
55
139
  end;
56
140
 
 
141
const
 
142
  // use the same pen shapes that are used for carbon
 
143
  CocoaDashStyle: Array [0..1] of Single = (3, 1);
 
144
  CocoaDotStyle: Array [0..1] of Single = (1, 1);
 
145
  CocoaDashDotStyle: Array [0..3] of Single = (3, 1, 1, 1);
 
146
  CocoaDashDotDotStyle: Array [0..5] of Single = (3, 1, 1, 1, 1, 1);
 
147
 
 
148
type
 
149
  TCocoaDashes = array of Float32;
 
150
 
57
151
  { TCocoaPen }
58
152
 
59
 
  TCocoaPen = class(TCocoaGDIObject)
60
 
  public
61
 
    Style : Integer;
62
 
    Width : Integer;
63
 
    R,G,B : Single;
64
 
    procedure Apply(cg: CGContextRef);
65
 
    constructor Create;
 
153
  TCocoaPen = class(TCocoaColorObject)
 
154
  strict private
 
155
    FWidth: Integer;
 
156
    FStyle: LongWord;
 
157
    FIsExtPen: Boolean;
 
158
    FIsGeometric: Boolean;
 
159
    FEndCap: CGLineCap;
 
160
    FJoinStyle: CGLineJoin;
 
161
   public
 
162
    Dashes: TCocoaDashes;
 
163
    constructor CreateDefault;
 
164
    constructor Create(const ALogPen: TLogPen; const AGlobal: Boolean = False);
 
165
    constructor Create(dwPenStyle, dwWidth: DWord; const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord);
 
166
    constructor Create(const ABrush: TCocoaBrush; const AGlobal: Boolean = False);
 
167
    procedure Apply(ADC: TCocoaContext; UseROP2: Boolean = True);
 
168
 
 
169
    property Width: Integer read FWidth;
 
170
    property Style: LongWord read FStyle;
 
171
    property IsExtPen: Boolean read FIsExtPen;
 
172
    property IsGeometric: Boolean read FIsGeometric;
 
173
    property JoinStyle: CGLineJoin read FJoinStyle;
 
174
    property CapStyle: CGLineCap read FEndCap;
66
175
  end;
67
176
 
68
177
  { TCocoaFont }
70
179
  TCocoaFontStyle = set of (cfs_Bold, cfs_Italic, cfs_Underline, cfs_Strikeout);
71
180
 
72
181
  TCocoaFont = class(TCocoaGDIObject)
73
 
    Name  : AnsiString;
74
 
    Size  : Integer;
75
 
    Style : TCocoaFontStyle;
76
 
    Antialiased: Boolean;
 
182
  strict private
 
183
    FFont: NSFont;
 
184
    FName: AnsiString;
 
185
    FSize: Integer;
 
186
    FStyle: TCocoaFontStyle;
 
187
    FAntialiased: Boolean;
 
188
  public
 
189
    constructor CreateDefault(AGlobal: Boolean = False);
 
190
    constructor Create(const ALogFont: TLogFont; AFontName: String; AGlobal: Boolean = False); reintroduce; overload;
 
191
    constructor Create(const AFont: NSFont; AGlobal: Boolean = False); overload;
 
192
    class function CocoaFontWeightToWin32FontWeight(const CocoaFontWeight: Integer): Integer; static;
 
193
    property Antialiased: Boolean read FAntialiased;
 
194
    property Font: NSFont read FFont;
 
195
    property Name: String read FName;
 
196
    property Size: Integer read FSize;
 
197
    property Style: TCocoaFontStyle read FStyle;
77
198
  end;
78
199
 
79
200
  { TCocoaBitmap }
80
201
 
81
 
  TCocoaBitmap = class(TCocoaGDIObject);
 
202
  TCocoaBitmap = class(TCocoaGDIObject)
 
203
  strict private
 
204
    FData: Pointer;
 
205
    FAlignment: TCocoaBitmapAlignment;
 
206
    FFreeData: Boolean;
 
207
    FDataSize: Integer;
 
208
    FBytesPerRow: Integer;
 
209
    FDepth: Byte;
 
210
    FBitsPerPixel: Byte;
 
211
    FWidth: Integer;
 
212
    FHeight: Integer;
 
213
    FType: TCocoaBitmapType;
 
214
    // Cocoa information
 
215
    FbitsPerSample: NSInteger;  // How many bits in each color component
 
216
    FsamplesPerPixel: NSInteger;// How many color components
 
217
    FImage: NSImage;
 
218
    FImagerep: NSBitmapImageRep;
 
219
    function GetColorSpace: NSString;
 
220
  public
 
221
    constructor Create(ABitmap: TCocoaBitmap);
 
222
    constructor Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
 
223
      AAlignment: TCocoaBitmapAlignment; AType: TCocoaBitmapType;
 
224
      AData: Pointer; ACopyData: Boolean = True);
 
225
    destructor Destroy; override;
 
226
    procedure SetInfo(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
 
227
      AAlignment: TCocoaBitmapAlignment; AType: TCocoaBitmapType);
 
228
 
 
229
    function CreateSubImage(const ARect: TRect): CGImageRef;
 
230
  public
 
231
    property BitmapType: TCocoaBitmapType read FType;
 
232
    property BitsPerPixel: Byte read FBitsPerPixel;
 
233
    property BitsPerSample: NSInteger read FBitsPerSample;
 
234
    property BytesPerRow: Integer read FBytesPerRow;
 
235
    property Image: NSImage read FImage;
 
236
    property ImageRep: NSBitmapImageRep read FImageRep;
 
237
    property ColorSpace: NSString read GetColorSpace;
 
238
    property Data: Pointer read FData;
 
239
    property DataSize: Integer read FDataSize;
 
240
    property Depth: Byte read FDepth;
 
241
    property Width: Integer read FWidth;
 
242
    property Height: Integer read FHeight;
 
243
  end;
 
244
 
 
245
  { TCocoaCursor }
 
246
 
 
247
  TCocoaCursor = class(TObject)
 
248
  strict private
 
249
    FStandard: Boolean;
 
250
    FBitmap: TCocoaBitmap;
 
251
    FCursor: NSCursor;
 
252
  public
 
253
    constructor CreateStandard(const ACursor: NSCursor);
 
254
    constructor CreateFromBitmap(const ABitmap: TCocoaBitmap; const hotSpot: NSPoint);
 
255
    destructor Destroy; override;
 
256
    function Install: TCocoaCursor;
 
257
    property Cursor: NSCursor read FCursor;
 
258
    property Standard: Boolean read FStandard;
 
259
  end;
 
260
 
 
261
 
 
262
  // device context data for SaveDC/RestoreDC
 
263
  TCocoaDCData = class
 
264
  public
 
265
    CurrentFont: TCocoaFont;
 
266
    CurrentBrush: TCocoaBrush;
 
267
    CurrentPen: TCocoaPen;
 
268
    CurrentRegion: TCocoaRegion;
 
269
 
 
270
    BkColor: TColor;
 
271
    BkMode: Integer;
 
272
    BkBrush: TCocoaBrush;
 
273
 
 
274
    TextColor: TColor;
 
275
 
 
276
    ROP2: Integer;
 
277
    PenPos: TPoint;
 
278
  end;
 
279
 
 
280
  TGlyphArray = array of NSGlyph;
82
281
 
83
282
  { TCocoaTextLayout }
84
283
 
85
 
  TCocoaTextLayout = class(TObject)
 
284
  TCocoaTextLayout = class
 
285
  strict private
 
286
    FBackgroundColor: TColor;
 
287
    FForegroundColor: TColor;
 
288
    FLayout: NSLayoutManager;
 
289
    FTextStorage: NSTextStorage;
 
290
    FTextContainer: NSTextContainer;
 
291
    FText: String;
 
292
    FFont: TCocoaFont;
 
293
    procedure SetBackgoundColor(AValue: TColor);
 
294
    procedure SetForegoundColor(AValue: TColor);
 
295
    procedure SetFont(AFont: TCocoaFont);
 
296
    procedure UpdateFont;
 
297
    procedure UpdateColor;
 
298
    function GetTextRange: NSRange;
86
299
  public
87
 
    constructor Create; virtual;
88
 
    procedure SetFont(AFont: TCocoaFont); virtual; abstract;
89
 
    procedure SetText(UTF8Text: PChar; ByteSize: Integer); virtual; abstract;
90
 
    function GetSize: TSize; virtual; abstract;
 
300
    constructor Create;
 
301
    destructor Destroy; override;
 
302
    procedure SetText(UTF8Text: PChar; ByteSize: Integer);
 
303
    function GetSize: TSize;
 
304
    function GetGlyphs: TGlyphArray;
 
305
    procedure Draw(ctx: NSGraphicsContext; X, Y: Integer; FillBackground: Boolean; DX: PInteger);
91
306
 
92
 
    procedure Draw(cg: CGContextRef; X, Y: Integer; DX: PInteger); virtual; abstract;
 
307
    property Font: TCocoaFont read FFont write SetFont;
 
308
    property BackgroundColor: TColor read FBackgroundColor write SetBackgoundColor;
 
309
    property ForegroundColor: TColor read FForegroundColor write SetForegoundColor;
93
310
  end;
94
 
  TCocoaTextLayoutClass = class of TCocoaTextLayout;
95
311
 
96
312
  { TCocoaContext }
97
313
 
98
314
  TCocoaContext = class(TObject)
99
315
  private
100
 
    fText    : TCocoaTextLayout;
101
 
    fBrush   : TCocoaBrush;
102
 
    fPen     : TCocoaPen;
103
 
    fFont    : TCocoaFont;
104
 
    fRegion  : TCocoaRegion;
105
 
    fBitmap  : TCocoaBitmap;
 
316
    FBkBrush: TCocoaBrush;
 
317
    FBkColor: TColor;
 
318
    FBkMode: Integer;
 
319
    FROP2: Integer;
 
320
    FText   : TCocoaTextLayout;
 
321
    FBrush  : TCocoaBrush;
 
322
    FPen    : TCocoaPen;
 
323
    FRegion : TCocoaRegion;
 
324
    FBitmap : TCocoaBitmap;
 
325
    FClipped: Boolean;
 
326
    FClipRegion: TCocoaRegion;
 
327
    FSavedDCList: TFPObjectList;
 
328
    FPenPos: TPoint;
 
329
    FSize: TSize;
 
330
    function GetFont: TCocoaFont;
 
331
    function GetTextColor: TColor;
106
332
    procedure SetBitmap(const AValue: TCocoaBitmap);
 
333
    procedure SetBkColor(AValue: TColor);
 
334
    procedure SetBkMode(AValue: Integer);
107
335
    procedure SetBrush(const AValue: TCocoaBrush);
108
336
    procedure SetFont(const AValue: TCocoaFont);
109
337
    procedure SetPen(const AValue: TCocoaPen);
110
338
    procedure SetRegion(const AValue: TCocoaRegion);
 
339
    procedure SetROP2(AValue: Integer);
 
340
    procedure SetTextColor(AValue: TColor);
111
341
  protected
112
 
    ContextSize : TSize;
 
342
    function SaveDCData: TCocoaDCData; virtual;
 
343
    procedure RestoreDCData(const AData: TCocoaDCData); virtual;
 
344
    procedure SetCGFillping(Ctx: CGContextRef; Width, Height: Integer);
 
345
    procedure RestoreCGFillping(Ctx: CGContextRef; Width, Height: Integer);
113
346
  public
114
 
    ctx      : NSGraphicsContext;
115
 
    PenPos   : TPoint;
116
 
    Stack    : Integer;
117
 
    TR,TG,TB : Single;
 
347
    ctx: NSGraphicsContext;
118
348
    constructor Create;
119
349
    destructor Destroy; override;
 
350
 
 
351
    function SaveDC: Integer;
 
352
    function RestoreDC(ASavedDC: Integer): Boolean;
 
353
 
120
354
    function InitDraw(width, height: Integer): Boolean;
121
 
    procedure MoveTo(x,y: Integer);
122
 
    procedure LineTo(x,y: Integer);
 
355
 
 
356
    // drawing functions
 
357
    procedure DrawBitmap(X, Y: Integer; ABitmap: TCocoaBitmap);
 
358
    procedure DrawFocusRect(ARect: TRect);
 
359
    procedure InvertRectangle(X1, Y1, X2, Y2: Integer);
 
360
    procedure MoveTo(X, Y: Integer);
 
361
    procedure LineTo(X, Y: Integer);
123
362
    procedure Polygon(const Points: array of TPoint; NumPts: Integer; Winding: boolean);
124
363
    procedure Polyline(const Points: array of TPoint; NumPts: Integer);
125
364
    procedure Rectangle(X1, Y1, X2, Y2: Integer; FillRect: Boolean; UseBrush: TCocoaBrush);
126
365
    procedure Ellipse(X1, Y1, X2, Y2: Integer);
127
 
    procedure TextOut(X,Y: Integer; UTF8Chars: PChar; Count: Integer; CharsDelta: PInteger);
128
 
    procedure SetOrigin(X,Y: Integer);
 
366
    procedure TextOut(X, Y: Integer; Options: Longint; Rect: PRect; UTF8Chars: PChar; Count: Integer; CharsDelta: PInteger);
 
367
    procedure Frame(const R: TRect);
 
368
    procedure Frame3d(var ARect: TRect; const FrameWidth: integer; const Style: TBevelCut);
 
369
    procedure FrameRect(const ARect: TRect; const ABrush: TCocoaBrush);
 
370
    function DrawCGImage(X, Y, Width, Height: Integer; CGImage: CGImageRef): Boolean;
 
371
    function StretchDraw(X, Y, Width, Height: Integer; SrcDC: TCocoaContext;
 
372
      XSrc, YSrc, SrcWidth, SrcHeight: Integer; Msk: TCocoaBitmap; XMsk,
 
373
      YMsk: Integer; Rop: DWORD): Boolean;
 
374
 
 
375
    function GetTextExtentPoint(AStr: PChar; ACount: Integer; var Size: TSize): Boolean;
 
376
    function GetTextMetrics(var TM: TTextMetric): Boolean;
 
377
    procedure SetOrigin(X, Y: Integer);
129
378
    procedure GetOrigin(var X,Y: Integer);
 
379
 
130
380
    function CGContext: CGContextRef; virtual;
131
 
    property Brush: TCocoaBrush read fBrush write SetBrush;
132
 
    property Pen: TCocoaPen read fPen write SetPen;
133
 
    property Font: TCocoaFont read fFont write SetFont;
134
 
    property Region: TCocoaRegion read fRegion write SetRegion;
135
 
    property Bitmap: TCocoaBitmap read fBitmap write SetBitmap;
 
381
    procedure SetAntialiasing(AValue: Boolean);
 
382
 
 
383
    function GetClipRect: TRect;
 
384
    function SetClipRegion(AClipRegion: TCocoaRegion; Mode: TCocoaCombine): TCocoaRegionType;
 
385
    function CopyClipRegion(ADstRegion: TCocoaRegion): TCocoaRegionType;
 
386
 
 
387
    property Clipped: Boolean read FClipped;
 
388
    property PenPos: TPoint read FPenPos write FPenPos;
 
389
    property ROP2: Integer read FROP2 write SetROP2;
 
390
    property Size: TSize read FSize;
 
391
 
 
392
    property BkColor: TColor read FBkColor write SetBkColor;
 
393
    property BkMode: Integer read FBkMode write SetBkMode;
 
394
    property BkBrush: TCocoaBrush read FBkBrush;
 
395
 
 
396
    property TextColor: TColor read GetTextColor write SetTextColor;
 
397
 
 
398
    // selected GDI objects
 
399
    property Brush: TCocoaBrush read FBrush write SetBrush;
 
400
    property Pen: TCocoaPen read FPen write SetPen;
 
401
    property Font: TCocoaFont read GetFont write SetFont;
 
402
    property Region: TCocoaRegion read FRegion write SetRegion;
 
403
    property Bitmap: TCocoaBitmap read FBitmap write SetBitmap;
136
404
  end;
137
405
 
138
406
var
139
 
  TextLayoutClass  : TCocoaTextLayoutClass = nil;
 
407
  DefaultBrush: TCocoaBrush;
 
408
  DefaultPen: TCocoaPen;
 
409
  DefaultFont: TCocoaFont;
 
410
 
 
411
function CheckDC(dc: HDC): TCocoaContext;
 
412
function CheckDC(dc: HDC; Str: string): Boolean;
 
413
function CheckGDIOBJ(obj: HGDIOBJ): TCocoaGDIObject;
 
414
function CheckBitmap(ABitmap: HBITMAP; AStr: string): Boolean;
140
415
 
141
416
implementation
142
417
 
 
418
uses
 
419
  CocoaInt;
 
420
 
 
421
//todo: a better check!
 
422
 
 
423
function CheckDC(dc: HDC): TCocoaContext;
 
424
begin
 
425
  Result := TCocoaContext(dc);
 
426
end;
 
427
 
 
428
function CheckDC(dc: HDC; Str: string): Boolean;
 
429
begin
 
430
  Result := dc<>0;
 
431
end;
 
432
 
 
433
function CheckGDIOBJ(obj: HGDIOBJ): TCocoaGDIObject;
 
434
begin
 
435
  Result := TCocoaGDIObject(obj);
 
436
end;
 
437
 
 
438
function CheckBitmap(ABitmap: HBITMAP; AStr: string): Boolean;
 
439
begin
 
440
  Result := ABitmap <> 0;
 
441
end;
 
442
 
 
443
{ TCocoaBitmap }
 
444
 
 
445
type
 
446
  // The following dummy categories fix bugs in the Cocoa bindings available in FPC
 
447
  // Remove them when the FPC binding parser is fixed.
 
448
  // More details:
 
449
  // http://wiki.freepascal.org/FPC_PasCocoa/Differences#Sending_messages_to_id
 
450
  // http://wiki.lazarus.freepascal.org/FPC_PasCocoa#Category_declaration
 
451
  NSBitmapImageRepFix = objccategory external(NSBitmapImageRep)
 
452
    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:';
 
453
    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:';
 
454
  end;
 
455
 
 
456
  NSGraphicsContextFix = objccategory external(NSGraphicsContext)
 
457
    procedure setImageInterpolation(interpolation: NSImageInterpolation); message 'setImageInterpolation:';
 
458
    procedure setShouldAntialias(antialias: Boolean); message 'setShouldAntialias:';
 
459
  end;
 
460
 
 
461
{ TCocoaFont }
 
462
 
 
463
constructor TCocoaFont.CreateDefault(AGlobal: Boolean = False);
 
464
begin
 
465
  Create(NSFont.systemFontOfSize(0));
 
466
end;
 
467
 
 
468
constructor TCocoaFont.Create(const ALogFont: TLogFont; AFontName: String; AGlobal: Boolean);
 
469
var
 
470
  FontName: NSString;
 
471
  Descriptor: NSFontDescriptor;
 
472
  Attributes: NSDictionary;
 
473
  Pool: NSAutoreleasePool;
 
474
  Win32Weight, LoopCount: Integer;
 
475
  CocoaWeight: NSInteger;
 
476
begin
 
477
  inherited Create(AGlobal);
 
478
 
 
479
  Pool := NSAutoreleasePool.alloc.init;
 
480
 
 
481
  FName := AFontName;
 
482
  if FName = 'default' then
 
483
  begin
 
484
    FName := NSStringToString(NSFont.systemFontOfSize(0).familyName);
 
485
    FSize := Round(NSFont.systemFontSize);
 
486
  end
 
487
  else
 
488
    FSize := ALogFont.lfHeight;
 
489
 
 
490
  // create font attributes
 
491
  Win32Weight := ALogFont.lfWeight;
 
492
  FStyle := [];
 
493
  if ALogFont.lfItalic > 0 then
 
494
    include(FStyle, cfs_Italic);
 
495
  if Win32Weight > FW_NORMAL then
 
496
    include(FStyle, cfs_Bold);
 
497
  if ALogFont.lfUnderline > 0 then
 
498
    include(FStyle, cfs_Underline);
 
499
  if ALogFont.lfStrikeOut > 0 then
 
500
    include(FStyle, cfs_StrikeOut);
 
501
 
 
502
  Attributes := NSDictionary.dictionaryWithObjectsAndKeys(
 
503
        NSStringUTF8(FName), NSFontFamilyAttribute,
 
504
        NSNumber.numberWithFloat(ALogFont.lfHeight), NSFontSizeAttribute,
 
505
        nil);
 
506
 
 
507
  Descriptor := NSFontDescriptor.fontDescriptorWithFontAttributes(Attributes);
 
508
  FFont := NSFont.fontWithDescriptor_textTransform(Descriptor, nil);
 
509
  // we could use NSFontTraitsAttribute to request the desired font style (Bold/Italic)
 
510
  // but in this case we may get NIL as result. This way is safer.
 
511
  if cfs_Italic in Style then
 
512
    FFont := NSFontManager.sharedFontManager.convertFont_toHaveTrait(FFont, NSItalicFontMask);
 
513
  if cfs_Bold in Style then
 
514
    FFont := NSFontManager.sharedFontManager.convertFont_toHaveTrait(FFont, NSBoldFontMask);
 
515
  case ALogFont.lfPitchAndFamily and $F of
 
516
    FIXED_PITCH, MONO_FONT:
 
517
      FFont := NSFontManager.sharedFontManager.convertFont_toHaveTrait(FFont, NSFixedPitchFontMask);
 
518
    VARIABLE_PITCH:
 
519
      FFont := NSFontManager.sharedFontManager.convertFont_toNotHaveTrait(FFont, NSFixedPitchFontMask);
 
520
  end;
 
521
  if Win32Weight <> FW_DONTCARE then
 
522
  begin
 
523
    // currently if we request the desired waight by Attributes we may get a nil font
 
524
    // so we need to get font weight and to convert it to lighter/havier
 
525
    LoopCount := 0;
 
526
    repeat
 
527
      // protection from endless loop
 
528
      if LoopCount > 12 then
 
529
        Exit;
 
530
      CocoaWeight := CocoaFontWeightToWin32FontWeight(NSFontManager.sharedFontManager.weightOfFont(FFont));
 
531
      if CocoaWeight < Win32Weight then
 
532
        FFont := NSFontManager.sharedFontManager.convertWeight_ofFont(True, FFont)
 
533
      else
 
534
      if CocoaWeight > Win32Weight then
 
535
        FFont := NSFontManager.sharedFontManager.convertWeight_ofFont(False, FFont);
 
536
      inc(LoopCount);
 
537
    until CocoaWeight = Win32Weight;
 
538
  end;
 
539
  FFont.retain;
 
540
  FAntialiased := ALogFont.lfQuality <> NONANTIALIASED_QUALITY;
 
541
  Pool.release;
 
542
end;
 
543
 
 
544
constructor TCocoaFont.Create(const AFont: NSFont; AGlobal: Boolean);
 
545
begin
 
546
  inherited Create(AGlobal);
 
547
  FFont := AFont;
 
548
  FName := NSStringToString(FFont.familyName);
 
549
  FSize := Round(FFont.pointSize);
 
550
  FStyle := [];
 
551
  FAntialiased := True;
 
552
end;
 
553
 
 
554
class function TCocoaFont.CocoaFontWeightToWin32FontWeight(const CocoaFontWeight: Integer): Integer; static;
 
555
begin
 
556
  case CocoaFontWeight of
 
557
    0, 1: Result := FW_THIN;
 
558
    2: Result := FW_ULTRALIGHT;
 
559
    3: Result := FW_EXTRALIGHT;
 
560
    4: Result := FW_LIGHT;
 
561
    5: Result := FW_NORMAL;
 
562
    6: Result := FW_MEDIUM;
 
563
    7, 8: Result := FW_SEMIBOLD;
 
564
    9: Result := FW_BOLD;
 
565
    10: Result := FW_EXTRABOLD;
 
566
  else
 
567
    Result := FW_HEAVY;
 
568
  end;
 
569
end;
 
570
 
 
571
{ TCocoaColorObject }
 
572
 
 
573
function TCocoaColorObject.GetColorRef: TColorRef;
 
574
begin
 
575
  Result := TColorRef(RGBToColor(FR, FG, FB));
 
576
end;
 
577
 
 
578
constructor TCocoaColorObject.Create(const AColor: TColor; ASolid, AGlobal: Boolean);
 
579
begin
 
580
  inherited Create(AGlobal);
 
581
 
 
582
  SetColor(AColor, ASolid);
 
583
end;
 
584
 
 
585
procedure TCocoaColorObject.SetColor(const AColor: TColor; ASolid: Boolean);
 
586
begin
 
587
  RedGreenBlue(ColorToRGB(AColor), FR, FG, FB);
 
588
  FA := ASolid;
 
589
end;
 
590
 
 
591
procedure TCocoaColorObject.GetRGBA(AROP2: Integer; out AR, AG, AB, AA: Single);
 
592
begin
 
593
  case AROP2 of
 
594
    R2_BLACK:
 
595
    begin
 
596
      AR := 0;
 
597
      AG := 0;
 
598
      AB := 0;
 
599
      AA := Byte(FA);
 
600
    end;
 
601
    R2_WHITE:
 
602
    begin
 
603
      AR := 1;
 
604
      AG := 1;
 
605
      AB := 1;
 
606
      AA := Byte(FA);
 
607
    end;
 
608
    R2_NOP:
 
609
    begin
 
610
      AR := 1;
 
611
      AG := 1;
 
612
      AB := 1;
 
613
      AA := 0;
 
614
    end;
 
615
    R2_NOT:
 
616
    begin
 
617
      AR := 1;
 
618
      AG := 1;
 
619
      AB := 1;
 
620
      AA := Byte(FA);
 
621
    end;
 
622
    R2_NOTCOPYPEN:
 
623
    begin
 
624
      AR := (255 - FR) / 255;
 
625
      AG := (255 - FG) / 255;
 
626
      AB := (255 - FB) / 255;
 
627
      AA := Byte(FA);
 
628
    end;
 
629
  else // copy
 
630
    begin
 
631
      AR := FR / 255;
 
632
      AG := FG / 255;
 
633
      AB := FB / 255;
 
634
      AA := Byte(FA);
 
635
    end;
 
636
  end;
 
637
end;
 
638
 
 
639
function TCocoaColorObject.CreateNSColor: NSColor;
 
640
begin
 
641
  Result := NSColor.colorWithCalibratedRed_green_blue_alpha(FR / 255, FG / 255, FB / 255, Byte(FA));
 
642
end;
 
643
 
 
644
{------------------------------------------------------------------------------
 
645
  Method:  TCocoaBitmap.Create
 
646
  Params:  AWidth        - Bitmap width
 
647
           AHeight       - Bitmap height
 
648
           ADepth        - Significant bits per pixel
 
649
           ABitsPerPixel - The number of allocated bits per pixel (can be larger than depth)
 
650
//           AAlignment    - Alignment of the data for each row
 
651
//           ABytesPerRow  - The number of bytes between rows
 
652
           ACopyData     - Copy supplied bitmap data (OPTIONAL)
 
653
 
 
654
  Creates Cocoa bitmap with the specified characteristics
 
655
 ------------------------------------------------------------------------------}
 
656
constructor TCocoaBitmap.Create(AWidth, AHeight, ADepth, ABitsPerPixel: Integer;
 
657
  AAlignment: TCocoaBitmapAlignment; AType: TCocoaBitmapType;
 
658
  AData: Pointer; ACopyData: Boolean);
 
659
var
 
660
  HasAlpha: Boolean;
 
661
  BitmapFormat: NSBitmapFormat;
 
662
begin
 
663
  inherited Create(False);
 
664
  {$ifdef VerboseBitmaps}
 
665
  DebugLn(Format('[TCocoaBitmap.Create] AWidth=%d AHeight=%d ADepth=%d ABitsPerPixel=%d'
 
666
    + ' AAlignment=%d AType=%d AData=? ACopyData=%d',
 
667
    [AWidth, AHeight, ADepth, ABitsPerPixel, Integer(AAlignment), Integer(AType), Integer(ACopyData)]));
 
668
  {$endif}
 
669
  SetInfo(AWidth, AHeight, ADepth, ABitsPerPixel, AAlignment, AType);
 
670
 
 
671
  // Copy the image data, if necessary
 
672
  if (AData = nil) or ACopyData then
 
673
  begin
 
674
    System.GetMem(FData, FDataSize);
 
675
    FFreeData := True;
 
676
    if AData <> nil then
 
677
      System.Move(AData^, FData^, FDataSize) // copy data
 
678
    else
 
679
      FillDWord(FData^, FDataSize shr 2, 0); // clear bitmap
 
680
  end
 
681
  else
 
682
  begin
 
683
    FData := AData;
 
684
    FFreeData := False;
 
685
  end;
 
686
 
 
687
  HasAlpha := AType in [cbtARGB, cbtRGBA, cbtBGRA];
 
688
  BitmapFormat := NSAlphaNonpremultipliedBitmapFormat;
 
689
  if AType = cbtARGB then
 
690
    BitmapFormat := BitmapFormat or NSAlphaFirstBitmapFormat;
 
691
 
 
692
  {$ifdef VerboseBitmaps}
 
693
  DebugLn(Format('[TCocoaBitmap.Create] NSBitmapImageRep.alloc HasAlpha=%d',
 
694
    [Integer(HasAlpha)]));
 
695
  {$endif}
 
696
  // Create the associated NSImageRep
 
697
  FImagerep := NSBitmapImageRep(NSBitmapImageRep.alloc.initWithBitmapDataPlanes_pixelsWide_pixelsHigh__colorSpaceName_bitmapFormat_bytesPerRow_bitsPerPixel(
 
698
    @FData, // planes, BitmapDataPlanes
 
699
    FWidth, // width, pixelsWide
 
700
    FHeight,// height, PixelsHigh
 
701
    FbitsPerSample,// bitsPerSample, bps
 
702
    FsamplesPerPixel, // samplesPerPixel, sps
 
703
    HasAlpha, // hasAlpha
 
704
    False, // isPlanar
 
705
    GetColorSpace, // colorSpaceName
 
706
    BitmapFormat, // bitmapFormat
 
707
    FBytesPerRow, // bytesPerRow
 
708
    FBitsPerPixel //bitsPerPixel
 
709
    ));
 
710
 
 
711
  // Create the associated NSImage
 
712
  FImage := NSImage.alloc.initWithSize(NSMakeSize(AWidth, AHeight));
 
713
  Image.addRepresentation(Imagerep);
 
714
end;
 
715
 
 
716
destructor TCocoaBitmap.Destroy;
 
717
begin
 
718
  image.release;
 
719
  if FFreeData then System.FreeMem(FData);
 
720
 
 
721
  inherited Destroy;
 
722
end;
 
723
 
 
724
procedure TCocoaBitmap.SetInfo(AWidth, AHeight, ADepth,
 
725
  ABitsPerPixel: Integer; AAlignment: TCocoaBitmapAlignment;
 
726
  AType: TCocoaBitmapType);
 
727
const
 
728
  ALIGNBITS: array[TCocoaBitmapAlignment] of Integer = (0, 1, 3, 7, $F);
 
729
var
 
730
  M: Integer;
 
731
begin
 
732
  if AWidth < 1 then AWidth := 1;
 
733
  if AHeight < 1 then AHeight := 1;
 
734
  FWidth := AWidth;
 
735
  FHeight := AHeight;
 
736
  FDepth := ADepth;
 
737
  FBitsPerPixel := ABitsPerPixel;
 
738
  FType := AType;
 
739
  FAlignment := AAlignment;
 
740
 
 
741
  if (FType in [cbtMono, cbtGray]) and (FDepth=0) then
 
742
    FDepth:=FBitsPerPixel;
 
743
 
 
744
  FBytesPerRow := ((AWidth * ABitsPerPixel) + 7) shr 3;
 
745
  M := FBytesPerRow and ALIGNBITS[AAlignment];
 
746
  if M <> 0 then Inc(FBytesPerRow, ALIGNBITS[AAlignment] + 1 - M);
 
747
 
 
748
  FDataSize := FBytesPerRow * FHeight;
 
749
 
 
750
  // Cocoa information
 
751
  case ABitsPerPixel of
 
752
    // Strangely, this might appear
 
753
    0:
 
754
    begin
 
755
      FbitsPerSample := 0;
 
756
      FsamplesPerPixel := 0;
 
757
    end;
 
758
    // Mono
 
759
    1:
 
760
    begin
 
761
      FbitsPerSample := 1;
 
762
      FsamplesPerPixel := 1;
 
763
    end;
 
764
    // Gray scale
 
765
    8:
 
766
    begin
 
767
      FbitsPerSample := 8;
 
768
      FsamplesPerPixel := 1;
 
769
    end;
 
770
    // ARGB
 
771
    32:
 
772
    begin
 
773
      FbitsPerSample := 8;
 
774
      FsamplesPerPixel := 4;
 
775
    end;
 
776
  else
 
777
    // Other RGB
 
778
    FbitsPerSample := ABitsPerPixel div 3;
 
779
    FsamplesPerPixel := 3;
 
780
  end;
 
781
end;
 
782
 
 
783
function TCocoaBitmap.CreateSubImage(const ARect: TRect): CGImageRef;
 
784
begin
 
785
  if ImageRep = nil then
 
786
    Result := nil
 
787
  else
 
788
    Result := CGImageCreateWithImageInRect(ImageRep.CGImage, RectToCGRect(ARect));
 
789
end;
 
790
 
 
791
function TCocoaBitmap.GetColorSpace: NSString;
 
792
begin
 
793
  if FType in [cbtMono, cbtGray] then
 
794
    Result := NSCalibratedWhiteColorSpace
 
795
  else
 
796
    Result := NSCalibratedRGBColorSpace;
 
797
end;
 
798
 
 
799
constructor TCocoaBitmap.Create(ABitmap: TCocoaBitmap);
 
800
begin
 
801
  Create(ABitmap.Width, ABitmap.Height, ABitmap.Depth, ABitmap.FBitsPerPixel,
 
802
    ABitmap.FAlignment, ABitmap.FType, ABitmap.Data);
 
803
end;
 
804
 
 
805
{ TCocoaCursor }
 
806
constructor TCocoaCursor.CreateStandard(const ACursor: NSCursor);
 
807
begin
 
808
  FBitmap := nil;
 
809
  FCursor := ACursor;
 
810
  FStandard := True;
 
811
end;
 
812
 
 
813
constructor TCocoaCursor.CreateFromBitmap(const ABitmap: TCocoaBitmap; const hotSpot: NSPoint);
 
814
begin
 
815
  FBitmap := ABitmap;
 
816
  FCursor := NSCursor.alloc.initWithImage_hotSpot(ABitmap.Image, hotSpot);
 
817
  FStandard := False;
 
818
end;
 
819
 
 
820
destructor TCocoaCursor.Destroy;
 
821
begin
 
822
  FBitmap.Free;
 
823
  if not Standard then
 
824
    FCursor.release;
 
825
  inherited;
 
826
end;
 
827
 
 
828
function TCocoaCursor.Install: TCocoaCursor;
 
829
begin
 
830
  FCursor.push;
 
831
  // also request form cursors invalidation
 
832
  CocoaWidgetSet.NSApp.keyWindow.resetCursorRects;
 
833
  Result := nil;
 
834
end;
 
835
 
 
836
{ TCocoaTextLayout }
 
837
 
 
838
procedure TCocoaTextLayout.UpdateFont;
 
839
const
 
840
  UnderlineStyle = NSUnderlineStyleSingle or NSUnderlinePatternSolid;
 
841
var
 
842
  Range: NSRange;
 
843
begin
 
844
  if Assigned(FFont) then
 
845
  begin
 
846
    Range := GetTextRange;
 
847
    // apply font itself
 
848
    FTextStorage.addAttribute_value_range(NSFontAttributeName, FFont.Font, Range);
 
849
    // aply font attributes which are not in NSFont
 
850
    if cfs_Underline in FFont.Style then
 
851
      FTextStorage.addAttribute_value_range(NSUnderlineStyleAttributeName, NSNumber.numberWithInteger(UnderlineStyle), Range);
 
852
    if cfs_Strikeout in FFont.Style then
 
853
      FTextStorage.addAttribute_value_range(NSStrikethroughStyleAttributeName, NSNumber.numberWithInteger(UnderlineStyle), Range);
 
854
  end;
 
855
end;
 
856
 
 
857
procedure TCocoaTextLayout.UpdateColor;
 
858
begin
 
859
  FTextStorage.addAttribute_value_range(NSForegroundColorAttributeName, ColorToNSColor(ForegroundColor), GetTextRange);
 
860
  FTextStorage.addAttribute_value_range(NSBackgroundColorAttributeName, ColorToNSColor(BackgroundColor), GetTextRange);
 
861
end;
 
862
 
 
863
function TCocoaTextLayout.GetTextRange: NSRange;
 
864
begin
 
865
  Result.location := 0;
 
866
  Result.length := FTextStorage.length;
 
867
end;
 
868
 
 
869
procedure TCocoaTextLayout.SetForegoundColor(AValue: TColor);
 
870
begin
 
871
  if FForegroundColor <> AValue then
 
872
  begin
 
873
    FForegroundColor := AValue;
 
874
    FTextStorage.beginEditing;
 
875
    UpdateColor;
 
876
    FTextStorage.endEditing;
 
877
  end;
 
878
end;
 
879
 
 
880
procedure TCocoaTextLayout.SetBackgoundColor(AValue: TColor);
 
881
begin
 
882
  if FBackgroundColor <> AValue then
 
883
  begin
 
884
    FBackgroundColor := AValue;
 
885
    FTextStorage.beginEditing;
 
886
    UpdateColor;
 
887
    FTextStorage.endEditing;
 
888
  end;
 
889
end;
 
890
 
 
891
constructor TCocoaTextLayout.Create;
 
892
var
 
893
  S: NSString;
 
894
begin
 
895
  FLayout := NSLayoutManager.alloc.init;
 
896
  FTextContainer := NSTextContainer.alloc.init;
 
897
  FTextContainer.setLineFragmentPadding(0);
 
898
  FLayout.addTextContainer(FTextContainer);
 
899
  FTextContainer.release;
 
900
  S := NSSTR('');
 
901
  FTextStorage := NSTextStorage.alloc.initWithString(S);
 
902
  S.release;
 
903
  FTextStorage.addLayoutManager(FLayout);
 
904
  FLayout.release;
 
905
  FFont := DefaultFont;
 
906
  FFont.AddRef;
 
907
  FText := '';
 
908
  FBackgroundColor := clWhite;
 
909
  FForegroundColor := clBlack;
 
910
end;
 
911
 
 
912
destructor TCocoaTextLayout.Destroy;
 
913
begin
 
914
  FTextStorage.release;
 
915
  FFont.release;
 
916
  inherited Destroy;
 
917
end;
 
918
 
 
919
procedure TCocoaTextLayout.SetFont(AFont: TCocoaFont);
 
920
begin
 
921
  if FFont <> AFont then
 
922
  begin
 
923
    FFont := AFont;
 
924
    FTextStorage.beginEditing;
 
925
    updateFont;
 
926
    FTextStorage.endEditing;
 
927
  end;
 
928
end;
 
929
 
 
930
procedure TCocoaTextLayout.SetText(UTF8Text: PChar; ByteSize: Integer);
 
931
var
 
932
  NewText: String;
 
933
  S: NSString;
 
934
begin
 
935
  if ByteSize >= 0 then
 
936
    System.SetString(NewText, UTF8Text, ByteSize)
 
937
  else
 
938
    NewText := StrPas(UTF8Text);
 
939
  if FText <> NewText then
 
940
  begin
 
941
    FText := NewText;
 
942
    S := NSStringUTF8(NewText);
 
943
    FTextStorage.beginEditing;
 
944
    FTextStorage.replaceCharactersInRange_withString(GetTextRange, S);
 
945
    updateFont;
 
946
    updateColor;
 
947
    FTextStorage.endEditing;
 
948
    S.release;
 
949
  end;
 
950
end;
 
951
 
 
952
function TCocoaTextLayout.GetSize: TSize;
 
953
var
 
954
  Range: NSRange;
 
955
begin
 
956
  Range := FLayout.glyphRangeForTextContainer(FTextContainer);
 
957
  with FLayout.boundingRectForGlyphRange_inTextContainer(Range, FTextContainer).size do
 
958
  begin
 
959
    Result.cx := Round(width);
 
960
    Result.cy := Round(height);
 
961
  end;
 
962
end;
 
963
 
 
964
function TCocoaTextLayout.GetGlyphs: TGlyphArray;
 
965
var
 
966
  Range: NSRange;
 
967
begin
 
968
  Range := FLayout.glyphRangeForTextContainer(FTextContainer);
 
969
  // required length + 1 space
 
970
  SetLength(Result, Range.length + 1);
 
971
  FLayout.getGlyphs_range(@Result[0], Range);
 
972
  SetLength(Result, Range.length);
 
973
end;
 
974
 
 
975
procedure TCocoaTextLayout.Draw(ctx: NSGraphicsContext; X, Y: Integer; FillBackground: Boolean; DX: PInteger);
 
976
var
 
977
  Range: NSRange;
 
978
  Pt: NSPoint;
 
979
  Context: NSGraphicsContext;
 
980
  Locations: array of NSPoint;
 
981
  Indexes: array of NSUInteger;
 
982
  I, Count: NSUInteger;
 
983
begin
 
984
  if not ctx.isFlipped then
 
985
    Context := NSGraphicsContext.graphicsContextWithGraphicsPort_flipped(ctx.graphicsPort, True)
 
986
  else
 
987
    Context := ctx;
 
988
 
 
989
  ctx.setCurrentContext(Context);
 
990
  ctx.setShouldAntialias(FFont.Antialiased);
 
991
  Range := FLayout.glyphRangeForTextContainer(FTextContainer);
 
992
  Pt.x := X;
 
993
  Pt.y := Y;
 
994
  if Assigned(DX) then
 
995
  begin
 
996
    Count := Range.length;
 
997
    SetLength(Locations, Count);
 
998
    SetLength(Indexes, Count);
 
999
    Locations[0] := FLayout.locationForGlyphAtIndex(0);
 
1000
    Indexes[0] := 0;
 
1001
    for I := 1 to Count - 1 do
 
1002
    begin
 
1003
      Locations[I] := Locations[I - 1];
 
1004
      Locations[I].x := Locations[I].x + DX[I - 1];
 
1005
      Indexes[I] := I;
 
1006
    end;
 
1007
    FLayout.setLocations_startingGlyphIndexes_count_forGlyphRange(@Locations[0], @Indexes[0], Count, Range);
 
1008
  end;
 
1009
  if FillBackground then
 
1010
    FLayout.drawBackgroundForGlyphRange_atPoint(Range, Pt);
 
1011
  FLayout.drawGlyphsForGlyphRange_atPoint(Range, Pt);
 
1012
end;
 
1013
 
143
1014
{ TCocoaContext }
144
1015
 
145
 
function TCocoaContext.CGContext:CGContextRef;
146
 
begin
147
 
  Result:=CGContextRef(ctx.graphicsPort);
 
1016
function TCocoaContext.CGContext: CGContextRef;
 
1017
begin
 
1018
  Result := CGContextRef(ctx.graphicsPort);
 
1019
end;
 
1020
 
 
1021
procedure TCocoaContext.SetAntialiasing(AValue: Boolean);
 
1022
begin
 
1023
  if not AValue then
 
1024
    ctx.setImageInterpolation(NSImageInterpolationNone)
 
1025
  else
 
1026
    ctx.setImageInterpolation(NSImageInterpolationDefault);
 
1027
  ctx.setShouldAntialias(AValue);
 
1028
end;
 
1029
 
 
1030
function TCocoaContext.GetClipRect: TRect;
 
1031
begin
 
1032
  Result := CGRectToRect(CGContextGetClipBoundingBox(CGContext));
 
1033
end;
 
1034
 
 
1035
function TCocoaContext.SetClipRegion(AClipRegion: TCocoaRegion; Mode: TCocoaCombine): TCocoaRegionType;
 
1036
begin
 
1037
  if FClipped then
 
1038
  begin
 
1039
    FClipped := False;
 
1040
    ctx.restoreGraphicsState;
 
1041
  end;
 
1042
 
 
1043
  if not Assigned(AClipRegion) then
 
1044
    FClipRegion.Clear
 
1045
  else
 
1046
  begin
 
1047
    ctx.saveGraphicsState;
 
1048
    FClipRegion.CombineWith(AClipRegion, Mode);
 
1049
    FClipRegion.Apply(Self);
 
1050
    FClipped := True;
 
1051
  end;
 
1052
  Result := FClipRegion.GetType;
 
1053
end;
 
1054
 
 
1055
function TCocoaContext.CopyClipRegion(ADstRegion: TCocoaRegion): TCocoaRegionType;
 
1056
begin
 
1057
  if Assigned(ADstRegion) and ADstRegion.CombineWith(FClipRegion, cc_Copy) then
 
1058
    Result := ADstRegion.GetType
 
1059
  else
 
1060
    Result := crt_Error;
148
1061
end;
149
1062
 
150
1063
procedure TCocoaContext.SetBitmap(const AValue: TCocoaBitmap);
151
1064
begin
152
 
  fBitmap:=AValue;
 
1065
  if FBitmap <> AValue then
 
1066
  begin
 
1067
    FBitmap:=AValue;
 
1068
 
 
1069
  end;
 
1070
end;
 
1071
 
 
1072
function TCocoaContext.GetTextColor: TColor;
 
1073
begin
 
1074
  Result := FText.ForegroundColor;
 
1075
end;
 
1076
 
 
1077
function TCocoaContext.GetFont: TCocoaFont;
 
1078
begin
 
1079
  Result := FText.Font;
 
1080
end;
 
1081
 
 
1082
procedure TCocoaContext.SetBkColor(AValue: TColor);
 
1083
begin
 
1084
  AValue := ColorToRGB(AValue);
 
1085
  FBkColor := AValue;
 
1086
  FBkBrush.SetColor(AValue, BkMode = OPAQUE);
 
1087
end;
 
1088
 
 
1089
procedure TCocoaContext.SetBkMode(AValue: Integer);
 
1090
begin
 
1091
  if FBkMode <> AValue then
 
1092
  begin
 
1093
    FBkMode := AValue;
 
1094
    FBkBrush.SetColor(FBkColor, FBkMode = OPAQUE);
 
1095
  end;
153
1096
end;
154
1097
 
155
1098
procedure TCocoaContext.SetBrush(const AValue: TCocoaBrush);
156
1099
begin
157
 
  fBrush:=AValue;
158
 
  if Assigned(fBrush) then fBrush.Apply(CGContext);
 
1100
  if FBrush <> AValue then
 
1101
  begin
 
1102
    FBrush := AValue;
 
1103
    if Assigned(FBrush) then FBrush.Apply(Self);
 
1104
  end;
159
1105
end;
160
1106
 
161
1107
procedure TCocoaContext.SetFont(const AValue: TCocoaFont);
162
1108
begin
163
 
  fFont:=AValue;
 
1109
  FText.Font := AValue;
164
1110
end;
165
1111
 
166
1112
procedure TCocoaContext.SetPen(const AValue: TCocoaPen);
167
1113
begin
168
 
  fPen:=AValue;
169
 
  if Assigned(fPen) then fPen.Apply(CGContext);
 
1114
  if FPen <> AValue then
 
1115
  begin
 
1116
    FPen := AValue;
 
1117
    if Assigned(FPen) then FPen.Apply(Self);
 
1118
  end;
170
1119
end;
171
1120
 
172
1121
procedure TCocoaContext.SetRegion(const AValue: TCocoaRegion);
173
1122
begin
174
 
  fRegion:=AValue;
 
1123
  if FRegion <> AValue then
 
1124
  begin
 
1125
    FRegion := AValue;
 
1126
    if Assigned(FRegion) then FRegion.Apply(Self);
 
1127
  end;
 
1128
end;
 
1129
 
 
1130
procedure TCocoaContext.SetROP2(AValue: Integer);
 
1131
begin
 
1132
  if FROP2 <> AValue then
 
1133
  begin
 
1134
    FROP2 := AValue;
 
1135
    Pen.Apply(Self);
 
1136
    Brush.Apply(Self);
 
1137
  end;
 
1138
end;
 
1139
 
 
1140
procedure TCocoaContext.SetTextColor(AValue: TColor);
 
1141
begin
 
1142
  FText.ForegroundColor := TColor(ColorToRGB(AValue));
 
1143
end;
 
1144
 
 
1145
function TCocoaContext.SaveDCData: TCocoaDCData;
 
1146
begin
 
1147
  Result := TCocoaDCData.Create;
 
1148
 
 
1149
  Result.CurrentFont := Font;
 
1150
  Result.CurrentBrush := FBrush;
 
1151
  Result.CurrentPen := FPen;
 
1152
  Result.CurrentRegion := FRegion;
 
1153
 
 
1154
  Result.BkColor := FBkColor;
 
1155
  Result.BkMode := FBkMode;
 
1156
  Result.BkBrush := FBkBrush;
 
1157
 
 
1158
  Result.TextColor := TextColor;
 
1159
 
 
1160
  Result.ROP2 := FROP2;
 
1161
  Result.PenPos := FPenPos;
 
1162
end;
 
1163
 
 
1164
procedure TCocoaContext.RestoreDCData(const AData: TCocoaDCData);
 
1165
begin
 
1166
  if (Font <> AData.CurrentFont) then
 
1167
  begin
 
1168
    if Assigned(Font) then
 
1169
      Font.Release;
 
1170
    if Assigned(AData.CurrentFont) then
 
1171
      AData.CurrentFont.AddRef;
 
1172
  end;
 
1173
  Font := AData.CurrentFont;
 
1174
 
 
1175
  if (FBrush <> AData.CurrentBrush) then
 
1176
  begin
 
1177
    if Assigned(FBrush) then
 
1178
      FBrush.Release;
 
1179
    if Assigned(AData.CurrentBrush) then
 
1180
      AData.CurrentBrush.AddRef;
 
1181
  end;
 
1182
  FBrush := AData.CurrentBrush;
 
1183
 
 
1184
  if (FPen <> AData.CurrentPen) then
 
1185
  begin
 
1186
    if Assigned(FPen) then
 
1187
      FPen.Release;
 
1188
    if Assigned(AData.CurrentPen) then
 
1189
      AData.CurrentPen.AddRef;
 
1190
  end;
 
1191
  FPen := AData.CurrentPen;
 
1192
 
 
1193
  if (FRegion <> AData.CurrentRegion) then
 
1194
  begin
 
1195
    if Assigned(FRegion) then
 
1196
      FRegion.Release;
 
1197
    if Assigned(AData.CurrentRegion) then
 
1198
      AData.CurrentRegion.AddRef;
 
1199
  end;
 
1200
  FRegion := AData.CurrentRegion;
 
1201
 
 
1202
  FBkColor := AData.BkColor;
 
1203
  FBkMode := AData.BkMode;
 
1204
  FBkBrush := AData.BkBrush;
 
1205
 
 
1206
  TextColor := AData.TextColor;
 
1207
 
 
1208
  FROP2 := AData.ROP2;
 
1209
  FPenPos := AData.PenPos;
175
1210
end;
176
1211
 
177
1212
constructor TCocoaContext.Create;
178
1213
begin
179
 
  fText:=TextLayoutClass.Create;
 
1214
  inherited Create;
 
1215
 
 
1216
  FBkBrush := TCocoaBrush.CreateDefault;
 
1217
 
 
1218
  FBrush := DefaultBrush;
 
1219
  FBrush.AddRef;
 
1220
  FPen := DefaultPen;
 
1221
  FPen.AddRef;
 
1222
  FRegion := TCocoaRegion.CreateDefault;
 
1223
  FRegion.AddRef;
 
1224
  FClipRegion := FRegion;
 
1225
  FText := TCocoaTextLayout.Create;
 
1226
  FClipped := False;
180
1227
end;
181
1228
 
182
1229
destructor TCocoaContext.Destroy;
183
1230
begin
184
 
  fText.Free;
 
1231
  FBkBrush.Free;
 
1232
 
 
1233
  if Assigned(FBrush) then
 
1234
    FBrush.Release;
 
1235
  if Assigned(FPen) then
 
1236
    FPen.Release;
 
1237
  if Assigned(FRegion) then
 
1238
    FRegion.Release;
 
1239
  FClipRegion.Free;
 
1240
  FSavedDCList.Free;
 
1241
  FText.Free;
185
1242
  inherited Destroy;
186
1243
end;
187
1244
 
188
 
function TCocoaContext.InitDraw(width,height:Integer): Boolean;
 
1245
function TCocoaContext.SaveDC: Integer;
 
1246
begin
 
1247
  if FClipped then
 
1248
    ctx.restoreGraphicsState;
 
1249
 
 
1250
  Result := 0;
 
1251
 
 
1252
  if FSavedDCList = nil then
 
1253
    FSavedDCList := TFPObjectList.Create(True);
 
1254
 
 
1255
  ctx.saveGraphicsState;
 
1256
  Result := FSavedDCList.Add(SaveDCData) + 1;
 
1257
 
 
1258
  if FClipped then
 
1259
  begin
 
1260
    ctx.saveGraphicsState;
 
1261
    FClipRegion.Apply(Self);
 
1262
  end;
 
1263
end;
 
1264
 
 
1265
function TCocoaContext.RestoreDC(ASavedDC: Integer): Boolean;
 
1266
begin
 
1267
  if FClipped then
 
1268
    ctx.restoreGraphicsState;
 
1269
 
 
1270
  Result := False;
 
1271
  if (FSavedDCList = nil) or (ASavedDC <= 0) or (ASavedDC > FSavedDCList.Count) then
 
1272
    Exit;
 
1273
 
 
1274
  while FSavedDCList.Count > ASavedDC do
 
1275
  begin
 
1276
    ctx.restoreGraphicsState;
 
1277
    FSavedDCList.Delete(FSavedDCList.Count - 1);
 
1278
  end;
 
1279
 
 
1280
  ctx.restoreGraphicsState;
 
1281
  RestoreDCData(TCocoaDCData(FSavedDCList[ASavedDC - 1]));
 
1282
  FSavedDCList.Delete(ASavedDC - 1);
 
1283
  Result := True;
 
1284
 
 
1285
  if FSavedDCList.Count = 0 then FreeAndNil(FSavedDCList);
 
1286
 
 
1287
  if FClipped then
 
1288
  begin
 
1289
    FClipped := False;
 
1290
    FClipRegion.Shape := HIShapeCreateEmpty;
 
1291
  end;
 
1292
 
 
1293
end;
 
1294
 
 
1295
function TCocoaContext.InitDraw(width, height:Integer): Boolean;
189
1296
var
190
 
  cg  : CGContextRef;
 
1297
  cg: CGContextRef;
191
1298
begin
192
 
  cg:=CGContext;
193
 
  Result:=Assigned(cg);
 
1299
  cg := CGContext;
 
1300
  Result := Assigned(cg);
194
1301
  if not Result then Exit;
195
1302
 
196
 
  ContextSize.cx:=width;
197
 
  ContextSize.cy:=height;
 
1303
  FSize.cx := width;
 
1304
  FSize.cy := height;
198
1305
 
199
1306
  CGContextTranslateCTM(cg, 0, height);
200
1307
  CGContextScaleCTM(cg, 1, -1);
201
 
  PenPos.x:=0;
202
 
  PenPos.y:=0;
203
 
end;
204
 
 
205
 
procedure TCocoaContext.MoveTo(x,y:Integer);
206
 
begin
207
 
  PenPos.x:=x;
208
 
  PenPos.y:=y;
209
 
end;
210
 
 
211
 
procedure TCocoaContext.LineTo(x,y:Integer);
 
1308
  FPenPos.x := 0;
 
1309
  FPenPos.y := 0;
 
1310
end;
 
1311
 
 
1312
procedure TCocoaContext.InvertRectangle(X1, Y1, X2, Y2: Integer);
 
1313
begin
 
1314
  // save dest context
 
1315
  ctx.saveGraphicsState;
 
1316
  try
 
1317
    DefaultBrush.Apply(Self, False);
 
1318
    CGContextSetBlendMode(CGContext, kCGBlendModeDifference);
 
1319
 
 
1320
    CGContextFillRect(CGContext, GetCGRectSorted(X1, Y1, X2, Y2));
 
1321
  finally
 
1322
    ctx.restoreGraphicsState;
 
1323
  end;
 
1324
end;
 
1325
 
 
1326
procedure TCocoaContext.MoveTo(X, Y: Integer);
 
1327
begin
 
1328
  FPenPos.x := X;
 
1329
  FPenPos.y := Y;
 
1330
end;
 
1331
 
 
1332
procedure TCocoaContext.LineTo(X, Y: Integer);
212
1333
var
213
 
  cg  : CGContextRef;
214
 
  p   : array [0..1] of CGPoint;
 
1334
  cg: CGContextRef;
 
1335
  p: array [0..1] of CGPoint;
215
1336
  deltaX, deltaY, absDeltaX, absDeltaY: Integer;
216
1337
  clipDeltaX, clipDeltaY: Float32;
217
1338
  tx,ty:Float32;
218
1339
begin
219
 
  cg:=CGContext;
 
1340
  cg := CGContext;
220
1341
  if not Assigned(cg) then Exit;
221
1342
 
222
1343
  deltaX := X - PenPos.x;
257
1378
  CGContextAddLines(cg, @p, 2);
258
1379
  CGContextStrokePath(cg);
259
1380
 
260
 
  PenPos.x := X;
261
 
  PenPos.y := Y;
 
1381
  FPenPos.x := X;
 
1382
  FPenPos.y := Y;
262
1383
end;
263
1384
 
264
1385
procedure CGContextAddLCLPoints(cg: CGContextRef; const Points: array of TPoint;NumPts:Integer);
265
1386
var
266
 
  cp  : array of CGPoint;
267
 
  i   : Integer;
 
1387
  cp: array of CGPoint;
 
1388
  i: Integer;
268
1389
begin
269
1390
  SetLength(cp, NumPts);
270
 
  for i:=0 to NumPts-1 do begin
 
1391
  for i:=0 to NumPts-1 do
 
1392
  begin
271
1393
    cp[i].x:=Points[i].X+0.5;
272
1394
    cp[i].y:=Points[i].Y+0.5;
273
1395
  end;
276
1398
 
277
1399
procedure CGContextAddLCLRect(cg: CGContextRef; x1, y1, x2, y2: Integer); overload;
278
1400
var
279
 
  r  : CGRect;
 
1401
  r: CGRect;
280
1402
begin
281
1403
  r.origin.x:=x1+0.5;
282
1404
  r.origin.y:=y1+0.5;
293
1415
procedure TCocoaContext.Polygon(const Points:array of TPoint;NumPts:Integer;
294
1416
  Winding:boolean);
295
1417
var
296
 
  cg  : CGContextRef;
 
1418
  cg: CGContextRef;
297
1419
begin
298
 
  cg:=CGContext;
 
1420
  cg := CGContext;
299
1421
  if not Assigned(cg) or (NumPts<=0) then Exit;
300
1422
 
301
1423
  CGContextBeginPath(cg);
310
1432
 
311
1433
procedure TCocoaContext.Polyline(const Points: array of TPoint; NumPts: Integer);
312
1434
var
313
 
  cg  : CGContextRef;
 
1435
  cg: CGContextRef;
314
1436
begin
315
 
  cg:=CGContext;
 
1437
  cg := CGContext;
316
1438
  if not Assigned(cg) or (NumPts<=0) then Exit;
317
1439
 
318
1440
  CGContextBeginPath(cg);
320
1442
  CGContextStrokePath(cg);
321
1443
end;
322
1444
 
323
 
procedure TCocoaContext.Rectangle(X1,Y1,X2,Y2:Integer;FillRect:Boolean; UseBrush: TCocoaBrush);
 
1445
procedure TCocoaContext.Rectangle(X1, Y1, X2, Y2: Integer; FillRect: Boolean; UseBrush: TCocoaBrush);
324
1446
var
325
 
  cg  : CGContextRef;
 
1447
  cg: CGContextRef;
326
1448
begin
327
 
  cg:=CGContext;
 
1449
  cg := CGContext;
328
1450
  if not Assigned(cg) then Exit;
329
1451
 
330
1452
  CGContextBeginPath(cg);
331
 
  CGContextAddLCLRect(cg, X1,Y1,X2,Y2);
332
 
  if FillRect then begin
 
1453
  CGContextAddLCLRect(cg, X1, Y1, X2, Y2);
 
1454
  if FillRect then
 
1455
  begin
333
1456
    //using the brush
334
 
    if Assigned(UseBrush) then UseBrush.Apply(cg);
 
1457
    if Assigned(UseBrush) then UseBrush.Apply(Self);
335
1458
    CGContextFillPath(cg);
336
1459
    //restore the brush
337
 
    if Assigned(UseBrush) and Assigned(fBrush) then fBrush.Apply(cg);
338
 
  end else
 
1460
    if Assigned(UseBrush) and Assigned(FBrush) then FBrush.Apply(Self);
 
1461
  end
 
1462
  else
339
1463
    CGContextStrokePath(cg);
340
1464
end;
341
1465
 
342
 
procedure TCocoaContext.Ellipse(X1,Y1,X2,Y2:Integer);
 
1466
procedure TCocoaContext.Ellipse(X1, Y1, X2, Y2:Integer);
343
1467
var
344
 
  cg : CGContextRef;
345
 
  r  : CGRect;
 
1468
  cg: CGContextRef;
 
1469
  r: CGRect;
346
1470
begin
347
 
  cg:=CGContext;
 
1471
  cg := CGContext;
348
1472
  if not Assigned(cg) then Exit;
349
1473
  r.origin.x:=x1+0.5;
350
1474
  r.origin.y:=y1+0.5;
355
1479
  CGContextDrawPath(CGContext, kCGPathFillStroke);
356
1480
end;
357
1481
 
358
 
procedure TCocoaContext.TextOut(X,Y:Integer;UTF8Chars:PChar;Count:Integer;
359
 
  CharsDelta:PInteger);
360
 
var
361
 
  cg      : CGContextRef;
362
 
begin
363
 
  cg:=CGContext;
364
 
  if not Assigned(cg) then Exit;
365
 
 
366
 
  CGContextScaleCTM(cg, 1, -1);
367
 
  CGContextTranslateCTM(cg, 0, -ContextSize.cy);
368
 
 
369
 
  CGContextSetRGBFillColor(cg, TR, TG, TB, 1);
370
 
  fText.SetText(UTF8Chars, Count);
371
 
  fText.Draw(cg, X, ContextSize.cy-Y, CharsDelta);
372
 
 
373
 
  if Assigned(fBrush) then fBrush.Apply(cg);
374
 
 
375
 
  CGContextTranslateCTM(cg, 0, ContextSize.cy);
376
 
  CGContextScaleCTM(cg, 1, -1);
377
 
end;
378
 
 
379
 
procedure TCocoaContext.SetOrigin(X,Y:Integer);
380
 
var
381
 
  cg  : CGContextRef;
382
 
begin
383
 
  cg:=CGContext;
384
 
  if not Assigned(cg) then Exit;
385
 
  if Assigned(cg) then CGContextTranslateCTM(cg, X, Y);
386
 
end;
387
 
 
388
 
procedure TCocoaContext.GetOrigin(var X,Y: Integer);
389
 
var
390
 
  cg  : CGContextRef;
391
 
  t   : CGAffineTransform;
392
 
begin
393
 
  cg:=CGContext;
394
 
  if not Assigned(cg) then Exit;
395
 
  t:=CGContextGetCTM(cg);
396
 
  X := Round(t.tx);
397
 
  Y := ContextSize.cy - Round(t.ty);
 
1482
procedure TCocoaContext.TextOut(X, Y: Integer; Options: Longint; Rect: PRect; UTF8Chars: PChar; Count: Integer; CharsDelta: PInteger);
 
1483
var
 
1484
  BrushSolid, FillBg: Boolean;
 
1485
begin
 
1486
  ctx.saveGraphicsState;
 
1487
 
 
1488
  if Assigned(Rect) then
 
1489
  begin
 
1490
    // fill background
 
1491
    if (Options and ETO_OPAQUE) <> 0 then
 
1492
    begin
 
1493
      BrushSolid := BkBrush.Solid;
 
1494
      BkBrush.Solid := True;
 
1495
      with Rect^ do
 
1496
        Rectangle(Left, Top, Right, Bottom, True, BkBrush);
 
1497
      BkBrush.Solid := BrushSolid;
 
1498
    end;
 
1499
 
 
1500
    if (Options and ETO_CLIPPED) <> 0 then
 
1501
    begin
 
1502
      CGContextBeginPath(CGContext);
 
1503
      CGContextAddRect(CGContext, RectToCGrect(Rect^));
 
1504
      CGContextClip(CGContext);
 
1505
    end;
 
1506
  end;
 
1507
 
 
1508
  FillBg := BkMode = OPAQUE;
 
1509
  if FillBg then
 
1510
    FText.BackgroundColor := BkBrush.ColorRef;
 
1511
  FText.SetText(UTF8Chars, Count);
 
1512
  FText.Draw(ctx, X, Y, FillBg, CharsDelta);
 
1513
 
 
1514
  ctx.restoreGraphicsState;
 
1515
end;
 
1516
 
 
1517
procedure TCocoaContext.Frame(const R: TRect);
 
1518
begin
 
1519
  Rectangle(R.Left, R.Top, R.Right + 1, R.Bottom + 1, False, nil);
 
1520
end;
 
1521
 
 
1522
procedure TCocoaContext.Frame3d(var ARect: TRect; const FrameWidth: integer; const Style: TBevelCut);
 
1523
var
 
1524
  I, D: Integer;
 
1525
  DrawInfo: HIThemeGroupBoxDrawInfo;
 
1526
begin
 
1527
  if Style = bvRaised then
 
1528
  begin
 
1529
    GetThemeMetric(kThemeMetricPrimaryGroupBoxContentInset, D);
 
1530
 
 
1531
    // draw frame as group box
 
1532
    DrawInfo.version := 0;
 
1533
    DrawInfo.state := kThemeStateActive;
 
1534
    DrawInfo.kind := kHIThemeGroupBoxKindPrimary;
 
1535
 
 
1536
    for I := 1 to FrameWidth do
 
1537
    begin
 
1538
      HIThemeDrawGroupBox(RectToCGRect(ARect), DrawInfo, CGContext, kHIThemeOrientationNormal);
 
1539
      InflateRect(ARect, -D, -D);
 
1540
    end;
 
1541
  end;
 
1542
end;
 
1543
 
 
1544
procedure TCocoaContext.FrameRect(const ARect: TRect; const ABrush: TCocoaBrush);
 
1545
begin
 
1546
  if ABrush <> Brush then
 
1547
    ABrush.Apply(Self);
 
1548
  if not ctx.currentContextDrawingToScreen then
 
1549
    ctx.setCurrentContext(ctx);
 
1550
  NSFrameRect(RectToNSRect(ARect));
 
1551
  if ABrush <> Brush then
 
1552
    Brush.Apply(Self);
 
1553
end;
 
1554
 
 
1555
procedure TCocoaContext.SetCGFillping(Ctx: CGContextRef; Width, Height: Integer);
 
1556
begin
 
1557
  if Width < 0 then
 
1558
  begin
 
1559
    CGContextTranslateCTM(Ctx, -Width, 0);
 
1560
    CGContextScaleCTM(Ctx, -1, 1);
 
1561
  end;
 
1562
 
 
1563
  if Height < 0 then
 
1564
  begin
 
1565
    CGContextTranslateCTM(Ctx, 0, -Height);
 
1566
    CGContextScaleCTM(Ctx, 1, -1);
 
1567
  end;
 
1568
end;
 
1569
 
 
1570
procedure TCocoaContext.RestoreCGFillping(Ctx: CGContextRef; Width, Height: Integer);
 
1571
begin
 
1572
  if Height < 0 then
 
1573
  begin
 
1574
    CGContextTranslateCTM(Ctx, 0, Height);
 
1575
    CGContextScaleCTM(Ctx, 1, -1);
 
1576
  end;
 
1577
 
 
1578
  if Width < 0 then
 
1579
  begin
 
1580
    CGContextScaleCTM(Ctx, -1, 1);
 
1581
    CGContextTranslateCTM(Ctx, Width, 0);
 
1582
  end;
 
1583
end;
 
1584
 
 
1585
function TCocoaContext.DrawCGImage(X, Y, Width, Height: Integer;
 
1586
  CGImage: CGImageRef): Boolean;
 
1587
begin
 
1588
  Result := False;
 
1589
 
 
1590
  // save dest context
 
1591
  ctx.saveGraphicsState;
 
1592
 
 
1593
  CGContextSetBlendMode(CGContext, kCGBlendModeNormal);
 
1594
  try
 
1595
    SetCGFillping(CGContext, Width, Height);
 
1596
    CGContextDrawImage(CGContext, GetCGRectSorted(X, Y, X + Width, Y + Height), CGImage);
 
1597
    RestoreCGFillping(CGContext, Width, Height);
 
1598
  finally
 
1599
    ctx.restoreGraphicsState;
 
1600
  end;
 
1601
 
 
1602
  Result := True;
 
1603
end;
 
1604
 
 
1605
function TCocoaContext.StretchDraw(X, Y, Width, Height: Integer;
 
1606
  SrcDC: TCocoaContext; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
 
1607
  Msk: TCocoaBitmap; XMsk, YMsk: Integer; Rop: DWORD): Boolean;
 
1608
var
 
1609
  Image, MskImage: CGImageRef;
 
1610
  SubImage, SubMask: Boolean;
 
1611
  Bmp: TCocoaBitmap;
 
1612
  LayRect, DstRect: CGRect;
 
1613
  ImgRect: CGRect;
 
1614
  LayerContext: CGContextRef;
 
1615
  Layer: CGLayerRef;
 
1616
  UseLayer: Boolean;
 
1617
begin
 
1618
  Result := False;
 
1619
 
 
1620
  Bmp := SrcDC.Bitmap;
 
1621
  if Assigned(Bmp) then
 
1622
    Image := Bmp.ImageRep.CGImage
 
1623
  else
 
1624
    Image := nil;
 
1625
 
 
1626
  if Image = nil then Exit;
 
1627
 
 
1628
  DstRect := CGRectMake(X, Y, Abs(Width), Abs(Height));
 
1629
 
 
1630
  SubMask := (Msk <> nil)
 
1631
         and (Msk.Image <> nil)
 
1632
         and (  (XMsk <> 0)
 
1633
             or (YMsk <> 0)
 
1634
             or (Msk.Width <> SrcWidth)
 
1635
             or (Msk.Height <> SrcHeight));
 
1636
 
 
1637
  SubImage := ((Msk <> nil) and (Msk.Image <> nil))
 
1638
           or (XSrc <> 0)
 
1639
           or (YSrc <> 0)
 
1640
           or (SrcWidth <> Bmp.Width)
 
1641
           or (SrcHeight <> Bmp.Height);
 
1642
 
 
1643
 
 
1644
  if SubMask then
 
1645
    MskImage := Msk.CreateSubImage(Bounds(XMsk, YMsk, SrcWidth, SrcHeight))
 
1646
  else
 
1647
    if Assigned(Msk) then
 
1648
      MskImage := Msk.ImageRep.CGImage
 
1649
    else
 
1650
      MskImage := nil;
 
1651
 
 
1652
  if SubImage then
 
1653
    Image := Bmp.CreateSubImage(Bounds(XSrc, YSrc, SrcWidth, SrcHeight));
 
1654
 
 
1655
 
 
1656
  UseLayer:=Assigned(MskImage)
 
1657
            or (CGImageGetWidth(Image)<>SrcWidth)
 
1658
            or (CGImageGetHeight(Image)<>SrcHeight);
 
1659
 
 
1660
  try
 
1661
    if not UseLayer then
 
1662
    begin
 
1663
      // Normal drawing
 
1664
      Result := DrawCGImage(X, Y, Width, Height, Image);
 
1665
    end
 
1666
    else
 
1667
    begin
 
1668
      // use temp layer to mask source image
 
1669
      // todo find a way to mask "hard" when stretching, now some soft remains are visible
 
1670
      LayRect := CGRectMake(0, 0, SrcWidth, SrcHeight);
 
1671
      Layer := CGLayerCreateWithContext(SrcDC.CGContext, LayRect.size, nil);
 
1672
 
 
1673
      // the sub-image is out of edges
 
1674
      if (CGImageGetWidth(Image)<>SrcWidth) or (CGImageGetHeight(Image)<>SrcHeight) then
 
1675
      begin
 
1676
        with ImgRect do
 
1677
          if XSrc<0 then origin.x:=SrcWidth-CGImageGetWidth(Image) else origin.x:=0;
 
1678
        with ImgRect do
 
1679
          if YSrc<0 then origin.y:=0 else origin.y:=SrcHeight-CGImageGetHeight(Image);
 
1680
 
 
1681
        ImgRect.size.width:=CGImageGetWidth(Image);
 
1682
        ImgRect.size.height:=CGImageGetHeight(Image);
 
1683
      end
 
1684
      else
 
1685
        ImgRect:=LayRect;
 
1686
 
 
1687
      try
 
1688
        LayerContext := CGLayerGetContext(Layer);
 
1689
        CGContextScaleCTM(LayerContext, 1, -1);
 
1690
        CGContextTranslateCTM(LayerContext, 0, -SrcHeight);
 
1691
 
 
1692
        SetCGFillping(LayerContext, Width, Height);
 
1693
        if Assigned(MskImage) then
 
1694
          CGContextClipToMask(LayerContext, ImgRect, MskImage);
 
1695
        CGContextDrawImage(LayerContext, ImgRect, Image);
 
1696
 
 
1697
        CGContextDrawLayerInRect(CGContext, DstRect, Layer);
 
1698
 
 
1699
        Result := True;
 
1700
      finally
 
1701
        CGLayerRelease(Layer);
 
1702
      end;
 
1703
    end;
 
1704
 
 
1705
  finally
 
1706
    if SubImage then CGImageRelease(Image);
 
1707
    if SubMask then CGImageRelease(MskImage);
 
1708
  end;
 
1709
end;
 
1710
 
 
1711
{------------------------------------------------------------------------------
 
1712
  Method:  GetTextExtentPoint
 
1713
  Params:  Str   - Text string
 
1714
           Count - Number of characters in string
 
1715
           Size  - The record for the dimensions of the string
 
1716
  Returns: If the function succeeds
 
1717
 
 
1718
  Computes the width and height of the specified string of text
 
1719
 ------------------------------------------------------------------------------}
 
1720
function TCocoaContext.GetTextExtentPoint(AStr: PChar; ACount: Integer; var Size: TSize): Boolean;
 
1721
begin
 
1722
  FText.SetText(AStr, ACount);
 
1723
  Size := FText.GetSize;
 
1724
  Result := True;
 
1725
end;
 
1726
 
 
1727
{------------------------------------------------------------------------------
 
1728
  Method:  TCocoaContext.GetTextMetrics
 
1729
  Params:  TM - The Record for the text metrics
 
1730
  Returns: If the function succeeds
 
1731
 
 
1732
  Fills the specified buffer with the metrics for the currently selected font
 
1733
 ------------------------------------------------------------------------------}
 
1734
function TCocoaContext.GetTextMetrics(var TM: TTextMetric): Boolean;
 
1735
var
 
1736
  Glyphs: TGlyphArray;
 
1737
  Adjustments: array of NSSize;
 
1738
  I: Integer;
 
1739
  A: Single;
 
1740
begin
 
1741
  FillChar(TM, SizeOf(TM), 0);
 
1742
 
 
1743
  TM.tmAscent := Round(Font.Font.ascender);
 
1744
  TM.tmDescent := -Round(Font.Font.descender);
 
1745
  TM.tmHeight := TM.tmAscent + TM.tmDescent;
 
1746
 
 
1747
  TM.tmInternalLeading := Round(Font.Font.leading);
 
1748
  TM.tmExternalLeading := 0;
 
1749
 
 
1750
  TM.tmMaxCharWidth := Round(Font.Font.maximumAdvancement.width);
 
1751
  FText.SetText('WMTigq[_|^', 10);
 
1752
  Glyphs := FText.GetGlyphs;
 
1753
  if Length(Glyphs) > 0 then
 
1754
  begin
 
1755
    SetLength(Adjustments, Length(Glyphs));
 
1756
    Font.Font.getAdvancements_forGlyphs_count(@Adjustments[0], @Glyphs[0], Length(Glyphs));
 
1757
    A := 0;
 
1758
    for I := 0 to High(Adjustments) do
 
1759
      A := A + Adjustments[I].width;
 
1760
    TM.tmAveCharWidth := Round(A / Length(Adjustments));
 
1761
    SetLength(Adjustments, 0);
 
1762
    SetLength(Glyphs, 0);
 
1763
  end
 
1764
  else
 
1765
    TM.tmAveCharWidth := TM.tmMaxCharWidth;
 
1766
 
 
1767
  TM.tmOverhang := 0;
 
1768
  TM.tmDigitizedAspectX := 0;
 
1769
  TM.tmDigitizedAspectY := 0;
 
1770
  TM.tmFirstChar := 'a';
 
1771
  TM.tmLastChar := 'z';
 
1772
  TM.tmDefaultChar := 'x';
 
1773
  TM.tmBreakChar := '?';
 
1774
 
 
1775
  TM.tmWeight := Font.CocoaFontWeightToWin32FontWeight(NSFontManager.sharedFontManager.weightOfFont(Font.Font));
 
1776
 
 
1777
  if cfs_Italic in Font.Style then
 
1778
    TM.tmItalic := 1;
 
1779
 
 
1780
  if cfs_Underline in Font.Style then
 
1781
    TM.tmUnderlined := 1;
 
1782
 
 
1783
  if cfs_StrikeOut in Font.Style then
 
1784
    TM.tmStruckOut := 1;
 
1785
 
 
1786
  TM.tmPitchAndFamily := TRUETYPE_FONTTYPE;
 
1787
  if Font.Font.isFixedPitch then
 
1788
    TM.tmPitchAndFamily := TM.tmPitchAndFamily or FIXED_PITCH;
 
1789
 
 
1790
  // we can take charset from Font.Charset also but leave it to default for now
 
1791
  TM.tmCharSet := DEFAULT_CHARSET;
 
1792
 
 
1793
  Result := True;
 
1794
end;
 
1795
 
 
1796
procedure TCocoaContext.DrawBitmap(X, Y: Integer; ABitmap: TCocoaBitmap);
 
1797
begin
 
1798
  NSGraphicsContext.saveGraphicsState();
 
1799
  NSGraphicsContext.setCurrentContext(ctx);
 
1800
  ABitmap.imagerep.drawAtPoint(NSMakePoint(X, Y));
 
1801
  NSGraphicsContext.restoreGraphicsState();
 
1802
end;
 
1803
 
 
1804
procedure TCocoaContext.DrawFocusRect(ARect: TRect);
 
1805
var
 
1806
  AOutSet: SInt32;
 
1807
begin
 
1808
  // LCL thinks that focus cannot be drawn outside focus rects, but carbon do that
 
1809
  // => correct rect
 
1810
  GetThemeMetric(kThemeMetricFocusRectOutset, AOutSet);
 
1811
  InflateRect(ARect, -AOutSet, -AOutSet);
 
1812
  HIThemeDrawFocusRect(RectToCGRect(ARect), True, CGContext, kHIThemeOrientationNormal);
 
1813
end;
 
1814
 
 
1815
procedure TCocoaContext.SetOrigin(X, Y:Integer);
 
1816
var
 
1817
  cg: CGContextRef;
 
1818
begin
 
1819
  cg := CGContext;
 
1820
  if Assigned(cg) then
 
1821
    CGContextTranslateCTM(cg, X, Y);
 
1822
end;
 
1823
 
 
1824
procedure TCocoaContext.GetOrigin(var X, Y: Integer);
 
1825
var
 
1826
  cg: CGContextRef;
 
1827
  t: CGAffineTransform;
 
1828
begin
 
1829
  cg := CGContext;
 
1830
  if Assigned(cg) then
 
1831
  begin
 
1832
    t := CGContextGetCTM(cg);
 
1833
    X := Round(t.tx);
 
1834
    Y := Size.cy - Round(t.ty);
 
1835
  end;
398
1836
end;
399
1837
 
400
1838
 
405
1843
 
406
1844
  Creates a new empty Cocoa region
407
1845
 ------------------------------------------------------------------------------}
408
 
constructor TCocoaRegion.Create;
 
1846
constructor TCocoaRegion.CreateDefault;
409
1847
begin
410
 
  inherited Create;
 
1848
  inherited Create(False);
411
1849
 
412
1850
  FShape := HIShapeCreateEmpty;
413
1851
end;
420
1858
 ------------------------------------------------------------------------------}
421
1859
constructor TCocoaRegion.Create(const X1, Y1, X2, Y2: Integer);
422
1860
begin
423
 
  inherited Create;
 
1861
  inherited Create(False);
424
1862
  FShape := HIShapeCreateWithRect(GetCGRect(X1, Y1, X2, Y2));
425
1863
end;
426
1864
 
473
1911
  end;
474
1912
 
475
1913
begin
476
 
  inherited Create;
 
1914
  inherited Create(False);
477
1915
 
478
1916
(*
479
1917
  The passed polygon is drawed into grayscale context, the region is constructed
565
2003
  Applies region to the specified context
566
2004
  Note: Clipping region is only reducing
567
2005
 ------------------------------------------------------------------------------}
568
 
procedure TCocoaRegion.Apply(cg: CGContextRef);
 
2006
procedure TCocoaRegion.Apply(ADC: TCocoaContext);
569
2007
begin
570
 
  if not Assigned(cg) then Exit;
571
 
  if HIShapeIsEmpty(FShape) or (HIShapeReplacePathInCGContext(FShape, cg)<>noErr) then
 
2008
  if ADC = nil then Exit;
 
2009
  if ADC.CGContext = nil then Exit;
 
2010
  if HIShapeIsEmpty(FShape) or (HIShapeReplacePathInCGContext(FShape, ADC.CGContext) <> noErr) then
572
2011
    Exit;
573
 
  CGContextClip(cg);
 
2012
  CGContextClip(ADC.CGContext);
574
2013
end;
575
2014
 
576
2015
{------------------------------------------------------------------------------
623
2062
  FShape := AShape;
624
2063
end;
625
2064
 
 
2065
procedure TCocoaRegion.Clear;
 
2066
begin
 
2067
  HIShapeSetEmpty(FShape)
 
2068
end;
 
2069
 
626
2070
function TCocoaRegion.CombineWith(ARegion: TCocoaRegion; CombineMode: TCocoaCombine): Boolean;
627
2071
var
628
2072
  sh1, sh2: HIShapeRef;
663
2107
 
664
2108
{ TCocoaPen }
665
2109
 
666
 
procedure TCocoaPen.Apply(cg:CGContextRef);
667
 
begin
668
 
  if not Assigned(cg) then Exit;
669
 
  CGContextSetRGBStrokeColor(cg, r, g, b, 1);
670
 
  CGContextSetLineWidth(cg, Width);
671
 
  //todo: style
672
 
end;
673
 
 
674
 
constructor TCocoaPen.Create;
675
 
begin
676
 
  inherited Create;
677
 
  Width:=1;
 
2110
procedure TCocoaPen.Apply(ADC: TCocoaContext; UseROP2: Boolean = True);
 
2111
 
 
2112
  function GetDashes(Source: TCocoaDashes): TCocoaDashes;
 
2113
  var
 
2114
    i: Integer;
 
2115
  begin
 
2116
    Result := Source;
 
2117
    for i := Low(Result) to High(Result) do
 
2118
      Result[i] := Result[i] * FWidth;
 
2119
  end;
 
2120
 
 
2121
var
 
2122
  AR, AG, AB, AA: Single;
 
2123
  AROP2: Integer;
 
2124
  ADashes: TCocoaDashes;
 
2125
begin
 
2126
  if ADC = nil then Exit;
 
2127
  if ADC.CGContext = nil then Exit;
 
2128
 
 
2129
  if UseROP2 then
 
2130
    AROP2 := ADC.ROP2
 
2131
  else
 
2132
    AROP2 := R2_COPYPEN;
 
2133
 
 
2134
  GetRGBA(AROP2, AR, AG, AB, AA);
 
2135
 
 
2136
  if AROP2 <> R2_NOT then
 
2137
    CGContextSetBlendMode(ADC.CGContext, kCGBlendModeNormal)
 
2138
  else
 
2139
    CGContextSetBlendMode(ADC.CGContext, kCGBlendModeDifference);
 
2140
 
 
2141
  CGContextSetRGBStrokeColor(ADC.CGContext, AR, AG, AB, AA);
 
2142
  CGContextSetLineWidth(ADC.CGContext, FWidth);
 
2143
 
 
2144
  if IsExtPen then
 
2145
  begin
 
2146
    if IsGeometric then
 
2147
    begin
 
2148
      CGContextSetLineCap(ADC.CGContext, FEndCap);
 
2149
      CGContextSetLineJoin(ADC.CGContext, FJoinStyle);
 
2150
    end;
 
2151
  end;
 
2152
 
 
2153
  case FStyle of
 
2154
    PS_DASH:
 
2155
      begin
 
2156
        ADashes := GetDashes(CocoaDashStyle);
 
2157
        CGContextSetLineDash(ADC.CGContext, 0, @ADashes[0], Length(ADashes));
 
2158
      end;
 
2159
    PS_DOT:
 
2160
      begin
 
2161
        ADashes := GetDashes(CocoaDotStyle);
 
2162
        CGContextSetLineDash(ADC.CGContext, 0, @ADashes[0], Length(ADashes));
 
2163
      end;
 
2164
    PS_DASHDOT:
 
2165
      begin
 
2166
        ADashes := GetDashes(CocoaDashDotStyle);
 
2167
        CGContextSetLineDash(ADC.CGContext, 0, @ADashes[0], Length(ADashes));
 
2168
      end;
 
2169
    PS_DASHDOTDOT:
 
2170
      begin
 
2171
        ADashes := GetDashes(CocoaDashDotDotStyle);
 
2172
        CGContextSetLineDash(ADC.CGContext, 0, @ADashes[0], Length(ADashes));
 
2173
      end;
 
2174
    PS_USERSTYLE:
 
2175
      CGContextSetLineDash(ADC.CGContext, 0, @Dashes[0], Length(Dashes));
 
2176
  else
 
2177
    CGContextSetLineDash(ADC.CGContext, 0, nil, 0);
 
2178
  end;
 
2179
end;
 
2180
 
 
2181
constructor TCocoaPen.CreateDefault;
 
2182
begin
 
2183
  inherited Create(clBlack, True, False);
 
2184
  FStyle := PS_SOLID;
 
2185
  FWidth := 1;
 
2186
  FIsExtPen := False;
 
2187
  Dashes := nil;
 
2188
end;
 
2189
 
 
2190
constructor TCocoaPen.Create(const ALogPen: TLogPen; const AGlobal: Boolean = False);
 
2191
begin
 
2192
  case ALogPen.lopnStyle of
 
2193
    PS_SOLID..PS_DASHDOTDOT,
 
2194
    PS_INSIDEFRAME:
 
2195
      begin
 
2196
        inherited Create(ColorToRGB(TColor(ALogPen.lopnColor)), True, AGlobal);
 
2197
        FWidth := Max(1, ALogPen.lopnWidth.x);
 
2198
      end;
 
2199
    else
 
2200
    begin
 
2201
      inherited Create(ColorToRGB(TColor(ALogPen.lopnColor)), False, AGlobal);
 
2202
      FWidth := 1;
 
2203
    end;
 
2204
  end;
 
2205
 
 
2206
  FStyle := ALogPen.lopnStyle;
 
2207
end;
 
2208
 
 
2209
constructor TCocoaPen.Create(dwPenStyle, dwWidth: DWord; const lplb: TLogBrush;
 
2210
  dwStyleCount: DWord; lpStyle: PDWord);
 
2211
var
 
2212
  i: integer;
 
2213
begin
 
2214
  case dwPenStyle and PS_STYLE_MASK of
 
2215
    PS_SOLID..PS_DASHDOTDOT,
 
2216
    PS_USERSTYLE:
 
2217
      begin
 
2218
        inherited Create(ColorToRGB(TColor(lplb.lbColor)), True, False);
 
2219
      end;
 
2220
    else
 
2221
    begin
 
2222
      inherited Create(ColorToRGB(TColor(lplb.lbColor)), False, False);
 
2223
    end;
 
2224
  end;
 
2225
 
 
2226
  FIsExtPen := True;
 
2227
  FIsGeometric := (dwPenStyle and PS_TYPE_MASK) = PS_GEOMETRIC;
 
2228
 
 
2229
  if IsGeometric then
 
2230
  begin
 
2231
    case dwPenStyle and PS_JOIN_MASK of
 
2232
      PS_JOIN_ROUND: FJoinStyle := kCGLineJoinRound;
 
2233
      PS_JOIN_BEVEL: FJoinStyle := kCGLineJoinBevel;
 
2234
      PS_JOIN_MITER: FJoinStyle := kCGLineJoinMiter;
 
2235
    end;
 
2236
 
 
2237
    case dwPenStyle and PS_ENDCAP_MASK of
 
2238
      PS_ENDCAP_ROUND: FEndCap := kCGLineCapRound;
 
2239
      PS_ENDCAP_SQUARE: FEndCap := kCGLineCapSquare;
 
2240
      PS_ENDCAP_FLAT: FEndCap := kCGLineCapButt;
 
2241
    end;
 
2242
    FWidth := Max(1, dwWidth);
 
2243
  end
 
2244
  else
 
2245
    FWidth := 1;
 
2246
 
 
2247
  if (dwPenStyle and PS_STYLE_MASK) = PS_USERSTYLE then
 
2248
  begin
 
2249
    SetLength(Dashes, dwStyleCount);
 
2250
    for i := 0 to dwStyleCount - 1 do
 
2251
      Dashes[i] := lpStyle[i];
 
2252
  end;
 
2253
 
 
2254
  FStyle := dwPenStyle and PS_STYLE_MASK;
 
2255
end;
 
2256
 
 
2257
constructor TCocoaPen.Create(const ABrush: TCocoaBrush; const AGlobal: Boolean);
 
2258
begin
 
2259
  inherited Create(ABrush.ColorRef, True, AGlobal);
 
2260
  FStyle := PS_SOLID;
 
2261
  FWidth := 1;
 
2262
  FIsExtPen := False;
 
2263
  Dashes := nil;
678
2264
end;
679
2265
 
680
2266
{ TCocoaBrush }
681
2267
 
682
 
procedure TCocoaBrush.Apply(cg:CGContextRef);
683
 
begin
684
 
  CGContextSetRGBFillColor(cg, R,G,B, 1);
685
 
end;
686
 
 
687
 
{ TCocoaTextLayout }
688
 
 
689
 
constructor TCocoaTextLayout.Create;
690
 
begin
691
 
  inherited Create;
 
2268
procedure DrawBitmapPattern(info: UnivPtr; c: CGContextRef); MWPascal;
 
2269
var
 
2270
  ABrush: TCocoaBrush absolute info;
 
2271
  AImage: CGImageRef;
 
2272
begin
 
2273
  AImage := ABrush.FImage;
 
2274
  CGContextDrawImage(c, GetCGRect(0, 0, CGImageGetWidth(AImage), CGImageGetHeight(AImage)),
 
2275
    AImage);
 
2276
end;
 
2277
 
 
2278
procedure TCocoaBrush.SetHatchStyle(AHatch: PtrInt);
 
2279
const
 
2280
  HATCH_DATA: array[HS_HORIZONTAL..HS_DIAGCROSS] of array[0..7] of Byte =
 
2281
 (
 
2282
 { HS_HORIZONTAL } ($FF, $FF, $FF, $00, $FF, $FF, $FF, $FF),
 
2283
 { HS_VERTICAL   } ($F7, $F7, $F7, $F7, $F7, $F7, $F7, $F7),
 
2284
 { HS_FDIAGONAL  } ($7F, $BF, $DF, $EF, $F7, $FB, $FD, $FE),
 
2285
 { HS_BDIAGONAL  } ($FE, $FD, $FB, $F7, $EF, $DF, $BF, $7F),
 
2286
 { HS_CROSS      } ($F7, $F7, $F7, $00, $F7, $F7, $F7, $F7),
 
2287
 { HS_DIAGCROSS  } ($7E, $BD, $DB, $E7, $E7, $DB, $BD, $7E)
 
2288
  );
 
2289
var
 
2290
  ACallBacks: CGPatternCallbacks;
 
2291
begin
 
2292
  if AHatch in [HS_HORIZONTAL..HS_DIAGCROSS] then
 
2293
  begin
 
2294
    FillChar(ACallBacks, SizeOf(ACallBacks), 0);
 
2295
    ACallBacks.drawPattern := @DrawBitmapPattern;
 
2296
    FBitmap := TCocoaBitmap.Create(8, 8, 1, 1, cbaByte, cbtMask, @HATCH_DATA[AHatch]);
 
2297
    FImage := FBitmap.ImageRep.CGImageForProposedRect_context_hints(nil, nil, nil);
 
2298
    FColored := False;
 
2299
    FCGPattern := CGPatternCreate(Self, GetCGRect(0, 0, 8, 8),
 
2300
      CGAffineTransformIdentity, 8, 8, kCGPatternTilingConstantSpacing,
 
2301
      Ord(FColored), ACallBacks);
 
2302
  end;
 
2303
end;
 
2304
 
 
2305
procedure TCocoaBrush.SetBitmap(ABitmap: TCocoaBitmap);
 
2306
var
 
2307
  AWidth, AHeight: Integer;
 
2308
  ACallBacks: CGPatternCallbacks;
 
2309
begin
 
2310
  AWidth := ABitmap.Width;
 
2311
  AHeight := ABitmap.Height;
 
2312
  FillChar(ACallBacks, SizeOf(ACallBacks), 0);
 
2313
  ACallBacks.drawPattern := @DrawBitmapPattern;
 
2314
  FBitmap := TCocoaBitmap.Create(ABitmap);
 
2315
  FImage := FBitmap.imageRep.CGImageForProposedRect_context_hints(nil, nil, nil);
 
2316
  FColored := True;
 
2317
  FCGPattern := CGPatternCreate(Self, GetCGRect(0, 0, AWidth, AHeight),
 
2318
    CGAffineTransformIdentity, AWidth, AHeight, kCGPatternTilingConstantSpacing,
 
2319
    Ord(FColored), ACallBacks);
 
2320
end;
 
2321
 
 
2322
procedure TCocoaBrush.SetImage(AImage: NSImage);
 
2323
var
 
2324
  AWidth, AHeight: Single;
 
2325
  ACallBacks: CGPatternCallbacks;
 
2326
  Rect: CGRect;
 
2327
begin
 
2328
  FillChar(ACallBacks, SizeOf(ACallBacks), 0);
 
2329
  ACallBacks.drawPattern := @DrawBitmapPattern;
 
2330
  FImage := CGImageCreateCopy(AImage.CGImageForProposedRect_context_hints(nil, nil, nil));
 
2331
  FColored := True;
 
2332
  Rect.origin.x := 0;
 
2333
  Rect.origin.y := 0;
 
2334
  Rect.size := CGSize(AImage.size);
 
2335
  FCGPattern := CGPatternCreate(Self, Rect,
 
2336
    CGAffineTransformIdentity, Rect.size.width, Rect.size.height, kCGPatternTilingConstantSpacing,
 
2337
    Ord(FColored), ACallBacks);
 
2338
end;
 
2339
 
 
2340
procedure TCocoaBrush.SetColor(AColor: NSColor);
 
2341
var
 
2342
  RGBColor, PatternColor: NSColor;
 
2343
begin
 
2344
  Clear;
 
2345
 
 
2346
  FColor := AColor;
 
2347
  FColor.retain;
 
2348
 
 
2349
  RGBColor := AColor.colorUsingColorSpaceName(NSCalibratedRGBColorSpace);
 
2350
 
 
2351
  if Assigned(RGBColor) then
 
2352
    SetColor(NSColorToRGB(RGBColor), True)
 
2353
  else
 
2354
  begin
 
2355
    PatternColor := AColor.colorUsingColorSpaceName(NSPatternColorSpace);
 
2356
    if Assigned(PatternColor) then
 
2357
    begin
 
2358
      SetColor(NSColorToColorRef(PatternColor.patternImage.backgroundColor), False);
 
2359
      SetImage(PatternColor.patternImage);
 
2360
    end
 
2361
    else
 
2362
      SetColor(0, True);
 
2363
  end;
 
2364
end;
 
2365
 
 
2366
constructor TCocoaBrush.CreateDefault(const AGlobal: Boolean = False);
 
2367
begin
 
2368
  inherited Create(clWhite, True, AGlobal);
 
2369
  FBitmap := nil;
 
2370
  FImage := nil;
 
2371
  FCGPattern := nil;
 
2372
  FColor := nil;
 
2373
end;
 
2374
 
 
2375
constructor TCocoaBrush.Create(const ALogBrush: TLogBrush; const AGlobal: Boolean = False);
 
2376
begin
 
2377
  FCGPattern := nil;
 
2378
  FBitmap := nil;
 
2379
  FImage := nil;
 
2380
  FColor := nil;
 
2381
  case ALogBrush.lbStyle of
 
2382
    BS_SOLID:
 
2383
        inherited Create(ColorToRGB(TColor(ALogBrush.lbColor)), True, AGlobal);
 
2384
    BS_HATCHED:        // Hatched brush.
 
2385
      begin
 
2386
        inherited Create(ColorToRGB(TColor(ALogBrush.lbColor)), True, AGlobal);
 
2387
        SetHatchStyle(ALogBrush.lbHatch);
 
2388
      end;
 
2389
    BS_DIBPATTERN,
 
2390
    BS_DIBPATTERN8X8,
 
2391
    BS_DIBPATTERNPT,
 
2392
    BS_PATTERN,
 
2393
    BS_PATTERN8X8:
 
2394
      begin
 
2395
        inherited Create(ColorToRGB(TColor(ALogBrush.lbColor)), False, AGlobal);
 
2396
        SetBitmap(TCocoaBitmap(ALogBrush.lbHatch));
 
2397
      end
 
2398
    else
 
2399
      inherited Create(ColorToRGB(TColor(ALogBrush.lbColor)), False, AGlobal);
 
2400
  end;
 
2401
end;
 
2402
 
 
2403
constructor TCocoaBrush.Create(const AColor: NSColor; const AGlobal: Boolean);
 
2404
var
 
2405
  RGBColor, PatternColor: NSColor;
 
2406
begin
 
2407
  FColor := AColor;
 
2408
  FColor.retain;
 
2409
 
 
2410
  FCGPattern := nil;
 
2411
  FBitmap := nil;
 
2412
  FImage := nil;
 
2413
  RGBColor := AColor.colorUsingColorSpaceName(NSCalibratedRGBColorSpace);
 
2414
  if Assigned(RGBColor) then
 
2415
    inherited Create(NSColorToRGB(RGBColor), True, AGlobal)
 
2416
  else
 
2417
  begin
 
2418
    PatternColor := AColor.colorUsingColorSpaceName(NSPatternColorSpace);
 
2419
    if Assigned(PatternColor) then
 
2420
    begin
 
2421
      inherited Create(NSColorToColorRef(PatternColor.patternImage.backgroundColor), False, AGlobal);
 
2422
      SetImage(PatternColor.patternImage);
 
2423
    end
 
2424
    else
 
2425
      inherited Create(0, True, AGlobal);
 
2426
  end;
 
2427
end;
 
2428
 
 
2429
procedure TCocoaBrush.Clear;
 
2430
begin
 
2431
  if FColor <> nil then
 
2432
  begin
 
2433
    FColor.release;
 
2434
    FColor := nil;
 
2435
  end;
 
2436
 
 
2437
  if FCGPattern <> nil then
 
2438
  begin
 
2439
    CGPatternRelease(FCGPattern);
 
2440
    FCGPattern := nil;
 
2441
  end;
 
2442
 
 
2443
  FreeAndNil(FBitmap);
 
2444
 
 
2445
  if FImage <> nil then
 
2446
  begin
 
2447
    CGImageRelease(FImage);
 
2448
    FImage := nil;
 
2449
  end;
 
2450
end;
 
2451
 
 
2452
destructor TCocoaBrush.Destroy;
 
2453
begin
 
2454
  Clear;
 
2455
  inherited Destroy;
 
2456
end;
 
2457
 
 
2458
procedure TCocoaBrush.Apply(ADC: TCocoaContext; UseROP2: Boolean = True);
 
2459
var
 
2460
  RGBA: array[0..3] of Single;
 
2461
  AROP2: Integer;
 
2462
  APatternSpace: CGColorSpaceRef;
 
2463
  BaseSpace: CGColorSpaceRef;
 
2464
begin
 
2465
  if ADC = nil then Exit;
 
2466
 
 
2467
  if UseROP2 then
 
2468
    AROP2 := ADC.ROP2
 
2469
  else
 
2470
    AROP2 := R2_COPYPEN;
 
2471
 
 
2472
  GetRGBA(AROP2, RGBA[0], RGBA[1], RGBA[2], RGBA[3]);
 
2473
 
 
2474
  if AROP2 <> R2_NOT then
 
2475
    CGContextSetBlendMode(ADC.CGContext, kCGBlendModeNormal)
 
2476
  else
 
2477
    CGContextSetBlendMode(ADC.CGContext, kCGBlendModeDifference);
 
2478
 
 
2479
  if Assigned(FCGPattern) then
 
2480
  begin
 
2481
    if not FColored then
 
2482
      BaseSpace := CGColorSpaceCreateDeviceRGB
 
2483
    else
 
2484
    begin
 
2485
      BaseSpace := nil;
 
2486
      RGBA[0] := 1.0;
 
2487
    end;
 
2488
    APatternSpace := CGColorSpaceCreatePattern(BaseSpace);
 
2489
    CGContextSetFillColorSpace(ADC.CGContext, APatternSpace);
 
2490
    CGColorSpaceRelease(APatternSpace);
 
2491
    if Assigned(BaseSpace) then CGColorSpaceRelease(BaseSpace);
 
2492
    CGContextSetFillPattern(ADC.CGcontext, FCGPattern, @RGBA[0]);
 
2493
  end
 
2494
  else
 
2495
    CGContextSetRGBFillColor(ADC.CGContext, RGBA[0], RGBA[1], RGBA[2], RGBA[3]);
692
2496
end;
693
2497
 
694
2498
{ TCocoaGDIObject }
695
2499
 
 
2500
constructor TCocoaGDIObject.Create(AGlobal: Boolean);
 
2501
begin
 
2502
  FRefCount := 0;
 
2503
  FGlobal := AGlobal;
 
2504
end;
 
2505
 
696
2506
procedure TCocoaGDIObject.AddRef;
697
2507
begin
698
 
  if RefCount>=0 then inc(RefCount);
 
2508
  if FGlobal then Exit;
 
2509
  if FRefCount >= 0 then inc(FRefCount);
699
2510
end;
700
2511
 
701
2512
procedure TCocoaGDIObject.Release;
702
2513
begin
703
 
  if RefCount>0 then Dec(RefCount)
704
 
  else if RefCount=0 then Free;
 
2514
  if FGlobal then Exit;
 
2515
  if FRefCount > 0 then
 
2516
    Dec(FRefCount)
 
2517
  else
 
2518
  begin
 
2519
    //DebugLn('TCocoaGDIObject.Release Error - ', dbgsName(self), ' RefCount = ', dbgs(FRefCount));
 
2520
  end;
705
2521
end;
706
2522
 
 
2523
initialization
 
2524
  DefaultBrush := TCocoaBrush.CreateDefault;
 
2525
  DefaultPen := TCocoaPen.CreateDefault;
 
2526
  DefaultFont := TCocoaFont.CreateDefault;
 
2527
 
 
2528
finalization
 
2529
  DefaultBrush.Free;
 
2530
  DefaultPen.Free;
 
2531
  DefaultFont.Free;
707
2532
end.