blob: 0f602e7f366decbf0d974ba74a66c77456bb1369 (
plain)
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
|
unit MainUnit;
interface
uses
MacTypes;
procedure RunMainProcedure;
procedure Message(msg: Str255);
procedure _Message(msg: Str255); C;
implementation
uses
FPCMacOSAll, CSupport;
var
gCurrentY: SInt16;
{-------------------------------- }
procedure RunMainProcedure;
label
whenErr;
var
err: OSStatus;
nib: IBNibRef;
win: WindowRef;
str: Str255;
fID: SInt16;
val: SInt32;
begin
// 1st the usual simple window and menubar from nib:
err:= CreateNibReference(CFSTR('main'), nib);
if err <> noErr then goto whenErr;
err:= SetMenuBarFromNib(nib, CFSTR('MenuBar'));
if err <> noErr then goto whenErr;
err := CreateWindowFromNib(nib, CFSTR('MainWindow'), win);
if err <> noErr then goto whenErr;
DisposeNibReference(nib);
ShowWindow(win);
SetPort(GetWindowPort(win));
// get 12 pt Geneva bold text:
GetFNum('Geneva', fID);
TextFont(fID);
TextSize(12);
TextFace(bold);
// call Message directly:
Message('FPC Carbon app with C/C++ support.');
// call Message through external C:
val:= CFunction;
NumToString(val, str);
Message('CFunction return val = ' + str);
// do the same through external C++:
val:= CPlusFunction;
NumToString(val, str);
Message('CPlusFunction return val = ' + str);
Message('');
Message('That''s all. You may as well quit now.');
// event loop until quit
RunApplicationEventLoop;
Halt(0);
whenErr:
Halt(1);
end;
{-------------------------------- }
procedure Message(msg: Str255);
begin
MoveTo(10, gCurrentY);
DrawString(msg);
gCurrentY:= gCurrentY + 24;
end;
{-------------------------------- }
procedure _Message(msg: Str255); C;
alias: '_Message';
begin Message(msg);
end;
begin
gCurrentY:= 30;
end.
|