1{
2 /***************************************************************************
3                         GTKINT.pp  -  GTKInterface Object
4                             -------------------
5
6                   Initial Revision  : Thu July 1st CST 1999
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
19unit GtkInt;
20
21{$mode objfpc}
22{$LONGSTRINGS ON}
23
24interface
25
26{$ifdef Trace}
27{$ASSERTIONS ON}
28{$endif}
29
30
31{$I gtkdefines.inc}
32
33uses
34  {$IFDEF WIN32}
35  // use windows unit first,
36  // if not, Rect and Point are taken from the windows unit instead of classes.
37  Windows,
38  {$ENDIF}
39  {$IFDEF UNIX}
40  // use unix units first,
41  // if not, TSize is taken from the unix unit instead of types.
42  ctypes, baseunix, unix,
43  {$ENDIF}
44  {$IFDEF TraceGdiCalls}
45  LineInfo,
46  {$ENDIF}
47  // rtl+fcl
48  Types, Classes, SysUtils,
49  // LazUtils
50  FPCAdds, LazUTF8,
51  // gtk
52  {$IFDEF gtk2}
53    glib2, gdk2pixbuf, gdk2, gtk2, Pango, gtk2proc,
54    {$ifdef HasGdk2X}
55      gdk2x,
56    {$endif}
57  {$ELSE}
58    glib, gdk, gtk, gdkpixbuf,
59  {$ENDIF}
60  // Target OS specific
61  {$ifdef HasX}
62  x, xlib,
63  {$endif}
64  Math, // after gtk to get the correct Float type
65  // LCL
66  LCLPlatformDef, InterfaceBase,
67  FileUtil, Translations, ExtDlgs, Dialogs, Controls, Forms, LCLStrConsts,
68  LMessages, LCLProc, LCLIntf, LCLType, DynHashArray, GraphType, GraphMath,
69  Graphics, Menus, Maps, LazLoggerBase, LazFileUtils, LazStringUtils, Themes,
70  // widgetset
71  GtkDebug, GtkFontCache, gtkDef, GtkProc, gtkMsgQueue, GtkExtra, WSLCLClasses;
72
73type
74
75  { TGTKWidgetSet }
76
77  TGTKWidgetSet = class(TWidgetSet)
78  private
79    FMultiThreadingEnabled: boolean;
80    FocusTimer: cardinal;
81    FAppActive: Boolean;
82    FLastFocusIn: PGtkWidget;
83    FLastFocusOut: PGtkWidget;
84    function GetAppActive: Boolean;
85    procedure SetAppActive(const AValue: Boolean);
86  protected
87    FKeyStateList_: TFPList; // Keeps track of which keys are pressed
88    FDeviceContexts: TDynHashArray;// hasharray of HDC
89    FGDIObjects: TDynHashArray;    // hasharray of PGdiObject
90    FMessageQueue: TGtkMessageQueue; // queue of PMsg (must be thread safe!)
91    WaitingForMessages: boolean;
92    MovedPaintMessageCount: integer;// how many paint messages moved to he end of the queue
93
94    FRCFilename: string;
95    FRCFileParsed: boolean;
96    FRCFileAge: integer;
97    FGTKToolTips: PGtkToolTips;
98
99    FLogHandlerID: guint; // ID returend by set_handler
100
101    FStockNullBrush: HBRUSH;
102    FStockBlackBrush: HBRUSH;
103    FStockLtGrayBrush: HBRUSH;
104    FStockGrayBrush: HBRUSH;
105    FStockDkGrayBrush: HBRUSH;
106    FStockWhiteBrush: HBRUSH;
107
108    FStockNullPen: HPEN;
109    FStockBlackPen: HPEN;
110    FStockWhitePen: HPEN;
111
112    FSysColorBrushes: array[0..MAX_SYS_COLORS] of HBrush;
113
114    FWaitHandles: PWaitHandleEventHandler;
115    {$ifdef unix}
116    FChildSignalHandlers: PChildSignalEventHandler;
117    {$else}
118    {$IFDEF VerboseGtkToDos}{$warning no declaration of FChildSignalHandlers for this OS}{$ENDIF}
119    {$endif}
120
121    {$Ifdef GTK2}
122    FDefaultFontDesc: PPangoFontDescription;
123    {$Endif}
124    FDefaultFont: TGtkIntfFont;
125    FStockSystemFont: HFONT;
126    FExtUTF8OutCache: Pointer;
127    FExtUTF8OutCacheSize: integer;
128    FGlobalCursor: HCursor;
129
130    FDCManager: TDeviceContextMemManager;
131    FDockImage: PGtkWidget;
132    FDragImageList: PGtkWidget;
133    FDragImageListIcon: PGtkWidget;
134    FDragHotStop: TPoint;
135
136    function CreateThemeServices: TThemeServices; override;
137    function GetDeviceContextClass: TGtkDeviceContextClass; virtual; abstract;
138  public
139    procedure InitStockItems; virtual;
140    procedure FreeStockItems; virtual;
141    procedure InitSystemColors;
142    procedure InitSystemBrushes; virtual;
143    procedure FreeSystemBrushes; virtual;
144    procedure PassCmdLineOptions; override;
145
146{$ifdef Unix}
147    procedure InitSynchronizeSupport;
148    procedure ProcessChildSignal;
149    procedure PrepareSynchronize(AObject: TObject);
150{$endif}
151
152    procedure HandlePipeEvent(AData: PtrInt; AFlags: dword);
153
154    // styles
155    procedure FreeAllStyles; virtual;
156    function GetCompStyle(Sender : TObject) : Longint; virtual;
157
158    // create and destroy
159    function CreateAPIWidget(AWinControl: TWinControl): PGtkWidget;
160    function OldCreateStatusBarPanel(StatusBar: TObject; Index: integer): PGtkWidget;
161    function CreateSimpleClientAreaWidget(Sender: TObject;
162      NotOnParentsClientArea: boolean): PGtkWidget;
163    procedure DestroyEmptySubmenu(Sender: TObject);virtual;
164    procedure DestroyConnectedWidget(Widget: PGtkWidget;
165                                     CheckIfDestroying: boolean);virtual;
166    function  RecreateWnd(Sender: TObject): Integer; virtual;
167
168    // clipboard
169    procedure SetClipboardWidget(TargetWidget: PGtkWidget);virtual;
170
171    // device contexts
172    function IsValidDC(const DC: HDC): Boolean;virtual;
173    function NewDC: TGtkDeviceContext;virtual;
174    function FindDCWithGDIObject(GDIObject: PGdiObject): TGtkDeviceContext;virtual;
175    procedure DisposeDC(aDC: TGtkDeviceContext);virtual;
176    function CreateDCForWidget(AWidget: PGtkWidget; AWindow: PGdkWindow;
177                               AWithChildWindows: Boolean; ADoubleBuffer: PgdkDrawable = nil): HDC;
178    function GetDoubleBufferedDC(Handle: HWND): HDC;
179
180    // GDIObjects
181    function IsValidGDIObject(const AGDIObj: HGDIOBJ): Boolean; virtual;
182    function IsValidGDIObjectType(const GDIObject: HGDIOBJ;
183                                  const GDIType: TGDIType): Boolean;virtual;
184    function NewGDIObject(const GDIType: TGDIType): PGdiObject;virtual;
185    procedure DisposeGDIObject(GdiObject: PGdiObject);virtual;
186    function ReleaseGDIObject(GdiObject: PGdiObject): boolean;virtual;
187    procedure ReferenceGDIObject(GdiObject: PGdiObject);virtual;
188    function CreateDefaultBrush: PGdiObject;virtual;
189    function CreateDefaultFont: PGdiObject;virtual;
190    function CreateDefaultPen: PGdiObject;virtual;
191    function CreateDefaultGDIBitmap: PGdiObject;virtual;
192    procedure UpdateDCTextMetric(DC: TGtkDeviceContext); virtual;
193    {$Ifdef GTK2}
194    function GetDefaultFontDesc(IncreaseReferenceCount: boolean): PPangoFontDescription;
195    {$Endif}
196    function GetDefaultGtkFont(IncreaseReferenceCount: boolean): TGtkIntfFont;
197    function GetGtkFont(DC: TGtkDeviceContext): TGtkIntfFont;
198    function CreateRegionCopy(SrcRGN: hRGN): hRGN; override;
199    function DCClipRegionValid(DC: HDC): boolean; override;
200    function CreateEmptyRegion: hRGN; override;
201
202    // images
203    procedure LoadPixbufFromLazResource(const ResourceName: string;
204      var Pixbuf: PGdkPixbuf);
205    function InternalGetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT;
206      BitSize : Longint; Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT; DIB : Boolean): Integer;virtual;
207    function RawImage_DescriptionFromDrawable(out ADesc: TRawImageDescription; ADrawable: PGdkDrawable; ACustomAlpha: Boolean): boolean;
208    function RawImage_DescriptionFromPixbuf(out ADesc: TRawImageDescription; APixbuf: PGdkPixbuf): boolean;
209    function RawImage_FromDrawable(out ARawImage: TRawImage; ADrawable, AAlpha: PGdkDrawable; ARect: PRect = nil): boolean;
210    function RawImage_FromPixbuf(out ARawImage: TRawImage; APixbuf: PGdkPixbuf; ARect: PRect = nil): boolean;
211    function RawImage_SetAlpha(var ARawImage: TRawImage; AAlpha: PGdkPixmap; ARect: PRect = nil): boolean;
212    function RawImage_AddMask(var ARawImage: TRawImage; AMask: PGdkBitmap; ARect: PRect = nil): boolean;
213    function StretchCopyArea(DestDC: HDC; X, Y, Width, Height: Integer;
214      SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer;
215      Mask: HBITMAP; XMask, YMask: Integer;
216      Rop: Cardinal): Boolean;
217
218    // RC file
219    procedure SetRCFilename(const AValue: string);virtual;
220    procedure CheckRCFilename;virtual;
221    procedure ParseRCFile;virtual;
222
223    // forms and dialogs
224    procedure BringFormToFront(Sender: TObject);
225    procedure UntransientWindow(GtkWindow: PGtkWindow);
226    // misc
227    function GetCaption(Sender : TObject) : String; virtual;
228    procedure WordWrap(DC: HDC; AText: PChar; MaxWidthInPixel: integer;
229      var Lines: PPChar; var LineCount: integer);
230
231    procedure ResizeChild(Sender : TObject; Left,Top,Width,Height : Integer);virtual;
232    procedure RemoveCallbacks(Widget: PGtkWidget); virtual;
233
234    // for gtk specific components:
235    procedure SetLabelCaption(const ALabel: PGtkLabel; const ACaption: String
236                              {$IFDEF Gtk1}
237                              ; const AComponent: TComponent = nil;
238                                const ASignalWidget: PGTKWidget = nil;
239                                const ASignal: PChar = nil{$ENDIF}); virtual; abstract;
240    procedure SetWidgetColor(const AWidget: PGtkWidget;
241                             const FGColor, BGColor: TColor;
242                             const Mask: tGtkStateEnum);
243    procedure SetWidgetFont(const AWidget : PGtkWidget;const AFONT : tFont); virtual; abstract;
244    procedure SetCallbackEx(const AMsg: LongInt; const AGTKObject: PGTKObject;
245                          const ALCLObject: TObject; Direct: boolean); virtual;
246    procedure SetCallbackDirect(const AMsg: LongInt; const AGTKObject: PGTKObject;
247                          const ALCLObject: TObject);
248    procedure SetCallback(const AMsg: LongInt; const AGTKObject: PGTKObject;
249                          const ALCLObject: TObject);
250    procedure SetCommonCallbacks(const AGTKObject: PGTKObject; const ALCLObject: TObject); virtual;
251    function  LCLtoGtkMessagePending: boolean;virtual;
252    procedure SendCachedGtkMessages;virtual;
253    // show, hide and invalidate
254    procedure SetVisible(Sender: TObject; const AVisible: Boolean); virtual;
255
256    // Drag ImageLsit
257    function DragImageList_BeginDrag(APixmap: PGdkPixmap; AMask: PGdkBitmap; AHotSpot: TPoint): Boolean;
258    procedure DragImageList_EndDrag;
259    function DragImageList_DragMove(X, Y: Integer): Boolean;
260    function DragImageList_SetVisible(NewVisible: Boolean): Boolean;
261
262  public
263    function LCLPlatform: TLCLPlatform; override;
264    // Application
265    procedure AppInit(var ScreenInfo: TScreenInfo); override;
266    procedure AppProcessMessages; override;
267    procedure AppWaitMessage; override;
268    procedure AppTerminate; override;
269    procedure AppMinimize; override;
270    procedure AppRestore; override;
271    procedure AppBringToFront; override;
272    procedure AppSetTitle(const ATitle: string); override;
273    // notebook
274    procedure AddDummyNoteBookPage(NoteBookWidget: PGtkNoteBook);virtual;
275  public
276    constructor Create; override;
277    destructor Destroy; override;
278    procedure SendCachedLCLMessages; override;
279    function  DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;
280    procedure DCSetPixel(CanvasHandle: HDC; X, Y: integer; AColor: TGraphicsColor); override;
281    procedure DCRedraw(CanvasHandle: HDC); override;
282    procedure SetDesigning(AComponent: TComponent); override;
283
284    // helper routines needed by interface methods
285    // |-forms
286    procedure UpdateTransientWindows; virtual;
287    // |-listbox
288    procedure SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
289                               MultiSelect, ExtendedSelect: boolean); virtual;
290    function ForceLineBreaks(DC : hDC; Src: PChar; MaxWidthInPixels : Longint;
291                             ConvertAmpersandsToUnderScores: Boolean) : PChar;
292
293    // create and destroy
294    function CreateTimer(Interval: integer; TimerProc: TWSTimerProc) : THandle; override;
295    function DestroyTimer(TimerHandle: THandle) : boolean; override;
296    procedure DestroyLCLComponent(Sender: TObject);virtual;
297
298    // for gtk controls not part of the LCL:
299    procedure FinishCreateHandle(const AWinControl: TWinControl; Widget: PGtkWidget; const AParams: TCreateParams);
300
301    {$I gtkwinapih.inc}
302    {$I gtklclintfh.inc}
303
304  public
305
306    // special methods and properties to track app activation / deactivation
307    procedure StartFocusTimer;
308    property AppActive: Boolean read GetAppActive write SetAppActive;
309    property LastFocusIn: PGtkWidget read FLastFocusIn write FLastFocusIn;
310    property LastFocusOut: PGtkWidget read FLastFocusOut write FLastFocusOut;
311
312    property RCFilename: string read FRCFilename write SetRCFilename;
313    property MultiThreadingEnabled: boolean read FMultiThreadingEnabled;
314  end;
315
316{$I gtklistslh.inc}
317{$I gtkfiledialogutilsh.inc}
318
319var
320  GTKWidgetSet: TGTKWidgetSet;
321
322implementation
323
324uses
325////////////////////////////////////////////////////
326// I M P O R T A N T
327////////////////////////////////////////////////////
328// To get as little as possible circles,
329// uncomment only those units with implementation
330////////////////////////////////////////////////////
331// GtkWSActnList,
332 GtkWSButtons,
333 GtkWSCalendar,
334 GtkWSCheckLst,
335 GtkWSComCtrls,
336 GtkWSControls,
337// GtkWSDbCtrls,
338// GtkWSDBGrids,
339 GtkWSDialogs,
340// GtkWSEditBtn,
341 GtkWSExtCtrls,
342 GtkWSExtDlgs,
343// GtkWSFileCtrl,
344 GtkWSForms,
345 GtkWSGrids,
346// GtkWSImgList,
347// GtkWSMaskEdit,
348 GtkWSMenus,
349 GtkWSPairSplitter,
350 GtkWSSpin,
351 GtkWSStdCtrls,
352// GtkWSToolwin,
353////////////////////////////////////////////////////
354  GtkWSPrivate,
355  GtkThemes,
356  Buttons, StdCtrls, PairSplitter,
357  GTKWinApiWindow, ComCtrls, Calendar, Spin,
358  ExtCtrls, FileCtrl, LResources, gtkglobals;
359
360{$I gtklistsl.inc}
361{$I gtkfiledialogutils.inc}
362{$I gtkwidgetset.inc}
363{$I gtkwinapi.inc}
364{$I gtklclintf.inc}
365
366
367procedure InternalInit;
368var
369  c: TClipboardType;
370begin
371  gtk_handler_quark := g_quark_from_static_string('gtk-signal-handlers');
372
373  MouseCaptureWidget := nil;
374  MouseCaptureType := mctGTK;
375
376  LastLeft:=EmptyLastMouseClick;
377  LastMiddle:=EmptyLastMouseClick;
378  LastRight:=EmptyLastMouseClick;
379
380  // clipboard
381  ClipboardSelectionData:=TFPList.Create;
382  for c:=Low(TClipboardType) to High(TClipboardType) do begin
383    ClipboardTypeAtoms[c]:=0;
384    ClipboardHandler[c]:=nil;
385    //ClipboardIgnoreLossCount[c]:=0;
386    ClipboardTargetEntries[c]:=nil;
387    ClipboardTargetEntryCnt[c]:=0;
388  end;
389
390  // charset encodings
391  {$IFDEF Gtk1}
392  SystemCharSetIsUTF8:=not NeedRTLAnsi;
393  {$ENDIF}
394
395  CharSetEncodingList := TList.Create;
396  CreateDefaultCharsetEncodings;
397
398  InitDesignSignalMasks;
399end;
400
401procedure InternalFinal;
402var i: integer;
403  ced: PClipboardEventData;
404  c: TClipboardType;
405begin
406  // clipboard
407  for i:=0 to ClipboardSelectionData.Count-1 do begin
408    ced:=PClipboardEventData(ClipboardSelectionData[i]);
409    if ced^.Data.Data<>nil then FreeMem(ced^.Data.Data);
410    Dispose(ced);
411  end;
412  for c:=Low(TClipboardType) to High(TClipboardType) do
413    FreeClipboardTargetEntries(c);
414  ClipboardSelectionData.Free;
415  ClipboardSelectionData:=nil;
416
417  // charset encodings
418  if CharSetEncodingList<>nil then begin
419    ClearCharSetEncodings;
420    CharSetEncodingList.Free;
421    CharSetEncodingList:=nil;
422  end;
423end;
424
425
426initialization
427{$IFDEF GTK1}
428  {$I gtkimages.lrs}
429{$ENDIF}
430  InternalInit;
431
432finalization
433  InternalFinal;
434
435end.
436