1 {
2 /***************************************************************************
3 CarbonInt.pas - CarbonInterface Object
4 ----------------------------------------
5
6 Initial Revision : Mon August 6th CST 2004
7
8
9 ***************************************************************************/
10
11 *****************************************************************************
12 This file is part of the Lazarus Component Library (LCL)
13
14 See the file COPYING.modifiedLGPL.txt, included in this distribution,
15 for details about the license.
16 *****************************************************************************
17 }
18
19 unit CarbonInt;
20
21 {$mode objfpc}{$H+}
22
23 interface
24
25 {$ifdef Trace}
26 {$ASSERTIONS ON}
27 {$endif}
28
29 // defines
30 {$I carbondefines.inc}
31
32 uses
33 // rtl+ftl
34 Types, Classes, SysUtils, Math,
35 // carbon bindings
36 MacOSAll,
37 // Cocoa bindings
38 {$ifdef CarbonUseCocoa}
39 foundation, appkit,
40 {$endif}
41 // interfacebase
42 InterfaceBase,
43 // widgetset
44 CarbonGDIObjects,
45 {$ifdef DebugBitmaps}
46 CarbonDebug,
47 {$endif}
48 glgrab,
49 LCLPlatformDef, LMessages, LCLMessageGlue, LCLProc, LCLIntf, LCLType, IntfGraphics,
50 GraphType, GraphMath, Graphics, Controls, Forms, Dialogs, Menus, Maps, Themes;
51
52 type
53
54 { TCarbonWidgetSet }
55
56 TCarbonWidgetSet = class(TWidgetSet)
57 private
58 // Set when the QuitEventHandler terminates
59 FTerminating: Boolean;
60 FUserTerm: Boolean;
61 FMainEventQueue: EventQueueRef;
62 FTimerMap: TMap; // the map contains all installed timers
63 FCurrentCursor: HCURSOR;
64 FMainMenu: HMENU; // Main menu attached to menu bar
65 FCaptureWidget: HWND; // Captured widget (TCarbonWidget descendant)
66 FFocusedWidget: HWND; // Forced Focus widgetset (TCarbonWidget descendant)
67 FOpenEventHandlerUPP: AEEventHandlerUPP;
68 FQuitEventHandlerUPP: AEEventHandlerUPP;
69
70 FAppLoop: TApplicationMainLoop;
71 FAppStdEvents: Boolean;
72 fMenuEnabled: Boolean;
73 FAEventHandlerRef: array[0..5] of EventHandlerRef;
74 {$ifdef CarbonUseCocoa}
75 pool: NSAutoreleasePool;
76 {$endif}
77 protected
CreateThemeServicesnull78 function CreateThemeServices: TThemeServices; override;
79 procedure PassCmdLineOptions; override;
80 procedure SendCheckSynchronizeMessage;
81 procedure OnWakeMainThread(Sender: TObject);
82
83 procedure RegisterEvents;
84
85 public
86 constructor Create; override;
87 destructor Destroy; override;
88
LCLPlatformnull89 function LCLPlatform: TLCLPlatform; override;
90
91 procedure AppInit(var ScreenInfo: TScreenInfo); override;
92 procedure AppRun(const ALoop: TApplicationMainLoop); override;
93 procedure AppWaitMessage; override;
94 procedure AppProcessMessages; override;
95 procedure AppTerminate; override;
96 procedure AppMinimize; override;
97 procedure AppRestore; override;
98 procedure AppBringToFront; override;
99 procedure AppSetIcon(const {%H-}Small, Big: HICON); override;
100 procedure AppSetTitle(const {%H-}ATitle: string); override;
101
GetLCLCapabilitynull102 function GetLCLCapability(ACapability: TLCLCapability): PtrUInt; override;
103
DCGetPixelnull104 function DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
105 procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
106 procedure DCRedraw(CanvasHandle: HDC); override;
107 procedure DCSetAntialiasing(CanvasHandle: HDC; AEnabled: Boolean); override;
108
109 procedure SetDesigning({%H-}AComponent: TComponent); override;
110
IsHelpKeynull111 function IsHelpKey({%H-}Key: Word; {%H-}Shift: TShiftState): Boolean; override;
112
113 // create and destroy
CreateTimernull114 function CreateTimer(Interval: integer; TimerFunc: TWSTimerProc) : THandle; override;
DestroyTimernull115 function DestroyTimer(TimerHandle: THandle) : boolean; override;
PrepareUserEventnull116 function PrepareUserEvent(Handle: HWND; Msg: Cardinal; wParam: WParam;
117 lParam: LParam; out Target: EventTargetRef): EventRef;
118
RawImage_DescriptionFromCarbonBitmapnull119 function RawImage_DescriptionFromCarbonBitmap(out ADesc: TRawImageDescription; ABitmap: TCarbonBitmap): Boolean;
RawImage_FromCarbonBitmapnull120 function RawImage_FromCarbonBitmap(out ARawImage: TRawImage; ABitmap, AMask: TCarbonBitmap; ARect: PRect = nil): Boolean;
RawImage_DescriptionToBitmapTypenull121 function RawImage_DescriptionToBitmapType(ADesc: TRawImageDescription; out bmpType: TCarbonBitmapType): Boolean;
GetImagePixelDatanull122 function GetImagePixelData(AImage: CGImageRef; out bitmapByteCount: PtrUInt): Pointer;
123
124 // the winapi compatibility methods
125 {$I carbonwinapih.inc}
126 // the extra LCL interface methods
127 {$I carbonlclintfh.inc}
128
129 public
130 procedure SetMainMenuEnabled(AEnabled: Boolean);
131 procedure SetRootMenu(const AMenu: HMENU);
132 property MainMenu: HMENU read FMainMenu;
133 property MenuEnabled: Boolean read fMenuEnabled;
134 public
135 procedure SetCaptureWidget(const AWidget: HWND);
136 procedure SetTextFractional(ACanvas: TCanvas; AEnabled: Boolean);
137 procedure SetFocusedWidget(const AWidget: HWND);
GetFocusedWidgetnull138 function GetFocusedWidget: HWND;
139 property CaptureWidgetSet: HWND read FCaptureWidget;
140 end;
141
142 const
143 // missing constant
144 kAEOpenContents = $6F636F6E (* 'ocon' *);
145
146 var
147 CarbonWidgetSet: TCarbonWidgetSet;
148
Create32BitAlphaBitmapnull149 function Create32BitAlphaBitmap(ABitmap, AMask: TCarbonBitmap): TCarbonBitmap;
150
151 implementation
152
153 uses
154 {%H-}CarbonWSFactory,
155 { these can/should go up }
156 CarbonDef, CarbonPrivate, CarbonMenus, {%H-}CarbonButtons, {%H-}CarbonBars, {%H-}CarbonEdits,
157 CarbonListViews, {%H-}CarbonTabs,
158 CarbonThemes, CarbonCanvas, {%H-}CarbonStrings, CarbonClipboard, CarbonCaret,
159 CarbonProc, CarbonDbgConsts, CarbonUtils,
160
161 Buttons, ExtCtrls, LResources;
162
163 var
164 FirstAppEventLock: MPEventID = nil;
165
166 const
167 EventFlags : MPEventFlags = 1;
168
169 procedure SignalFirstAppEvent;
170 begin
171 MPSetEvent(FirstAppEventLock, EventFlags);
172 end;
173
174 procedure WaitFirstAppEvent;
175 var
176 fl : MPEventFlags;
177 begin
178 fl := EventFlags;
179 if FirstAppEventLock <> nil then
180 begin
181 MPWaitForEvent(FirstAppEventLock, @fl, kDurationForever);
182 SignalFirstAppEvent;
183 end;
184 end;
185
186 // the implementation of the utility methods
187 {$I carbonobject.inc}
188 // the implementation of the winapi compatibility methods
189 {$I carbonwinapi.inc}
190 // the implementation of the extra LCL interface methods
191 {$I carbonlclintf.inc}
192
193
194 procedure InternalInit;
195 begin
196 MPCreateEvent(FirstAppEventLock);
197 end;
198
199 procedure InternalFinal;
200 begin
201 if Assigned(FirstAppEventLock) then
202 begin
203 SignalFirstAppEvent;
204 MPDeleteEvent(FirstAppEventLock);
205 FirstAppEventLock:=nil;
206 end;
207 end;
208
209
210 initialization
211 InternalInit;
212
213 finalization
214 InternalFinal;
215
216 end.
217