Créer une fenêtre MacOSX via l'API Cocoa

[Paul TOTH]

Bonjour,

Voici un exemple de création d'une fenêtre MacOSX avec instanciation des objets NSApplication, NSWindow et création des classes TApplicationDelegate et TWindowDelegate qui reçoivent les événements des deux précédents.

Il faut savoir que Objective-C est une surcouche à C qui se contente de faire les appels que j'ai mis ici sous Delphi XE2, c'est donc plus verveux sous Delphi XE2 mais au final c'est la même chose.

Le coeur du système est la fonction objc_msgSend qui permet d'invoquer la méthode d'un object. L'objet peut être une classe (objc_getClass) et dans ce cas on a une méthode de classe, ou une instance obtenue par un objc_msgSend justement. En Objective-C le code objc_msgSend(objc_getClass('NSObject'), sel_getUid('alloc')) s'écrira tout simplement [NSObject alloc]; de même l'appel d'init se fera dans la foulée [[NSObject alloc] init].

Notez cependant que Objective-C utilise des fichiers NIB qui sont l'équivalent des DFM de Delphi, donc généralement l'approche est tout de même différente.

Code :

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
 
program MacAPI;
 
// (c)2012 Execute SARL http://www.execute.re
 
{$APPTYPE CONSOLE}
 
{$R *.res}
 
const
// les "DLL" nécessairse à l'application
  libdl   = '/usr/lib/libdl.dylib';
  libobjc = 'libobjc.A.dylib';
 
// pour dlopen équivalent à LoadLibrary
  RTLD_LAZY   = 1;
 
 // NSWindow.styleMask
  NSTitledWindowMask         = 1;
  NSClosableWindowMask       = 2;
  NSMiniaturizableWindowMask = 4;
  NSResizableWindowMask      = 8;
 
 // NSWindow.NSBackingStoreType
  NSBackingStoreBuffered     = 2;
 
type
  NSPoint = record
    x: Single;
    y: Single;
  end;
 
  NSSize = record
    width: Single;
    height: Single;
  end;
 
  NSRect = record
    origin: NSPoint;
    size: NSSize;
  end;
 
function dlopen(Filename: PAnsiChar; Flag: Integer): NativeUInt; cdecl;
  external libdl name '_dlopen';
 
// Objective-C Runtime
 
function objc_allocateClassPair(superclass: Pointer; name: PAnsiChar; ExtraBytes: Longword): Pointer; cdecl;
  external libobjc name '_objc_allocateClassPair';
 
function class_addMethod(Cls: Pointer; theSelector: Pointer; Impl: Pointer; types: PAnsiChar): Integer;
  cdecl; external libobjc name '_class_addMethod';
 
procedure objc_registerClassPair(Cls: Pointer); cdecl;
  external libobjc name '_objc_registerClassPair';
 
function objc_getClass(const name: PAnsiChar): Pointer; cdecl;
  external libobjc name '_objc_getClass';
 
function sel_getUid(const str: PAnsiChar): Pointer; cdecl;
  external libobjc name '_sel_getUid';
 
function objc_msgSend(theReceiver, theSelector: Pointer): Pointer; cdecl; varargs;
  external libobjc name '_objc_msgSend';
 
var
// Selector (ou messages) de Objective-C
  msg_alloc       : Pointer;
  msg_init        : Pointer;
  msg_setDelegate : Pointer;
  msg_object      : Pointer;
  msg_setTitle    : Pointer;
  msg_stringWithCharacters: Pointer;
 
// Classes Objective-C
  NSObject        : Pointer;
  NSString        : Pointer;
 
// Classes utilisateur
  TAppDelegate    : Pointer;
  TWindowDelegate : Pointer;
 
// variables de l'application
  Pool            : Pointer;
  App             : Pointer;
 
// allouer une classe d'après son nom équivalent de TObject.newInstance
function Alloc(const AClass: PAnsiChar): Pointer;
begin
  Result := objc_msgSend(objc_getClass(AClass), msg_alloc);
end;
 
// Appelle le constructor "init" d'une classe d'après son nom
function Init(const AClass: PAnsiChar): Pointer; overload;
begin
  Result := objc_msgSend(Alloc(AClass), msg_init);
end;
 
// Appelle le constructor "init" d'une classe d'après son Pointer (objc_getClass ou objc_allocateClassPair)
function Init(const AClass: Pointer): Pointer; overload;
begin
  Result := objc_msgSend(objc_msgSend(AClass, msg_alloc), msg_init);
end;
 
// Conversion d'un chaîne Delphi en NSString autodétruite
function StrToNSString(const Str: string): Pointer;
begin
  Result := objc_msgSend(NSString, msg_stringWithCharacters, PWideChar(Str), Length(Str));
end;
 
// Evénement "OnLoad" de l'application
function applicationDidFinishLaunching(id, sel, notification: Pointer): Boolean; cdecl;
var
  Rect  : NSRect;
  Flags : LongWord;
  Window: Pointer;
begin
  WriteLn('Evénement applicationDidFinishLaunching');
 
  Rect.origin.x := 100;
  Rect.origin.y := 100;
  Rect.size.width := 320;
  Rect.size.height := 200;
 
  Flags := NSTitledWindowMask
        or NSClosableWindowMask
        or NSMiniaturizableWindowMask
        or NSResizableWindowMask;
 
  WriteLn(' Création d''une NSWindow');
  Window := objc_msgSend(
    Alloc('NSWindow'),
    sel_getUid('initWithContentRect:styleMask:backing:defer:'),
    Rect, Flags, NSBackingStoreBuffered, True
  );
 
  WriteLn(' Association d''un TWindowDelegate');
  objc_msgSend(Window, msg_setDelegate, Init(TWindowDelegate));
 
  WriteLn(' Afficher la fenêtre');
  objc_msgSend(Window, sel_getUid('makeKeyAndOrderFront:'), App);
 
  Result := True;
end;
 
// L'application doit-elle se terminer quand toutes les fenêtres sont fermées ?
function applicationShouldTerminateAfterLastWindowClosed(id, sel, App: Pointer): Boolean; cdecl;
begin
  WriteLn('Evénement applicationShouldTerminateAfterLastWindowClosed');
 
  Result := True;
end;
 
// Evénements OnResize d'une fenêtre
procedure windowDidResize(id, sel, notification: Pointer); cdecl;
var
  Window: Pointer;
begin
  WriteLn('Evénement windowDidResize');
 
 // Lecture de l'objet "Sender"
  Window := objc_msgSend(notification, msg_object);
 
  // changement du titre
  objc_msgSend(Window, msg_setTitle, StrToNSString('Hello'));
end;
 
begin
  WriteLn('Chargement de AppKit');
  dlopen('/System/Library/Frameworks/AppKit.framework/AppKit', RTLD_LAZY);
 
  WriteLn('Lecture des selecteurs');
  msg_alloc                := sel_getUid('alloc');
  msg_init                 := sel_getUid('init');
  msg_setDelegate          := sel_getUid('setDelegate:');
  msg_object               := sel_getUid('object');
  msg_setTitle             := sel_getUid('setTitle:');
  msg_stringWithCharacters := sel_getUid('stringWithCharacters:length:');
 
  WriteLn('Lecture des classes');
  NSObject := objc_getClass('NSObject');
  NSString := objc_getClass('NSString');
 
  WriteLn('Déclaration de la classe TAppDelegate');
  TAppDelegate := objc_allocateClassPair(NSObject, 'TAppDelegate', 0);
  // Ajout des méthodes dont on a besoin AVANT le register
  class_addMethod(
    TAppDelegate,
    sel_getUid('applicationDidFinishLaunching:'),
    @applicationDidFinishLaunching,
    'i12@0:4@8' // 'i' = retourne en Integer, '@' = NSObject, ':' = Selector
  );
  class_addMethod(
    TAppDelegate,
    sel_getUid('applicationShouldTerminateAfterLastWindowClosed:'),
    @applicationShouldTerminateAfterLastWindowClosed,
    'B12@0:4@8' // retourne un Boolean à l'offset 12, NSObject à l'offset 0, Selector à l'offset 4, NSObject à l'offset  8
  );
  // obligatoire AVANT d'instancier la classe
  objc_registerClassPair(TAppDelegate);
 
  WriteLn('Déclaration de la classe TWindowDelegate');
  TWindowDelegate := objc_allocateClassPair(NSObject, 'TWindowDelegate', 0);
  // Ajout des méthodes dont on a besoin
  class_addMethod(
    TWindowDelegate,
    sel_getUid('windowDidResize:'),
    @windowDidResize,
    //'v12@0:4@8' // procedure (void) à l'offet 12, NSObject à l'offet 0, Selector à l'offet 4, NSObject à l'offset 8
    //'v@:@' // fonctionne également sans préciser les offsets !
    nil // fonctionne également sans rien précisier (voir le cas des overload...)
  );
  objc_registerClassPair(TWindowDelegate);
 
  WriteLn('Allocation d''un NSAutoreleasePool');
  Pool := Init('NSAutoreleasePool');
 
  try
 
    WriteLn('Allocation d''un NSApplication');
    App := objc_msgSend(objc_getClass('NSApplication'), sel_getUid('sharedApplication'));
    WriteLn('Associer l''AppDelegate');
    objc_msgSend(App, msg_setDelegate, Init(TAppDelegate));
 
  finally
 
    WriteLn('Libération du NSAutorealasePool (si plus utilisé)');
    objc_msgSend(Pool, sel_getUId('release'));
 
  end;
 
  WriteLn('Lancement de l''application');
  objc_msgSend(App, sel_getUid('run'));
 
  WriteLn('Jamais de retour ici.');
end.

MacAPI.jpg

[ShaiLeTroll]

C'est un programme CONSOLE ?
Je ne savais pas que l'on pouvait faire de la Console MAC sous Delphi XE2, faut dire que je n'a pas du tout exploré ça !

C'est un projet FMX ? je suppose avec la plateforme MacOS ?
Comme ton code utilise juste le minimum de la RTL (le namespace System inclu par défaut), ton programme n'inclu pas les 8Mo de FMX ?

Intéressant, c'est un peu brutale comme méthode mais cela montre les bases sous MacOS en Delphi comme on le faisait en Borland C++5.0 à coup de CreateWindow
J'avoue ne pas être aller très loin dans le bouquin (acheté en occaz) "Borland C++ Version 5. Programmation Windows 95" de Gérard Leblanc vu que je en même temps découvrais Delphi 4 et les facilités du RAD !

Merci Paul !



FMX c'est une bonne idée, mais je le mode full graphique, c'est peut-être un peu lourd,
En tant que PRO, j'ai préféré un mode avec un système de Render que l'on pourrait changer à volonté

des Render FMX très graphiques mais aussi des Render plus léger basé sur les Contrôles Windows ou Apple comme à l'époque de VCL\CLX !
Après tout un TButton c'est un juste un concept : une zone en relief avec texte clickable
Les options graphiques communes sont mise dans TButtonRenderAbstract et implémenté par un Render selon OS et Options souhaités TButtonRenderWin, TButtonRenderCocoa, TButtonRenderFMX
Idem, la gestion de la Souris, OnMouseMove, OnMouseEnter ... tout ça on le sépare dans un TButtonMouseControllerAbstract ... en fonction des possibilités de l'OS, on offre plus ou moins de possibilité
Evidemment tout cela encapsulé pour ne pas effrayer l'utilisateur !
Dans l'inspecteur on aurait eu des sous rubriques + Win + Mac, un peu comme le gestionnaire de config !

FMX lui offre le minimum commun, du coup, on perd des trucs possibles en Windows parce qu'ils ne l'ont pas codé en Apple !

Et dans la DFM, on aurait pu définir pour chaque Render les options spécifiques de chacun (Image, Couleur de Font, ...) pour avoir le meilleur résultat que possible dans chaque variante !

Un tel système plus souple aurait été une meilleure façon d'intégrer des composants externes comme TMS ou DevExpress !

Je pense au Smooth de TMS, quelle corvée lorsque l'on veut passer des anciens composants TMS au composants Smooth TMS, il faut ajouter les uns, supprimer les autres, se retaper toute la config, changer le code qui n'est plus compatible...

Du coup Paul, tu vas te lancer un Défi et nous faire ta propre VCL Cross-Plateforme comme tu l'avais déjà fait ?

Perso, pour un projet Web (une sorte de XML Rad), j'ai appliqué le MVC à différent niveaux (on peut considérer qu'un export de DB, c'est juste une Vue, suffit donc de faire autant de Vue que de format exportable)
en PHP, j'ai refait une sorte de TClientDataSet (et tout ce qui va avec) avec des "vues" permettant son remplissage ou exportation en via CSV, XML, JSON mais via ZendDB
Dans le code c'est des Factory qui font le boulot pour instancier les bonnes classes

Si l'on applique le principe du MVC au TButton, on le découpe en plus petit élément, le Render étant la Vue, la Souris\Clavier son contrôleur ...

[Paul TOTH]

Hello,

non ce n'est pas FMX, c'est du Cocoa, l'appli compilé en mode release fait 70Ko (mais il faut ajouter libcgunwind dont je ne sais pas s'il est possible de se séparer).

Firemonkey utilise cette API pour construire les fenêtre sous MacOSX en y ajoutant un contexte OpenGL. Par contre en FMX c'est invoqué via un système assez complexe qui mappe les Interface Delphi vers l'API ci-dessus. L'avantage c'est qu'il suffit de définir une Interface pour que Delphi produise grâce aux RTTI les bons appels à l'OS, mais c'est assez lourd je trouve.

et oui il y a derrière cela une idée à la LightVCL

Code :

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
 
uses
  System.SysUtils,
  Execute.CrossControls in 'Execute.CrossControls.pas';
 
type
  TCrossForm1 = class(TForm)
    procedure Resize; override;
  end;
 
{$R CrossControls_Demo1.dfm}
 
procedure TCrossForm1.Resize;
begin
  Caption := Format('Width = %d, Height = %d', [Width, Height]);
end;
 
var
  CrossForm1: TCrossForm1;
 
begin
  Application.Initialize;
  Application.CreateForm(TCrossForm1, CrossForm1);
  Application.Run;
end.

CrossControls.jpg

[ShaiLeTroll]

Envoyé par Paul TOTH

non ce n'est pas FMX, c'est du Cocoa, l'appli compilé en mode release fait 70Ko (mais il faut ajouter libcgunwind dont je ne sais pas s'il est possible de se séparer).

Tu fais donc Fichier | Nouveau | Autre | Nouvelle Application Console
Framework cible : aucun
Ajout Plateforme : OS X
OK !
Je n'avais jamais essayé en passant par une appli console (j'en fait jamais)

Après comment gères-tu les Forms ?
installes-tu tes composants comme Package de Conception et tu utilises le RAD pour construire une TCrossForm avec je suppose des TCrossEdit, TCrossButton ... ?

Le système par interface à l'avantage d'être souple, évite un maximum de directive mais je préfère un système de classe abstraite avec une Registry\Factory (comme le TJPEGImage par exemple)
Il n'y au final que l'appel aux Registry qui est soumis au directive, à l'exécution c'est plus rapide, il n'a que la VMT à gérer sans passer par les QueryInterface de MS ou système équivalent pour Mac

Je suis convaincu que d'autres seraient intéressé par ta nouvelle LightVCL car un peu rebuté par la lourdeur apparente de FMX !

Moi, c'est plus la partie développement sur laquelle je suis curieux mais j'ai pas le temps (et pas de Mac )

[Paul TOTH]

pour l'instant pas de conception visuel...mais pour l'instant j'ai pas grand chose de toute façon

l'idée serait d'utiliser RegisterCustomModule pour créer un éditeur de fiche spécifique...ou de trouver un moyen pour limité TForm aux seuls propriétés de CrossControls. L'autre solution est d'avoir des propriétés bidons dans CrossControls.TForm qui permettent de partir du TForm de la Vcl (et donc de recompiler directement un project VCL comme avec LighVCL)

Dans l'exemple j'exploite la capacité de Delphi à compiler un DFM texte que je tape à la main et je charge les propriétés avec InitInheritedComponent.

Le but serait d'avoir comme avec LightVCL de quoi faire un écran avec TButton, TListBox, TEdit, TPanel, TImage histoire de faire une fenêtre de paramétrage, saisie de mot de passe etc...puis la possibilité d'avoir un contexte OpenGL qui soit le même dans les 2 OS.

[Paul TOTH]

c'est quoi bazar ?!

Code :

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
 
var
  r,g,b,a : Single;
begin
  NSColor := objc_getClass('NSColor');
 
  r := 0.51;
  g := 0.52;
  b := 0.53;
  a := 0.54;
 
  Color :=  objc_msgSend(
     NSColor,
     sel_getUid('colorWithCalibratedRed:green:blue:alpha:'),
     r, g, b, a
    );
 
  r := objc_msgSend_fpret(Color, sel_getUid('redComponent'));
  g := objc_msgSend_fpret(Color, sel_getUid('greenComponent'));
  b := objc_msgSend_fpret(Color, sel_getUid('blueComponent'));
  a := objc_msgSend_fpret(Color, sel_getUid('alphaComponent'));
 
  WriteLn('r = ', r:0:2, ', g = ', g:0:2, ', b = ', b:0:2, ', a = ', a:0:2);
// r = 0.00, g = 1.00, b = 0.00, a = 1.00 
end;

et en testant d'autres valeurs c'est encore pire

0,0,0,0 => 0,0,0,0
1,0,0,0 => 0,1,0,0
0,1,0,0 => 0,0,0,1
0,0,1,0 => 0,0,0,0

du coup on pourrait penser qu'il y a un décalage...mais
0.25,0,0,0, => 0,1,0,0 !!!

je n'y comprend rien

EDIT: j'ai trouvé, mais je ne comprend pas la logique, il faut appeler objc_msgSend_fpret pour créer le NSColor ?! c'est supposé être utilisé pour retourner des floats, pas des objets...

EDIT: PAS DU TOUT ! c'est un des tests que j'avais fait mais non, en fait le problème doit venir du "varargs" ... si je surcharge la déclaration de la fonction ça fonctionne:

Code :

1
2
3
4
5
6
7
8
9
10
 
type
  colorWithCalibratedRGBA = function(theReceiver: Pointer; theSelector: Pointer; r,g,b,a: Single): Pointer; cdecl varargs;
begin
  Color := colorWithCalibratedRGBA(@objc_msgSend)(
     NSColor,
     sel_getUid('colorWithCalibratedRed:green:blue:alpha:'),
     r,g,b,a
    );
end;

MacAPI.dpr.229: Color := objc_msgSend(
000D8BD3 6830000000 push $00000030
000D8BD8 55 push ebp
000D8BD9 68EDFEEFBE push $beeffeed
000D8BDE 83C4F8 add esp,-$08
000D8BE1 FF75C4 push dword ptr [ebp-$3c]
000D8BE4 FF75C0 push dword ptr [ebp-$40]
000D8BE7 FF75CC push dword ptr [ebp-$34]
000D8BEA FF75C8 push dword ptr [ebp-$38]
000D8BED FF75D4 push dword ptr [ebp-$2c]
000D8BF0 FF75D0 push dword ptr [ebp-$30]
000D8BF3 FF75DC push dword ptr [ebp-$24]
000D8BF6 FF75D8 push dword ptr [ebp-$28]
000D8BF9 680C000000 push $0000000c
000D8BFE 55 push ebp
000D8BFF 68EDFEEFBE push $beeffeed
000D8C04 83C4F8 add esp,-$08
000D8C07 8D8314910D00 lea eax,[ebx+MyApplicationDelegate_impl_applicationDidFinishLaunching + $6B4]
000D8C0D 50 push eax
000D8C0E E830040500 call $00129043
000D8C13 83C418 add esp,$18
000D8C16 FE4424F4 inc byte ptr [esp-$0c]
000D8C1A 50 push eax
000D8C1B 8B45E4 mov eax,[ebp-$1c]
000D8C1E 50 push eax
000D8C1F E8F4060500 call $00129318
000D8C24 83C43C add esp,$3c
000D8C27 FE4424F4 inc byte ptr [esp-$0c]
000D8C2B 8945E0 mov [ebp-$20],eax
MacAPI.dpr.234: Color := colorWithCalibratedRGBA(@objc_msgSend)(
000D8C2E 6820000000 push $00000020
000D8C33 55 push ebp
000D8C34 68EDFEEFBE push $beeffeed
000D8C39 83C4F8 add esp,-$08
000D8C3C DD45C0 fld qword ptr [ebp-$40]
000D8C3F 83C4FC add esp,-$04
000D8C42 D91C24 fstp dword ptr [esp]
000D8C45 9B wait
000D8C46 DD45C8 fld qword ptr [ebp-$38]
000D8C49 83C4FC add esp,-$04
000D8C4C D91C24 fstp dword ptr [esp]
000D8C4F 9B wait
000D8C50 DD45D0 fld qword ptr [ebp-$30]
000D8C53 83C4FC add esp,-$04
000D8C56 D91C24 fstp dword ptr [esp]
000D8C59 9B wait
000D8C5A DD45D8 fld qword ptr [ebp-$28]
000D8C5D 83C4FC add esp,-$04
000D8C60 D91C24 fstp dword ptr [esp]
000D8C63 9B wait
000D8C64 680C000000 push $0000000c
000D8C69 55 push ebp
000D8C6A 68EDFEEFBE push $beeffeed
000D8C6F 83C4F8 add esp,-$08
000D8C72 8D8314910D00 lea eax,[ebx+MyApplicationDelegate_impl_applicationDidFinishLaunching + $6B4]
000D8C78 50 push eax
000D8C79 E8C5030500 call $00129043
000D8C7E 83C418 add esp,$18
000D8C81 FE4424F4 inc byte ptr [esp-$0c]
000D8C85 50 push eax
000D8C86 8B45E4 mov eax,[ebp-$1c]
000D8C89 50 push eax
000D8C8A 8B8300901200 mov eax,[ebx+$00129000]
000D8C90 FFD0 call eax
000D8C92 83C42C add esp,$2c
000D8C95 FE4424F4 inc byte ptr [esp-$0c]
000D8C99 8945E0 mov [ebp-$20],eax

les Single sont passés par fld et non par push...

[Paul TOTH]

pfiou ! pas simple de faire une VCL pour Mac, là j'ai des problèmes de position du texte dans les contrôles...

crossdemo.jpg

[tourlourou]

Si c'est bien pour le même challenge, pas simples non plus les designers de fiches ?

[Paul TOTH]

Envoyé par tourlourou

Si c'est bien pour le même challenge, pas simples non plus les designers de fiches ?

tout à fait

pour l'instant je laisse tomber le designer, il n'y a pas assez d'information sur le sujet pour s'en sortir...et c'est bien dommage car ils ont forcément prévu le cas pour Firemonkey, l'IDE est donc prêt à gérer des custom designer, il ne manque que l'information ou - à minima - les sources de ce qui a éta fait pour les FMX.

[Paul TOTH]

et hop ! un petit contexte OpenGL en plus non non, pas de DirectX ici

Capturejpg.jpg