File: cocoacustomcontrol.pas

package info (click to toggle)
lazarus 4.0%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 275,760 kB
  • sloc: pascal: 2,341,904; xml: 509,420; makefile: 348,726; cpp: 93,608; sh: 3,387; java: 609; perl: 297; sql: 222; ansic: 137
file content (450 lines) | stat: -rw-r--r-- 13,511 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
unit CocoaCustomControl;

{$mode objfpc}{$H+}
{$modeswitch objectivec2}
{$interfaces corba}

interface

uses
  Classes, SysUtils,
  Forms,
  MacOSAll, CocoaAll, CocoaPrivate, CocoaCallback,
  CocoaCursor, Cocoa_Extra, CocoaUtils;

type
  { TCocoaCustomControl }

  TCocoaCustomControl = objcclass(NSControl)
  private
    fstr : NSString;

    isdrawing   : integer;
    faileddraw  : Boolean;
  public
    callback: ICommonCallback;
    auxMouseByParent: Boolean;
    procedure dealloc; override;
    function acceptsFirstResponder: LCLObjCBoolean; override;
    procedure drawRect(dirtyRect: NSRect); override;
    function lclGetCallback: ICommonCallback; override;
    procedure lclClearCallback; override;
    function lclIsMouseInAuxArea(Event: NSevent): Boolean; override;
    // mouse
    function acceptsFirstMouse(event: NSEvent): LCLObjCBoolean; override;
    procedure mouseDown(event: NSEvent); override;
    procedure mouseUp(event: NSEvent); override;
    procedure rightMouseDown(event: NSEvent); override;
    procedure rightMouseUp(event: NSEvent); override;
    procedure rightMouseDragged(event: NSEvent); override;
    procedure otherMouseDown(event: NSEvent); override;
    procedure otherMouseUp(event: NSEvent); override;
    procedure otherMouseDragged(event: NSEvent); override;
    procedure mouseDragged(event: NSEvent); override;
    procedure mouseEntered(event: NSEvent); override;
    procedure mouseExited(event: NSEvent); override;
    procedure mouseMoved(event: NSEvent); override;
    procedure scrollWheel(event: NSEvent); override;
    // nsview
    procedure setFrame(aframe: NSRect); override;
    // value
    procedure setStringValue(avalue: NSString); override;
    function stringValue: NSString; override;
    procedure addSubView(aview: NSView); override;
    procedure doCommandBySelector (aSelector: SEL); override;
  end;

  { TCocoaCustomControlWithBaseInputClient }

  TCocoaCustomControlWithBaseInputClient = objcclass(TCocoaCustomControl, NSTextInputClientProtocol)
  private
    _inIME: Boolean;
  private
    function getWindowEditor(): NSTextView; message 'getWindowEditor';
    procedure DoCallInputClientInsertText(nsText:NSString); message 'DoCallInputClientInsertText:';
  public
    // NSTextInputClientProtocol related.
    // implements a base NSTextInputClient for non-editable LCL CustomControl,
    // like Form, Grid, ListView, that are not system control and not FullEditControl.
    // 1. when using IME in these controls, a temporary and one-time editor is shown
    //    at the bottom of the control, supporting IME such as Chinese.
    // 2. refers to MacOS Finder, when using IME in the file list view,
    //    a small window will pop up at the bottom of the screen for input.
    //    the text can then be used for filename starting character match.
    // 3. it is useful for implementing IME support for controls that do not
    //    have a text input window.
    procedure keyDown(theEvent: NSEvent); override;
    procedure insertText_replacementRange (aString: id; replacementRange: NSRange);
    procedure setMarkedText_selectedRange_replacementRange (aString: id; selectedRange: NSRange; replacementRange: NSRange);
    procedure unmarkText;
    function selectedRange: NSRange;
    function markedRange: NSRange;
    function hasMarkedText: LCLObjCBoolean;
    function firstRectForCharacterRange_actualRange (aRange: NSRange; actualRange: NSRangePointer): NSRect;

    function attributedSubstringForProposedRange_actualRange (aRange: NSRange; actualRange: NSRangePointer): NSAttributedString;
    function validAttributesForMarkedText: NSArray;
    function characterIndexForPoint (aPoint: NSPoint): NSUInteger;
  end;

implementation

{ TCocoaCustomControl }

procedure TCocoaCustomControl.setStringValue(avalue: NSString);
begin
  if Assigned(fstr) then fstr.release;
  if ASsigned(avalue) then
    fstr:=avalue.copyWithZone(nil)
  else
    fstr:=nil;
  inherited setStringValue(avalue);
end;

function TCocoaCustomControl.stringValue: NSString;
begin
  Result:=fstr;
end;

procedure TCocoaCustomControl.addSubView(aview: NSView);
var
  mask: NSUInteger;
begin
  inherited addSubView(aview);

  if Assigned(aview) then
  begin
    // forcing LCL compatible "auto-move" mode. Sticking to left/top corner
    if not autoresizesSubviews then
      {$ifdef BOOLFIX}
      setAutoresizesSubviews_(Ord(true));
      {$else}
      setAutoresizesSubviews(true);
      {$endif}
    if self.isFlipped then
      mask:= NSViewMaxYMargin or NSViewMaxXMargin
    else
      mask:= NSViewMinYMargin or NSViewMaxXMargin;
    aview.setAutoresizingMask(mask);
  end;
end;

procedure TCocoaCustomControl.dealloc;
begin
  if Assigned(fstr) then fstr.release;
  inherited dealloc;
end;

function TCocoaCustomControl.acceptsFirstResponder: LCLObjCBoolean;
begin
  Result := True;
end;

function TCocoaCustomControl.acceptsFirstMouse(event: NSEvent): LCLObjCBoolean;
begin
  // By default, a mouse-down event in a window that isn’t the key window
  // simply brings the window forward and makes it key; the event isn’t sent
  // to the NSView object over which the mouse click occurs. The NSView can
  // claim an initial mouse-down event, however, by overriding acceptsFirstMouse: to return YES.
  // see bug #33034
  Result:=true;
end;

procedure TCocoaCustomControl.drawRect(dirtyRect: NSRect);
begin
  if isdrawing=0 then faileddraw:=false;
  inc(isdrawing);
  inherited drawRect(dirtyRect);

  // Implement Color property
  if Assigned(callback) then
    callback.DrawBackground(NSGraphicsContext.currentContext, bounds, dirtyRect);

  if CheckMainThread and Assigned(callback) then
    callback.Draw(NSGraphicsContext.currentContext, bounds, dirtyRect);
  dec(isdrawing);

  if (isdrawing=0) and (faileddraw) then
  begin
    // if the frame is changed during the Paint event,
    // redrawing must be triggered to ensure that the
    // correctly updated NSGraphicsContext is obtained.
    // 1. for the new version of macOS, just set setNeedsDisplay()
    // 2. for older versions of macOS, display() must be called by itself,
    //    and just setting by setNeedsDisplay() will not work.
    if NSAppKitVersionNumber >= NSAppKitVersionNumber11_0 then
      self.lclInvalidate
    else
      self.display;
  end;
end;

function TCocoaCustomControl.lclGetCallback: ICommonCallback;
begin
  Result := callback;
end;

procedure TCocoaCustomControl.lclClearCallback;
begin
  callback := nil;
end;

function TCocoaCustomControl.lclIsMouseInAuxArea(Event: NSevent): Boolean;
begin
  if auxMouseByParent and Assigned(superview) then
    Result := superview.lclIsMouseInAuxArea(Event)
  else
    Result := false;
end;

procedure TCocoaCustomControl.mouseDown(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited mouseDown(event);
end;

procedure TCocoaCustomControl.mouseDragged(event: NSEvent);
begin
  window.disableCursorRects;

  if not Assigned(callback) or not callback.MouseMove(event) then
    // calling inherited causes the drag event to be passed to the
    // parent controls

    //inherited mouseDragged(event);
    ;
end;

procedure TCocoaCustomControl.mouseEntered(event: NSEvent);
begin
  inherited mouseEntered(event);
end;

procedure TCocoaCustomControl.mouseExited(event: NSEvent);
begin
  inherited mouseExited(event);
end;

procedure TCocoaCustomControl.mouseMoved(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseMove(event) then
    inherited mouseMoved(event);
end;

procedure TCocoaCustomControl.scrollWheel(event: NSEvent);
begin
  if Assigned(self.lclGetTarget) and (self.lclGetTarget is TScrollingWinControl) then begin
    inherited scrollWheel(event);
    if Assigned(callback) then
      callback.scrollWheel(event);
  end else begin
    if NOT Assigned(callback) or NOT callback.scrollWheel(event) then
      inherited scrollWheel(event);
  end;
end;

procedure TCocoaCustomControl.setFrame(aframe: NSRect);
begin
  if NSEqualRects(aframe, frame) then Exit;
  if isdrawing>0 then
    faileddraw := true;

  inherited setFrame(aframe);
  // it actually should come from a notifcation
  if Assigned(callback) then callback.frameDidChange(self);
end;

procedure TCocoaCustomControl.mouseUp(event: NSEvent);
begin
  if not window.areCursorRectsEnabled then
  begin
    window.enableCursorRects;
    window.resetCursorRects;
    CursorHelper.SetCursorAtMousePos;
  end;

  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited mouseUp(event);
end;

procedure TCocoaCustomControl.rightMouseDown(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited rightMouseDown(event);
end;

procedure TCocoaCustomControl.rightMouseUp(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited rightMouseUp(event);
end;

procedure TCocoaCustomControl.rightMouseDragged(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseMove(event) then
    inherited rightMouseDragged(event);
end;

procedure TCocoaCustomControl.otherMouseDown(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited otherMouseDown(event);
end;

procedure TCocoaCustomControl.otherMouseUp(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseUpDownEvent(event) then
    inherited otherMouseUp(event);
end;

procedure TCocoaCustomControl.otherMouseDragged(event: NSEvent);
begin
  if not Assigned(callback) or not callback.MouseMove(event) then
    inherited otherMouseDragged(event);
end;

procedure TCocoaCustomControl.doCommandBySelector(aSelector: SEL);
begin
  inherited doCommandBySelector(ASelector);
end;

{ TCocoaCustomControlWithBaseInputClient }

function TCocoaCustomControlWithBaseInputClient.getWindowEditor(): NSTextView;
begin
  Result:= NSTextView( self.window.fieldEditor_forObject(true,nil) );
end;

procedure TCocoaCustomControlWithBaseInputClient.DoCallInputClientInsertText(nsText:NSString);
begin
  if Assigned(callback) then
    callback.InputClientInsertText(nsText.UTF8String);
  nsText.release;
end;

procedure TCocoaCustomControlWithBaseInputClient.keyDown(theEvent: NSEvent);
var
  textView: NSView;
  isFirst: Boolean;
begin
  if (not _inIME) and (theEvent.keyCode in
     [kVK_Return, kVK_ANSI_KeypadEnter, kVK_Escape, kVK_Space]) then
  begin
    inherited;
    exit;
  end;

  isFirst:= not _inIME;
  inputContext.handleEvent(theEvent);
  if _inIME and isFirst then
  begin
    textView:= getWindowEditor();
    textView.setFrameSize( NSMakeSize(self.frame.size.width,16) );
    self.addSubView( textView );
  end
  else if not _inIME then
    inputContext.discardMarkedText;
end;

// in TCocoaCustomControl, such as Form, Grid, ListView,
// after inputting text, another control may be focused.
// in insertText_replacementRange(), Cocoa/InputContext doesn't like it,
// so calling InputClientInsertText() asynchronously.
procedure TCocoaCustomControlWithBaseInputClient.insertText_replacementRange(aString: id;
  replacementRange: NSRange);
var
  nsText: NSString;
begin
  if not _inIME then exit;

  unmarkText;

  nsText:= getNSStringObject(aString).copy;
  performSelector_withObject_afterDelay(ObjCSelector('DoCallInputClientInsertText:'), nsText, 0 );
end;

procedure TCocoaCustomControlWithBaseInputClient.setMarkedText_selectedRange_replacementRange(
  aString: id; selectedRange: NSRange; replacementRange: NSRange);
var
  textView: NSTextView;
  nsText: NSString;
begin
  nsText:= getNSStringObject(aString);
  if nsText.length > 0 then
  begin
    _inIME:= true;
    textView:= getWindowEditor();
    if Assigned(textView) then
      textView.setMarkedText_selectedRange_replacementRange(aString,selectedRange,replacementRange);
  end
  else
    unmarkText;
end;

function TCocoaCustomControlWithBaseInputClient.hasMarkedText: LCLObjCBoolean;
begin
  Result := _inIME;
end;

procedure TCocoaCustomControlWithBaseInputClient.unmarkText;
var
  textView: NSTextView;
begin
  _inIME:= false;
  textView:= getWindowEditor();
  if Assigned(textView) then
    textView.removeFromSuperview;
end;

function TCocoaCustomControlWithBaseInputClient.firstRectForCharacterRange_actualRange(
  aRange: NSRange; actualRange: NSRangePointer): NSRect;
var
  point: NSPoint;
  rect: NSRect;
begin
  point:= self.convertPoint_toView(NSZeroPoint, nil);
  rect:= NSMakeRect(point.x, point.y, 0, 16);
  Result:= self.window.convertRectToScreen(rect);
end;

function TCocoaCustomControlWithBaseInputClient.selectedRange: NSRange;
var
  textView: NSText;
begin
  textView:= getWindowEditor();
  if not Assigned(textView) then
    Result:= NSMakeRange( NSNotFound, 0 )
  else
    Result:= textView.selectedRange;
end;

function TCocoaCustomControlWithBaseInputClient.markedRange: NSRange;
var
  textView: NSTextView;
begin
  textView:= getWindowEditor();
  if not Assigned(textView) then
    Result:= NSMakeRange( NSNotFound, 0 )
  else
    Result:= textView.markedRange;
end;

function TCocoaCustomControlWithBaseInputClient.attributedSubstringForProposedRange_actualRange(
  aRange: NSRange; actualRange: NSRangePointer): NSAttributedString;
begin
  Result := nil;
end;

function TCocoaCustomControlWithBaseInputClient.validAttributesForMarkedText: NSArray;
begin
  Result := nil;
end;

function TCocoaCustomControlWithBaseInputClient.characterIndexForPoint(aPoint: NSPoint
  ): NSUInteger;
begin
  Result := 0;
end;

end.