1{%MainUnit gtk2int.pas}
2
3{******************************************************************************
4                         All GTK Winapi implementations.
5                   Initial Revision  : Sat Nov 13 12:53:53 1999
6
7
8  !! Keep alphabetical !!
9
10  Support routines go to gtk2proc.pp
11
12 ******************************************************************************
13 Implementation
14 ******************************************************************************
15
16 *****************************************************************************
17  This file is part of the Lazarus Component Library (LCL)
18
19  See the file COPYING.modifiedLGPL.txt, included in this distribution,
20  for details about the license.
21 *****************************************************************************
22}
23{$IFOPT C-}
24// Uncomment for local trace
25//  {$C+}
26//  {$DEFINE ASSERT_IS_ON}
27{$EndIf}
28
29{off $define VerboseScrollWindowEx}
30
31
32//##apiwiz##sps##   // Do not remove
33
34{------------------------------------------------------------------------------
35  Method:   Arc
36  Params:   left, top, right, bottom, angle1, angle2
37  Returns:  Nothing
38
39  Use Arc to draw an elliptically curved line with the current Pen.
40  The angles angle1 and angle2 are 1/16th of a degree. For example, a full
41  circle equals 5760 (16*360). Positive values of Angle and AngleLength mean
42  counter-clockwise while negative values mean clockwise direction.
43  Zero degrees is at the 3'o clock position.
44  Angle1 is the starting angle. Angle2 is relative to Angle1 (added).
45  Example:
46    Angle1 = 10*16, Angle2 = 30*16 will draw an arc from 10 to 40 degree.
47
48 ------------------------------------------------------------------------------}
49function TGtk2WidgetSet.Arc(DC: HDC; Left, top, right, bottom, angle1,
50  angle2: Integer): Boolean;
51var
52  DevCtx: TGtkDeviceContext absolute DC;
53  DCOrigin: TPoint;
54  Angle: Integer;
55begin
56  Result := IsValidDC(DC);
57  if not Result then Exit;
58
59    // Draw outline
60  DevCtx.SelectPenProps;
61
62  if not (dcfPenSelected in DevCtx.Flags)
63  then begin
64    Result := False;
65    Exit;
66  end;
67  if DevCtx.IsNullPen then Exit;
68
69  if DevCtx.HasTransf then
70  begin
71    DevCtx.TransfRect(Left, Top, Right, Bottom);
72    DevCtx.TransfNormalize(Left, Right);
73    DevCtx.TransfNormalize(Top, Bottom);
74    // we must convert angles too because of possible negative axis orientations
75    Angle := Angle1 + Angle2;
76    DevCtx.TransfAngles(Angle1, Angle);
77    Angle2 := Angle - Angle1;
78  end;
79
80  DCOrigin := DevCtx.Offset;
81  inc(Left, DCOrigin.X);
82  inc(Top, DCOrigin.Y);
83  inc(Right, DCOrigin.X);
84  inc(Bottom, DCOrigin.Y);
85
86  {$IFDEF DebugGDKTraps}BeginGDKErrorTrap;{$ENDIF}
87  DevCtx.RemovePixbuf;
88  gdk_draw_arc(DevCtx.Drawable, DevCtx.GC, 0, left, top, right - left, bottom - top,
89                   Angle1*4, Angle2*4);
90  {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
91end;
92
93 {------------------------------------------------------------------------------
94  Method:   AngleChord
95  Params:   DC, x1, y1, x2, y2, angle1, angle2
96  Returns:  Nothing
97
98  Use AngleChord to draw a filled Chord-shape on the canvas. The angles angle1
99  and angle2 are 1/16th of a degree. For example, a full circle equals 5760
100  16*360). Positive values of Angle and AngleLength mean counter-clockwise while
101  negative values mean clockwise direction. Zero degrees is at the 3'o clock
102  position.
103
104------------------------------------------------------------------------------}
105function TGtk2WidgetSet.AngleChord(DC: HDC;
106  x1, y1, x2, y2, angle1, angle2: Integer): Boolean;
107begin
108  Result := inherited AngleChord(DC, x1, y1, x2, y2, angle1, angle2);
109end;
110
111{------------------------------------------------------------------------------
112  Function: BeginPaint
113  Params:
114  Returns:
115
116 ------------------------------------------------------------------------------}
117function TGtk2WidgetSet.BeginPaint(Handle: hWnd; var PS : TPaintStruct) : hdc;
118var
119  Widget: PGtkWidget;
120  Info: PWidgetInfo;
121  DC: TGtkDeviceContext;
122  paintrect : TGDKRectangle;
123  Control: TWinControl;
124
125begin
126  Widget:={%H-}PGtkWidget(Handle);
127  Info:=GetWidgetInfo(Widget);
128  if Info<>nil then
129    Inc(Info^.PaintDepth);
130  PS.hDC:=GetDC(Handle);
131  DC:=TGtkDeviceContext(PS.hDC);
132  DC.PaintRectangle:=PS.rcPaint;
133
134  Result := PS.hDC;
135
136  if Handle <> 0
137  then Control := TWinControl(GetLCLObject({%H-}Pointer(Handle)))
138  else Control := nil;
139
140  if (Control <> nil)
141  and TWSWinControlClass(Control.WidgetSetClass).GetDoubleBuffered(Control)
142  and not GTK_WIDGET_DOUBLE_BUFFERED({%H-}PGTKWidget(Handle))
143  then begin
144    //DebugLn(['TGtk2WidgetSet.BeginPaint ',DbgSName(Control)]);
145    paintrect.x := PS.rcPaint.Left;
146    paintrect.y := PS.rcPaint.Top;
147    paintrect.width := PS.rcPaint.Right- PS.rcPaint.Left;
148    paintrect.height := PS.rcPaint.Bottom - PS.rcPaint.Top;
149    if (paintrect.width <= 0) or (paintrect.height <=0)
150    then begin
151      paintrect.x := 0;
152      paintrect.y := 0;
153      gdk_drawable_get_size(TGtkDeviceContext(Result).Drawable,
154                            @paintrect.width, @paintrect.height);
155    end;
156    gdk_window_freeze_updates(TGtkDeviceContext(Result).Drawable);
157    gdk_window_begin_paint_rect (TGtkDeviceContext(Result).Drawable, @paintrect);
158  end;
159
160end;
161
162{------------------------------------------------------------------------------
163  Function: BitBlt
164  Params:  DestDC:                The destination devicecontext
165           X, Y:                  The left/top corner of the destination rectangle
166           Width, Height:         The size of the destination rectangle
167           SrcDC:                 The source devicecontext
168           XSrc, YSrc:            The left/top corner of the source rectangle
169           Rop:                   The raster operation to be performed
170  Returns: True if succesful
171
172  The BitBlt function copies a bitmap from a source context into a destination
173  context using the specified raster operation.
174 ------------------------------------------------------------------------------}
175function TGtk2WidgetSet.BitBlt(DestDC: HDC; X, Y, Width, Height: Integer;
176  SrcDC: HDC; XSrc, YSrc: Integer; Rop: DWORD): Boolean;
177begin
178  Result := StretchBlt(DestDC, X, Y, Width, Height, SrcDC, XSrc, YSrc, Width,
179                       Height, ROP);
180end;
181
182{------------------------------------------------------------------------------
183  Function: CallNextHookEx
184  Params:  none
185  Returns: Nothing
186
187
188 ------------------------------------------------------------------------------}
189function TGtk2WidgetSet.CallNextHookEx(hHk: HHOOK; ncode: Integer;
190  wParam: WParam; lParam: LParam): Integer;
191begin
192  Result := 0;
193  // TODO: TGtk2WidgetSet.CallNextHookEx: Does anything need to be done here?
194end;
195
196{------------------------------------------------------------------------------
197  Function: CallWindowProc
198  Params: lpPrevWndFunc:
199          Handle:
200          Msg:
201          wParam:
202          lParam:
203  Returns:
204
205 ------------------------------------------------------------------------------}
206function TGtk2WidgetSet.CallWindowProc(lpPrevWndFunc: TFarProc; Handle: HWND;
207  Msg: UINT; wParam: WParam; lParam: lParam): Integer;
208var
209  Proc : TWndMethod;
210  Mess : TLMessage;
211  P : Pointer;
212begin
213  Result := -1;
214  if Handle = 0 then Exit;
215  P := g_object_get_data({%H-}PGObject(Handle),'WNDPROC');
216  if P <> nil then
217    Proc := TWndMethod(P^)
218  else
219    Exit;
220  Mess.msg := msg;
221  Mess.LParam := LParam;
222  Mess.WParam := WParam;
223  Proc(Mess);
224  Result := Mess.Result;
225end;
226
227{------------------------------------------------------------------------------
228  Function: ClientToScreen
229  Params:  Handle : HWND; var P : TPoint
230  Returns: true on success
231
232  Converts the client-area coordinates of P to screen coordinates.
233 ------------------------------------------------------------------------------}
234function TGtk2WidgetSet.ClientToScreen(Handle : HWND; var P : TPoint) : Boolean;
235var
236  Position: TPoint;
237Begin
238  if Handle = 0
239  then begin
240    Position.X := 0;
241    Position.Y := 0;
242  end
243  else begin
244    Position:=GetWidgetClientOrigin({%H-}PGtkWidget(Handle));
245  end;
246
247  Inc(P.X, Position.X);
248  Inc(P.Y, Position.Y);
249
250  //DebugLn(Format('Trace:  [GTKObject.ClientToScreen] Handle: 0x%x --> (%d, %d)', [Integer(Handle), P.X, P.y]));
251  Result := True;
252end;
253
254{------------------------------------------------------------------------------
255  Function: ClipboardFormatToMimeType
256  Params:  FormatID - a registered format identifier (0 is invalid)
257  Returns: the corresponding mime type as string
258 ------------------------------------------------------------------------------}
259function TGtk2WidgetSet.ClipboardFormatToMimeType(
260  FormatID: TClipboardFormat): string;
261var p: PChar;
262begin
263  if FormatID<>0 then begin
264    p:=gdk_atom_name(FormatID);
265    Result:=StrPas(p);
266    g_free(p);
267  end else
268    Result:='';
269end;
270
271{------------------------------------------------------------------------------
272  Function: ClipboardGetData
273  Params:  ClipboardType
274           FormatID - a registered format identifier (0 is invalid)
275           Stream - If format is available, it will be appended to this stream
276  Returns: true on success
277 ------------------------------------------------------------------------------}
278function TGtk2WidgetSet.ClipboardGetData(ClipboardType: TClipboardType;
279  FormatID: TClipboardFormat; Stream: TStream): boolean;
280var
281  FormatAtom: TGdkAtom;
282  SupportedCnt, i: integer;
283  SupportedFormats: PGdkAtom;
284  SelData: TGtkSelectionData;
285  CompoundTextList: PPGChar;
286  CompoundTextCount: integer;
287
288  function IsFormatSupported(CurFormat: TGdkAtom): boolean;
289  var
290    i: integer;
291    AllID: TGdkAtom;
292  begin
293    //DebugLn('IsFormatSupported CurFormat=',dbgs(CurFormat),' SupportedCnt=',dbgs(SupportedCnt));
294    if CurFormat=0 then begin
295      Result:=false;
296      exit;
297    end;
298    if SupportedCnt<0 then begin
299      Result:=false;
300      AllID:=gdk_atom_intern('TARGETS',GdkFalse);
301      SelData:=RequestSelectionData(ClipboardWidget,ClipboardType,AllID);
302      {$IFDEF DEBUG_CLIPBOARD}
303      DebugLn('IsFormatSupported A ',Dbgs(SelData.Selection),
304      ' ',HexStr(Cardinal(ClipboardTypeAtoms[ClipboardType]),8),
305      ' SelData.Target='+dbgs(SelData.Target),' AllID='+dbgs(AllID),
306      ' SelData.TheType='+dbgs(SelData._type)+' ATOM='+dbgs(gdk_atom_intern('ATOM',GdkTrue))+' Name="'+GdkAtomToStr(SelData._type)+'"',
307      ' SelData.Length='+dbgs(SelData.Length),
308      ' SelData.Format='+dbgs(SelData.Format)
309      );
310      {$ENDIF}
311      if (SelData.Selection<>ClipboardTypeAtoms[ClipboardType])
312      or (SelData.Target<>AllID)
313      or (SelData._Type<>gdk_atom_intern('ATOM',GdkFalse))
314      or ((SelData.Format shr 3)<=0) then begin
315        SupportedCnt:=0;
316        exit;
317      end;
318      SupportedCnt:=SelData.Length div (SelData.Format shr 3);
319      SupportedFormats:=PGdkAtom(SelData.Data);
320      //DebugLn('IsFormatSupported SupportedCnt=',dbgs(SupportedCnt));
321
322      {$IFDEF DEBUG_CLIPBOARD}
323      i:=SupportedCnt-1;
324      while (i>=0) do begin
325        debugln(' ',dbgs(i),' "',GdkAtomToStr(SupportedFormats[i]),'"');
326        dec(i);
327      end;
328      {$ENDIF}
329    end;
330    i:=SupportedCnt-1;
331    while (i>=0) and (SupportedFormats[i]<>CurFormat) do dec(i);
332    Result:=(i>=0);
333  end;
334
335  procedure CheckAtomFormat(const atom_name: Pgchar; only_if_exists:gboolean);
336  var
337    FormatTry: TGdkAtom;
338  begin
339    if FormatAtom<>0 then exit;
340    FormatTry:=gdk_atom_intern(atom_name,only_if_exists);
341    if IsFormatSupported(FormatTry) then
342      FormatAtom:=FormatTry;
343  end;
344
345begin
346  {$IfDef DEBUG_CLIPBOARD}
347  DebugLn('[TGtk2WidgetSet.ClipboardGetData] A ClipboardWidget=',Dbgs(ClipboardWidget),' FormatID=',ClipboardFormatToMimeType(FormatID),' Now=',dbgs(Now));
348  {$EndIf}
349  Result:=false;
350  if (FormatID=0) or (Stream=nil) then exit;
351  if not (ClipboardType in [ctPrimarySelection,ctSecondarySelection,ctClipboard])
352  then exit;
353  // request the data from the selection owner
354  SupportedCnt:=-1;
355  SupportedFormats:=nil;
356  FillChar(SelData,SizeOf(TGtkSelectionData),0);
357  try
358
359    FormatAtom:=FormatID;
360    if (FormatAtom=gdk_atom_intern('text/plain',GdkTrue)) then begin
361      // text/plain is supported in various formats in gtk
362      FormatAtom:=0;
363      // check for UTF8 text format 'UTF8_STRING'
364      CheckAtomFormat('UTF8_STRING',GdkFalse);
365      // The COMPOUND_TEXT format can be converted and is therefore
366      // used as default for 'text/plain'
367      if (SupportedCnt=0) then
368        FormatAtom:=gdk_atom_intern('COMPOUND_TEXT',GdkFalse)
369      else begin
370        CheckAtomFormat('COMPOUND_TEXT',GdkFalse);
371        // then check for simple text format 'text/plain'
372        CheckAtomFormat('text/plain',GdkFalse);
373        // then check for simple text format STRING
374        CheckAtomFormat('STRING',GdkFalse);
375        // check for some other formats that can be interpreted as text
376        CheckAtomFormat('FILE_NAME',GdkTrue);
377        CheckAtomFormat('HOST_NAME',GdkTrue);
378        CheckAtomFormat('USER',GdkTrue);
379        // the TEXT format is not reliable, but it should be supported
380        CheckAtomFormat('TEXT',GdkFalse);
381      end;
382    end;
383
384    {$IfDef DEBUG_CLIPBOARD}
385    DebugLn('[TGtk2WidgetSet.ClipboardGetData] B  Format=',ClipboardFormatToMimeType(FormatAtom),' FormatAtom=',dbgs(FormatAtom),' Now=',dbgs(Now));
386    {$EndIf}
387    if FormatAtom=0 then exit;
388
389    // request data from owner
390    SelData:=RequestSelectionData(ClipboardWidget,ClipboardType,FormatAtom);
391    {$IfDef DEBUG_CLIPBOARD}
392    DebugLn('[TGtk2WidgetSet.ClipboardGetData] C  Length=',dbgs(SelData.Length),' Now=',dbgs(Now),' ',
393      ' SelData.Selection=',dbgs(SelData.Selection),' SelData.Length=',dbgs(SelData.Length));
394    {$EndIf}
395    if (SelData.Selection<>ClipboardTypeAtoms[ClipboardType])
396    or (SelData.Target<>FormatAtom) then begin
397      {$IfDef DEBUG_CLIPBOARD}
398      DebugLn('[TGtk2WidgetSet.ClipboardGetData] REQUESTED FORMAT NOT SUPPORTED  Length=',dbgs(SelData.Length));
399      {$ENDIF}
400      exit;
401    end;
402
403    // write data to stream
404    if (SelData.Data<>nil) and (SelData.Length>0) then begin
405      if (FormatID=gdk_atom_intern('text/plain',GdkTrue)) then begin
406        // the lcl expects the return format as simple text
407        // transform if necessary
408        if FormatAtom=gdk_atom_intern('COMPOUND_TEXT',GdkTrue) then begin
409          CompoundTextList:=nil;
410          CompoundTextCount:=gdk_text_property_to_text_list(SelData._Type,
411            SelData.Format,SelData.Data,SelData.Length,CompoundTextList);
412          try
413            {$IfDef DEBUG_CLIPBOARD}
414            DebugLn('[TGtk2WidgetSet.ClipboardGetData] D  CompoundTextCount=',dbgs(CompoundTextCount),' Now=',dbgs(Now));
415            {$EndIf}
416            for i:=0 to CompoundTextCount-1 do
417              if (CompoundTextList[i]<>nil) then
418                Stream.Write(CompoundTextList[i]^,StrLen(CompoundTextList[i]));
419          finally
420            gdk_free_text_list(CompoundTextList);
421          end;
422        end else
423          Stream.Write(SelData.Data^,SelData.Length);
424      end else begin
425        Stream.Write(SelData.Data^,SelData.Length);
426      end;
427    end;
428
429    {$IfDef DEBUG_CLIPBOARD}
430    DebugLn('[TGtk2WidgetSet.ClipboardGetData] END ',' Now=',dbgs(Now));
431    {$EndIf}
432    Result:=true;
433  finally
434    if SupportedFormats<>nil then
435      FreeMem(SupportedFormats);
436    if (SelData.Data<>nil) and (PGdkAtom(SelData.Data)<>SupportedFormats) then
437      FreeMem(SelData.Data);
438  end;
439end;
440
441{------------------------------------------------------------------------------
442  Function: ClipboardGetFormats
443  Params:  ClipboardType
444  Returns: true on success
445           Count contains the number of supported formats
446           List is an array of TClipboardType
447
448  ! List will be created. You must free it yourself with FreeMem(List) !
449 ------------------------------------------------------------------------------}
450function TGtk2WidgetSet.ClipboardGetFormats(ClipboardType: TClipboardType;
451  var Count: integer; var List: PClipboardFormat): boolean;
452var
453  AllID: TGdkAtom;
454  FormatAtoms: PGdkAtom;
455  Cnt, i: integer;
456  AddTextPlain: boolean;
457  SelData: TGtkSelectionData;
458
459  function IsFormatSupported(CurFormat: TGdkAtom): boolean;
460  var a: integer;
461  begin
462    if CurFormat<>0 then begin
463      for a:=0 to Cnt-1 do begin
464        {$IfDef DEBUG_CLIPBOARD}
465        DebugLn('  IsFormatSupported ',dbgs(CurFormat),'  ',dbgs(FormatAtoms[a]));
466        {$EndIf}
467        if FormatAtoms[a]=CurFormat then begin
468          Result:=true;
469          exit;
470        end;
471      end;
472    end;
473    Result:=false;
474  end;
475
476  function IsFormatSupported(Formats: TGtkClipboardFormats): boolean;
477  var Format: TGtkClipboardFormat;
478  begin
479    for Format:=Low(TGtkClipboardFormat) to High(TGtkClipboardFormat) do
480      if (Format in Formats)
481      and (IsFormatSupported(
482               gdk_atom_intern(PGChar(GtkClipboardFormatName[Format]),GdkTrue)))
483      then begin
484        Result:=true;
485        exit;
486      end;
487    Result:=false;
488  end;
489
490
491begin
492  {$IfDef DEBUG_CLIPBOARD}
493  DebugLn('[TGtk2WidgetSet.ClipboardGetFormats] A ClipboardWidget=',Dbgs(ClipboardWidget),' Now=',dbgs(Now));
494  {$EndIf}
495  Result:=false;
496  Count:=0;
497  List:=nil;
498  if not (ClipboardType in [ctPrimarySelection,ctSecondarySelection,ctClipboard])
499  then exit;
500  // request the list of supported formats from the selection owner
501  AllID:=gdk_atom_intern('TARGETS',GdkFalse);
502
503  SelData:=RequestSelectionData(ClipboardWidget,ClipboardType,AllID);
504
505  try
506    {$IfDef DEBUG_CLIPBOARD}
507    DebugLn('[TGtk2WidgetSet.ClipboardGetFormats] Checking TARGETS answer ',
508      ' selection: '+dbgs(SelData.Selection)+'='+dbgs(ClipboardTypeAtoms[ClipboardType])+
509                ' "'+GdkAtomToStr(SelData.Selection)+'"',
510      ' target: '+dbgs(SelData.Target),'=',dbgs(AllID),
511                ' "'+GdkAtomToStr(SelData.Target),'"',
512      ' theType: '+dbgs(SelData._type)+'='+dbgs(gdk_atom_intern('ATOM',GdkFalse))+
513                ' "'+GdkAtomToStr(SelData._type)+'"',
514      ' Length='+dbgs(SelData.Length),
515      ' Format='+dbgs(SelData.Format),
516      ' Data='+Dbgs(SelData.Data),
517      ' Now='+dbgs(Now)
518      );
519    {$EndIf}
520    if (SelData.Selection<>ClipboardTypeAtoms[ClipboardType])
521    or (SelData.Target<>AllID)
522    or (SelData.Format<=0)
523    or ((SelData._Type<>gdk_atom_intern('ATOM',GdkFalse))
524         and (SelData._Type<>AllID))
525    then
526      exit;
527    Cnt:=SelData.Length div (SelData.Format shr 3);
528    if (SelData.Data<>nil) and (Cnt>0) then begin
529      Count:=Cnt;
530      FormatAtoms:=PGdkAtom(SelData.Data);
531      // add transformable lcl formats
532      // for example: the lcl expects text as 'text/plain', but gtk applications
533      // also know 'TEXT' and 'STRING'. These formats can automagically
534      // transformed into the lcl format, so the lcl format is also supported
535      // and will be added to the list
536
537      AddTextPlain:=false;
538      if (not IsFormatSupported(gdk_atom_intern('text/plain',GdkTrue)))
539      and (IsFormatSupported([gfCOMPOUND_TEXT,gfTEXT,gfSTRING,gfFILE_NAME,
540        gfHOST_NAME,gfUSER]))
541      then begin
542        AddTextPlain:=true;
543        inc(Count);
544      end;
545
546      // copy normal supported formats
547      GetMem(List,SizeOf(TClipboardFormat)*Count);
548      i:=0;
549      while (i<Cnt) do begin
550        {$IfDef DEBUG_CLIPBOARD}
551        DebugLn('[TGtk2WidgetSet.ClipboardGetFormats] Supported formats: ',
552                dbgs(i)+'/'+dbgs(Cnt),':  ',dbgs(FormatAtoms[i]));
553        DebugLn('  MimeType="',ClipboardFormatToMimeType(FormatAtoms[i]),'"');
554        {$EndIf}
555        List[i]:=FormatAtoms[i];
556        inc(i);
557      end;
558
559      // add all lcl formats that the gtk-interface can transform from the
560      // supported formats
561      if AddTextPlain then begin
562        List[i]:=gdk_atom_intern('text/plain',GdkFalse);
563        inc(i);
564      end;
565    end;
566  finally
567    if SelData.Data<>nil then FreeMem(SelData.Data);
568  end;
569  Result:=true;
570end;
571
572{------------------------------------------------------------------------------
573  Function: ClipboardGetOwnerShip
574  Params:  ClipboardType
575           OnRequestProc - TClipboardRequestEvent is defined in LCLIntf.pp
576                           If OnRequestProc is nil the onwership will end.
577           FormatCount - number of formats
578           Formats - array of TClipboardFormat. The supported formats the owner
579                      provides.
580
581  Returns: true on success
582
583  Sets the supported formats and requests ownership for the clipboard.
584  Each time the clipboard is read the OnRequestProc will be executed.
585  If someone else requests the ownership, the OnRequestProc will be executed
586  with the invalid FormatID 0 to notify the old owner of the lost of ownership.
587 ------------------------------------------------------------------------------}
588function TGtk2WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
589  OnRequestProc: TClipboardRequestEvent;  FormatCount: integer;
590  Formats: PClipboardFormat): boolean;
591var TargetEntries: PGtkTargetEntry;
592
593  function IsFormatSupported(FormatID: TGdkAtom): boolean;
594  var i: integer;
595  begin
596    if FormatID=0 then begin
597      Result:=false;
598      exit;
599    end;
600    i:=FormatCount-1;
601    while (i>=0) and (Formats[i]<>FormatID) do dec(i);
602    Result:=(i>=0);
603  end;
604
605  procedure AddTargetEntry(var Index: integer; const FormatName: string);
606  begin
607    {$IfDef DEBUG_CLIPBOARD}
608    DebugLn('  AddTargetEntry ',FormatName);
609    {$EndIf}
610    TargetEntries[Index].Target := StrAlloc(Length(FormatName) + 1);
611    StrPCopy(TargetEntries[Index].Target, FormatName);
612    TargetEntries[Index].flags:=0;
613    TargetEntries[Index].Info:=Index;
614    inc(Index);
615  end;
616
617{function TGtk2WidgetSet.ClipboardGetOwnerShip(ClipboardType: TClipboardType;
618  OnRequestProc: TClipboardRequestEvent;  FormatCount: integer;
619  Formats: PClipboardFormat): boolean;}
620var
621  TargetEntriesSize, i: integer;
622  gtkFormat: TGtkClipboardFormat;
623  ExpFormatCnt: integer;
624  OldClipboardWidget: PGtkWidget;
625begin
626  if ClipboardType in [ctPrimarySelection, ctSecondarySelection, ctClipboard] then
627  begin
628    {$IfDef DEBUG_CLIPBOARD}
629    DebugLn('[TGtk2WidgetSet.ClipboardGetOwnerShip] A');
630    {$EndIf}
631    ClipboardHandler[ClipboardType]:=nil;
632    Result:=false;
633    if (ClipboardWidget=nil) or (FormatCount=0) or (Formats=nil) then
634    begin
635      // end ownership
636      if (ClipBoardWidget <> nil)
637      and (GetControlWindow(ClipboardWidget)<>nil)
638      and (gdk_selection_owner_get(ClipboardTypeAtoms[ClipboardType]) =
639           GetControlWindow(ClipboardWidget))
640      then begin
641        gtk_selection_owner_set(nil,ClipboardTypeAtoms[ClipboardType],0);
642      end;
643      Result:=true;
644      exit;
645    end;
646
647    // registering targets
648    FreeClipboardTargetEntries(ClipboardType);
649
650    // the gtk-interface adds automatically some gtk formats unknown to the lcl
651    ExpFormatCnt:=FormatCount;
652    for gtkFormat:=Low(TGtkClipboardFormat) to High(TGtkClipboardFormat) do
653      ClipboardExtraGtkFormats[ClipboardType][gtkFormat]:=false;
654    {$IfDef DEBUG_CLIPBOARD}
655    DebugLn('[TGtk2WidgetSet.ClipboardGetOwnerShip] B');
656    {$EndIf}
657    if IsFormatSupported(gdk_atom_intern('text/plain',GdkTrue)) then
658    begin
659      // lcl provides 'text/plain' and the gtk-interface will automatically
660      // provide some more text formats
661      ClipboardExtraGtkFormats[ClipboardType][gfUTF8_STRING]:=not IsFormatSupported(
662                gdk_atom_intern(PGChar(GtkClipboardFormatName[gfUTF8_STRING]),GdkFalse));
663      ClipboardExtraGtkFormats[ClipboardType][gfCOMPOUND_TEXT]:=
664          not IsFormatSupported(
665                gdk_atom_intern(PGChar(GtkClipboardFormatName[gfCOMPOUND_TEXT]),GdkFalse));
666      ClipboardExtraGtkFormats[ClipboardType][gfSTRING]:=not IsFormatSupported(
667                gdk_atom_intern(PGChar(GtkClipboardFormatName[gfSTRING]),GdkFalse));
668      ClipboardExtraGtkFormats[ClipboardType][gfTEXT]:=not IsFormatSupported(
669                gdk_atom_intern(PGChar(GtkClipboardFormatName[gfTEXT]),GdkFalse));
670    end;
671
672    for gtkFormat:=Low(TGtkClipboardFormat) to High(TGtkClipboardFormat) do
673      if ClipboardExtraGtkFormats[ClipboardType][gtkFormat] then
674        inc(ExpFormatCnt);
675
676    // build TargetEntries
677    TargetEntriesSize:=SizeOf(TGtkTargetEntry) * ExpFormatCnt;
678    GetMem(TargetEntries,TargetEntriesSize);
679    FillChar(TargetEntries^,TargetEntriesSize,0);
680    i:=0;
681    while i<FormatCount do
682      AddTargetEntry(i,ClipboardFormatToMimeType(Formats[i]));
683    for gtkFormat:=Low(TGtkClipboardFormat) to High(TGtkClipboardFormat) do
684      if ClipboardExtraGtkFormats[ClipboardType][gtkFormat] then
685        AddTargetEntry(i,GtkClipboardFormatName[gtkFormat]);
686
687    // set the supported formats
688    ClipboardTargetEntries[ClipboardType]:=TargetEntries;
689    ClipboardTargetEntryCnt[ClipboardType]:=ExpFormatCnt;
690
691    // reset the clipboard widget (this will set the new target list)
692    OldClipboardWidget:=ClipboardWidget;
693    SetClipboardWidget(nil);
694    SetClipboardWidget(OldClipboardWidget);
695
696    // taking the ownership
697    {$IfDef DEBUG_CLIPBOARD}
698    DebugLn('[TGtk2WidgetSet.ClipboardGetOwnerShip] C');
699    {$EndIf}
700    if gtk_selection_owner_set(ClipboardWidget,
701      ClipboardTypeAtoms[ClipboardType],0)=GdkFalse
702    then begin
703      {$IfDef DEBUG_CLIPBOARD}
704      DebugLn('[TGtk2WidgetSet.ClipboardGetOwnerShip] D FAILED');
705      {$EndIf}
706      exit;
707    end;
708
709    {$IfDef DEBUG_CLIPBOARD}
710    DebugLn('[TGtk2WidgetSet.ClipboardGetOwnerShip] YEAH, got it!');
711    {$EndIf}
712    ClipboardHandler[ClipboardType]:=OnRequestProc;
713
714    Result:=true;
715  end else
716    { the gtk does not support this kind of clipboard, so the application can
717     have the ownership at any time. The TClipboard in clipbrd.pp has an
718     internal cache system, so that an application can use all types of
719     clipboards even if the underlying platform does not support it.
720     Of course this will only be a local clipboard, invisible to other
721     applications. }
722    Result:=true;
723end;
724
725function TGtk2WidgetSet.ClipboardFormatNeedsNullByte(
726  const AFormat: TPredefinedClipboardFormat): Boolean;
727begin
728  Result := False;
729end;
730
731{------------------------------------------------------------------------------
732  Function: ClipboardRegisterFormat
733  Params:  AMimeType
734  Returns: the registered Format identifier (TClipboardFormat)
735 ------------------------------------------------------------------------------}
736function TGtk2WidgetSet.ClipboardRegisterFormat(const AMimeType: string
737  ): TClipboardFormat;
738var AtomName: PChar;
739begin
740  if Assigned(Application) then begin
741    AtomName:=PChar(AMimeType);
742    Result:=gdk_atom_intern(AtomName,GdkFalse);
743  end else
744    RaiseGDBException(
745      'ERROR: TGtk2WidgetSet.ClipboardRegisterFormat gdk not initialized');
746end;
747
748
749{------------------------------------------------------------------------------
750  Function: CreateBitmap
751  Params:  none
752  Returns: Nothing
753
754
755 ------------------------------------------------------------------------------}
756function TGtk2WidgetSet.CreateBitmap(Width, Height: Integer; Planes, BitCount: Longint; BitmapBits: Pointer): HBITMAP;
757
758
759const
760  MIN_LOADER_HEADER_SIZE = 128;
761
762type
763  // the loader internally used starts decoding the header after 128 bytes.
764  // by adding dummy bytes and adjusting the data offset, we make sure that we
765  // we write atleast 128 bytes
766
767  TBitmapHeader = packed record
768    FileHeader: tagBitmapFileHeader;
769    InfoHeader: tagBitmapInfoHeader;
770    Dummy: array[1..MIN_LOADER_HEADER_SIZE] of Byte;
771  end;
772
773var
774  GdiObject: PGdiObject;
775
776  procedure FillBitmapInfo(out Header: TBitmapHeader);
777  begin
778    FillChar(Header{%H-}, SizeOf(Header), 0);
779
780    Header.InfoHeader.biSize := SizeOf(Header.InfoHeader);
781    Header.InfoHeader.biWidth := Width;
782    Header.InfoHeader.biHeight := Height;
783    Header.InfoHeader.biPlanes := Planes;
784    Header.InfoHeader.biBitCount := Bitcount;
785    Header.InfoHeader.biCompression := BI_RGB;
786    Header.InfoHeader.biSizeImage := (((BitCount * Width + 31) shr 5) shl 2) * Height;
787    Header.InfoHeader.biXPelsPerMeter := GetDeviceCaps(0, LOGPIXELSX);
788    Header.InfoHeader.biYPelsPerMeter := GetDeviceCaps(0, LOGPIXELSY);
789
790    Header.FileHeader.bfType      := LeToN($4D42);
791    Header.FileHeader.bfSize      := MIN_LOADER_HEADER_SIZE + Header.InfoHeader.biSizeImage;
792    Header.FileHeader.bfOffBits   := MIN_LOADER_HEADER_SIZE;
793  end;
794
795  procedure LoadDataByPixbufLoader;
796  const
797    ALIGNDATA: Word = 0;
798  var
799    Header: TBitmapHeader;
800    Loader: PGdkPixbufLoader;
801    Src: PGDKPixbuf;
802    res: Boolean;
803    LineSize, Count: Integer;
804    BitsPtr: PByte;
805  begin
806    Loader := gdk_pixbuf_loader_new;
807    if Loader = nil then Exit;
808
809
810    FillBitmapInfo(Header);
811    Src := nil;
812    try
813      if not gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(@Header), MIN_LOADER_HEADER_SIZE,nil)
814      then begin
815        DebugLn('WARNING: [TGtk2WidgetSet.CreateBitmap] Error loading Bitmap Header!');
816        Exit;
817      end;
818
819      LineSize := (((BitCount * Width + 15) shr 4) shl 1);
820      if (LineSize and 2) <> 0
821      then begin
822        // bitmapdata needs to be DWord aligned, while CreateBitmap is Word aligned
823        // so "feed" the loader line by line :(
824        Count := Height;
825        res := True;
826        BitsPtr := BitmapBits;
827        while res and (Count > 0) do
828        begin
829          res := gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(BitsPtr), LineSize,nil)
830             and gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(@ALIGNDATA), 2,nil);
831          Inc(BitsPtr, LineSize);
832          Dec(Count);
833        end;
834      end
835      else begin
836        // data is DWord aligned :)
837        res := gdk_pixbuf_loader_write(Loader, TGdkPixBufBuffer(BitmapBits), Header.InfoHeader.biSizeImage,nil);
838      end;
839
840      if not res
841      then begin
842        DebugLn('WARNING: [TGtk2WidgetSet.CreateBitmap] Error loading Image!');
843        Exit;
844      end;
845
846      Src := gdk_pixbuf_loader_get_pixbuf(loader);
847      if Src = nil
848      then begin
849        DebugLn('WARNING: [TGtk2WidgetSet.CreateBitmap] Error loading Pixbuf!');
850        Exit;
851      end;
852
853    finally
854      gdk_pixbuf_loader_close(Loader,nil);
855    end;
856
857    if GdiObject^.GDIPixmapObject.Image<>nil then
858    begin
859      gdk_pixmap_unref(GdiObject^.GDIPixmapObject.Image);
860      GdiObject^.GDIPixmapObject.Image:=nil;
861    end;
862    if GdiObject^.GDIPixmapObject.Mask<>nil then
863    begin
864      gdk_bitmap_unref(GdiObject^.GDIPixmapObject.Mask);
865      GdiObject^.GDIPixmapObject.Mask:=nil;
866    end;
867    gdk_pixbuf_render_pixmap_and_mask(Src,
868      GdiObject^.GDIPixmapObject.Image, GdiObject^.GDIPixmapObject.Mask, $80);
869    gdk_pixbuf_unref(Src);
870
871    GdiObject^.Depth := gdk_drawable_get_depth(GdiObject^.GDIPixmapObject.Image);
872    if GdiObject^.Depth = 1
873    then begin
874      if GdiObject^.GDIPixmapObject.Mask <> nil
875      then gdk_pixmap_unref(GdiObject^.GDIPixmapObject.Mask);
876      GdiObject^.GDIPixmapObject.Mask := nil;
877      GdiObject^.GDIBitmapType := gbBitmap;
878    end
879    else begin
880      GdiObject^.GDIBitmapType := gbPixmap;
881    end;
882
883
884    GdiObject^.Visual := gdk_window_get_visual(GDIObject^.GDIPixmapObject.Image);
885    if GdiObject^.Visual = nil
886    then GdiObject^.Visual := gdk_visual_get_best_with_depth(GdiObject^.Depth)
887    else gdk_visual_ref(GdiObject^.Visual);
888
889    GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, GdkTrue);
890  end;
891
892  procedure LoadBitmapData;
893  var
894    LineSize, n: Integer;
895    BitsPtr: Pointer;
896    Src, Dst: PByte;
897  begin
898    LineSize := (Width + 7) shr 3;
899    if (LineSize and 1) <> 0
900    then begin
901      // the gdk_bitmap_create_from_data expects data byte aligned while
902      // Createbitmap is word aligned. adjust data
903      BitsPtr := GetMem(LineSize * Height);
904      Dst := BitsPtr;
905      Src := BitmapBits;
906      for n := 1 to height do
907      begin
908        Move(Src^, Dst^, LineSize);
909        Inc(Src, LineSize + 1);
910        Inc(Dst, LineSize);
911      end;
912    end
913    else begin
914      BitsPtr := BitmapBits;
915    end;
916
917    GdiObject^.GDIBitmapType := gbBitmap;
918    GdiObject^.GDIBitmapObject := gdk_bitmap_create_from_data(nil, BitsPtr, Width, Height);
919    GdiObject^.Visual := nil; // bitmaps don't have a visual
920    GdiObject^.SystemVisual := False;
921
922    if BitsPtr <> BitmapBits
923    then FreeMem(BitsPtr);
924  end;
925
926begin
927  //DebugLn(Format('Trace:> [TGtk2WidgetSet.CreateBitmap] Width: %d, Height: %d, Planes: %d, BitCount: %d, BitmapBits: 0x%x', [Width, Height, Planes, BitCount, PtrUInt(BitmapBits)]));
928
929  if (BitCount < 1) or (Bitcount > 32)
930  then begin
931    Result := 0;
932    DebugLn(Format('ERROR: [TGtk2WidgetSet.CreateBitmap] Illegal depth %d', [BitCount]));
933    Exit;
934  end;
935
936  GdiObject := NewGDIObject(gdiBitmap);
937
938  if BitmapBits = nil
939  then begin
940    if BitCount = 1
941    then begin
942      GdiObject^.GDIBitmapType := gbBitmap;
943      GdiObject^.GDIBitmapObject := gdk_pixmap_new(nil, Width, Height, 1);
944      GdiObject^.Visual := nil; // bitmaps don't have a visual
945    end
946    else begin
947      GdiObject^.GDIBitmapType := gbPixmap;
948      GdiObject^.GDIPixmapObject.Image := gdk_pixmap_new(nil, Width, Height, BitCount);
949      GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIPixmapObject.Image);
950      gdk_visual_ref(GdiObject^.Visual);
951    end;
952    GdiObject^.SystemVisual := False;
953  end
954  else begin
955    if BitCount = 1
956    then begin
957      LoadBitmapData;
958    end
959    else begin
960      // Load the data by faking it as a windows bitmap stream (this handles all conversion)
961      // Problem with his method is that it doesn't result in the bitmap requested.
962      // it is always a device compatible bitmap
963      // maybe we should add a gdPixBuf type the the GDIObject for formats not compatible
964      // with a native pixmap format
965      LoadDataByPixbufLoader;
966    end;
967  end;
968
969  Result := HBITMAP({%H-}PtrUInt(GdiObject));
970
971  //DebugLn(Format('Trace:< [TGtk2WidgetSet.CreateBitmap] --> 0x%x', [Integer(Result)]));
972end;
973
974
975{------------------------------------------------------------------------------
976  Function:  CreateBrushIndirect
977  Params:  none
978  Returns: Nothing
979
980
981 ------------------------------------------------------------------------------}
982function TGtk2WidgetSet.CreateBrushIndirect(const LogBrush: TLogBrush): HBRUSH;
983const
984  HATCH_BDIAGONAL : array[0..7] of Byte = ($80, $40, $20, $10, $08, $04, $02, $01);
985  HATCH_CROSS     : array[0..7] of Byte = ($08, $08, $08, $FF, $08, $08, $08, $08);
986  HATCH_DIAGCROSS : array[0..7] of Byte = ($81, $42, $24, $18, $18, $24, $42, $81);
987  HATCH_FDIAGONAL : array[0..7] of Byte = ($01, $02, $04, $08, $10, $20, $40, $80);
988  HATCH_HORIZONTAL: array[0..7] of Byte = ($00, $00, $00, $FF, $00, $00, $00, $00);
989  HATCH_VERTICAL  : array[0..7] of Byte = ($08, $08, $08, $08, $08, $08, $08, $08);
990var
991  GObject: PGdiObject;
992  TmpMask: PGdkBitmap;
993begin
994  //DebugLn(Format('Trace:> [TGtk2WidgetSet.CreateBrushIndirect]  Style: %d, Color: %8x', [LogBrush.lbStyle, LogBrush.lbColor]));
995
996  {$IFDEF DebugGDKTraps}
997  BeginGDKErrorTrap;
998  {$ENDIF}
999
1000  GObject := NewGDIObject(gdiBrush);
1001  try
1002    {$IFDEF DebugGDIBrush}
1003    DebugLn('[TGtk2WidgetSet.CreateBrushIndirect] ',DbgS(GObject));
1004    {$ENDIF}
1005    GObject^.IsNullBrush := False;
1006    with LogBrush do
1007    begin
1008      case lbStyle of
1009        BS_NULL {BS_HOLLOW}: // Same as BS_HOLLOW.
1010          GObject^.IsNullBrush := True;
1011        BS_SOLID:          // Solid brush.
1012          GObject^.GDIBrushFill := GDK_SOLID;
1013        BS_HATCHED:        // Hatched brush.
1014          begin
1015            GObject^.GDIBrushFill := GDK_STIPPLED;
1016            case lbHatch of
1017              HS_BDIAGONAL:
1018                GObject^.GDIBrushPixmap := gdk_bitmap_create_from_data(
1019                   nil, pgchar(@HATCH_BDIAGONAL[0]), 8, 8);
1020              HS_CROSS:
1021                GObject^.GDIBrushPixmap := gdk_bitmap_create_from_data(
1022                   nil, pgchar(@HATCH_CROSS[0]), 8, 8);
1023              HS_DIAGCROSS:
1024                GObject^.GDIBrushPixmap := gdk_bitmap_create_from_data(
1025                   nil, pgchar(@HATCH_DIAGCROSS[0]), 8, 8);
1026              HS_FDIAGONAL:
1027                GObject^.GDIBrushPixmap := gdk_bitmap_create_from_data(
1028                   nil, pgchar(@HATCH_FDIAGONAL[0]), 8, 8);
1029              HS_HORIZONTAL:
1030                GObject^.GDIBrushPixmap := gdk_bitmap_create_from_data(
1031                   nil, pgchar(@HATCH_HORIZONTAL[0]), 8, 8);
1032              HS_VERTICAL:
1033                GObject^.GDIBrushPixmap := gdk_bitmap_create_from_data(
1034                   nil, pgchar(@HATCH_VERTICAL[0]), 8, 8);
1035              else
1036                GObject^.GDIBrushFill := GDK_SOLID;
1037            end;
1038          end;
1039
1040        BS_DIBPATTERN,     // A pattern brush defined by a device-independent
1041             // bitmap (DIB) specification. If lbStyle is BS_DIBPATTERN, the
1042             // lbHatch member contains a handle to a packed DIB.Windows 95:
1043             // Creating brushes from bitmaps or DIBs larger than 8x8 pixels
1044             // is not supported. If a larger bitmap is given, only a portion
1045             // of the bitmap is used.
1046        BS_DIBPATTERN8X8,  // Same as BS_DIBPATTERN.
1047        BS_DIBPATTERNPT,   // A pattern brush defined by a device-independent
1048             // bitmap (DIB) specification. If lbStyle is BS_DIBPATTERNPT, the
1049             // lbHatch member contains a pointer to a packed DIB.
1050        BS_PATTERN,        // Pattern brush defined by a memory bitmap.
1051        BS_PATTERN8X8:     // Same as BS_PATTERN.
1052          begin
1053            GObject^.GDIBrushPixmap := nil;
1054            if IsValidGDIObject(lbHatch) and ({%H-}PGdiObject(lbHatch)^.GDIType = gdiBitmap) then
1055            begin
1056              case {%H-}PGdiObject(lbHatch)^.GDIBitmapType of
1057                gbBitmap:
1058                begin
1059                  GObject^.GDIBrushPixmap := {%H-}PGdiObject(lbHatch)^.GDIBitmapObject;
1060                  GObject^.GDIBrushFill := GDK_STIPPLED;
1061                end;
1062                gbPixmap:
1063                begin
1064                  GObject^.GDIBrushPixmap := {%H-}PGdiObject(lbHatch)^.GDIPixmapObject.Image;
1065                  GObject^.GDIBrushFill := GDK_TILED;
1066                end;
1067                gbPixbuf:
1068                begin
1069                  GObject^.GDIBrushPixmap := nil;
1070                  TmpMask := nil;
1071                  gdk_pixbuf_render_pixmap_and_mask({%H-}PGdiObject(lbHatch)^.GDIPixbufObject,
1072                    GObject^.GDIBrushPixmap, TmpMask, $80);
1073                  gdk_pixmap_unref(TmpMask);
1074                end;
1075                else
1076                begin
1077                  DebugLn('TGtk2WidgetSet.CreateBrushIndirect: Unsupported GDIBitmapType')
1078                end;
1079              end
1080            end
1081            else
1082              RaiseGDBException('unsupported bitmap');
1083            if GObject^.GDIBrushPixmap <> nil then
1084              gdk_pixmap_ref(GObject^.GDIBrushPixmap);
1085          end;
1086        else
1087          RaiseGDBException(Format('unsupported Style %d',[lbStyle]));
1088      end;
1089
1090      {$IFDEF DebugGDKTraps}
1091      EndGDKErrorTrap;
1092      {$ENDIF}
1093
1094      if not GObject^.IsNullBrush then
1095        SetGDIColorRef(GObject^.GDIBrushColor, lbColor);
1096    end;
1097    Result := HBRUSH({%H-}PtrUInt(GObject));
1098  except
1099    Result:=0;
1100    DisposeGDIObject(GObject);
1101    DebugLn('TGtk2WidgetSet.CreateBrushIndirect failed');
1102  end;
1103  //DebugLn(Format('Trace:< [TGtk2WidgetSet.CreateBrushIndirect] Got --> %x', [Result]));
1104end;
1105
1106{------------------------------------------------------------------------------
1107  Function: CreateCaret
1108  Params:  none
1109  Returns: Nothing
1110
1111
1112 ------------------------------------------------------------------------------}
1113function TGtk2WidgetSet.CreateCaret(Handle: HWND; Bitmap: hBitmap; width,
1114  Height: Integer): Boolean;
1115var
1116  GTKObject: PGTKObject;
1117  BMP: PGDKPixmap;
1118begin
1119  //DebugLn('Trace:TODO: [TGtk2WidgetSet.CreateCaret] Finish');
1120
1121  GTKObject := {%H-}PGTKObject(Handle);
1122  Result := GTKObject <> nil;
1123
1124  if Result then begin
1125    if gtk_type_is_a(g_object_type(GTKObject), GTKAPIWidget_GetType)
1126    then begin
1127      if IsValidGDIObjectType(Bitmap, gdiBitmap) then
1128        BMP := {%H-}PGdiObject(Bitmap)^.GDIBitmapObject
1129      else
1130        BMP := nil;
1131      GTKAPIWidget_CreateCaret(PGTKAPIWidget(GTKObject), Width, Height, BMP);
1132    end
1133//    else if // TODO: other widgettypes
1134    else begin
1135      Result := False;
1136    end;
1137  end;
1138end;
1139
1140{------------------------------------------------------------------------------
1141  Function: CreateCompatibleBitmap
1142  Params: DC:
1143          Width:
1144          Height:
1145  Returns:
1146
1147  Creates a bitmap compatible with the specified device context.
1148 ------------------------------------------------------------------------------}
1149function TGtk2WidgetSet.CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBITMAP;
1150var
1151  DevCtx: TGtkDeviceContext absolute DC;
1152
1153  GDIObject: PGdiObject;
1154  Depth : Longint;
1155  Drawable, DefDrawable: PGDkDrawable;
1156begin
1157  //DebugLn(Format('Trace:> [TGtk2WidgetSet.CreateCompatibleBitmap] DC: 0x%x, W: %d, H: %d', [DC, Width, Height]));
1158
1159  if IsValidDC(DC) and (DevCtx.Drawable <> nil)
1160  then begin
1161    DefDrawable := DevCtx.Drawable;
1162    Depth := gdk_drawable_get_depth(DevCtx.Drawable);
1163  end
1164  else begin
1165    DefDrawable := nil;
1166    Depth := gdk_visual_get_system^.Depth;
1167  end;
1168
1169
1170  if (Depth < 1) or (Depth > 32)
1171  then begin
1172    Result := 0;
1173    DebugLn(Format('ERROR: [TGtk2WidgetSet.CreateCompatibleBitmap] Illegal depth %d', [Depth]));
1174    Exit;
1175  end;
1176
1177  GdiObject := NewGDIObject(gdiBitmap);
1178
1179  Drawable := gdk_pixmap_new(DefDrawable, Width, Height, Depth);
1180  GdiObject^.Visual := gdk_window_get_visual(Drawable);
1181  if Depth = 1
1182  then begin
1183    GdiObject^.GDIBitmapType := gbBitmap;
1184    GdiObject^.GDIBitmapObject := Drawable;
1185  end
1186  else begin
1187    GdiObject^.GDIBitmapType := gbPixmap;
1188    GdiObject^.GDIPixmapObject.Image := Drawable;
1189  end;
1190
1191  if GdiObject^.Visual = nil
1192  then begin
1193    GdiObject^.Visual := gdk_visual_get_best_with_depth(Depth);
1194    if GdiObject^.Visual = nil
1195    then GdiObject^.Visual := gdk_visual_get_system;
1196    GdiObject^.SystemVisual := True;
1197  end
1198  else begin
1199    gdk_visual_ref(GdiObject^.Visual);
1200    GdiObject^.SystemVisual := False;
1201  end;
1202
1203  GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, GdkTrue);
1204
1205  Result := HBITMAP({%H-}PtrUInt(GdiObject));
1206
1207  //DebugLn(Format('Trace:< [TGtk2WidgetSet.CreateCompatibleBitmap] DC: 0x%x --> 0x%x', [DC, Result]));
1208end;
1209
1210{------------------------------------------------------------------------------
1211  Function: CreateCompatibleDC
1212  Params:  none
1213  Returns: Nothing
1214 ------------------------------------------------------------------------------}
1215function TGtk2WidgetSet.CreateCompatibleDC(DC: HDC): HDC;
1216var
1217  pNewDC: TGtkDeviceContext;
1218begin
1219  Result := 0;
1220  pNewDC := NewDC;
1221
1222  // ToDo: TGtk2WidgetSet.CreateCompatibleDC: when is a DC compatible?
1223
1224  // do not copy
1225  // In a compatible DC you have to select a bitmap into it
1226(*
1227  if IsValidDC(DC) then
1228    with TGtkDeviceContext(DC)^ do
1229    begin
1230      pNewDC^.hWnd := hWnd;
1231      pNewDC^.Drawable := Drawable;
1232      pNewDC^.GC := gdk_gc_new(Drawable);
1233    end
1234  else begin
1235    // We can't do anything yet
1236    // Wait till a bitmap get selected
1237  end;
1238*)
1239  with pNewDC do
1240  begin
1241    gdk_color_black(gdk_colormap_get_system, @CurrentTextColor.Color);
1242    BuildColorRefFromGDKColor(CurrentTextColor);
1243    gdk_color_white(gdk_colormap_get_system, @CurrentBackColor.Color);
1244    BuildColorRefFromGDKColor(CurrentBackColor);
1245  end;
1246  Result := HDC(pNewDC);
1247
1248  //DebugLn(Format('trace:  [TGtk2WidgetSet.CreateCompatibleDC] DC: 0x%x --> 0x%x', [Integer(DC), Integer(Result)]));
1249end;
1250
1251function TGtk2WidgetSet.DestroyCursor(Handle: HCURSOR): Boolean;
1252begin
1253  Result := Handle <> 0;
1254  if Result then
1255    gdk_cursor_destroy({%H-}PGdkCursor(Handle));
1256end;
1257
1258function TGtk2WidgetSet.DestroyIcon(Handle: HICON): Boolean;
1259begin
1260  Result := (Handle <> 0) and
1261            (
1262              GDK_IS_PIXBUF({%H-}Pointer(Handle)) or
1263              // todo: replace with GDK_IS_CURSOR when fpc will have it
1264              G_TYPE_CHECK_INSTANCE_TYPE({%H-}Pointer(Handle),GDK_TYPE_CURSOR)
1265            );
1266  if Result then
1267    if GDK_IS_PIXBUF({%H-}Pointer(Handle)) then
1268      gdk_pixbuf_unref({%H-}PGdkPixbuf(Handle))
1269    else
1270      gdk_cursor_unref({%H-}PGdkCursor(Handle));
1271end;
1272
1273function TGtk2WidgetSet.DPtoLP(DC: HDC; var Points; Count: Integer): BOOL;
1274var
1275  DevCtx: TGtkDeviceContext absolute DC;
1276  P: PPoint;
1277begin
1278  Result := False;
1279
1280  if not IsValidDC(DC) then Exit(False);
1281
1282  if not DevCtx.HasTransf then Exit(True);
1283
1284  P := @Points;
1285  while Count > 0 do
1286  begin
1287    Dec(Count);
1288    DevCtx.InvTransfPoint(P^.X, P^.Y);
1289    Inc(P);
1290  end;
1291
1292  Result := True;
1293end;
1294
1295{
1296  Gtk2 has no function to build an elliptical region so we approximate it to a
1297  polygon. Our Ellipse is axis-aligned, so it's parametrization is:
1298
1299  X(t) = Xc + a * cos(t)
1300  Y(t) = Yc + b * sin(t)
1301
1302  (Xc,Yc) is the center of the ellipse
1303}
1304function TGtk2WidgetSet.CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRGN;
1305var
1306  points: array of TGdkPoint;
1307  n_points: Integer;
1308  i, Xc, Yc, a, b: Integer;
1309  t: Double;
1310  GObject: PGdiObject;
1311  RegionObj: PGdkRegion;
1312begin
1313  a := (X2 - X1) div 2;
1314  b := (Y2 - Y1) div 2;
1315  Xc := X1 + a;
1316  Yc := Y1 + b;
1317
1318  // Choose a large enough amount of points
1319  n_points := Max(X2-X1,Y2-Y1) * 4;
1320  SetLength(points{%H-}, n_points);
1321  // And fill them iterating through the ellipse
1322  for i := 0 to n_points - 1 do
1323  begin
1324    t := (i / n_points) * 2 * Pi;
1325    points[i].X := Round(Xc + a * cos(t));
1326    points[i].Y := Round(Yc + b * sin(t));
1327  end;
1328
1329  GObject := NewGDIObject(gdiRegion);
1330  RegionObj := gdk2.gdk_region_polygon(@points[0], n_points, GDK_WINDING_RULE);
1331  GObject^.GDIRegionObject := RegionObj;
1332
1333  Result := HRGN({%H-}PtrUInt(GObject));
1334
1335  // Free the allocated array
1336  SetLength(points, 0);
1337  //DebugLn('TGtk2WidgetSet.CreateRectRgn A ',GDKRegionAsString(RegionObj));
1338end;
1339
1340{------------------------------------------------------------------------------
1341  Function: CreateFontIndirect
1342  Params:  const LogFont: TLogFont
1343  Returns: HFONT
1344
1345  Creates a font GDIObject.
1346 ------------------------------------------------------------------------------}
1347function TGtk2WidgetSet.CreateFontIndirect(const LogFont: TLogFont): HFONT;
1348begin
1349  Result := CreateFontIndirectEx(LogFont,'');
1350end;
1351
1352{------------------------------------------------------------------------------
1353  Function: CreateFontIndirectEx
1354  Params:  const LogFont: TLogFont; const LongFontName: string
1355  Returns: HFONT
1356
1357  Creates a font GDIObject.
1358 ------------------------------------------------------------------------------}
1359function TGtk2WidgetSet.CreateFontIndirectEx(const LogFont: TLogFont;
1360  const LongFontName: string): HFONT;
1361{off $DEFINE VerboseFonts}
1362var
1363  GdiObject: PGdiObject;
1364  FullString, aFamily, aStyle, ALongFontName: String;
1365  aSize: Integer;
1366  aSizeInPixels: Boolean;
1367  PangoDesc: PPangoFontDescription;
1368  CachedFont: TGtkFontCacheDescriptor;
1369  AttrList: PPangoAttrList;
1370  AttrListTemporary: Boolean;
1371  Attr: PPangoAttribute;
1372  CurFont: PPangoLayout;
1373  TmpStr: PChar;
1374begin
1375  {$IFDEF VerboseFonts}
1376  DebugLn('TGtk2WidgetSet.CreateFontIndirectEx A Name=',LogFont.lfFaceName,' Height=',dbgs(LogFont.lfHeight),' LongName=',LongFontName);
1377  {$ENDIF}
1378  Result := 0;
1379  PangoDesc := nil;
1380  GdiObject := nil;
1381  if LongFontName = '' then
1382    ALongFontName := LogFont.lfFaceName
1383  else
1384    ALongFontName := LongFontName;
1385  try
1386    // first search in cache
1387    CachedFont:=FontCache.FindGTkFontDesc(LogFont, ALongFontName);
1388    if CachedFont<>nil then begin
1389      CachedFont.Item.IncreaseRefCount;
1390      GdiObject := NewGdiObject(gdiFont);
1391      GdiObject^.UntransfFontHeight := 0;
1392      GdiObject^.GDIFontObject := TGtkFontCacheItem(CachedFont.Item).GtkFont;
1393      {$IFDEF VerboseFonts}
1394      WriteLn('Was already in cache');
1395      {$ENDIF}
1396      exit;
1397    end;
1398
1399    with LogFont do
1400    begin
1401      if lfFaceName[0] = #0
1402      then begin
1403        //DebugLn('ERROR: [Tgt2kObject.CreateFontIndirectEx] No fontname');
1404        Exit;
1405      end;
1406
1407      // if we have really default font
1408      if (lfHeight = 0) and
1409         (lfWeight = FW_NORMAL) and
1410         (lfItalic = 0) and
1411         (lfUnderline = 0) and
1412         (lfStrikeOut = 0) and
1413         (lfOrientation = 0) and
1414         IsFontNameDefault(lfFacename) then
1415      begin
1416        // use default font
1417        {$IFDEF VerboseFonts}
1418        DebugLn(['TGtk2WidgetSet.CreateFontIndirectEx Creating default font']);
1419        {$ENDIF}
1420        GdiObject := CreateDefaultFont;
1421        exit;
1422      end;
1423
1424      FontNameToPangoFontDescStr(ALongFontname, aFamily, aStyle, aSize, aSizeInPixels);
1425
1426      // if font specified size, prefer this instead of 'possibly' inaccurate
1427      // lfHeight note that lfHeight may actually have a most accurate value
1428      // but there is no way to know this at this point.
1429
1430      // setting the size, this could be done in two ways
1431      // method 1: fontdesc using fontname like "helvetica 12"
1432      // method 2: fontdesc using fontname like "helvetica" and later modify size
1433
1434      // to obtain consistent font sizes method 2 should be used
1435      // for method 1 converting lfheight to fontsize can lead to rounding errors
1436      //   for example, font size=12, lfheight=-12 (75dpi), at 75 dpi aSize=11
1437      //   so we would get a font "helvetica 11" instead of "helvetica 12"
1438      // size information, and later modify font size
1439
1440      // using method 2
1441
1442      if IsFontNameDefault(aFamily) then
1443      begin
1444        CurFont := GetDefaultGtkFont(False);
1445        if PANGO_IS_LAYOUT(CurFont) then
1446        begin
1447          PangoDesc := pango_layout_get_font_description(CurFont);
1448          if PangoDesc = nil then
1449            PangoDesc := pango_context_get_font_description(pango_layout_get_context(CurFont));
1450          aFamily := StrPas(pango_font_description_get_family(PangoDesc));
1451          if (aSize = 0) and (lfHeight = 0) then
1452          begin
1453            aSize := pango_font_description_get_size(PangoDesc);
1454            if not pango_font_description_get_size_is_absolute(PangoDesc) then
1455              aSize := aSize div PANGO_SCALE;
1456          end;
1457        end;
1458      end;
1459
1460      if (aSize = 0) and (lfHeight = 0) then
1461        FullString := '10' // use some default: TODO: find out the default size of the widget
1462      else
1463      if aSize > 0 then
1464      begin
1465        FullString := IntToStr(aSize);
1466        if aSizeInPixels then
1467          FullString := FullString + 'px';
1468      end
1469      else
1470        FullString := '';
1471
1472      if Pos(',', AFamily) > 0 then
1473        FullString := AFamily + ' ' + aStyle + ' ' + FullString
1474      else
1475        FullString := AFamily + ', ' + aStyle + ' ' + FullString;
1476      PangoDesc := pango_font_description_from_string(PChar(FullString));
1477
1478      if (pango_font_description_get_weight(PangoDesc) = PANGO_WEIGHT_NORMAL)
1479        and (lfWeight <> FW_DONTCARE) then
1480        pango_font_description_set_weight(PangoDesc, lfWeight);
1481
1482      if (pango_font_description_get_style (PangoDesc) = PANGO_STYLE_NORMAL)
1483          and (lfItalic <> 0) then
1484        pango_font_description_set_style(PangoDesc, PANGO_STYLE_ITALIC);
1485      TmpStr := pango_font_description_to_string(PangoDesc);
1486      aStyle := TmpStr;
1487      g_free(TmpStr);
1488      if (aSize=0) and (lfHeight<>0) then
1489      begin
1490        // a size is not specified, try to calculate one based on lfHeight
1491        // and use this value not in the font name but set this value appart
1492        // NOTE: in gtk2.8 is possible to use pango_font_description_set_absolute_size
1493        // which would be great with the given lfheight value, but older gtk2 version
1494        // doesn't have this function
1495        if lfHeight < 0 then
1496          aSize := -lfHeight * PANGO_SCALE
1497        else
1498          aSize := lfHeight * PANGO_SCALE;
1499        pango_font_description_set_absolute_size(PangoDesc, aSize);
1500      end;
1501
1502      // create font
1503      // TODO: use context widget (CreateFontIndirectEx needs a parameter for this: Context: HWnd)
1504      GdiObject := NewGdiObject(gdiFont);
1505      GdiObject^.UntransfFontHeight := 0;
1506      GdiObject^.GDIFontObject:=gtk_widget_create_pango_layout(
1507                                               GetStyleWidget(lgsdefault), nil);
1508      CurFont:=GdiObject^.GDIFontObject;
1509
1510      pango_layout_set_font_description(CurFont,PangoDesc);
1511
1512      if (LogFont.lfUnderline<>0) or (LogFont.lfStrikeOut<>0) then
1513      begin
1514        AttrListTemporary := false;
1515        AttrList := pango_layout_get_attributes(CurFont);
1516        if (AttrList = nil) then
1517        begin
1518          AttrList := pango_attr_list_new();
1519          AttrListTemporary := True;
1520        end;
1521
1522        if LogFont.lfUnderline<>0 then
1523        begin
1524          Attr := pango_attr_underline_new(PANGO_UNDERLINE_SINGLE);
1525          pango_attr_list_change(AttrList, Attr);
1526        end;
1527
1528        if LogFont.lfStrikeOut<>0 then
1529        begin
1530          Attr := pango_attr_strikethrough_new(True);
1531          pango_attr_list_change(AttrList, Attr);
1532        end;
1533
1534        pango_layout_set_attributes(CurFont, AttrList);
1535
1536        if AttrListTemporary then
1537          pango_attr_list_unref(AttrList);
1538      end;
1539
1540      pango_layout_set_single_paragraph_mode(CurFont, True);
1541      pango_layout_set_width(CurFont, -1);
1542      pango_layout_set_alignment(CurFont, PANGO_ALIGN_LEFT);
1543
1544      if (lfEscapement <> 0) then
1545      begin
1546        // the rotation is done via the pango matrix of the context
1547        // it must be set by the device context
1548      end;
1549    end;
1550  finally
1551    if (CachedFont = nil) and (GdiObject<>nil) and (GdiObject^.GDIFontObject <> nil) then
1552    begin
1553      // add to cache
1554      CachedFont := FontCache.Add(GdiObject^.GDIFontObject, LogFont, ALongFontName);
1555      //decrement refcount for GdiObject^.GDIFontObject so that object gets
1556      //released when removing from FontCache.
1557      g_object_unref(GdiObject^.GDIFontObject);
1558      if CachedFont <> nil then
1559      begin
1560        CachedFont.PangoFontDescription := PangoDesc;
1561        PangoDesc := nil;
1562      end;
1563    end;
1564    {$IFDEF VerboseFonts}
1565    if (GdiObject<>nil) and (GdiObject^.GDIFontObject <> nil) then begin
1566      DebugLn(['TGtk2WidgetSet.CreateFontIndirectEx New pangolayout=',dbgs(GdiObject^.GDIFontObject),' Cached=',FontCache.FindGTKFont(GdiObject^.GDIFontObject)<>nil]);
1567    end;
1568    {$ENDIF}
1569    // clean up helper objects
1570    if PangoDesc<>nil then
1571      pango_font_description_free(PangoDesc);
1572
1573    if (GdiObject<>nil) then begin
1574      if (GdiObject^.GDIFontObject = nil) then begin
1575        DebugLn(['TGtk2WidgetSet.CreateFontIndirectEx Unable to create font A']);
1576        DisposeGDIObject(GdiObject);
1577        Result := 0;
1578      end else begin
1579        // return the new font
1580        GdiObject^.LogFont:=LogFont;
1581        Result := HFONT({%H-}PtrUInt(GdiObject));
1582      end;
1583    end else begin
1584      {$IFDEF VerboseFonts}
1585      DebugLn(['TGtk2WidgetSet.CreateFontIndirectEx Unable to create font B']);
1586      {$ENDIF}
1587    end;
1588    {$IFDEF VerboseFonts}
1589    DebugLn(['TGtk2WidgetSet.CreateFontIndirectEx END Result=',dbgs(Pointer(PtrInt(Result)))]);
1590    {$ENDIF}
1591  end;
1592end;
1593
1594function TGtk2WidgetSet.CreateIconIndirect(IconInfo: PIconInfo): HICON;
1595var
1596  bitmap: PGdkBitmap;
1597  pixmap: PGdkPixmap;
1598  pixbuf: PGdkPixbuf;
1599  Width, Height: integer;
1600  MaxWidth, MaxHeight: guint;
1601begin
1602  Result := 0;
1603  if not IsValidGDIObject(IconInfo^.hbmColor) then Exit;
1604
1605  if {%H-}PGDIObject(IconInfo^.hbmColor)^.GDIBitmapType = gbPixbuf then
1606  begin
1607    pixbuf := gdk_pixbuf_copy({%H-}PGDIObject(IconInfo^.hbmColor)^.GDIPixbufObject);
1608  end
1609  else
1610  begin
1611    pixmap := {%H-}PGDIObject(IconInfo^.hbmColor)^.GDIPixmapObject.Image;
1612    //DbgDumpPixmap(pixmap, '');
1613
1614    gdk_drawable_get_size(pixmap, @Width, @Height);
1615
1616    if not IconInfo^.fIcon then
1617    begin
1618      gdk_display_get_maximal_cursor_size(gdk_display_get_default,
1619                                          @MaxWidth, @MaxHeight);
1620
1621      if (Width > integer(MaxWidth))
1622      or (Height > integer(MaxHeight)) then Exit;
1623    end;
1624
1625    bitmap := CreateGdkMaskBitmap(IconInfo^.hbmColor, IconInfo^.hbmMask);
1626    pixbuf := CreatePixbufFromImageAndMask(pixmap, 0, 0, Width, Height, nil, bitmap);
1627    if bitmap <> nil then
1628      gdk_bitmap_unref(bitmap);
1629  end;
1630
1631  if IconInfo^.fIcon then
1632  begin
1633    Result := HICON({%H-}PtrUInt(pixbuf));
1634  end
1635  else
1636  begin
1637    // create cursor from pixbuf
1638    Result := HCURSOR({%H-}PtrUInt(gdk_cursor_new_from_pixbuf(gdk_display_get_default,
1639      pixbuf, IconInfo^.xHotSpot, IconInfo^.yHotSpot)));
1640    if pixbuf <> nil then
1641      gdk_pixbuf_unref(pixbuf);
1642  end;
1643end;
1644
1645{------------------------------------------------------------------------------
1646  Function: CreatePalette
1647  Params:  LogPalette
1648  Returns: a handle to the Palette created
1649
1650
1651 ------------------------------------------------------------------------------}
1652function TGtk2WidgetSet.CreatePalette(const LogPalette: TLogPalette): HPALETTE;
1653var
1654  GObject: PGdiObject;
1655begin
1656  //DebugLn('trace:[TGtk2WidgetSet.CreatePalette]');
1657
1658  GObject := NewGDIObject(gdiPalette);
1659  GObject^.SystemPalette := False;
1660  GObject^.PaletteRealized := False;
1661  GObject^.VisualType := GDK_VISUAL_PSEUDO_COLOR;
1662  GObject^.PaletteVisual := nil;
1663
1664  {$IFDEF DebugGDKTraps}
1665  BeginGDKErrorTrap;
1666  {$ENDIF}
1667
1668  GObject^.PaletteVisual := gdk_visual_get_best_with_type(GObject^.VisualType);
1669  if GObject^.PaletteVisual = nil
1670  then begin
1671    GObject^.PaletteVisual := GDK_Visual_Get_System;
1672    GDK_Visual_Ref(GObject^.PaletteVisual);
1673  end;
1674  GObject^.PaletteColormap := GDK_Colormap_new(GObject^.PaletteVisual, GdkTrue);
1675
1676  {$IFDEF DebugGDKTraps}
1677  EndGDKErrorTrap;
1678  {$ENDIF}
1679
1680  GObject^.RGBTable := TDynHashArray.Create(-1);
1681  GObject^.RGBTable.OnGetKeyForHashItem:=@GetRGBAsKey;
1682  GObject^.IndexTable := TDynHashArray.Create(-1);
1683  GObject^.IndexTable.OnGetKeyForHashItem:=@GetIndexAsKey;
1684  InitializePalette(GObject, LogPalette.palPalEntry, LogPalette.palNumEntries);
1685
1686  Result := HPALETTE({%H-}PtrUInt(GObject));
1687end;
1688
1689{------------------------------------------------------------------------------
1690  Function: CreatePenIndirect
1691  Params:  none
1692  Returns: Nothing
1693
1694
1695 ------------------------------------------------------------------------------}
1696function TGtk2WidgetSet.CreatePenIndirect(const LogPen: TLogPen): HPEN;
1697var
1698  GObject: PGdiObject;
1699begin
1700  //DebugLn('trace:[TGtk2WidgetSet.CreatePenIndirect]');
1701//write('CreatePenIndirect->');
1702  GObject := NewGDIObject(gdiPen);
1703  GObject^.UnTransfPenWidth := 0;
1704  GObject^.GDIPenDashes := nil;
1705
1706  GObject^.IsExtPen := False;
1707  with LogPen do
1708  begin
1709    GObject^.GDIPenStyle := lopnStyle;
1710    GObject^.GDIPenWidth := lopnWidth.X;
1711    SetGDIColorRef(GObject^.GDIPenColor,lopnColor);
1712  end;
1713
1714  Result := HPEN({%H-}PtrUInt(GObject));
1715end;
1716
1717{------------------------------------------------------------------------------
1718  Method:  CreatePolygonRgn
1719  Params:  Points, NumPts, FillMode
1720  Returns: the handle to the region
1721
1722  Creates a Polygon, a closed many-sided shaped region. The Points parameter is
1723  an array of points that give the vertices of the polygon. FillMode=Winding
1724  determines what points are going to be included in the region. When Winding
1725  is True, points are selected by using the Winding fill algorithm. When Winding
1726  is False, points are selected by using using the even-odd (alternative) fill
1727  algorithm. NumPts indicates the number of points to use.
1728  The first point is always connected to the last point.
1729 ------------------------------------------------------------------------------}
1730function TGtk2WidgetSet.CreatePolygonRgn(Points: PPoint; NumPts: Integer;
1731  FillMode: integer): HRGN;
1732var
1733  i: integer;
1734  PointArray: PGDKPoint;
1735  GObject: PGdiObject;
1736  fr : TGDKFillRule;
1737begin
1738  Result := 0;
1739  if NumPts<=1 then exit; // gdk_region_polygon will crash on a polygon with 1 point
1740  GObject := NewGDIObject(gdiRegion);
1741
1742  GetMem(PointArray,SizeOf(TGdkPoint)*NumPts);
1743  for i:=0 to NumPts-1 do begin
1744    PointArray[i].x:=Points[i].x;
1745    PointArray[i].y:=Points[i].y;
1746  end;
1747
1748  If FillMode=Winding then
1749    fr := GDK_WINDING_RULE
1750  else
1751    fr := GDK_EVEN_ODD_RULE;
1752
1753  GObject^.GDIRegionObject := gdk_region_polygon(PointArray, NumPts, fr);
1754
1755  FreeMem(PointArray);
1756
1757  Result := HRGN({%H-}PtrUInt(GObject));
1758end;
1759
1760{------------------------------------------------------------------------------
1761  Function: CreateRectRgn
1762  Params:  none
1763  Returns: Nothing
1764 ------------------------------------------------------------------------------}
1765function TGtk2WidgetSet.CreateRectRgn(X1,Y1,X2,Y2 : Integer): HRGN;
1766var
1767  R: TGDKRectangle;
1768  RRGN: PGDKRegion;
1769  GObject: PGdiObject;
1770  RegionObj: PGdkRegion;
1771begin
1772  GObject := NewGDIObject(gdiRegion);
1773  if X1<=X2 then begin
1774    R.X := gint16(X1);
1775    R.Width := X2 - X1;
1776  end else begin
1777    R.X := gint16(X2);
1778    R.Width := X1 - X2;
1779  end;
1780  if Y1<=Y2 then begin
1781    R.Y := gint16(Y1);
1782    R.Height := Y2 - Y1;
1783  end else begin
1784    R.Y := gint16(Y2);
1785    R.Height := Y1 - Y1;
1786  end;
1787
1788  RRGN := gdk_region_new;
1789  RegionObj:=PGdkRegion(gdk_region_union_with_rect(RRGN,@R));
1790  GObject^.GDIRegionObject := RegionObj;
1791  gdk_region_destroy(RRGN);
1792
1793  Result := HRGN({%H-}PtrUInt(GObject));
1794  //DebugLn('TGtk2WidgetSet.CreateRectRgn A ',GDKRegionAsString(RegionObj));
1795end;
1796
1797{------------------------------------------------------------------------------
1798  Function: CombineRgn
1799  Params:  Dest, Src1, Src2, fnCombineMode
1800  Returns: longint
1801
1802  Combine the 2 Source Regions into the Destination Region using the specified
1803  Combine Mode. The Destination must already be initialized. The Return value
1804  is the Destination's Region type, or ERROR.
1805
1806  The Combine Mode can be one of the following:
1807      RGN_AND  : Gets a region of all points which are in both source regions
1808
1809      RGN_COPY : Gets an exact copy of the first source region
1810
1811      RGN_DIFF : Gets a region of all points which are in the first source
1812                 region but not in the second.(Source1 - Source2)
1813
1814      RGN_OR   : Gets a region of all points which are in either the first
1815                 source region or in the second.(Source1 + Source2)
1816
1817      RGN_XOR  : Gets all points which are in either the first Source Region
1818                 or in the second, but not in both.
1819
1820  The result can be one of the following constants
1821      Error
1822      NullRegion
1823      SimpleRegion
1824      ComplexRegion
1825 ------------------------------------------------------------------------------}
1826function TGtk2WidgetSet.CombineRgn(Dest, Src1, Src2: HRGN;
1827  fnCombineMode: Longint): Longint;
1828var
1829  Continue: Boolean;
1830  D, S1, S2: PGDKRegion;
1831  DObj, S1Obj, S2Obj: PGDIObject;
1832begin
1833  Result := SIMPLEREGION;
1834  DObj := {%H-}PGdiObject(Dest);
1835  S1Obj := {%H-}PGdiObject(Src1);
1836  S2Obj := {%H-}PGdiObject(Src2);
1837  Continue := IsValidGDIObject(Dest) and IsValidGDIObject(Src1)
1838              and IsValidGDIObject(Src2);
1839  if not Continue then begin
1840    DebugLn('WARNING: [TGtk2WidgetSet.CombineRgn] Invalid HRGN');
1841    exit(Error);
1842  end;
1843  if DObj^.RefCount>1 then
1844  begin
1845    DebugLn('WARNING: [TGtk2WidgetSet.CombineRgn] Invalid Dest');
1846    exit(RegionType(DObj^.GDIRegionObject));
1847  end;
1848
1849  S1 := S1Obj^.GDIRegionObject;
1850  S2 := S2Obj^.GDIRegionObject;
1851  //DebugLn('TGtk2WidgetSet.CombineRgn A fnCombineMode=',Dbgs(fnCombineMode));
1852  case fnCombineMode of
1853    RGN_AND :
1854      D := PGDKRegion(gdk_region_intersect(S1, S2));
1855    RGN_COPY :
1856      D := gdk_region_copy(S1);
1857    RGN_DIFF :
1858      D := PGDKRegion(gdk_region_subtract(S1, S2));
1859    RGN_OR :
1860      D := PGDKRegion(gdk_region_union(S1, S2));
1861    RGN_XOR :
1862      D := PGDKRegion(gdk_region_xor(S1, S2));
1863    else begin
1864      Result:= ERROR;
1865      D := nil;
1866    end;
1867  end;
1868  if Assigned(DObj^.GDIRegionObject) then
1869    gdk_region_destroy(DObj^.GDIRegionObject);
1870  DObj^.GDIRegionObject := D;
1871  Result := RegionType(D);
1872  //DebugLn('TGtk2WidgetSet.CombineRgn B Mode=',dbgs(fnCombineMode),
1873  //  ' S1=',GDKRegionAsString(S1),' S2=',GDKRegionAsString(S2),' D=',GDKRegionAsString(D),'');
1874end;
1875
1876{------------------------------------------------------------------------------
1877  Function: DeleteDC
1878  Params:  none
1879  Returns: Nothing
1880 ------------------------------------------------------------------------------}
1881function TGtk2WidgetSet.DeleteDC(hDC: HDC): Boolean;
1882begin
1883  // TODO:
1884  // for now it's just the same, however CreateDC/FreeDC
1885  // and GetDC/ReleaseDC are couples
1886  // we should use gdk_new_gc for create and gtk_new_gc for Get
1887  Result:= (ReleaseDC(0, hDC) = 1);
1888end;
1889
1890{------------------------------------------------------------------------------
1891  Function: DeleteObject
1892  Params:  none
1893  Returns: Nothing
1894
1895  DeleteObject is allowed while the object is still selected. The msdn docs
1896  are misleading. Marc tested with resource profiler under win XP.
1897 ------------------------------------------------------------------------------}
1898function TGtk2WidgetSet.DeleteObject(GDIObject: HGDIOBJ): Boolean;
1899
1900  procedure RaiseInvalidGDIObject;
1901  begin
1902    {$ifdef TraceGdiCalls}
1903    DebugLn();
1904    DebugLn('TGtk2WidgetSet.DeleteObject: TraceCall for invalid object: ');
1905    DumpBackTrace(PgdiObject(GdiObject)^.StackAddrs);
1906    DebugLn();
1907    DebugLn('Exception will follow:');
1908    DebugLn();
1909    {$endif}
1910    RaiseGDBException('TGtk2WidgetSet.DeleteObject invalid GdiObject='+dbgs(GdiObject));
1911  end;
1912
1913var
1914  GDIObjectExists: boolean;
1915begin
1916  if GDIObject = 0 then
1917  begin
1918    Result := True;
1919    Exit;
1920  end;
1921  {$IFDEF DebugLCLComponents}
1922  if DebugGdiObjects.IsDestroyed(Pointer(GDIObject)) then
1923  begin
1924    DebugLn(['TGtk2WidgetSet.DeleteObject object already deleted ',GDIObject]);
1925    debugln(DebugGdiObjects.GetInfo(PGdiObject(GDIObject),true));
1926    Halt;
1927  end;
1928  {$ENDIF}
1929
1930  // Find out if we want to release internal GDI object
1931  GDIObjectExists := FGDIObjects.Contains({%H-}PGdiObject(GDIObject));
1932  Result := GDIObjectExists;
1933  if not GDIObjectExists then
1934  begin
1935    RaiseInvalidGDIObject;
1936  end;
1937
1938  Result := ReleaseGDIObject({%H-}PGdiObject(GDIObject));
1939end;
1940
1941function TGtk2WidgetSet.DestroyCaret(Handle: HWND): Boolean;
1942var
1943  GTKObject: PGTKObject;
1944begin
1945  GTKObject := {%H-}PGTKObject(Handle);
1946  Result := true;
1947
1948  if GTKObject<>nil then begin
1949    if gtk_type_is_a(g_object_type(GTKObject), GTKAPIWidget_GetType)
1950    then begin
1951      GTKAPIWidget_DestroyCaret(PGTKAPIWidget(GTKObject));
1952    end
1953//    else if // TODO: other widgettypes
1954    else begin
1955      Result := False;
1956    end;
1957  end;
1958end;
1959
1960function TGtk2WidgetSet.DrawFrameControl(DC: HDC; const Rect : TRect;
1961  uType, uState : Cardinal) : Boolean;
1962{const
1963  ADJUST_FLAG: array[Boolean] of Integer = (0, BF_ADJUST);
1964  PUSH_EDGE_FLAG: array[Boolean] of Integer = (EDGE_RAISED, EDGE_SUNKEN);
1965  PUSH_EDGE_FLAG2: array[Boolean] of Integer = (0, BF_FLAT);}
1966var
1967  DevCtx: TGtkDeviceContext absolute DC;
1968  Widget: PGtkWidget;
1969  R: TRect;
1970  ClipArea: TGdkRectangle;
1971
1972  procedure DrawButtonPush;
1973  var
1974    State: TGtkStateType;
1975    Shadow: TGtkShadowType;
1976    aStyle : PGTKStyle;
1977    aDC: TGtkDeviceContext;
1978    DCOrigin: TPoint;
1979  begin
1980    //if Widget<>nil then begin
1981
1982    // use the gtk paint functions to draw a widget style dependent button
1983
1984    //writeln('DrawButtonPush ',
1985    //  ' DFCS_BUTTONPUSH=',uState and DFCS_BUTTONPUSH,
1986    //  ' DFCS_PUSHED=',uState and DFCS_PUSHED,
1987    //  ' DFCS_INACTIVE=',uState and DFCS_INACTIVE,
1988    //  ' DFCS_FLAT=',uState and DFCS_FLAT,
1989    //  '');
1990    // set State (the interior filling style)
1991    if (DFCS_PUSHED and uState)<>0 then
1992      State := GTK_STATE_ACTIVE //button pressed(GTK ignores disabled)
1993    else if (DFCS_INACTIVE and uState)<>0 then
1994      State := GTK_STATE_INSENSITIVE //button disabled
1995    else if (DFCS_HOT and uState)<>0 then
1996      State := GTK_STATE_PRELIGHT // button enabled, special (e.g. mouse over)
1997    else
1998      State := GTK_STATE_NORMAL; // button enabled, normal
1999
2000    // set Shadow (the border style)
2001    if (DFCS_PUSHED and uState)<>0 then begin
2002      // button down
2003      Shadow:=GTK_SHADOW_IN;
2004    end else begin
2005      if (((DFCS_FLAT+DFCS_CHECKED) and uState)=DFCS_FLAT) then begin
2006        // button up, flat, no special
2007        Shadow:=GTK_SHADOW_ETCHED_OUT;
2008        //Shadow:=GTK_SHADOW_NONE;
2009      end else begin
2010        // button up
2011        Shadow:=GTK_SHADOW_OUT;
2012      end;
2013    end;
2014
2015    aDC:=TGtkDeviceContext(DC);
2016    DCOrigin:= aDC.Offset;
2017
2018    If Widget <> nil then
2019      aStyle := gtk_widget_get_style(Widget)
2020    else
2021      aStyle := GetStyle(lgsButton);
2022    if aStyle = nil then
2023      aStyle := GetStyle(lgsGTK_Default);
2024
2025      // MG: You can't assign a style to any window. Why it is needed anyway?
2026      //aStyle := gtk_style_attach(gtk_style_ref(aStyle),aDC.Drawable);
2027
2028    if aStyle<>nil then
2029    begin
2030      aDC.RemovePixbuf;
2031      if (Shadow=GTK_SHADOW_NONE) then
2032        gtk_paint_flat_box(aStyle,aDC.Drawable,
2033           State,
2034           Shadow,
2035           @ClipArea,
2036           GetStyleWidget(lgsButton),
2037           'button',
2038           R.Left+DCOrigin.X,R.Top+DCOrigin.Y,
2039           R.Right-R.Left,R.Bottom-R.Top)
2040      else
2041        gtk_paint_box(aStyle,aDC.Drawable,
2042           State,
2043           Shadow,
2044           @ClipArea,
2045           GetStyleWidget(lgsButton),
2046           'button',
2047           R.Left+DCOrigin.X,R.Top+DCOrigin.Y,
2048           R.Right-R.Left,R.Bottom-R.Top);
2049    end;
2050    Result := True;
2051  end;
2052
2053  procedure DrawCheckOrRadioButton(IsRadioButton: Boolean);
2054  const
2055    LazGtkStyleMap: array[Boolean] of TLazGtkStyle = (lgsCheckbox, lgsRadiobutton);
2056  var
2057    State: TGtkStateType;
2058    Shadow: TGtkShadowType;
2059    aDC: TGtkDeviceContext;
2060    DCOrigin: TPoint;
2061    Style : PGTKStyle;
2062    Widget : PGTKWidget;
2063  begin
2064    // use the gtk paint functions to draw a widget style dependent check/radio button
2065    if (DFCS_BUTTON3STATE and uState)<>0 then
2066      Shadow := GTK_SHADOW_ETCHED_IN //3state style
2067    else if (DFCS_CHECKED and uState)<>0 then
2068      Shadow := GTK_SHADOW_IN //checked style
2069    else
2070      Shadow := GTK_SHADOW_OUT; //unchecked style
2071
2072    if (DFCS_PUSHED and uState)<>0 then
2073      State := GTK_STATE_ACTIVE //button pressed(GTK ignores disabled)
2074    else if (DFCS_INACTIVE and uState)<>0 then
2075      State := GTK_STATE_INSENSITIVE //button disabled
2076    else if (DFCS_HOT and uState)<>0 then
2077      State := GTK_STATE_PRELIGHT // button enabled, special (e.g. mouse over)
2078    else
2079      State := GTK_STATE_NORMAL; // button enabled, normal
2080
2081    aDC:=TGtkDeviceContext(DC);
2082    DCOrigin := aDC.Offset;
2083
2084    Style := GetStyle(LazGtkStyleMap[IsRadioButton]);
2085
2086    if Style = nil then
2087    begin
2088      Style := GetStyle(lgsGTK_Default);
2089      if Style <> nil then
2090        Style := gtk_style_attach(gtk_style_ref(Style),aDC.Drawable);
2091    end;
2092
2093    Widget := GetStyleWidget(LazGtkStyleMap[IsRadioButton]);
2094
2095    if Widget = nil then
2096      Widget := GetStyleWidget(lgsDefault);
2097    if Widget <> nil then
2098      Widget^.Window := aDC.Drawable;
2099    Result := Style <> nil;
2100    if Result then
2101    begin
2102      aDC.RemovePixbuf;
2103      if IsRadioButton then
2104        gtk_paint_option(Style,aDC.Drawable, State,
2105          Shadow, @ClipArea, Widget, 'radiobutton',
2106          R.Left+DCOrigin.X,R.Top+DCOrigin.Y,
2107          R.Right-R.Left, R.Bottom-R.Top)
2108      else
2109        gtk_paint_check(Style,aDC.Drawable, State,
2110          Shadow, @ClipArea, Widget, 'checkbutton',
2111          R.Left+DCOrigin.X,R.Top+DCOrigin.Y,
2112          R.Right-R.Left, R.Bottom-R.Top);
2113    end;
2114  end;
2115
2116var
2117  ClientWidget: PGtkWidget;
2118begin
2119  Result := False;
2120  if IsValidDC(DC) then
2121  begin
2122    if DevCtx.HasTransf then
2123    begin
2124      R := DevCtx.TransfRectIndirect(Rect);
2125      DevCtx.TransfNormalize(R.Left, R.Right);
2126      DevCtx.TransfNormalize(R.Top, R.Bottom);
2127    end else
2128      R := Rect;
2129
2130    Widget:=TGtkDeviceContext(DC).Widget;
2131    //It's possible to draw in a DC without a widget, e.g., a Bitmap
2132    if Widget <> nil then
2133    begin
2134      ClientWidget:=GetFixedWidget(Widget);
2135      if ClientWidget<>nil then
2136        Widget:=ClientWidget;
2137    end;
2138  end else
2139    Widget:=nil;
2140
2141  ClipArea := DevCtx.ClipRect;
2142  case uType of
2143    DFC_CAPTION:
2144      begin  //all draw CAPTION commands here
2145      end;
2146    DFC_MENU:
2147      begin
2148
2149      end;
2150    DFC_SCROLL:
2151      begin
2152      end;
2153    DFC_BUTTON:
2154      begin
2155        //DebugLn(Format('Trace:  [TGtk2WidgetSet.DrawFrameControl] DFC_BUTTON --> draw rect = %d,%d,%d,%d',[R.Left,R.Top,R.Right,R.Bottom]));
2156        //figure out the style first
2157        if (uState and $1F) in [DFCS_BUTTONCHECK, DFCS_BUTTON3STATE] then
2158         begin
2159           //DebugLn('Trace:State ButtonCheck');
2160           DrawCheckOrRadioButton(False);
2161         end
2162         else if (DFCS_BUTTONRADIO and uState) <> 0 then
2163         begin
2164           //DebugLn('Trace:State ButtonRadio');
2165           DrawCheckOrRadioButton(True);
2166         end
2167         else if (DFCS_BUTTONPUSH and uState) <> 0 then
2168         begin
2169           //DebugLn('Trace:State ButtonPush');
2170           DrawButtonPush;
2171         end
2172         else if (DFCS_BUTTONRADIOIMAGE and uState) <> 0 then
2173         begin
2174           //DebugLn('Trace:State ButtonRadioImage');
2175         end
2176         else if (DFCS_BUTTONRADIOMASK and uState) <> 0 then
2177         begin
2178           //DebugLn('Trace:State ButtonRadioMask');
2179         end
2180         else
2181           DebugLn(Format('ERROR: [TGtk2WidgetSet.DrawFrameControl] Unknown State 0x%x', [uState]));
2182      end;
2183  else
2184    DebugLn(Format('ERROR: [TGtk2WidgetSet.DrawFrameControl] Unknown type %d', [uType]));
2185  end;
2186end;
2187
2188function TGtk2WidgetSet.DrawFocusRect(DC: HDC; const Rect: TRect): boolean;
2189var
2190  DevCtx: TGtkDeviceContext absolute DC;
2191  Origin: TPoint;
2192
2193  procedure DrawPixel(X1,Y1: Integer);
2194  begin
2195    inc(X1,Origin.X);
2196    inc(Y1,Origin.Y);
2197    TGtkDeviceContext(DC).RemovePixbuf;
2198    gdk_draw_point(TGtkDeviceContext(DC).Drawable, TGtkDeviceContext(DC).GC, X1, Y1);
2199  end;
2200
2201  procedure DrawVertLine(X1,Y1,Y2: integer);
2202  begin
2203    if Y2<Y1 then
2204      while Y2<Y1 do begin
2205        DrawPixel(X1, Y1);
2206        dec(Y1, 2);
2207      end
2208    else
2209      while Y1<Y2 do begin
2210        DrawPixel(X1, Y1);
2211        inc(Y1, 2);
2212      end;
2213  end;
2214
2215  procedure DrawHorzLine(X1,Y1,X2: integer);
2216  begin
2217    if X2<X1 then
2218      while X2<X1 do begin
2219        DrawPixel(X1, Y1);
2220        dec(X1, 2);
2221      end
2222    else
2223      while X1<X2 do begin
2224        DrawPixel(X1, Y1);
2225        inc(X1, 2);
2226      end;
2227  end;
2228
2229var
2230  OldROP: Integer;
2231  APen, TempPen: HPEN;
2232  LogPen : TLogPen;
2233  R: TRect;
2234begin
2235  Result := False;
2236  if IsValidDC(DC) then
2237  begin
2238    with LogPen do
2239    begin
2240      lopnStyle   := PS_DOT;
2241      lopnWidth.X := 2;
2242      lopnColor   := clWhite;
2243    end;
2244    if DevCtx.HasTransf then
2245      R := DevCtx.TransfRectIndirect(Rect)
2246    else
2247      R := Rect;
2248
2249    APen := CreatePenIndirect(LogPen);
2250    TempPen := SelectObject(DC, APen);
2251    OldRop := SetROP2(DC, R2_XORPEN);
2252
2253    Origin := DevCtx.Offset;
2254    try
2255      DrawHorzLine(R.Left, R.Top, R.Right-1);
2256      DrawVertLine(R.Right-1, R.Top, R.Bottom-1);
2257      DrawHorzLine(R.Right-1, R.Bottom-1, R.Left);
2258      DrawVertLine(R.Left, R.Bottom-1, R.Top);
2259
2260      Result := True;
2261    finally
2262      SelectObject(DC, TempPen);
2263      DeleteObject(APen);
2264      SetROP2(DC, OldROP);
2265    end;
2266  end;
2267end;
2268
2269{------------------------------------------------------------------------------
2270  Function: DrawEdge
2271  Params:   DC: HDC; var Rect: TRect; edge: Cardinal; grfFlags: Cardinal
2272  Returns:  Boolean
2273
2274  Draws one or more edges of a rectangle. The rectangle is the area
2275  Left to Right-1 and Top to Bottom-1.
2276 ------------------------------------------------------------------------------}
2277function TGtk2WidgetSet.DrawEdge(DC: HDC; var ARect: TRect; Edge: Cardinal;
2278  grfFlags: Cardinal): Boolean;
2279
2280  procedure DrawEdges(var R: TRect; GC: pgdkGC; Drawable:PGdkDrawable;
2281    const TopLeftColor, BottomRightColor: TGDKColor);
2282  begin
2283    gdk_gc_set_foreground(GC, @TopLeftColor);
2284    if (grfFlags and BF_TOP) = BF_TOP then begin
2285      gdk_draw_line(Drawable, GC, R.Left, R.Top, R.Right, R.Top);
2286      inc(R.Top);
2287    end;
2288    if (grfFlags and BF_LEFT) = BF_LEFT then begin
2289      gdk_draw_line(Drawable, GC, R.Left, R.Top, R.Left, R.Bottom);
2290      inc(R.Left);
2291    end;
2292
2293    gdk_gc_set_foreground(GC, @BottomRightColor);
2294    if (grfFlags and BF_BOTTOM) = BF_BOTTOM then begin
2295      gdk_draw_line(Drawable, GC, R.Left, R.Bottom-1, R.Right, R.Bottom-1);
2296      dec(R.Bottom);
2297    end;
2298    if (grfFlags and BF_RIGHT) = BF_RIGHT then begin
2299      gdk_draw_line(Drawable, GC, R.Right-1, R.Top, R.Right-1, R.Bottom);
2300      dec(R.Right);
2301    end;
2302  end;
2303
2304var
2305  InnerTL, OuterTL,
2306  InnerBR, OuterBR, MiddleColor: TGDKColor;
2307  BInner, BOuter: Boolean;
2308  R: TRect;
2309  DCOrigin: TPoint;
2310begin
2311  //DebugLn('TGtk2WidgetSet.DrawEdge Edge=',DbgS(Edge),8),' grfFlags=',DbgS(Cardinal(grfFlags));
2312  Result := IsValidDC(DC);
2313  if Result then
2314    with TGtkDeviceContext(DC) do
2315    begin
2316      R := ARect;
2317
2318      LPtoDP(DC, R, 2);
2319
2320      DCOrigin := Offset;
2321      OffsetRect(R, DCOrigin.X, DCOrigin.Y);
2322
2323      // try to use the gdk functions, so that the current theme is used
2324      BInner := False;
2325      BOuter := False;
2326
2327      // TODO: change this to real colors
2328      if (edge and BDR_RAISEDINNER) = BDR_RAISEDINNER
2329      then begin
2330        InnerTL := AllocGDKColor(GetSysColor(COLOR_BTNHIGHLIGHT));
2331        InnerBR := AllocGDKColor(GetSysColor(COLOR_BTNSHADOW));
2332        BInner := True;
2333      end;
2334      if (edge and BDR_SUNKENINNER) = BDR_SUNKENINNER
2335      then begin
2336        InnerTL := AllocGDKColor(GetSysColor(COLOR_BTNSHADOW));
2337        InnerBR := AllocGDKColor(GetSysColor(COLOR_BTNHIGHLIGHT));
2338        BInner := True;
2339      end;
2340      if (edge and BDR_RAISEDOUTER) = BDR_RAISEDOUTER
2341      then begin
2342        OuterTL := AllocGDKColor(GetSysColor(COLOR_BTNHIGHLIGHT));
2343        OuterBR := AllocGDKColor(GetSysColor(COLOR_BTNSHADOW));
2344        BOuter := True;
2345      end;
2346      if (edge and BDR_SUNKENOUTER) = BDR_SUNKENOUTER
2347      then begin
2348        OuterTL := AllocGDKColor(GetSysColor(COLOR_BTNSHADOW));
2349        OuterBR := AllocGDKColor(GetSysColor(COLOR_BTNHIGHLIGHT));
2350        BOuter := True;
2351      end;
2352
2353      gdk_gc_set_fill(GC, GDK_SOLID);
2354      SelectedColors := dcscCustom;
2355
2356      // Draw outer rect
2357      if BOuter then
2358      begin
2359        RemovePixbuf;
2360        DrawEdges(R, GC,Drawable,OuterTL,OuterBR);
2361      end;
2362
2363      // Draw inner rect
2364      if BInner then
2365      begin
2366        RemovePixbuf;
2367        DrawEdges(R,GC,Drawable,InnerTL,InnerBR);
2368      end;
2369
2370  //      gdk_colormap_free_colors(gdk_colormap_get_system, @OuterTL, 1);
2371  //      gdk_colormap_free_colors(gdk_colormap_get_system, @OuterBR, 1);
2372  //      gdk_colormap_free_colors(gdk_colormap_get_system, @InnerTL, 1);
2373  //      gdk_colormap_free_colors(gdk_colormap_get_system, @InnerBR, 1);
2374
2375      //Draw interiour
2376      if ((grfFlags and BF_MIDDLE) = BF_MIDDLE) then
2377      begin
2378        RemovePixbuf;
2379        MiddleColor := AllocGDKColor(GetSysColor(COLOR_BTNFACE));
2380        gdk_gc_set_foreground(GC, @MiddleColor);
2381        gdk_draw_rectangle(Drawable, GC, 1, R.Left, R.Top,
2382          R.Right - R.Left, R.Bottom - R.Top);
2383      end;
2384
2385      // adjust rect if needed
2386      if (grfFlags and BF_ADJUST) = BF_ADJUST then
2387      begin
2388        ARect := R;
2389        OffsetRect(ARect, -DCOrigin.X, -DCOrigin.Y);
2390        DPtoLP(DC, ARect, 2);
2391      end;
2392      Result := True;
2393    end;
2394end;
2395
2396{------------------------------------------------------------------------------
2397  Method:  DrawText
2398  Params:  DC, Str, Count, Rect, Flags
2399  Returns: If the string was drawn, or CalcRect run
2400
2401 ------------------------------------------------------------------------------}
2402function TGtk2WidgetSet.DrawText(DC: HDC; Str: PChar; Count: Integer;
2403  var Rect: TRect; Flags: Cardinal): Integer;
2404const
2405  TabString = '        ';
2406var
2407  pIndex: Longint;
2408  AStr: String;
2409
2410  TM: TTextmetric;
2411  theRect: TRect;
2412  Lines: PPChar;
2413  I, NumLines: Longint;
2414  TempDC: HDC;
2415  TempPen: HPEN;
2416  TempBrush: HBRUSH;
2417  l: LongInt;
2418  Pt: TPoint;
2419  SavedRect: TRect; // if font orientation <> 0
2420  LineHeight: Integer;
2421  Size: TSize;
2422
2423  function LeftOffset: Longint;
2424  begin
2425    if (Flags and DT_RIGHT) = DT_RIGHT then
2426      Result := DT_RIGHT
2427    else
2428      if (Flags and DT_CENTER) = DT_CENTER then
2429        Result := DT_CENTER
2430    else
2431      Result := DT_LEFT;
2432  end;
2433
2434  function TopOffset: Longint;
2435  begin
2436    if (Flags and DT_BOTTOM) = DT_BOTTOM then
2437      Result := DT_BOTTOM
2438    else
2439      if (Flags and DT_VCENTER) = DT_VCENTER then
2440        Result := DT_VCENTER
2441    else
2442      Result := DT_TOP;
2443  end;
2444
2445  function CalcRect: Boolean;
2446  begin
2447    Result := (Flags and DT_CALCRECT) = DT_CALCRECT;
2448  end;
2449
2450  function TextExtentPoint(Str: PChar; Count: Integer; var Sz: TSize): Boolean;
2451  var
2452    NewStr: String;
2453  begin
2454    if (Flags and DT_EXPANDTABS) <> 0 then
2455    begin
2456      NewStr := StringReplace(Str, #9, TabString, [rfReplaceAll]);
2457      Result := GetTextExtentPoint(DC, PChar(NewStr), Length(NewStr), Sz);
2458    end
2459    else
2460      Result := GetTextExtentPoint(Dc, Str, Count, Sz);
2461  end;
2462
2463  procedure DoCalcRect;
2464  var
2465    AP: TSize;
2466    J, MaxWidth,
2467    LineWidth, ActualHeight: Integer;
2468  begin
2469    theRect := Rect;
2470
2471    MaxWidth := theRect.Right - theRect.Left;
2472
2473    if (Flags and DT_SINGLELINE) > 0 then
2474    begin
2475      // ignore word and line breaks
2476      TextExtentPoint(PChar(AStr), length(AStr), AP{%H-});
2477      theRect.Bottom := theRect.Top + TM.tmHeight;
2478      if (Flags and DT_CALCRECT)<>0 then
2479      begin
2480        theRect.Right := theRect.Left +  AP.cX;
2481        theRect.Bottom := theRect.Top +  AP.cY;
2482      end
2483      else
2484      begin
2485        theRect.Right := theRect.Left + Min(MaxWidth, AP.cX);
2486        theRect.Bottom := theRect.Top +  AP.cY;
2487        if (Flags and DT_VCENTER) > 0 then
2488        begin
2489          OffsetRect(theRect, 0, ((Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top)) div 2);
2490        end
2491        else
2492        if (Flags and DT_BOTTOM) > 0 then
2493        begin
2494          OffsetRect(theRect, 0, (Rect.Bottom - Rect.Top) - (theRect.Bottom - theRect.Top));
2495        end;
2496
2497      end;
2498    end
2499    else
2500    begin
2501      // consider line breaks
2502      if (Flags and DT_WORDBREAK) = 0 then
2503      begin
2504        // do not break at word boundaries
2505        TextExtentPoint(PChar(AStr), length(AStr), AP);
2506        MaxWidth := AP.cX;
2507      end;
2508      Self.WordWrap(DC, PChar(AStr), MaxWidth, Lines, NumLines);
2509
2510      if (Flags and DT_CALCRECT)<>0 then
2511      begin
2512        LineWidth := 0;
2513        ActualHeight := 0;
2514        if (Lines <> nil) then
2515        begin
2516          for J := 0 to NumLines - 1 do
2517          begin
2518            TextExtentPoint(Lines[J], StrLen(Lines[J]), AP);
2519            LineWidth := Max(LineWidth, AP.cX);
2520            Inc(ActualHeight, AP.cY);
2521          end;
2522        end;
2523        LineWidth := Min(MaxWidth, LineWidth);
2524      end else
2525      begin
2526        LineWidth := MaxWidth;
2527        ActualHeight := NumLines*TM.tmHeight;
2528      end;
2529
2530      theRect.Right := theRect.Left + LineWidth;
2531      theRect.Bottom := theRect.Top + ActualHeight;
2532      if NumLines>1 then
2533        Inc(theRect.Bottom, (NumLines-1)*TM.tmExternalLeading);// space between lines
2534
2535      //debugln('TGtk2WidgetSet.DrawText A ',dbgs(theRect),' TM.tmHeight=',dbgs(TM.tmHeight),' LineWidth=',dbgs(LineWidth),' NumLines=',dbgs(NumLines));
2536    end;
2537
2538    if not CalcRect then
2539      case LeftOffset of
2540        DT_CENTER:
2541          OffsetRect(theRect, (Rect.Right - theRect.Right) div 2, 0);
2542        DT_RIGHT:
2543          OffsetRect(theRect, Rect.Right - theRect.Right, 0);
2544      end;
2545  end;
2546
2547  // if our Font.Orientation <> 0 we must recalculate X,Y offset
2548  // also it works only with DT_TOP DT_LEFT. Gtk2 can handle multiline
2549  // text in this case too.
2550  procedure CalculateOffsetWithAngle(const AFontAngle: Integer;
2551    var TextLeft,TextTop: Integer);
2552  var
2553    OffsX, OffsY: integer;
2554    Angle: Double;
2555    Size: TSize;
2556    R: TRect;
2557  begin
2558    R := SavedRect;
2559    OffsX := R.Right - R.Left;
2560    OffsY := R.Bottom - R.Top;
2561    Size.cx := OffsX;
2562    Size.cy := OffsY;
2563    Angle := AFontAngle / 10;
2564    if Angle < 0 then
2565      Angle := 360 + Angle;
2566
2567    if Angle <= 90 then
2568    begin
2569      OffsX := 0;
2570      OffsY := Trunc(Size.cx * sin(Angle * Pi / 180));
2571    end else
2572    if Angle <= 180 then
2573    begin
2574      OffsX := Trunc(Size.cx * -cos(Angle * Pi / 180));
2575      OffsY := Trunc(Size.cx * sin(Angle * Pi / 180) +
2576         Size.cy * cos((180 - Angle) * Pi / 180));
2577    end else
2578    if Angle <= 270 then
2579    begin
2580      OffsX := Trunc(Size.cx * -cos(Angle * Pi / 180) +
2581        Size.cy * sin((Angle - 180) * Pi / 180));
2582      OffsY := Trunc(Size.cy * sin((270 - Angle) * Pi / 180));
2583    end else
2584    if Angle <= 360 then
2585    begin
2586      OffsX := Trunc(Size.cy * sin((360 - Angle) * Pi / 180));
2587      OffsY := 0;
2588    end;
2589    TextTop := OffsY;
2590    TextLeft := OffsX;
2591  end;
2592
2593  function NeedOffsetCalc: Boolean;
2594  var
2595    AClipRect: TRect;
2596  begin
2597    {see issue #27547}
2598    AClipRect := RectFromGdkRect(TGtkDeviceContext(DC).ClipRect);
2599    OffsetRect(AClipRect, -AClipRect.Left, -AClipRect.Top);
2600    Result := (TGtkDeviceContext(DC).CurrentFont^.LogFont.lfOrientation <> 0) and
2601        (Flags and DT_SINGLELINE <> 0) and
2602        (Flags and DT_VCENTER = 0) and (Flags and DT_CENTER = 0) and
2603        (Flags and DT_RIGHT = 0) and (Flags and  DT_BOTTOM = 0) and
2604        (Flags and DT_CALCRECT = 0) and not IsRectEmpty(SavedRect) and
2605        EqualRect(AClipRect, Rect);
2606  end;
2607
2608
2609  procedure DrawLineRaw(theLine: PChar; LineLength, TopPos: Longint);
2610  var
2611    Points: array[0..1] of TSize;
2612    LeftPos: Longint;
2613  begin
2614    if LeftOffset <> DT_LEFT then
2615      GetTextExtentPoint(DC, theLine, LineLength, {%H-}Points[0]);
2616
2617    if TempBrush = HBRUSH(-1) then
2618      TempBrush := SelectObject(DC, GetStockObject(NULL_BRUSH));
2619    case LeftOffset of
2620      DT_LEFT:
2621        LeftPos := theRect.Left;
2622      DT_CENTER:
2623        LeftPos := theRect.Left + (theRect.Right - theRect.Left) div 2
2624                 - Points[0].cX div 2;
2625      DT_RIGHT:
2626        LeftPos := theRect.Right - Points[0].cX;
2627    end;
2628
2629    Pt := Point(0, 0);
2630    // Draw line of Text
2631    if NeedOffsetCalc then
2632    begin
2633      Pt.X := SavedRect.Left;
2634      Pt.Y := SavedRect.Top;
2635      CalculateOffsetWithAngle(TGtkDeviceContext(DC).CurrentFont^.LogFont.lfOrientation, Pt.X, Pt.Y);
2636    end;
2637    TextUtf8Out(DC, LeftPos + Pt.X, TopPos + Pt.Y, theLine, lineLength);
2638  end;
2639
2640  procedure DrawLine(theLine: PChar; LineLength, TopPos: Longint);
2641  var
2642    Points: array[0..1] of TSize;
2643    LogP: TLogPen;
2644    LeftPos: Longint;
2645  begin
2646    if TempBrush = HBRUSH(-1) then
2647      TempBrush := SelectObject(DC, GetStockObject(NULL_BRUSH));
2648
2649    FillByte({%H-}Points[0],SizeOf(Points[0])*2,0);
2650    if LeftOffset <> DT_Left then
2651      GetTextExtentPoint(DC, theLine, LineLength, Points[0]);
2652
2653    case LeftOffset of
2654      DT_LEFT:
2655        LeftPos := theRect.Left;
2656      DT_CENTER:
2657        LeftPos := theRect.Left + (theRect.Right - theRect.Left) div 2
2658                 - Points[0].cX div 2;
2659      DT_RIGHT:
2660        LeftPos := theRect.Right - Points[0].cX;
2661    end;
2662
2663    Pt := Point(0, 0);
2664    if NeedOffsetCalc then
2665    begin
2666      Pt.X := SavedRect.Left;
2667      Pt.Y := SavedRect.Top;
2668      CalculateOffsetWithAngle(TGtkDeviceContext(DC).CurrentFont^.LogFont.lfOrientation, Pt.X, Pt.Y);
2669    end;
2670    // Draw line of Text
2671    TextUtf8Out(DC, LeftPos + Pt.X, TopPos + Pt.Y, theLine, LineLength);
2672
2673    // Draw Prefix
2674    if (pIndex > 0) and (pIndex<=LineLength) then
2675    begin
2676      // Create & select pen of font color
2677      if TempPen = HPEN(-1) then
2678      begin
2679        LogP.lopnStyle := PS_SOLID;
2680        LogP.lopnWidth.X := 1;
2681        LogP.lopnColor := GetTextColor(DC);
2682        TempPen := SelectObject(DC, CreatePenIndirect(LogP));
2683      end;
2684
2685      {Get prefix line position}
2686      GetTextExtentPoint(DC, theLine, pIndex - 1, Points[0]);
2687      Points[0].cX := LeftPos + Points[0].cX;
2688      Points[0].cY := TopPos + tm.tmHeight - TM.tmDescent + 1;
2689
2690      GetTextExtentPoint(DC, @aStr[pIndex], UTF8CodepointSize(@aStr[pIndex]), Points[1]);
2691      Points[1].cX := Points[0].cX + Points[1].cX;
2692      Points[1].cY := Points[0].cY;
2693
2694      {Draw prefix line}
2695      Polyline(DC, PPoint(@Points[0]), 2);
2696    end;
2697  end;
2698
2699begin
2700  if (Str=nil) or (Str[0]=#0) then Exit(0);
2701
2702  //DebugLn(Format('trace:> [TGtk2WidgetSet.DrawText] DC:0x%x, Str:''%s'', Count: %d, Rect = %d,%d,%d,%d, Flags:%d',
2703  //  [DC, Str, Count, Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, Flags]));
2704
2705  if not IsValidDC(DC) then Exit(0);
2706  if (Count < -1) or (IsRectEmpty(Rect) and
2707    ((Flags and DT_CALCRECT = 0) and (Flags and DT_NOCLIP = 0))) then Exit(0);
2708
2709  // Don't try to use StrLen(Str) in cases count >= 0
2710  // In those cases str is NOT required to have a null terminator !
2711  if Count = -1 then Count := StrLen(Str);
2712
2713  Lines := nil;
2714  NumLines := 0;
2715  TempDC := HDC(-1);
2716  TempPen := HPEN(-1);
2717  TempBrush := HBRUSH(-1);
2718
2719  try
2720    if (Flags and (DT_SINGLELINE or DT_CALCRECT or DT_NOPREFIX or DT_NOCLIP or DT_EXPANDTABS)) =
2721       (DT_SINGLELINE or DT_NOPREFIX or DT_NOCLIP)
2722    then begin
2723      //DebugLn(['TGtk2WidgetSet.DrawText Calc single line']);
2724      CopyRect(theRect, Rect);
2725      SavedRect := Rect;
2726      DrawLineRaw(Str, Count, Rect.Top);
2727      Result := Rect.Bottom - Rect.Top;
2728      Exit;
2729    end;
2730
2731    SetLength(AStr{%H-},Count);
2732    if Count>0 then
2733      System.Move(Str^,AStr[1],Count);
2734
2735    if (Flags and DT_EXPANDTABS) <> 0 then
2736      AStr := StringReplace(AStr, #9, TabString, [rfReplaceAll]);
2737
2738    if (Flags and DT_NOPREFIX) <> DT_NOPREFIX then
2739      pIndex := DeleteAmpersands(AStr)
2740    else
2741      pIndex := -1;
2742
2743    GetTextMetrics(DC, TM{%H-});
2744    DoCalcRect;
2745    Result := theRect.Bottom - theRect.Top;
2746    if (Flags and DT_CALCRECT) = DT_CALCRECT
2747    then begin
2748      //DebugLn(['TGtk2WidgetSet.DrawText Complex Calc']);
2749      CopyRect(Rect, theRect);
2750      exit;
2751    end;
2752
2753    TempDC := SaveDC(DC);
2754
2755    if (Flags and DT_NOCLIP) <> DT_NOCLIP then
2756    begin
2757      if theRect.Right > Rect.Right then
2758        theRect.Right := Rect.Right;
2759      if theRect.Bottom > Rect.Bottom then
2760        theRect.Bottom := Rect.Bottom;
2761      IntersectClipRect(DC, theRect.Left, theRect.Top,
2762        theRect.Right, theRect.Bottom);
2763    end;
2764
2765    if (Flags and DT_SINGLELINE) = DT_SINGLELINE
2766    then begin
2767      // DebugLn(['TGtk2WidgetSet.DrawText Draw single line']);
2768      SavedRect := TheRect;
2769      DrawLine(PChar(AStr), length(AStr), theRect.Top);
2770      Exit; //we're ready
2771    end;
2772
2773    // multiple lines
2774    if Lines = nil then Exit;  // nothing to do
2775    if NumLines = 0 then Exit; //
2776
2777
2778    //DebugLn(['TGtk2WidgetSet.DrawText Draw multiline']);
2779    SavedRect := Classes.Rect(0, 0, 0, 0); // no font orientation change if multilined text
2780    for i := 0 to NumLines - 1 do
2781    begin
2782      if theRect.Top > theRect.Bottom then Break;
2783
2784      if  ((Flags and DT_EDITCONTROL) = DT_EDITCONTROL)
2785      and (tm.tmHeight > (theRect.Bottom - theRect.Top))
2786      then Break;
2787
2788      if Lines[i] <> nil then
2789      begin
2790        l:=StrLen(Lines[i]);
2791        DrawLine(Lines[i], l, theRect.Top);
2792        dec(pIndex,l+length(LineEnding));
2793        GetTextExtentPoint(DC, Lines[i], l, Size{%H-});
2794        LineHeight := Size.cY;
2795      end
2796      else
2797        LineHeight := TM.tmHeight;
2798      Inc(theRect.Top, LineHeight + TM.tmExternalLeading);// space between lines
2799    end;
2800
2801  finally
2802    Reallocmem(Lines, 0);
2803    if TempBrush <> HBRUSH(-1) then
2804      SelectObject(DC, TempBrush);// DeleteObject not needed here, because it was a default Brush
2805    if TempPen <> HPEN(-1) then
2806      DeleteObject(SelectObject(DC, TempPen));
2807    if TempDC <> HDC(-1) then
2808      RestoreDC(DC, TempDC);
2809  end;
2810end;
2811
2812{------------------------------------------------------------------------------
2813  Function: EnableScrollBar
2814  Params:  Wnd, wSBflags, wArrows
2815  Returns: Nothing
2816
2817
2818 ------------------------------------------------------------------------------}
2819function TGtk2WidgetSet.EnableScrollBar(Wnd: HWND; wSBflags, wArrows: Cardinal): Boolean;
2820begin
2821  // TODO: implement TGtk2WidgetSet.EnableScrollBar
2822  Result := False;
2823end;
2824
2825{------------------------------------------------------------------------------
2826  Function: EnableWindow
2827  Params: hWnd:
2828          bEnable:
2829  Returns:
2830  If the window was previously disabled, the return value is TRUE.
2831  If the window was not previously disabled, the return value is FALSE.
2832 ------------------------------------------------------------------------------}
2833function TGtk2WidgetSet.EnableWindow(hWnd: HWND; bEnable: Boolean): Boolean;
2834begin
2835  Result := False;
2836  if hWnd <> 0 then
2837  begin
2838    Result := not GTK_WIDGET_SENSITIVE({%H-}PGtkWidget(HWND));
2839    gtk_widget_set_sensitive({%H-}PGtkWidget(hWnd), bEnable);
2840    InvalidateLastWFPResult(nil, RectFromGdkRect({%H-}PGtkWidget(HWND)^.allocation));
2841  end;
2842end;
2843
2844{------------------------------------------------------------------------------
2845  Function: EndPaint
2846  Params:
2847  Returns:
2848
2849 ------------------------------------------------------------------------------}
2850function TGtk2WidgetSet.EndPaint(Handle: hwnd; var PS: TPaintStruct): Integer;
2851var
2852  Widget: PGtkWidget;
2853  Info: PWidgetInfo;
2854  Control: TWinControl;
2855
2856begin
2857  Result:=1;
2858  if PS.HDC = 0 then Exit;
2859
2860  if Handle <> 0
2861  then Control := TWinControl(GetLCLObject({%H-}Pointer(Handle)))
2862  else Control := nil;
2863
2864  if (Control <> nil)
2865  and TWSWinControlClass(Control.WidgetSetClass).GetDoubleBuffered(Control)
2866  and not GTK_WIDGET_DOUBLE_BUFFERED({%H-}PGTKWidget(Handle))
2867  then begin
2868    gdk_window_thaw_updates(TGtkDeviceContext(PS.HDC).Drawable);
2869    gdk_window_end_paint (TGtkDeviceContext(PS.HDC).Drawable);
2870  end;
2871
2872  Widget := {%H-}PGtkWidget(Handle);
2873  Info:=GetWidgetInfo(Widget);
2874  if Info<>nil then
2875    dec(Info^.PaintDepth);
2876
2877  ReleaseDC(Handle, PS.HDC);
2878end;
2879
2880function TGtk2WidgetSet.EnumDisplayMonitors(hdc: HDC; lprcClip: PRect;
2881  lpfnEnum: MonitorEnumProc; dwData: LPARAM): LongBool;
2882var
2883  i: integer;
2884begin
2885  Result := True;
2886  for i := 0 to gdk_screen_get_n_monitors(gdk_screen_get_default) - 1 do
2887  begin
2888    Result := Result and lpfnEnum(i + 1, 0, nil, dwData);
2889    if not Result then break;
2890  end;
2891end;
2892
2893{.$define VerboseEnumFonts}
2894{$IFDEF GTK2OLDENUMFONTFAMILIES}
2895function TGtk2WidgetSet.EnumFontFamilies(DC: HDC; Family: Pchar;
2896  EnumFontFamProc: FontEnumProc; LParam:Lparam):longint;
2897var
2898  xFonts: PPChar;
2899  FontList: TStringList;
2900  EnumLogFont: TEnumLogFont;
2901  Metric: TNewTextMetric;
2902  I,N: Integer;
2903  tmp: String;
2904  FontType: Integer;
2905begin
2906  result := 0;
2907  if not Assigned(EnumFontFamProc) then begin
2908    result := 2;
2909    DebugLn('EnumFontFamProc Callback not set');
2910    // todo: raise exception?
2911    exit;
2912  end;
2913  FontList := TStringlist.Create;
2914  try
2915    if Family<>'' then
2916      Tmp := '-*-'+Family+'-*-*-*-*-*-*-*-*-*-*-*-*'
2917    else
2918      Tmp := '-*'; // get rid of aliases
2919    {$ifdef VerboseEnumFonts}
2920    WriteLn('Looking for fonts matching: ', tmp);
2921    {$endif}
2922    {$ifdef HasX}
2923    XFonts := XListFonts(gdk_display, pchar(Tmp), 10000, @N);
2924    {$else}
2925    {$IFDEF VerboseGtkToDos}{$warning implement getting XFonts for this OS}{$ENDIF}
2926    XFonts := nil;
2927    N:=0;
2928    {$endif}
2929    try
2930      for I := 0 to N - 1 do
2931        if XFonts[I] <> nil then begin
2932          Tmp := ExtractFamilyFromXLFDName(XFonts[I]);
2933          {$ifdef VerboseEnumFonts}
2934          WriteLn(I:5,' [', tmp, '] Font=',XFonts[i]);
2935          {$endif}
2936          if Tmp <> '' then begin
2937            if family='' then begin
2938              // get just the font names
2939              if FontList.IndexOf(Tmp) < 0 then begin
2940                EnumLogFont.elfLogFont := XLFDNameToLogFont(XFonts[i]);
2941                FillChar(Metric, SizeOf(Metric), #0);
2942                FontType := 0; // todo: GetFontTypeFromXLDF or FontId
2943                EnumLogFont.elfFullName := '';
2944                EnumFontFamProc(EnumLogFont, Metric, FontType, Lparam);
2945                FontList.Append(Tmp);
2946              end;
2947            end else begin
2948              EnumLogFont.elfLogFont := XLFDNameToLogFont(XFonts[i]);
2949              EnumlogFont.elfFullname := '';
2950              EnumLogFont.elfStyle := '';
2951              FillChar(Metric, SizeOf(Metric), #0);
2952              FontType := 0; // todo: GetFontTypeFromXLDF or FontId
2953              EnumFontFamProc(EnumLogFont, Metric, FontType, Lparam);
2954            end;
2955          end;
2956        end;
2957    finally
2958      {$ifdef HasX}
2959      XFreeFontNames(XFonts);
2960      {$endif}
2961    end;
2962  finally
2963    Fontlist.Free;
2964  end;
2965end;
2966
2967function TGtk2WidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
2968  Callback: FontEnumExProc; Lparam:LParam; Flags: dword): longint;
2969type
2970  TXLFD=record
2971    Foundry: string[15];
2972    Family, CharsetReg, CharsetCod: string[32];
2973    WeightName,widthName,StyleName: string[20];
2974    Slant: string[5];
2975    PixelSize,PointSize,ResX,ResY: Integer;
2976  end;
2977
2978var
2979  Xlfd: TXLFD;
2980  CharsetFilter: TStringList;
2981  PitchFilter: TStringList;
2982  EnumLogFont: TEnumLogFontEx;
2983  Metric: TNewTextMetricEx;
2984
2985  function ParseXLFDFont(const font: string): boolean;
2986    function MyStrToIntDef(const s: string; def: integer): integer;
2987    begin
2988      result := StrToIntDef(s, Def);
2989      if result=0 then
2990        result := def
2991    end;
2992  begin
2993    result := IsFontNameXLogicalFontDesc(font);
2994    fillchar(Xlfd, SizeOf(Xlfd), 0);
2995    if result then with Xlfd do begin
2996      Foundry     := ExtractXLFDItem(Font, XLFD_FOUNDRY);
2997      Family      := ExtractXLFDItem(Font, XLFD_FAMILY);
2998      CharsetReg  := ExtractXLFDItem(Font, XLFD_CHARSET_REG);
2999      CharSetCod  := ExtractXLFDItem(Font, XLFD_CHARSET_COD);
3000      WeightName  := ExtractXLFDItem(Font, XLFD_WEIGHTNAME);
3001      Slant       := ExtractXLFDItem(Font, XLFD_SLANT);
3002      WidthName   := ExtractXLFDItem(Font, XLFD_WIDTHNAME);
3003      StyleName   := ExtractXLFDItem(Font, XLFD_STYLENAME);
3004      ResX        := MyStrToIntDef(ExtractXLFDItem(Font, XLFD_RESX), 72);
3005      ResY        := MyStrToIntDef(ExtractXLFDItem(Font, XLFD_RESX), 72);
3006      PixelSize   := StrToIntDef(ExtractXLFDItem(Font, XLFD_PIXELSIZE), 0);
3007      PointSize   := StrToIntDef(ExtractXLFDItem(Font, XLFD_POINTSIZE), 0);
3008    end;
3009  end;
3010
3011  function XLFDToFontStyle: string;
3012  var
3013    s: string;
3014  begin
3015    result := xlfd.WeightName;
3016    s :=lowercase(xlfd.Slant);
3017    if s='i'  then result := result + ' '+ 'italic' else
3018    if s='o'  then result := result + ' '+ 'oblique' else
3019    if s='ri' then result := result + ' '+ 'reverse italic' else
3020    if s='ro' then result := result + ' '+ 'reverse oblique'
3021    else begin
3022      if (S<>'r')and(S<>'') then
3023        result := result + ' ' + S;
3024    end;
3025  end;
3026
3027  procedure QueueCharsetFilter(Charset: byte);
3028  var
3029    i: integer;
3030    rec: PCharsetEncodingRec;
3031    s: string;
3032  begin
3033    for i:=0 to CharsetEncodingList.count-1 do begin
3034      Rec := CharsetEncodingList[i];
3035      if (Rec=nil) or (Rec^.CharSet<>Charset) or (not Rec^.EnumMap) then
3036        continue;
3037      s := Rec^.CharSetReg;
3038      if Rec^.CharsetRegPart then
3039        s := s + '*';
3040      s := s + '-' + Rec^.CharSetCod;
3041      if Rec^.CharsetCodPart then
3042        s := s + '*';
3043      CharsetFilter.Add(s);
3044    end;
3045  end;
3046
3047  procedure QueuePitchFilter(Pitch: byte);
3048  begin
3049
3050    if pitch and FIXED_PITCH = FIXED_PITCH then begin
3051      PitchFilter.Add('m');
3052      PitchFilter.Add('c'); // character cell it's also fixed pitch
3053    end;
3054
3055    if pitch and VARIABLE_PITCH = VARIABLE_PITCH then
3056      PitchFilter.Add('p');
3057
3058    if pitch and MONO_FONT = MONO_FONT then
3059      PitchFilter.Add('m');
3060
3061    if PitchFilter.Count=0 then
3062      PitchFilter.Add('*');
3063  end;
3064
3065  function XLFDToCharset: byte;
3066  const
3067    CharsetPriority: array[1..19] of byte =
3068    (
3069      SYMBOL_CHARSET,       MAC_CHARSET,      SHIFTJIS_CHARSET,
3070      HANGEUL_CHARSET,      JOHAB_CHARSET,    GB2312_CHARSET,
3071      CHINESEBIG5_CHARSET,  GREEK_CHARSET,    TURKISH_CHARSET,
3072      VIETNAMESE_CHARSET,   HEBREW_CHARSET,   ARABIC_CHARSET,
3073      BALTIC_CHARSET,       RUSSIAN_CHARSET,  THAI_CHARSET,
3074      EASTEUROPE_CHARSET,   OEM_CHARSET,      FCS_ISO_10646_1,
3075      ANSI_CHARSET
3076    );
3077  var
3078    i,n: integer;
3079    rec: PCharsetEncodingRec;
3080  begin
3081    for i := Low(CharsetPriority) to High(CharsetPriority) do
3082      for n:= 0 to CharsetEncodingList.count-1 do begin
3083        rec := CharsetEncodingList[n];
3084        if (rec=nil) or (rec^.CharSet<>CharsetPriority[i]) then
3085          continue;
3086        // try to match registry part
3087        if rec^.CharSetReg<>'*' then begin
3088          if rec^.CharsetRegPart then begin
3089            if pos(rec^.CharSetReg, xlfd.CharsetReg)=0 then
3090              continue;
3091          end else begin
3092            if AnsiCompareText(Rec^.CharSetReg, xlfd.CharsetReg) <> 0 then
3093              continue;
3094          end;
3095        end;
3096        // try to match coding part
3097        if rec^.CharSetCod<>'*' then begin
3098          if rec^.CharsetCodPart then begin
3099            if pos(rec^.CharSetCod, xlfd.CharsetCod)=0 then
3100              continue;
3101          end else begin
3102            if AnsiCompareText(Rec^.CharSetCod, xlfd.CharsetCod) <> 0 then
3103              continue;
3104          end;
3105        end;
3106        // this one is good enought to match bot registry and encondig part
3107        result := CharsetPriority[i];
3108        exit;
3109      end;
3110    result := DEFAULT_CHARSET;
3111  end;
3112
3113  function XLFDCharsetToScript: string;
3114  begin
3115    result := xlfd.CharsetReg + '-' + xlfd.CharsetCod;
3116  end;
3117
3118  function FoundryAndFamilyFilter(const FaceName: string): string;
3119  var
3120    foundry,family: string;
3121    i: LongInt;
3122  begin
3123    if FaceName='' then begin
3124      family := '*';
3125      foundry := '*';
3126    end else begin
3127      family := FaceName;
3128      // look for foundry encoded in family name
3129      i := pos(FOUNDRYCHAR_OPEN, family);
3130      if i<>0 then begin
3131        Foundry := copy(Family, i+1, Length(Family));
3132        family := trim(copy(family, 1, i-1));
3133        i := pos(FOUNDRYCHAR_CLOSE, Foundry);
3134        if i<>0 then
3135          Delete(Foundry, i, Length(Foundry))
3136        else
3137          ; // ill formed but it's ok.
3138      end else
3139        Foundry := '*';
3140    end;
3141    result := Foundry+'-'+Family;
3142  end;
3143
3144  function XLFDFamilyFace: string;
3145  begin
3146    with xlfd do
3147    if (Length(Foundry)>0) and (Length(Family) + length(Foundry) + 3 < 31) then
3148      result := Family + ' '+ FOUNDRYCHAR_OPEN + Foundry + FOUNDRYCHAR_CLOSE
3149    else
3150      result := Family;
3151  end;
3152
3153  function XLFDToFontType: integer;
3154  begin
3155    if ((xlfd.PointSize=0) and (xlfd.PixelSize=0))
3156         or ((xlfd.PointSize=120) and (xlfd.PixelSize=17)) // see bug 16298
3157    then
3158      result := TRUETYPE_FONTTYPE
3159    else
3160      result := RASTER_FONTTYPE or DEVICE_FONTTYPE;
3161  end;
3162
3163  // process the current xlfd font, if user returns 0 from callback finish
3164  function ProcessXFont(const index: integer; const font: string;
3165    FontList: TStringList): boolean;
3166  var
3167    FontType: Integer;
3168    tmp: string;
3169    FullSearch: boolean;
3170  begin
3171    FullSearch := ( lpLogFont^.lfFaceName = '');
3172    result := false;
3173    with xlfd, EnumLogFont do
3174    if FullSearch then begin
3175      //
3176      // quick enumeration of fonts, make sure this is
3177      // documented because only some fields are filled !!!
3178      //
3179      Foundry    := ExtractXLFDItem(Font, XLFD_FOUNDRY);
3180      Family     := ExtractXLFDItem(Font, XLFD_FAMILY);
3181      tmp := XLFDFamilyFace();
3182
3183      if FontList.IndexOf(tmp) < 0 then begin
3184        PixelSize  := StrToIntDef(ExtractXLFDItem(Font, XLFD_PIXELSIZE), 0);
3185        PointSize  := StrToIntDef(ExtractXLFDItem(Font, XLFD_POINTSIZE), 0);
3186        CharsetReg := ExtractXLFDItem(Font, XLFD_CHARSET_REG);
3187        CharsetCod := ExtractXLFDItem(Font, XLFD_CHARSET_COD);
3188        FontType := XLFDToFontType();
3189        elfLogFont.lfCharSet := XLFDToCharset();
3190        elfLogFont.lfFaceName := tmp;
3191        result := Callback(EnumLogFont, Metric, FontType, LParam)=0;
3192        FontList.Append(tmp);
3193      end;
3194    end else
3195    if ParseXLFDFont(Font) then begin
3196      //
3197      // slow enumeration of fonts, only if face is present
3198      //
3199      // family
3200      tmp := XLFDFamilyFace();
3201      {$ifdef verboseEnumFonts}
3202      DebugLn(dbgs(index),' face=', tmp, ' Font=', Font);
3203      {$endif}
3204
3205      //if FontList.IndexOf(tmp) < 0 then begin
3206
3207        // Fonttype
3208        FontType := XLFDToFontType();
3209        // LogFont
3210        elfLogFont := XLFDNameToLogFont(Font);
3211        elfLogFont.lfFaceName := tmp;
3212        elfLogFont.lfCharSet := XLFDToCharset();
3213        // from logfont
3214
3215        elfStyle := XLFDToFontStyle();
3216
3217        elfScript := XLFDCharsetToScript();
3218        // tempted to feed here full xlfd, but 63 chars might be to small
3219        if Foundry = '' then
3220          elfFullName := Family
3221        else
3222          elfFullName := Foundry + ' ' + Family ;
3223
3224        // Metric
3225        //
3226        fillchar(metric.ntmeFontSignature,
3227          sizeOf(metric.ntmeFontSignature), 0);
3228        with metric.ntmentm do begin
3229          tmheight := elfLogFont.lfHeight;
3230          tmAveCharWidth := elfLogFont.lfWidth;
3231          tmWeight :=  elfLogFont.lfWeight;
3232          tmDigitizedAspectX := ResX;
3233          tmDigitizedAspectY := ResY;
3234          tmItalic := elfLogFont.lfItalic;
3235          tmUnderlined := elfLogFont.lfUnderline;
3236          tmStruckOut := elfLogFont.lfStrikeOut;
3237          tmPitchAndFamily := elfLogFont.lfPitchAndFamily;
3238          tmCharSet := elfLogFont.lfCharSet;
3239          // todo fields
3240          tmMaxCharWidth := elfLogFont.lfWidth; // todo
3241          tmAscent  := 0;           // todo
3242          tmDescent := 0;           // todo
3243          tmInternalLeading := 0;   // todo
3244          tmExternalLeading := 0;   // todo
3245          tmOverhang := 0;          // todo;
3246          tmFirstChar := ' ';       // todo, atm ascii
3247          tmLastChar  := #255;      // todo, atm ascii
3248          tmDefaultChar := '.';     // todo, atm dot
3249          tmBreakChar := ' ';       // todo, atm space
3250          ntmFlags := 0;                // todo combination of NTM_XXXX constants
3251          ntmSizeEM := tmHeight;        // todo
3252          ntmCellHeight :=  ntmSizeEM;  // todo
3253          ntmAvgWidth :=  ntmSizeEM;    // todo
3254        end; // with metric.ntmentm do ...
3255
3256        // do callback
3257        result := Callback(EnumLogFont, Metric, FontType, LParam) = 0;
3258        FontList.Append(tmp);
3259      //end; // if not FullSearch or (FontList.IndexOf(tmp) < 0 then ...
3260    end; // with xlfd, EnumLogFont do ...
3261  end;
3262var
3263  xFonts: PPChar;
3264  FontList: TStringList;
3265  I,J,K,N: Integer;
3266  Tmp,FandF: String;
3267begin
3268  result := 0;
3269  // initial checks
3270  if not Assigned(Callback) then begin
3271    result := 2;
3272    DebugLn('EnumFontFamiliesEx: EnumFontFamProcEx Callback not set');
3273    // todo: raise exception?
3274    exit;
3275  end;
3276  if not Assigned(lpLogFont) then begin
3277    result := 3;
3278    DebugLn('EnumFontFamiliesEx: lpLogFont not set');
3279    // todo: enumerate all fonts?
3280    exit;
3281  end;
3282
3283  // foundry and family filter
3284  FandF := FoundryAndFamilyFilter(lpLogFont^.lfFaceName);
3285
3286  FontList := TStringlist.Create;
3287  CharSetFilter := TStringList.Create;
3288  PitchFilter := TStringList.Create;
3289  PitchFilter.Duplicates := dupIgnore;
3290  try
3291    QueueCharSetFilter(lpLogFont^.lfCharSet);
3292    QueuePitchFilter(lpLogFont^.lfPitchAndFamily);
3293
3294    {$ifdef verboseEnumFonts}
3295    for j:=0 to CharSetFilter.Count-1 do begin
3296      // pitch filter is guaranteed to have at least one element
3297      for k:=0 to PitchFilter.Count-1 do begin
3298        tmp := '-'+FAndF+'-*-*-*-*-*-*-*-*-'+PitchFilter[k]+'-*-'+CharSetFilter[j];
3299        DebugLn('EnumFontFamiliesEx: will enumerate fonts matching: ', tmp);
3300      end;
3301    end;
3302    {$endif}
3303    for j:=0 to CharSetFilter.Count-1 do begin
3304      for k:=0 to PitchFilter.Count-1 do begin
3305        tmp := '-'+FAndF+'-*-*-*-*-*-*-*-*-'+PitchFilter[k]+'-*-'+CharSetFilter[j];
3306        {$ifdef HasX}
3307        XFonts := XListFonts(gdk_display, pchar(Tmp), 10000, @N);
3308        {$else}
3309        {$IFDEF VerboseGtkToDos}{$warning implement getting XFonts for this OS}{$ENDIF}
3310        XFonts := nil;
3311        N:=0;
3312        {$endif}
3313        try
3314          {$ifdef VerboseEnumFonts}
3315          DebugLn('EnumFontFamiliesEx: found ',dbgs(N),' fonts matching: ', tmp);
3316          {$endif}
3317          for i:=0 to N-1 do
3318            if XFonts[i]<>nil then
3319              if ProcessXFont(i, XFonts[i], FontList) then
3320                break;
3321        finally
3322          {$ifdef HasX}
3323          XFreeFontNames(XFonts);
3324          {$endif}
3325        end;
3326      end;
3327    end;
3328  finally
3329    PitchFilter.Free;
3330    Fontlist.Free;
3331    CharSetFilter.Free;
3332  end;
3333end;
3334
3335{$ELSE} //  pure pango font families
3336
3337function TGtk2WidgetSet.EnumFontFamiliesEx(DC: HDC; lpLogFont: PLogFont;
3338  Callback: FontEnumExProc; Lparam:LParam; Flags: dword): longint;
3339
3340type
3341  TPangoFontFaces = packed record
3342    FamilyName: String;
3343    Faces: Array of String;
3344  end;
3345  PPangoFontFaces = Array of TPangoFontFaces;
3346
3347var
3348  i: Integer;
3349  FontType: Integer;
3350  EnumLogFont: TEnumLogFontEx;
3351  Metric: TNewTextMetricEx;
3352  FontList: TStringList;
3353  Faces: PPangoFontFaces;
3354
3355  AStyle: String;
3356  StylesCount: Integer;
3357  StylesList: TStringList;
3358  y: Integer;
3359  CharsetList: TByteList;
3360  CS: Byte;
3361
3362  function Gtk2GetFontFamiliesDefault(var AList: TStringList): Integer;
3363  var
3364    i, j: Integer;
3365    AFamilies: PPPangoFontFamily;
3366    AFaces: PPPangoFontFace;
3367    ANumFaces: Integer;
3368    PContext: PPangoContext;
3369  begin
3370    AList.Clear;
3371    SetLength(Faces, 0);
3372    Result := -1;
3373    AFamilies := nil;
3374
3375    PContext := gdk_pango_context_get;
3376    pango_context_list_families(PContext, @AFamilies, @Result);
3377    SetLength(Faces, Result);
3378    for i := 0 to Result - 1 do
3379    begin
3380      j := AList.Add(StrPas(pango_font_family_get_name(AFamilies[i])));
3381      AList.Objects[j] := TObject(PtrUInt(pango_font_family_is_monospace(AFamilies[i])));
3382      Faces[i].FamilyName := AList[j];
3383      AFaces := nil;
3384      pango_font_family_list_faces(AFamilies[i], @AFaces, @ANumFaces);
3385      SetLength(Faces[i].Faces, ANumFaces);
3386      for j := 0 to ANumFaces - 1 do
3387        Faces[i].Faces[j] := StrPas(pango_font_face_get_face_name(AFaces[j]));
3388      g_free(AFaces);
3389    end;
3390    g_free(AFamilies);
3391    g_object_unref(PContext);
3392  end;
3393
3394  function Gtk2GetFontFamilies(var List: TStringList;
3395    const APitch: Byte;
3396    const AFamilyName: String;
3397    const {%H-}AWritingSystem: Byte): Integer;
3398  var
3399    StrLst: TStringList;
3400    NewList: TStringList;
3401    S: String;
3402    j: integer;
3403  begin
3404    Result := -1;
3405    StrLst := TStringList.Create;
3406    NewList := TStringList.Create;
3407
3408    try
3409      Gtk2GetFontFamiliesDefault(StrLst);
3410      for j := 0 to StrLst.Count - 1 do
3411      begin
3412        S := StrLst[j];
3413        if APitch <> DEFAULT_PITCH then
3414        begin
3415          case APitch of
3416            FIXED_PITCH, MONO_FONT:
3417            begin
3418              if StrLst.Objects[j] <> nil then
3419                NewList.Add(S);
3420            end;
3421            VARIABLE_PITCH:
3422            begin
3423              if StrLst.Objects[j] = nil then
3424                NewList.Add(S);
3425            end;
3426          end;
3427        end else
3428          NewList.Add(S);
3429      end;
3430
3431      if AFamilyName <> '' then
3432      begin
3433        for j := NewList.Count - 1 downto 0 do
3434        begin
3435          S := NewList[j];;
3436          if S <> AFamilyName then
3437            NewList.Delete(J);
3438        end;
3439      end;
3440      for j := 0 to NewList.Count - 1 do
3441      begin
3442        S := NewList[j];
3443        List.Add(S);
3444      end;
3445      Result := List.Count;
3446    finally
3447      StrLst.Free;
3448      NewList.Free;
3449    end;
3450  end;
3451
3452  function GetStyleAt(AIndex: Integer): String;
3453  var
3454    S: String;
3455  begin
3456    Result := '';
3457    if (AIndex >= 0) and (AIndex < StylesList.Count) then
3458    begin
3459      S := StylesList[AIndex];
3460      Result := S;
3461    end;
3462  end;
3463
3464  function FillLogFontA(const AIndex: Integer; var ALogFontA: TLogFontA;
3465    var {%H-}AMetric: TNewTextMetricEx; var {%H-}AFontType: Integer;
3466    out AStyle: String): Integer;
3467  var
3468    Font: PPangoFontDescription;
3469    FontStyle: TPangoStyle;
3470    FontWeight: TPangoWeight;
3471    S: String;
3472    i: Integer;
3473  begin
3474    S := FontList[AIndex];
3475    Font := pango_font_description_from_string(PChar(S));
3476
3477    FontStyle := pango_font_description_get_style(Font);
3478    FontWeight := pango_font_description_get_weight(Font);
3479
3480    ALogFontA.lfItalic := Byte(FontStyle = PANGO_STYLE_ITALIC);
3481
3482    // keep newer pango compat to LCL
3483    if FontWeight = 380 {PANGO_WEIGHT_BOOK as of pango 1.24} then
3484      FontWeight := PANGO_WEIGHT_NORMAL
3485    else
3486    if FontWeight = 1000 {PANGO_WEIGHT_ULTRAHEAVY as of pango 1.24} then
3487      FontWeight := PANGO_WEIGHT_HEAVY;
3488
3489    ALogFontA.lfWeight := FontWeight;
3490
3491    ALogFontA.lfHeight := pango_font_description_get_size(Font);
3492    if not pango_font_description_get_size_is_absolute(Font) then
3493      ALogFontA.lfHeight := ALogFontA.lfHeight div PANGO_SCALE;
3494
3495    // pango does not have underline and strikeout params for font
3496    // ALogFontA.lfUnderline := ;
3497    // ALogFontA.lfStrikeOut := ;
3498
3499    StylesList.Clear;
3500    for i := High(Faces[AIndex].Faces) downto 0 do
3501      StylesList.Add(Faces[AIndex].Faces[i]);
3502
3503    AStyle := '';
3504    Result := StylesList.Count;
3505
3506    if StylesList.Count > 0  then
3507      AStyle := GetStyleAt(0);
3508
3509    // current pango support in fpc is really poor, we cannot
3510    // get PangoScript since it's in pango >= 1.4
3511    // FillCharsetListForFont()
3512  end;
3513
3514begin
3515  Result := 0;
3516  {$ifdef VerboseEnumFonts}
3517  WriteLn('[TGtk2WidgetSet.EnumFontFamiliesEx] Charset=',lpLogFont^.lfCharSet,
3518  ' face ',lpLogFont^.lfFaceName,' pitchAndFamily=',lpLogFont^.lfPitchAndFamily);
3519  {$endif}
3520  Result := 0;
3521  Metric.ntmentm.ntmAvgWidth := 0; // just to shutup compiler
3522  if (lpLogFont^.lfCharSet = DEFAULT_CHARSET) and
3523     (lpLogFont^.lfFaceName= '') and
3524     (lpLogFont^.lfPitchAndFamily = 0) then
3525  begin
3526    FontType := 0;
3527    FontList := TStringList.create;
3528    try
3529      if Gtk2GetFontFamiliesDefault(FontList) > 0 then
3530      begin
3531        for i := 0 to FontList.Count - 1 do
3532        begin
3533          EnumLogFont.elfLogFont.lfFaceName := FontList[i];
3534          Result := Callback(EnumLogFont, Metric, FontType, LParam);
3535        end;
3536      end;
3537    finally
3538      FontList.free;
3539    end;
3540  end else
3541  begin
3542    Result := 0;
3543    FontType := TRUETYPE_FONTTYPE;
3544    FontList := TStringList.Create;
3545    StylesList := TStringList.Create;
3546    CharsetList := TByteList.Create;
3547    for i := 0 to CharsetEncodingList.Count - 1 do
3548    begin
3549      CS := TCharSetEncodingRec(CharsetEncodingList.Items[i]^).CharSet;
3550      if CharsetList.IndexOf(CS) = -1 then
3551        CharsetList.Add(CS);
3552    end;
3553    try
3554      if Gtk2GetFontFamilies(FontList, lpLogFont^.lfPitchAndFamily,
3555        lpLogFont^.lfFaceName, lpLogFont^.lfCharSet) > 0 then
3556      begin
3557        for i := 0 to FontList.Count - 1 do
3558        begin
3559          EnumLogFont.elfLogFont.lfFaceName := FontList[i];
3560          EnumLogFont.elfLogFont.lfPitchAndFamily := lpLogFont^.lfPitchAndFamily;
3561          EnumLogFont.elfFullName := FontList[i];
3562
3563          StylesCount := FillLogFontA(i, EnumLogFont.elfLogFont, Metric, FontType,
3564            AStyle);
3565          EnumLogFont.elfStyle := AStyle;
3566
3567          if CharSetList.Count > 0 then
3568            EnumLogFont.elfLogFont.lfCharSet := CharsetList.Items[0];
3569
3570          Result := Callback(EnumLogFont, Metric, FontType, LParam);
3571          for y := 1 to StylesCount - 1 do
3572          begin
3573            AStyle := GetStyleAt(y);
3574            EnumLogFont.elfStyle := AStyle;
3575            Result := Callback(EnumLogFont, Metric, FontType, LParam);
3576          end;
3577          for y := 1 to CharSetList.Count - 1 do
3578          begin
3579            EnumLogFont.elfLogFont.lfCharSet := CharsetList.Items[y];
3580            Result := Callback(EnumLogFont, Metric, FontType, LParam);
3581          end;
3582        end;
3583      end;
3584    finally
3585      CharSetList.Free;
3586      StylesList.Free;
3587      FontList.Free;
3588    end;
3589  end;
3590end;
3591{$ENDIF}
3592
3593
3594{------------------------------------------------------------------------------
3595  Method:   Ellipse
3596  Params:   X1, Y1, X2, Y2
3597  Returns:  Nothing
3598
3599  Use Ellipse to draw a filled circle or ellipse.
3600 ------------------------------------------------------------------------------}
3601function TGtk2WidgetSet.Ellipse(DC: HDC; x1, y1, x2, y2: Integer): Boolean;
3602var
3603  DevCtx: TGtkDeviceContext absolute DC;
3604  Left, Top, Width, Height: Integer;
3605  DCOrigin: TPoint;
3606begin
3607  Result := IsValidDC(DC);
3608  if not Result then Exit;
3609
3610  if DevCtx.HasTransf then
3611    DevCtx.TransfRect(X1, Y1, X2, Y2);
3612
3613  CalculateLeftTopWidthHeight(X1, Y1, X2, Y2, Left, Top, Width, Height);
3614  if (Width = 0) or (Height = 0) then Exit(True);
3615  // X2, Y2 is not part of the rectangle
3616  dec(Width);
3617  dec(Height);
3618
3619  // first draw interior in brush color
3620  DCOrigin := DevCtx.Offset;
3621
3622  {$IFDEF DebugGDKTraps}
3623  BeginGDKErrorTrap;
3624  {$ENDIF}
3625
3626  if not DevCtx.IsNullBrush then
3627  begin
3628    DevCtx.SelectBrushProps;
3629    DevCtx.RemovePixbuf;
3630    gdk_draw_arc(DevCtx.Drawable, DevCtx.GC, 1,
3631                 Left+DCOrigin.X, Top+DCOrigin.Y, Width, Height, 0, 360 shl 6);
3632  end;
3633
3634  // Draw outline
3635
3636  DevCtx.SelectPenProps;
3637  if (dcfPenSelected in DevCtx.Flags) then
3638  begin
3639    Result := True;
3640    if not DevCtx.IsNullPen then
3641    begin
3642      DevCtx.RemovePixbuf;
3643      gdk_draw_arc(DevCtx.Drawable, DevCtx.GC, 0,
3644                   Left+DCOrigin.X, Top+DCOrigin.Y, Width, Height, 0, 360 shl 6);
3645    end;
3646  end
3647  else
3648    Result := False;
3649
3650  {$IFDEF DebugGDKTraps}
3651  EndGDKErrorTrap;
3652  {$ENDIF}
3653end;
3654
3655{------------------------------------------------------------------------------
3656  Method: EqualRgn
3657  Params:  Rgn1: HRGN; Rgn2: HRGN
3658  Returns: True if the two regions are equal
3659
3660  Checks the two specified regions to determine whether they are identical. The
3661  function considers two regions identical if they are equal in size and shape.
3662 ------------------------------------------------------------------------------}
3663function TGtk2WidgetSet.EqualRgn(Rgn1: HRGN; Rgn2: HRGN): Boolean;
3664var
3665  AGdiObject: PGdiObject absolute Rgn1;
3666  BGdiObject: PGdiObject absolute Rgn2;
3667begin
3668  Result := IsValidGDIObject(Rgn1) and IsValidGDIObject(Rgn2);
3669  if Result then
3670    Result := gdk_region_equal(AGdiObject^.GDIRegionObject,
3671                               BGdiObject^.GDIRegionObject);
3672end;
3673
3674{------------------------------------------------------------------------------
3675  Function: ExcludeClipRect
3676  Params:  dc: hdc; Left, Top, Right, Bottom : Integer
3677  Returns: integer
3678
3679  Subtracts all intersecting points of the passed bounding rectangle
3680  (Left, Top, Right, Bottom) from the Current clipping region in the
3681  device context (dc).
3682
3683  The result can be one of the following constants
3684      Error
3685      NullRegion
3686      SimpleRegion
3687      ComplexRegion
3688 ------------------------------------------------------------------------------}
3689function TGtk2WidgetSet.ExcludeClipRect(dc: hdc;
3690  Left, Top, Right, Bottom : Integer) : Integer;
3691begin
3692  Result := Inherited ExcludeClipRect(DC, Left, Top, Right, Bottom);
3693end;
3694
3695function TGtk2WidgetSet.ExtCreatePen(dwPenStyle, dwWidth: DWord;
3696  const lplb: TLogBrush; dwStyleCount: DWord; lpStyle: PDWord): HPEN;
3697var
3698  GObject: PGdiObject;
3699  i: integer;
3700begin
3701  GObject := NewGDIObject(gdiPen);
3702  GObject^.UnTransfPenWidth := 0;
3703  GObject^.IsExtPen := True;
3704  GObject^.GDIPenStyle := dwPenStyle;
3705  GObject^.GDIPenWidth := dwWidth;
3706  SetGDIColorRef(GObject^.GDIPenColor, lplb.lbColor);
3707  GObject^.GDIPenDashesCount := dwStyleCount;
3708
3709  if dwStyleCount > 0 then
3710  begin
3711    GetMem(GObject^.GDIPenDashes, dwStyleCount * SizeOf(gint8));
3712    for i := 0 to dwStyleCount - 1 do
3713      GObject^.GDIPenDashes[i] := lpStyle[i];
3714  end;
3715
3716  Result := HPEN({%H-}PtrUInt(GObject));
3717end;
3718
3719{------------------------------------------------------------------------------
3720  Function: ExtSelectClipRGN
3721  Params:  dc, RGN, Mode
3722  Returns: integer
3723
3724  Combines the passed Region with the current clipping region in the device
3725  context (dc), using the specified mode.
3726
3727  The Combine Mode can be one of the following:
3728      RGN_AND  : all points which are in both regions
3729
3730      RGN_COPY : an exact copy of the source region, same as SelectClipRGN
3731
3732      RGN_DIFF : all points which are in the Clipping Region but
3733                 not in the Source.(Clip - RGN)
3734
3735      RGN_OR   : all points which are in either the Clip Region or
3736                 in the Source.(Clip + RGN)
3737
3738      RGN_XOR  : all points which are in either the Clip Region
3739                 or in the Source, but not in both.
3740
3741  The result can be one of the following constants
3742      Error
3743      NullRegion
3744      SimpleRegion
3745      ComplexRegion
3746 ------------------------------------------------------------------------------}
3747function TGtk2WidgetSet.ExtSelectClipRGN(dc: hdc; rgn : hrgn;
3748  Mode : Longint) : Integer;
3749var
3750  Clip,
3751  Tmp : hRGN;
3752  X, Y : Longint;
3753begin
3754  Result := SIMPLEREGION;
3755  if not IsValidDC(DC) then
3756    Result := ERROR
3757  else with TGtkDeviceContext(DC) do
3758  begin
3759    //DebugLn('TGtk2WidgetSet.ExtSelectClipRGN A ClipRegValid=',dbgs(DCClipRegionValid(DC)),
3760    //  ' Mode=',dbgs(Mode),' RGN=',GDKRegionAsString(PGdiObject(RGN)^.GDIRegionObject));
3761    if ClipRegion = nil then
3762    begin
3763      // there is no clipping region in the DC
3764      case Mode of
3765        RGN_COPY:
3766          begin
3767            Result := RegionType({%H-}PGdiObject(RGN)^.GDIRegionObject);
3768            If Result <> ERROR then
3769              Result := SelectClipRGN(DC, RGN);
3770          end;
3771        RGN_OR,
3772        RGN_XOR,
3773        RGN_AND,
3774        RGN_DIFF:
3775          begin
3776            // get existing clip
3777            if Drawable=nil then
3778              Clip:=CreateEmptyRegion
3779            else begin
3780              GDK_Window_Get_Size(Drawable, @X, @Y);
3781              Clip := CreateRectRGN(-Offset.X, -Offset.Y, X - Offset.X, Y - Offset.Y);
3782            end;
3783            // create target clip
3784            Tmp := CreateEmptyRegion;
3785            // combine
3786            Result := CombineRGN(Tmp, Clip, RGN, Mode);
3787            // commit
3788            //DebugLn('TGtk2WidgetSet.ExtSelectClipRGN B ClipRegValid=',dbgs(ClipRegion),' TmpRGN=',GDKRegionAsString(PGdiObject(Tmp)^.GDIRegionObject));
3789            SelectClipRGN(DC, Tmp);
3790            // clean up
3791            DeleteObject(Clip);
3792            DeleteObject(Tmp);
3793          end;
3794        end;
3795      end
3796    else
3797      Result := inherited ExtSelectClipRGN(dc, rgn, mode);
3798  end;
3799end;
3800
3801{------------------------------------------------------------------------------
3802  Function: ExtTextOut
3803  Params:  none
3804  Returns: Nothing
3805
3806    gdk_drawable_get_size(pixmap, @Width, @Height);
3807
3808 ------------------------------------------------------------------------------}
3809function TGtk2WidgetSet.ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint;
3810  Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
3811var
3812  DevCtx: TGtkDeviceContext absolute DC;
3813
3814  LineStart, LineEnd, StrEnd: PChar;
3815  Width, Height: Integer;
3816  TopY, LineLen, LineHeight, SavedDC: Integer;
3817  TxtPt: TPoint;
3818  DCOrigin: TPoint;
3819  Foreground, BackgroundColor: PGDKColor;
3820  CurDx: PInteger;
3821  CurStr: PChar;
3822  R: TRect;
3823
3824  procedure DoTextOut(X,Y : Integer; Str: Pchar; CurCount: Integer);
3825  var
3826    CurScreenX: LongInt;
3827    CharLen: LongInt;
3828  begin
3829    if (Dx <> nil) then
3830    begin
3831      CurScreenX := X;
3832      while CurCount > 0 do
3833      begin
3834        CharLen := UTF8CodepointSize(CurStr);
3835        DevCtx.DrawTextWithColors(CurStr, CharLen, CurScreenX, Y, Foreground, BackgroundColor);
3836        inc(CurScreenX, CurDx^);
3837        inc(CurDx);
3838        inc(CurStr, CharLen);
3839        dec(CurCount, CharLen);
3840      end;
3841    end
3842    else
3843      DevCtx.DrawTextWithColors(Str, Count, X, Y, Foreground, BackgroundColor);
3844  end;
3845
3846begin
3847  //DebugLn(['TGtk2WidgetSet.ExtTextOut X=',X,' Y=',Y,' Str="',copy(Str,1,Count),'" Count=',Count,' DX=',dbgs(DX)]);
3848  //DebugLn(Format('trace:> [TGtk2WidgetSet.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
3849  Result := IsValidDC(DC);
3850  if not Result then Exit;
3851
3852  if DevCtx.GC <> nil then; // create GC
3853
3854  if ((Options and (ETO_OPAQUE + ETO_CLIPPED)) <> 0) and (Rect = nil) then
3855  begin
3856    R := RectFromGdkRect(DevCtx.ClipRect);
3857    OffsetRect(R, -R.Left, -R.Top);
3858    OffsetRect(R, X, Y);
3859    DrawText(DC, Str, Count, R, DT_SINGLELINE or DT_CALCRECT);
3860    Rect := @R;
3861  end;
3862
3863  BackgroundColor := nil;
3864
3865  // to reduce flickering calculate first and then paint
3866
3867  DCOrigin := DevCtx.Offset;
3868
3869  if (Options and ETO_CLIPPED) <> 0 then
3870  begin
3871    SavedDC := SaveDC(DC);
3872    IntersectClipRect(DC, Rect^.Left, Rect^.Top, Rect^.Right, Rect^.Bottom);
3873  end;
3874
3875  if DevCtx.HasTransf then
3876  begin
3877    if Assigned(Rect) then
3878      Rect^ := DevCtx.TransfRectIndirect(Rect^);
3879    DevCtx.TransfPoint(X, Y);
3880  end;
3881
3882  LineLen := FindLineLen(Str,Count);
3883  TopY := Y;
3884  UpdateDCTextMetric(DevCtx);
3885  TxtPt.X := X + DCOrigin.X;
3886  LineHeight := DevCtx.DCTextMetric.TextMetric.tmHeight;
3887  TxtPt.Y := TopY + DCOrigin.Y;
3888
3889  DevCtx.SelectedColors := dcscCustom;
3890
3891  if ((Options and ETO_OPAQUE) <> 0) then
3892  begin
3893    Width := Rect^.Right - Rect^.Left;
3894    Height := Rect^.Bottom - Rect^.Top;
3895    EnsureGCColor(DC, dccCurrentBackColor, True, False);
3896    DevCtx.RemovePixbuf;
3897    gdk_draw_rectangle(DevCtx.Drawable, DevCtx.GC, 1,
3898                       Rect^.Left+DCOrigin.X, Rect^.Top+DCOrigin.Y,
3899                       Width, Height);
3900  end;
3901
3902
3903  if (DevCtx.BkMode = OPAQUE) then
3904  begin
3905    AllocGDIColor(DC, @DevCtx.CurrentBackColor);
3906    BackGroundColor := @DevCtx.CurrentBackColor.Color;
3907  end;
3908
3909  EnsureGCColor(DC, dccCurrentTextColor, True, False);
3910  Foreground := nil;//StyleForegroundColor(CurrentTextColor.ColorRef, nil);
3911
3912  CurDx:=Dx;
3913  CurStr:=Str;
3914  LineStart:=Str;
3915  if LineLen < 0 then
3916  begin
3917    LineLen:=Count;
3918    if Count> 0 then
3919      DoTextOut(TxtPt.X, TxtPt.Y, LineStart, LineLen);
3920  end else
3921  begin  //write multiple lines
3922    StrEnd := Str + Count;
3923    while LineStart < StrEnd do
3924    begin
3925      LineEnd := LineStart + LineLen;
3926      if LineLen>0 then
3927        DoTextOut(TxtPt.X, TxtPt.Y, LineStart, LineLen);
3928      inc(TxtPt.Y, LineHeight);
3929      //writeln('TGtk2WidgetSet.ExtTextOut ',LineHeight,' ',DevCtx.DCTextMetric.TextMetric.tmAscent,' ',DevCtx.DCTextMetric.TextMetric.tmDescent);
3930      LineStart := LineEnd + 1; // skip #13
3931      if (LineStart<StrEnd) and (LineStart^ in [#10,#13])
3932      and (LineStart^ <> LineEnd^) then
3933        inc(LineStart); // skip #10
3934      Count := StrEnd - LineStart;
3935      LineLen := FindLineLen(LineStart, Count);
3936      if LineLen < 0 then
3937        LineLen := Count;
3938    end;
3939  end;
3940
3941  if (Options and ETO_CLIPPED) <> 0 then
3942    RestoreDC(DC, SavedDC);
3943  Result := True;
3944  //DebugLn(Format('trace:< [TGtk2WidgetSet.ExtTextOut] DC:0x%x, X:%d, Y:%d, Options:%d, Str:''%s'', Count: %d', [DC, X, Y, Options, Str, Count]));
3945end;
3946
3947{------------------------------------------------------------------------------
3948  Function: FillRect
3949  Params: none
3950  Returns: Nothing
3951
3952  The FillRect function fills a rectangle by using the specified brush.
3953  This function includes the left and top borders, but excludes the right and
3954  bottom borders of the rectangle.
3955 ------------------------------------------------------------------------------}
3956function TGtk2WidgetSet.FillRect(DC: HDC; const Rect: TRect; Brush: HBRUSH): Boolean;
3957var
3958  TempBr: HBrush;
3959begin
3960  Result := IsValidDC(DC) and IsValidGDIObject(Brush);
3961  if not Result or IsRectEmpty(Rect) then
3962    Exit;
3963  if ({%H-}PGdiObject(Brush)^.GDIBrushFill = GDK_TILED) and (TGtkDeviceContext(DC).BkMode = OPAQUE) then
3964  begin
3965    // fill a rectangle with a solid back color first
3966    TempBr := CreateSolidBrush(TGtkDeviceContext(DC).CurrentBackColor.ColorRef);
3967    TGtkDeviceContext(DC).FillRect(Rect, TempBr, True);
3968    DeleteObject(TempBr);
3969  end;
3970  Result := TGtkDeviceContext(DC).FillRect(Rect, Brush, True);
3971  //DebugLn(Format('trace:< [TGtk2WidgetSet.FillRect] DC:0x%x; Rect: ((%d,%d)(%d,%d)); brush: %x', [Integer(DC), Rect.left, rect.top, rect.right, rect.bottom, brush]));
3972end;
3973
3974{------------------------------------------------------------------------------
3975  Function: FillRgn
3976  Params:  DC: HDC; RegionHnd: HRGN; hbr: HBRUSH
3977  Returns: True if the function succeeds
3978
3979  Fills a region by using the specified brush
3980 ------------------------------------------------------------------------------}
3981function TGtk2WidgetSet.FillRgn(DC: HDC; RegionHnd: HRGN; hbr: HBRUSH): Bool;
3982var
3983  GtkDC: Integer;
3984  OldRgn: PGdkRegion;
3985  DevCtx: TGtkDeviceContext absolute DC;
3986  ARect: TRect;
3987  CRect : TGDKRectangle;
3988  hasClipping: Boolean;
3989begin
3990
3991  Result := IsValidDC(DC) and IsValidGDIObject(hbr) and IsValidGDIObject(RegionHnd);
3992  if not Result then Exit;
3993  GtkDC := SaveDC(DC);
3994  if (DevCtx.ClipRegion <> nil) and (DevCtx.ClipRegion^.GDIRegionObject <> nil) then
3995    OldRgn := gdk_region_copy(DevCtx.ClipRegion^.GDIRegionObject)
3996  else
3997    OldRgn := nil;
3998  hasClipping := Assigned(OldRgn);
3999  try
4000    if SelectClipRGN(DC, RegionHnd) <> ERROR then
4001    begin
4002      gdk_region_get_clipbox({%H-}PGDIObject(RegionHnd)^.GDIRegionObject, @CRect);
4003      ARect := RectFromGdkRect(CRect);
4004      DevCtx.FillRect(ARect, hbr, True);
4005      // revert clip (whatever it is - null or valid region)
4006      SelectClipRGN(DC, {%H-}HRGN(OldRgn));
4007      Result := True;
4008    end;
4009  finally
4010    if hasClipping then
4011      gdk_region_destroy(OldRgn);
4012    RestoreDC(DC, GtkDC);
4013  end;
4014end;
4015
4016{------------------------------------------------------------------------------
4017  Function: Frame3d
4018  Params: -
4019  Returns: Nothing
4020
4021  Draws a 3d border in GTK native style.
4022 ------------------------------------------------------------------------------}
4023function TGtk2WidgetSet.Frame3d(DC: HDC; var ARect: TRect;
4024  const FrameWidth: integer; const Style: TBevelCut): Boolean;
4025var
4026  DevCtx: TGtkDeviceContext absolute DC;
4027  TheStyle: PGtkStyle;
4028  i, AWidth: integer;
4029  P: TPoint;
4030  gc1, gc2: PGdkGC;
4031  OldGC1Values, OldGC2Values: TGdkGCValues;
4032begin
4033  Result := IsValidDC(DC);
4034  if not Result or (FrameWidth = 0) then Exit;
4035  TheStyle := gtk_widget_get_style(GetStyleWidget(lgsButton));
4036  if TheStyle = nil then exit;
4037
4038  if DevCtx.HasTransf then
4039  begin
4040    ARect := DevCtx.TransfRectIndirect(ARect);
4041    DevCtx.TransfNormalize(ARect.Left, ARect.Right);
4042    DevCtx.TransfNormalize(ARect.Top, ARect.Bottom);
4043    P.X := FrameWidth;
4044    P.Y := FrameWidth;
4045    P := DevCtx.TransfExtentIndirect(P);
4046    AWidth := Abs(Min(P.X, P.Y));
4047  end else
4048    AWidth := FrameWidth;
4049
4050  case Style of
4051    bvNone:
4052      begin
4053        InflateRect(ARect, -AWidth, -AWidth);
4054        Exit;
4055      end;
4056    bvLowered:
4057      begin
4058        gc1 := TheStyle^.dark_gc[GTK_STATE_NORMAL];
4059        gc2 := TheStyle^.light_gc[GTK_STATE_NORMAL];
4060      end;
4061    bvRaised:
4062     begin
4063        gc1 := TheStyle^.light_gc[GTK_STATE_NORMAL];
4064        gc2 := TheStyle^.dark_gc[GTK_STATE_NORMAL];
4065     end;
4066    bvSpace:
4067     begin
4068        InflateRect(ARect, -AWidth, -AWidth);
4069        Exit;
4070     end;
4071  end;
4072
4073  with DevCtx do
4074  begin
4075    if WithChildWindows then
4076    begin
4077      gdk_gc_get_values(gc1, @OldGC1Values);
4078      gdk_gc_get_values(gc2, @OldGC2Values);
4079      gdk_gc_set_subwindow(gc1, GDK_INCLUDE_INFERIORS);
4080      gdk_gc_set_subwindow(gc2, GDK_INCLUDE_INFERIORS);
4081    end;
4082
4083    DevCtx.RemovePixbuf;
4084    for i := 1 to AWidth do
4085    begin
4086      gdk_draw_line(Drawable, gc1, ARect.Left + Offset.x, ARect.Top + Offset.y,
4087        ARect.Right + Offset.x - 2, ARect.Top + Offset.y);
4088      gdk_draw_line(Drawable, gc1, ARect.Left + Offset.x, ARect.Top + Offset.y,
4089        ARect.Left + Offset.x, ARect.Bottom + Offset.y - 2);
4090      gdk_draw_line(Drawable, gc2, ARect.Left + Offset.x, ARect.Bottom + Offset.y - 1,
4091        ARect.Right + Offset.x - 1, ARect.Bottom + Offset.y - 1);
4092      gdk_draw_line(Drawable, gc2, ARect.Right + Offset.x - 1, ARect.Top + Offset.y,
4093        ARect.Right + Offset.x - 1, ARect.Bottom + Offset.y - 1);
4094      // inflate the rectangle (! ARect will be returned to the user with this)
4095      InflateRect(ARect, -1, -1);
4096    end;
4097
4098    if WithChildWindows then
4099    begin
4100      gdk_gc_set_subwindow(gc1, OldGC1Values.subwindow_mode);
4101      gdk_gc_set_subwindow(gc2, OldGC2Values.subwindow_mode);
4102    end;
4103
4104  end;
4105end;
4106
4107{------------------------------------------------------------------------------
4108  function TGtk2WidgetSet.FrameRect(DC: HDC; const ARect: TRect;
4109    hBr: HBRUSH): Integer;
4110 ------------------------------------------------------------------------------}
4111function TGtk2WidgetSet.FrameRect(DC: HDC; const ARect: TRect;
4112  hBr: HBRUSH): Integer;
4113var
4114  DevCtx: TGtkDeviceContext absolute DC;
4115  DCOrigin: TPoint;
4116  R: TRect;
4117  OldBrush: HBrush;
4118begin
4119  Result:=0;
4120  if not IsValidDC(DC) then Exit;
4121  if not IsValidGDIObject(hBr) then Exit;
4122
4123  // Draw outline
4124  Result := 1;
4125  if {%H-}PGdiObject(hBr)^.IsNullBrush then Exit;
4126
4127  OldBrush := SelectObject(DC, hBr);
4128  DevCtx.SelectedColors := dcscCustom;
4129  EnsureGCColor(DC, dccGDIBrushColor, True, False);//Brush Color
4130
4131  R := ARect;
4132  LPtoDP(DC, R, 2);
4133
4134  DCOrigin := DevCtx.Offset;
4135  DevCtx.RemovePixbuf;
4136  gdk_draw_rectangle(DevCtx.Drawable, DevCtx.GC, 0,
4137                     R.Left + DCOrigin.X, R.Top + DCOrigin.Y,
4138                     R.Right-R.Left-1, R.Bottom-R.Top-1);
4139  SelectObject(DC, OldBrush);
4140end;
4141
4142{------------------------------------------------------------------------------
4143  Function: GetActiveWindow
4144  Params: none
4145  Returns:
4146
4147 ------------------------------------------------------------------------------}
4148function TGtk2WidgetSet.GetActiveWindow : HWND;
4149var
4150  TopList, List: PGList;
4151  Widget: PGTKWidget;
4152  Window: PGTKWindow;
4153begin
4154  // Default to 0
4155  Result := 0;
4156
4157  TopList := gdk_window_get_toplevels;
4158  List := TopList;
4159  while List <> nil do
4160  begin
4161    if (List^.Data <> nil) then
4162    begin
4163      gdk_window_get_user_data(PGDKWindow(List^.Data), Pgpointer(@Window));
4164      if GDK_IS_WINDOW(PGDKWindow(List^.Data)) and
4165        gdk_window_is_visible(PGDKWindow(List^.Data)) and
4166        gtk_is_window(Window) then
4167      begin
4168        Widget := Window^.focus_widget;
4169        if Widget=nil then Widget:=PGtkWidget(Window);
4170        //DebugLn('TGtk2WidgetSet.GetActiveWindow Window=',GetWidgetDebugReport(PgtkWidget(Window)),' Window^.focus_widget= ',GetWidgetDebugReport(Window^.focus_widget));
4171
4172        if (Widget <> nil) and gtk_widget_has_focus(Widget) then
4173        begin
4174          // return the window
4175          Result := HWND({%H-}PtrUInt(GetMainWidget(PGtkWidget(Window))));
4176          //DebugLn('TGtk2WidgetSet.GetActiveWindow Result=',GetWidgetDebugReport(PgtkWidget(Result)));
4177          Break;
4178        end;
4179      end;
4180    end;
4181    list := g_list_next(list);
4182  end;
4183  if TopList <> nil
4184  then g_list_free(TopList);
4185end;
4186
4187function TGtk2WidgetSet.GetForegroundWindow: HWND;
4188begin
4189  Result:=0;
4190  {$IFDEF HASX}
4191  Result:=X11GetActiveWindow;
4192  {$ENDIF}
4193end;
4194
4195{------------------------------------------------------------------------------
4196  Function: GetDIBits
4197  Params:
4198  Returns:
4199
4200 ------------------------------------------------------------------------------}
4201function TGtk2WidgetSet.GetDIBits(DC: HDC; Bitmap: HBitmap; StartScan, NumScans: UINT;
4202  Bits: Pointer; var BitInfo: BitmapInfo; Usage: UINT): Integer;
4203begin
4204  Result := 0;
4205  if IsValidGDIObject(Bitmap)
4206  then begin
4207    case {%H-}PGDIObject(Bitmap)^.GDIType of
4208      gdiBitmap:
4209        Result := InternalGetDIBits(DC, Bitmap, StartScan, NumScans, -1, Bits,
4210                                      BitInfo, Usage, True);
4211      else
4212        DebugLn('WARNING: [TGtk2WidgetSet.GetDIBits] not a Bitmap!');
4213    end;
4214  end
4215  else
4216    DebugLn('WARNING: [TGtk2WidgetSet.GetDIBits] invalid Bitmap!');
4217end;
4218
4219{------------------------------------------------------------------------------
4220  Function: GetBitmapBits
4221  Params:
4222  Returns:
4223
4224 ------------------------------------------------------------------------------}
4225function TGtk2WidgetSet.GetBitmapBits(Bitmap: HBITMAP; Count: Longint;  Bits: Pointer): Longint;
4226var
4227  BitInfo : tagBitmapInfo;
4228begin
4229  Result := 0;
4230  if IsValidGDIObject(Bitmap)
4231  then begin
4232    case {%H-}PGDIObject(Bitmap)^.GDIType of
4233      gdiBitmap:
4234        Result := InternalGetDIBits(0, Bitmap, 0, 0, Count, Bits, BitInfo, 0, False);
4235      else
4236        DebugLn('WARNING: [TGtk2WidgetSet.GetBitmapBits] not a Bitmap!');
4237    end;
4238  end
4239  else
4240    DebugLn('WARNING: [TGtk2WidgetSet.GetBitmapBits] invalid Bitmap!');
4241end;
4242
4243function TGtk2WidgetSet.GetBkColor(DC: HDC): TColorRef;
4244var
4245  DevCtx: TGtkDeviceContext absolute DC;
4246begin
4247  Result := CLR_INVALID;
4248  if IsValidDC(DC) then
4249    Result := DevCtx.CurrentBackColor.ColorRef;
4250end;
4251
4252{------------------------------------------------------------------------------
4253  Function: GetCapture
4254  Params:  none
4255  Returns: Nothing
4256
4257
4258 ------------------------------------------------------------------------------}
4259function TGtk2WidgetSet.GetCapture: HWND;
4260var
4261  Widget: PGtkWidget;
4262  AWindow: PGtkWindow;
4263  IsModal: gboolean;
4264begin
4265  Widget:=gtk_grab_get_current;
4266  // for the LCL a modal window is not capturing
4267  if Widget<>nil then begin
4268    if GtkWidgetIsA(Widget,GTK_TYPE_WINDOW) then begin
4269      AWindow:=PGtkWindow(Widget);
4270      IsModal:=gtk_window_get_modal(AWindow);
4271      if IsModal then
4272        Widget:=nil;
4273    end;
4274  end;
4275  Result := HWnd({%H-}PtrUInt(Widget));
4276end;
4277
4278{------------------------------------------------------------------------------
4279  Function: GetCaretPos
4280  Params:  lpPoint: The caretposition
4281  Returns: True if succesful
4282
4283 ------------------------------------------------------------------------------}
4284function TGtk2WidgetSet.GetCaretPos(var lpPoint: TPoint): Boolean;
4285var
4286  //FocusObject: PGTKObject;
4287  modmask : TGDKModifierType;
4288begin
4289  {$IFDEF DebugGDKTraps}
4290  BeginGDKErrorTrap;
4291  {$ENDIF}
4292  gdk_window_get_pointer(nil,@lpPoint.X,@lpPoint.y,@modmask);
4293  {$IFDEF DebugGDKTraps}
4294  EndGDKErrorTrap;
4295  {$ENDIF}
4296  Result := True;
4297end;
4298
4299{------------------------------------------------------------------------------
4300  function TGtk2WidgetSet.GetCaretRespondToFocus(handle: HWND;
4301    var ShowHideOnFocus: boolean): Boolean;
4302 ------------------------------------------------------------------------------}
4303function TGtk2WidgetSet.GetCaretRespondToFocus(handle: HWND;
4304  var ShowHideOnFocus: boolean): Boolean;
4305begin
4306  if handle<>0 then begin
4307    if gtk_type_is_a({%H-}g_object_type({%H-}PGTKObject(handle)), GTKAPIWidget_GetType)
4308    then begin
4309      GTKAPIWidget_GetCaretRespondToFocus({%H-}PGTKAPIWidget(handle),
4310        ShowHideOnFocus);
4311      Result:=true;
4312    end
4313    else begin
4314      Result := False;
4315    end;
4316  end else
4317    Result:=false;
4318end;
4319
4320{------------------------------------------------------------------------------
4321  Function: GetCharABCWidths        pbd
4322  Params:  Don't care yet
4323  Returns: False so that the font cache in the newest mwEdit will use
4324           TextMetrics info which is working already
4325 ------------------------------------------------------------------------------}
4326function TGtk2WidgetSet.GetCharABCWidths(DC: HDC; p2, p3: UINT;
4327  const ABCStructs): Boolean;
4328begin
4329  Result := False;
4330end;
4331
4332{------------------------------------------------------------------------------
4333  Function: GetClientBounds
4334  Params: handle:
4335          Result:
4336  Returns: true on success
4337
4338  Returns the client bounds of a control. The client bounds is the rectangle of
4339  the inner area of a control, where the child controls are visible. The
4340  coordinates are relative to the control's left and top.
4341 ------------------------------------------------------------------------------}
4342function TGtk2WidgetSet.GetClientBounds(handle : HWND; var ARect : TRect) : Boolean;
4343var
4344  Widget, ClientWidget: PGtkWidget;
4345  CurGDKWindow: PGdkWindow;
4346  ClientOrigin: TPoint;
4347  ClientWindow, MainWindow: PGdkWindow;
4348begin
4349  Result := False;
4350  if Handle = 0 then Exit;
4351  Widget := {%H-}pgtkwidget(Handle);
4352  ClientWidget := GetFixedWidget(Widget);
4353  if (ClientWidget <> Widget) then begin
4354    ClientWindow:=GetControlWindow(ClientWidget);
4355    MainWindow:=GetControlWindow(Widget);
4356    if MainWindow<>ClientWindow then begin
4357      // widget and client are on different gdk windows
4358      if (GTK_WIDGET_NO_WINDOW(ClientWidget)) then begin
4359        // ClientWidget is a sub widget
4360        ARect.Left:=ClientWidget^.allocation.x;
4361        ARect.Top:=ClientWidget^.allocation.y;
4362      end else begin
4363        // ClientWidget owns the gdkwindow
4364        ARect.Left:=0;
4365        ARect.Top:=0;
4366      end;
4367      CurGDKWindow:=ClientWindow;
4368      while (CurGDKWindow<>MainWindow) do
4369      begin
4370        if not GDK_IS_WINDOW(CurGDKWindow) then
4371          break;
4372        gdk_window_get_position(CurGDKWindow,@ClientOrigin.x,@ClientOrigin.y);
4373        inc(ARect.Left,ClientOrigin.x);
4374        inc(ARect.Top,ClientOrigin.y);
4375        CurGDKWindow:=gdk_window_get_parent(CurGDKWindow);
4376      end;
4377      if GTK_WIDGET_NO_WINDOW(Widget) then begin
4378        // Widget is a sub widget
4379        dec(ARect.Left,Widget^.allocation.x);
4380        dec(ARect.Top,Widget^.allocation.y);
4381      end;
4382      ARect.Right:=ARect.Left+ClientWidget^.Allocation.Width;
4383      ARect.Bottom:=ARect.Top+ClientWidget^.Allocation.Height;
4384
4385      Result:=true;
4386    end else if MainWindow<>nil then begin
4387      // both are on the same gdkwindow
4388      ARect.Left:=ClientWidget^.allocation.X-Widget^.allocation.X;
4389      ARect.Top:=ClientWidget^.allocation.Y-Widget^.allocation.Y;
4390      ARect.Right:=ARect.Left+ClientWidget^.allocation.Width;
4391      ARect.Bottom:=ARect.Top+ClientWidget^.allocation.Height;
4392      Result:=true;
4393    end;
4394  end;
4395  if not Result then begin
4396    with Widget^.Allocation do
4397      ARect := Rect(0,0,Width,Height);
4398  end;
4399  Result:=true;
4400end;
4401
4402{------------------------------------------------------------------------------
4403  Function: GetClientRect
4404  Params: handle:
4405          Result:
4406  Returns: true on success
4407
4408  Returns the client rectangle of a control. Left and Top are always 0.
4409  The client rectangle is the size of the inner area of a control, where the
4410  child controls are visible.
4411 ------------------------------------------------------------------------------}
4412function TGtk2WidgetSet.GetClientRect(handle : HWND; var ARect : TRect) : Boolean;
4413begin
4414  Result := false;
4415  if Handle = 0 then Exit;
4416  ARect := GetWidgetClientRect({%H-}PGtkWidget(Handle));
4417  Result := True;
4418end;
4419
4420{------------------------------------------------------------------------------
4421  Function: GetClipBox
4422  Params: dc, lprect
4423  Returns: Integer
4424
4425  Returns the smallest rectangle which includes the entire current
4426  Clipping Region, or if no Clipping Region is set, the current
4427  dimensions of the Drawable.
4428
4429  The result can be one of the following constants
4430      Error
4431      NullRegion
4432      SimpleRegion
4433      ComplexRegion
4434 ------------------------------------------------------------------------------}
4435function TGtk2WidgetSet.GetClipBox(DC : hDC; lpRect : PRect) : Longint;
4436var
4437  DevCtx: TGtkDeviceContext absolute DC;
4438
4439  CRect : TGDKRectangle;
4440  X, Y : Longint;
4441  DCOrigin: Tpoint;
4442begin
4443  // set default values
4444  Result := SIMPLEREGION;
4445  if lpRect <> nil then
4446    lpRect^ := Rect(0,0,0,0);
4447
4448  if not IsValidDC(DC)
4449  then begin
4450    Result := ERROR;
4451    Exit;
4452  end;
4453
4454  DCOrigin := DevCtx.Offset;
4455  if DevCtx.ClipRegion = nil then
4456  begin
4457    if (DevCtx.PaintRectangle.Left<>0)
4458    or (DevCtx.PaintRectangle.Top<>0)
4459    or (DevCtx.PaintRectangle.Right<>0)
4460    or (DevCtx.PaintRectangle.Bottom<>0) then
4461      lpRect^ := DevCtx.PaintRectangle
4462    else
4463    begin
4464      gdk_window_get_size(DevCtx.Drawable, @X, @Y);
4465      lpRect^ := Rect(0,0,X,Y);
4466    end;
4467    Result := SIMPLEREGION;
4468  end
4469  else
4470  begin
4471    Result := RegionType(DevCtx.ClipRegion^.GDIRegionObject);
4472    gdk_region_get_clipbox(DevCtx.ClipRegion^.GDIRegionObject, @CRect);
4473    lpRect^.Left   := CRect.X;
4474    lpRect^.Top    := CRect.Y;
4475    lpRect^.Right  := lpRect^.Left + CRect.Width;
4476    lpRect^.Bottom := lpRect^.Top + CRect.Height;
4477  end;
4478  DPtoLP(DC, lpRect^, 2);
4479  OffsetRect(lpRect^, -DCOrigin.X, -DCOrigin.Y);
4480end;
4481
4482{------------------------------------------------------------------------------
4483  Function: GetRGNBox
4484  Params: rgn, lprect
4485  Returns: Integer
4486
4487  Returns the smallest rectangle which includes the entire passed
4488  Region, if lprect is null then just returns RegionType.
4489
4490  The result can be one of the following constants
4491      Error
4492      NullRegion
4493      SimpleRegion
4494      ComplexRegion
4495
4496
4497 ------------------------------------------------------------------------------}
4498function TGtk2WidgetSet.GetRgnBox(RGN : HRGN; lpRect : PRect) : Longint;
4499var
4500  ClipR : TGDKRectangle;
4501begin
4502  Result := SIMPLEREGION;
4503  If lpRect <> nil then
4504    lpRect^ := Rect(0,0,0,0);
4505  If Not IsValidGDIObject(RGN) then
4506    Result := ERROR
4507  else begin
4508    Result := RegionType({%H-}PGDIObject(RGN)^.GDIRegionObject);
4509    If lpRect <> nil then begin
4510      gdk_region_get_clipbox({%H-}PGDIObject(RGN)^.GDIRegionObject,
4511        @ClipR);
4512      With lpRect^ do begin
4513        Left   := ClipR.X;
4514        Top    := ClipR.Y;
4515        Right  := ClipR.X + ClipR.Width;
4516        Bottom := ClipR.Y + ClipR.Height;
4517      end;
4518    end;
4519  end;
4520end;
4521
4522function TGtk2WidgetSet.GetROP2(DC: HDC): Integer;
4523begin
4524  if IsValidDC(DC)
4525  then Result := TGtkDeviceContext(DC).ROP2
4526  else Result := 0;
4527end;
4528
4529{------------------------------------------------------------------------------
4530  Function: GetClipRGN
4531  Params: dc, rgn
4532  Returns: Integer
4533
4534  Returns a copy of the current Clipping Region.
4535
4536  The result can be one of the following constants
4537     0 = no clipping set
4538     1 = ok
4539    -1 = error
4540 ------------------------------------------------------------------------------}
4541function TGtk2WidgetSet.GetClipRGN(DC: hDC; RGN: hRGN): Longint;
4542var
4543  DCOrigin: TPoint;
4544  ClipRegionWithDCOffset: PGdkRegion;
4545  CurRegionObject: PGdkRegion;
4546  ARect: TRect;
4547begin
4548  Result := SIMPLEREGION;
4549  If (not IsValidDC(DC)) then
4550    Result := ERROR
4551  else
4552  if Not IsValidGDIObject(RGN) then
4553  begin
4554    Result := ERROR;
4555    DebugLn('WARNING: [TGtk2WidgetSet.GetClipRGN] Invalid HRGN');
4556  end
4557  else
4558  if Assigned(TGtkDeviceContext(DC).ClipRegion) and
4559    not IsValidGDIObject(HGDIOBJ({%H-}PtrUInt(TGtkDeviceContext(DC).ClipRegion))) then
4560    Result := ERROR
4561  else with TGtkDeviceContext(DC) do
4562  begin
4563    CurRegionObject := nil;
4564    if Assigned(ClipRegion) then
4565      CurRegionObject := ClipRegion^.GDIRegionObject;
4566    ARect := Rect(0, 0, 0, 0);
4567    //debugln(['TGtk2WidgetSet.GetClipRGN ',GetWidgetDebugReport(Widget),' CurRegionObject=',Assigned(CurRegionObject),' DC=',dbgs(DC)]);
4568
4569    if Assigned(CurRegionObject) then begin
4570      // create a copy of the current clipregion
4571      ClipRegionWithDCOffset := gdk_region_copy(CurRegionObject);
4572      // move it to the DC offset
4573      // Example: if the ClipRegion is at 10,10 and the DCOrigin is at 10,10,
4574      //          then the ClipRegion must be moved to 0,0
4575      DCOrigin := Offset;
4576      gdk_region_offset(ClipRegionWithDCOffset, -DCOrigin.x, -DCOrigin.Y);
4577    end
4578    else
4579    begin
4580      // create a default clipregion
4581      GetClipBox(DC, @ARect);
4582      LPtoDP(DC, ARect, 2);
4583      ClipRegionWithDCOffset := CreateRectGDKRegion(ARect);
4584    end;
4585
4586    // free the old region in RGN
4587    if Assigned({%H-}PGdiObject(RGN)^.GDIRegionObject) then
4588      gdk_region_destroy({%H-}PGdiObject(RGN)^.GDIRegionObject);
4589    // set the new region in RGN
4590    {%H-}PGdiObject(RGN)^.GDIRegionObject := ClipRegionWithDCOffset;
4591
4592    Result := RegionType(ClipRegionWithDCOffset);
4593    //DebugLn('TGtk2WidgetSet.GetClipRGN B DC=',DbgS(DC),
4594    //  ' DCOrigin=',dbgs(DCOrigin),' RGN=',GDKRegionAsString(ClipRegionWithDCOffset),' Result=',dbgs(Result));
4595    If Result = NULLREGION then
4596      Result := 0
4597    else If Result <> ERROR then
4598      Result := 1;
4599  end;
4600  If Result = ERROR then
4601    Result := -1;
4602end;
4603
4604{------------------------------------------------------------------------------
4605  Function: GetCmdLineParamDescForInterface
4606  Params: none
4607  Returns: ansistring
4608
4609  Returns a description of the command line parameters, that are understood by
4610  the interface.
4611 ------------------------------------------------------------------------------}
4612function TGtk2WidgetSet.GetCmdLineParamDescForInterface: string;
4613  function b(const s: string): string;
4614  begin
4615    Result:=BreakString(s,75,22)+LineEnding+LineEnding;
4616  end;
4617
4618begin
4619  Result:=
4620     b(rsgtkOptionNoTransient)
4621    +b(rsgtkOptionModule)
4622    +b(rsgOptionFatalWarnings)
4623    +b(rsgtkOptionDebug)
4624    +b(rsgtkOptionNoDebug)
4625    +b(rsgdkOptionDebug)
4626    +b(rsgdkOptionNoDebug)
4627    +b(rsgtkOptionDisplay)
4628    +b(rsgtkOptionSync)
4629    +b(rsgtkOptionNoXshm)
4630    +b(rsgtkOptionName)
4631    +b(rsgtkOptionClass)
4632    +b(rsqtOptionDisableAccurateFrame);
4633end;
4634
4635{------------------------------------------------------------------------------
4636  Method: GetCurrentObject
4637  Params:
4638    DC - A handle to the DC
4639    uObjectType - The object type to be queried
4640  Returns: If the function succeeds, the return value is a handle to the specified object.
4641    If the function fails, the return value is NULL.
4642 ------------------------------------------------------------------------------}
4643
4644function TGtk2WidgetSet.GetCurrentObject(DC: HDC; uObjectType: UINT): HGDIOBJ;
4645var
4646  Gtk2DC: TGtkDeviceContext absolute DC;
4647begin
4648  Result := 0;
4649  if not GTK2WidgetSet.IsValidDC(DC) then
4650    Exit;
4651  case uObjectType of
4652    OBJ_BITMAP: Result := {%H-}HGDIOBJ(Gtk2DC.CurrentBitmap);
4653    OBJ_BRUSH: Result := {%H-}HGDIOBJ(Gtk2DC.CurrentBrush);
4654    OBJ_FONT: Result := {%H-}HGDIOBJ(Gtk2DC.CurrentFont);
4655    OBJ_PEN: Result := {%H-}HGDIOBJ(Gtk2DC.CurrentPen);
4656  end;
4657end;
4658
4659{------------------------------------------------------------------------------
4660  Function: GetCursorPos
4661  Params:  lpPoint: The cursorposition
4662  Returns: True if succesful
4663
4664 ------------------------------------------------------------------------------}
4665function TGtk2WidgetSet.GetCursorPos(var lpPoint: TPoint ): Boolean;
4666begin
4667  gdk_display_get_pointer(gdk_display_get_default(), nil, @lpPoint.X, @lpPoint.Y, nil);
4668  Result := True;
4669end;
4670
4671{------------------------------------------------------------------------------
4672  Function: GetDC
4673  Params:  none
4674  Returns: Nothing
4675
4676  hWnd is any widget.
4677  The DC will be created for the client area and without the child areas
4678  (they are clipped away). Child areas are all child gdkwindows
4679  (e.g. not TControls).
4680 ------------------------------------------------------------------------------}
4681function TGtk2WidgetSet.GetDC(hWnd: HWND): HDC;
4682begin
4683  Result:=CreateDCForWidget({%H-}PGtkWidget(hWnd),nil,false);
4684end;
4685
4686{------------------------------------------------------------------------------
4687  function TGtk2WidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
4688
4689
4690 ------------------------------------------------------------------------------}
4691function TGtk2WidgetSet.GetDeviceCaps(DC: HDC; Index: Integer): Integer;
4692var
4693  Visual: PGdkVisual;
4694
4695  function GetVisual: boolean;
4696  begin
4697    Visual:=nil;
4698    with TGtkDeviceContext(DC) do begin
4699      If Drawable <> nil then
4700        Visual:=gdk_window_get_visual(PGdkWindow(Drawable));
4701      if Visual = nil then
4702        Visual := GDK_Visual_Get_System;
4703    end;
4704    Result:=Visual<>nil;
4705  end;
4706
4707begin
4708  Result := -1;
4709  If DC = 0 then begin
4710    DC := GetDC(0);
4711    If DC = 0 then
4712      exit;
4713    Result := GetDeviceCaps(DC, Index);
4714    ReleaseDC(0, DC);
4715    exit;
4716  end;
4717  if not IsValidDC(DC) then exit;
4718  with TGtkDeviceContext(DC) do
4719  Case Index of
4720  HORZRES : { Horizontal width in pixels }
4721    If Drawable = nil then
4722      Result := GetSystemMetrics(SM_CXSCREEN)
4723    else
4724      gdk_drawable_get_size(Drawable, @Result, nil);
4725
4726  VERTRES : { Vertical height in pixels }
4727    If Drawable = nil then
4728      Result := GetSystemMetrics(SM_CYSCREEN)
4729    else
4730      gdk_drawable_get_size(Drawable, nil, @Result);
4731
4732  BITSPIXEL : { Number of used bits per pixel = depth }
4733    If Drawable = nil then
4734      Result := GDK_Visual_Get_System^.Depth
4735    else
4736      Result := gdk_drawable_get_depth(Drawable);
4737
4738  PLANES : { Number of planes }
4739    // ToDo
4740    Result := 1;
4741
4742  //For Size in MM, MM = (Pixels*100)/(PPI*25.4)
4743
4744  HORZSIZE : { Horizontal size in millimeters }
4745    Result := RoundToInt((GetDeviceCaps(DC, HORZRES) * 100) /
4746                    (GetDeviceCaps(DC, LOGPIXELSX) * 25.4));
4747
4748  VERTSIZE : { Vertical size in millimeters }
4749    Result := RoundToInt((GetDeviceCaps(DC, VERTRES) * 100) /
4750                    (GetDeviceCaps(DC, LOGPIXELSY) * 25.4));
4751
4752  //So long as gdk_screen_width_mm is acurate, these should be
4753  //acurate for Screen GDKDrawables. Once we get Metafiles
4754  //we will also have to add internal support for Papersizes etc..
4755
4756  LOGPIXELSX : { Logical pixels per inch in X }
4757    Result := ScreenInfo.PixelsPerInchX;
4758
4759  LOGPIXELSY : { Logical pixels per inch in Y }
4760    Result := ScreenInfo.PixelsPerInchY;
4761
4762  SIZEPALETTE: { number of entries in color palette }
4763    if GetVisual then
4764      Result:=Visual^.colormap_size
4765    else
4766      Result:=0;
4767
4768  NUMRESERVED: { number of reserverd colors in color palette }
4769    Result:=0;
4770
4771  else
4772    DebugLn('TGtk2WidgetSet.GetDeviceCaps not supported: Type=',dbgs(Index));
4773  end;
4774end;
4775
4776{------------------------------------------------------------------------------
4777  function GetDeviceSize(DC: HDC; var p: TPoint): boolean;
4778
4779  Retrieves the width and height of the device context in pixels.
4780 ------------------------------------------------------------------------------}
4781function TGtk2WidgetSet.GetDeviceSize(DC: HDC; var p: TPoint): boolean;
4782var
4783  DevCtx: TGtkDeviceContext absolute DC;
4784begin
4785  if not IsValidDC(DC) then Exit(False);
4786
4787  if DevCtx.Drawable <> nil
4788  then begin
4789    P := Point(0,0);
4790    gdk_window_get_size(PGdkWindow(DevCtx.Drawable), @P.X, @P.Y);
4791    Exit(True);
4792  end;
4793
4794  {$IFDEF RaiseExceptionOnNilPointers}
4795  RaiseGDBException('TGtk2WidgetSet.GetDeviceSize Window=nil');
4796  {$ENDIF}
4797  DebugLn('TGtk2WidgetSet.GetDeviceSize:', ' WARNING: DC ',DbgS(DC),' without gdkwindow.',
4798          ' Widget=',DbgS(DevCtx.Widget));
4799  Result := False;
4800end;
4801
4802{------------------------------------------------------------------------------
4803  function TGtk2WidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC;
4804    WindowHandle: HWND; var OriginDiff: TPoint): boolean;
4805
4806  Returns the origin of PaintDC relative to the window handle.
4807  Example:
4808    A PaintDC of a TButton at 20,10 with a DC Offset of 0,0 on a form and the
4809    WindowHandle is the form.
4810    Then OriginDiff is the difference between the Forms client origin
4811    and the PaintDC: 20,10.
4812 ------------------------------------------------------------------------------}
4813function TGtk2WidgetSet.GetDCOriginRelativeToWindow(PaintDC: HDC;
4814  WindowHandle: HWND; var OriginDiff: TPoint): boolean;
4815
4816var
4817  DevCtx: TGtkDeviceContext absolute PaintDC;
4818
4819  DCOrigin: TPoint;
4820  DCScreenOrigin: TPoint;
4821  WindowScreenOrigin: TPoint;
4822  Widget: PGtkWidget;
4823  DCWindow: PGdkWindow;
4824begin
4825  Result := false;
4826  OriginDiff := Point(0, 0);
4827  if not IsValidDC(PaintDC) then exit;
4828
4829  DCOrigin := DevCtx.Offset;
4830
4831  DCWindow := PGdkWindow(DevCtx.Drawable);
4832  gdk_window_get_origin(DCWindow, @(DCScreenOrigin.X), @(DCScreenOrigin.Y));
4833  inc(DCScreenOrigin.X, DCOrigin.X);
4834  inc(DCScreenOrigin.Y, DCOrigin.Y);
4835
4836  Widget := GetFixedWidget({%H-}PGtkWidget(WindowHandle));
4837  if Widget = nil then
4838    Widget := {%H-}PGtkWidget(WindowHandle);
4839
4840  gdk_window_get_origin(PGdkWindow(Widget^.window), @(WindowScreenOrigin.X), @(WindowScreenOrigin.Y));
4841
4842  OriginDiff.X := DCScreenOrigin.X - WindowScreenOrigin.X;
4843  OriginDiff.Y := DCScreenOrigin.Y - WindowScreenOrigin.Y;
4844  Result := True;
4845  //DebugLn(['TGtk2WidgetSet.GetDCOriginRelativeToWindow DCScreenOrigin=',dbgs(DCScreenOrigin),' WindowScreenOrigin=',dbgs(WindowScreenOrigin),' OriginDiff=',dbgs(OriginDiff)]);
4846end;
4847
4848{------------------------------------------------------------------------------
4849  Function: GetDesignerDC
4850  Params:  none
4851  Returns: Nothing
4852
4853  WindowHandle is any widget.
4854  The DC will be created for the client area including the child areas.
4855 ------------------------------------------------------------------------------}
4856function TGtk2WidgetSet.GetDesignerDC(WindowHandle: HWND): HDC;
4857begin
4858  //DebugLn('TGtk2WidgetSet.GetDesignerDC A');
4859  Result:=CreateDCForWidget({%H-}PGtkWidget(WindowHandle),nil,true);
4860end;
4861
4862{------------------------------------------------------------------------------
4863  Function: GetFocus
4864  Params:  none
4865  Returns: The handle of the window with focus
4866
4867  The GetFocus function retrieves the handle of the window that has the focus.
4868 ------------------------------------------------------------------------------}
4869function TGtk2WidgetSet.GetFocus: HWND;
4870var
4871  TopList, List: PGList;
4872  Widget: PGTKWidget;
4873  Window: PGTKWindow;
4874  Info: PWidgetInfo;
4875begin
4876  // Default to 0
4877  Result := 0;
4878
4879  {$IFDEF DebugGDKTraps}
4880  BeginGDKErrorTrap;
4881  {$ENDIF}
4882
4883  TopList := gdk_window_get_toplevels;
4884  List := TopList;
4885  while List <> nil do
4886  begin
4887    if (List^.Data <> nil)
4888    then begin
4889      gdk_window_get_user_data(PGDKWindow(List^.Data), Pgpointer(@Window));
4890
4891      if gtk_is_window(Window)
4892      then begin
4893        Widget := Window^.focus_widget;
4894        {$IFDEF DebugLCLComponents}
4895        if DebugGtkWidgets.IsDestroyed(Widget) then begin
4896          DebugLn(['TGtk2WidgetSet.GetFocus Window^.focus_widget was already destroyed:']);
4897          DebugLn(DebugGtkWidgets.GetInfo(Widget,true));
4898        end;
4899        {$ENDIF}
4900
4901        if (Widget <> nil) and gtk_widget_has_focus(Widget)
4902        then begin
4903          Info:=GetWidgetInfo(PGtkWidget(Window));
4904          if (Info=nil) or (not (wwiDeactivating in Info^.Flags)) then
4905            Result := HWND({%H-}PtrUInt(GetMainWidget(Widget)));
4906          Break;
4907        end;
4908      end;
4909    end;
4910    list := g_list_next(list);
4911  end;
4912
4913  if TopList <> nil
4914  then g_list_free(TopList);
4915  {$IFDEF VerboseFocus}
4916  DebugLn('TGtk2WidgetSet.GetFocus: Result=',dbgHex(Result));
4917  {$ENDIF}
4918
4919  {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
4920end;
4921
4922{------------------------------------------------------------------------------
4923  function GetFontLanguageInfo(DC: HDC): DWord; override;
4924 ------------------------------------------------------------------------------}
4925function TGtk2WidgetSet.GetFontLanguageInfo(DC: HDC): DWord;
4926begin
4927  Result := 0;
4928  If IsValidDC(DC) then
4929  with TGtkDeviceContext(DC) do begin
4930    UpdateDCTextMetric(TGtkDeviceContext(DC));
4931    if TGtkDeviceContext(DC).DCTextMetric.IsDoubleByteChar then
4932      inc(Result,GCP_DBCS);
4933  end;
4934end;
4935
4936{------------------------------------------------------------------------------
4937  Function: GetKeyState
4938  Params:  nVirtKey: The requested key
4939  Returns: If the function succeeds, the return value specifies the status of
4940           the given virtual key. If the high-order bit is 1, the key is down;
4941           otherwise, it is up. If the low-order bit is 1, the key is toggled.
4942
4943  The GetKeyState function retrieves the status of the specified virtual key.
4944 ------------------------------------------------------------------------------}
4945function TGtk2WidgetSet.GetKeyState(nVirtKey: Integer): Smallint;
4946const
4947  StateDown    = -128; // $FF80
4948  StateToggled = 1;
4949  KEYSTATE: array[Boolean] of Smallint = (0, StateDown);
4950  TOGGLESTATE: array[Boolean] of Smallint = (0, StateToggled);
4951  GDK_BUTTON_MASKS: array[VK_LBUTTON..VK_XBUTTON2] of guint32 =
4952  (
4953{ VK_LBUTTON  } GDK_BUTTON1_MASK,
4954{ VK_RBUTTON  } GDK_BUTTON3_MASK,
4955{ VK_CANCEL   } 0,
4956{ VK_MBUTTON  } GDK_BUTTON2_MASK,
4957{ VK_XBUTTON1 } GDK_BUTTON4_MASK,
4958{ VK_XBUTTON2 } GDK_BUTTON5_MASK
4959  );
4960var
4961  GdkModMask: TGdkModifierType;
4962  x, y: gint;
4963begin
4964  case nVirtKey of
4965    // remap
4966    VK_LSHIFT:   nVirtKey := VK_SHIFT;
4967    VK_LCONTROL: nVirtKey := VK_CONTROL;
4968    VK_LMENU:    nVirtKey := VK_MENU;
4969  end;
4970
4971  {$IFDEF Use_KeyStateList}
4972  Result := KEYSTATE[FKeyStateList_.IndexOf({%H-}Pointer(PtrUInt(nVirtKey))) >=0];
4973  {$ELSE}
4974  Implement this
4975  {$ENDIF}
4976
4977  // try extended keys
4978  if Result = 0
4979  then begin
4980    {$IFDEF Use_KeyStateList}
4981    Result := KEYSTATE[FKeyStateList_.IndexOf({%H-}Pointer(PtrUInt(nVirtKey or KEYMAP_EXTENDED))) >=0];
4982    {$ELSE}
4983    Implement this
4984    {$ENDIF}
4985  end;
4986
4987  {$IFDEF Use_KeyStateList}
4988  // add toggle
4989  Result := Result or TOGGLESTATE[FKeyStateList_.IndexOf({%H-}Pointer(
4990                                  PtrUInt(nVirtKey or KEYMAP_TOGGLE))) >=0];
4991  // If there are tons of new keyboard errors this is probably the cause
4992  GdkModMask := gtk_accelerator_get_default_mod_mask;
4993  if (Result and StateDown) <> 0 then
4994  begin
4995    if (nVirtKey = VK_CONTROL) and (GdkModMask and GDK_CONTROL_MASK = 0) then
4996      Result := Result and not StateDown;
4997    //if (nVirtKey = VK_SHIFT) and (GtkModMask and GDK_SHIFT_MASK = 0 then
4998    //  Result := Result and not StateDown;
4999  end;
5000  {$ENDIF}
5001
5002  // Mouse buttons. Toggle state is not tracked
5003  if nVirtKey in [VK_LBUTTON, VK_RBUTTON, VK_MBUTTON..VK_XBUTTON2] then
5004  begin
5005    gdk_display_get_pointer(gdk_display_get_default, nil,
5006      @x, @y, @GdkModMask);
5007    Result := Result or KEYSTATE[GdkModMask and GDK_BUTTON_MASKS[nVirtKey] <> 0]
5008  end;
5009end;
5010
5011function TGtk2WidgetSet.GetMapMode(DC: HDC): Integer;
5012var
5013  DevCtx: TGtkDeviceContext absolute DC;
5014begin
5015  if IsValidDC(DC) then
5016    Result := DevCtx.MapMode
5017  else
5018    Result := 0;
5019end;
5020
5021function TGtk2WidgetSet.GetMonitorInfo(Monitor: HMONITOR; lpmi: PMonitorInfo): Boolean;
5022var
5023  MonitorRect: TGdkRectangle;
5024  {$IFDEF HasX}
5025  x, y, w, h: gint;
5026  {$ENDIF}
5027begin
5028  Result := (lpmi <> nil) and (lpmi^.cbSize >= SizeOf(TMonitorInfo)) or (Monitor = 0);
5029  if not Result then Exit;
5030  Dec(Monitor);
5031  gdk_screen_get_monitor_geometry(gdk_screen_get_default, Monitor, @MonitorRect);
5032  with MonitorRect do
5033    lpmi^.rcMonitor := Bounds(x, y, width, height);
5034  // there is no way to determine workarea in gtk
5035  {$IFDEF HasX}
5036  if XGetWorkarea(x, y, w, h) <> -1 then
5037    lpmi^.rcWork := Bounds(Max(MonitorRect.x, x), Max(MonitorRect.y, y),
5038                  Min(MonitorRect.Width, w), Min(MonitorRect.Height, h))
5039  else
5040  {$ENDIF}
5041  lpmi^.rcWork := lpmi^.rcMonitor;
5042  // since gtk-2.20 we have correct api to get primary monitor. issue #32464
5043  if Assigned(gdk_screen_get_primary_monitor) then
5044  begin
5045    if (Monitor = gdk_screen_get_primary_monitor(gdk_screen_get_default)) then
5046      lpmi^.dwFlags := MONITORINFOF_PRIMARY
5047    else
5048      lpmi^.dwFlags := 0;
5049  end else
5050  begin
5051    // gtk2 below 2.20
5052    if Monitor = 0 then
5053      lpmi^.dwFlags := MONITORINFOF_PRIMARY
5054    else
5055      lpmi^.dwFlags := 0;
5056  end;
5057end;
5058
5059{------------------------------------------------------------------------------
5060  Function: GetObject
5061  Params:  GDIObj - handle, BufSize - size of Buf argument, Buf - buffer
5062  Returns: Size of buffer
5063 ------------------------------------------------------------------------------}
5064function TGtk2WidgetSet.GetObject(GDIObj: HGDIOBJ; BufSize: Integer; Buf: Pointer): Integer;
5065  function GetObject_Bitmap: Integer;
5066  var
5067    NumColors, ImageDepth: Longint;
5068    BitmapSection : TDIBSECTION;
5069  begin
5070    if Buf = nil
5071    then begin
5072      Result := SizeOf(TDIBSECTION);
5073      Exit;
5074    end;
5075
5076    Result := 0;
5077
5078    FillChar(BitmapSection{%H-}, SizeOf(TDIBSECTION), 0);
5079    with {%H-}PGDIObject(GDIObj)^, BitmapSection,
5080      BitmapSection.dsBm, BitmapSection.dsBmih
5081    do begin
5082      {dsBM - BITMAP}
5083      bmType := LeToN($4D42);
5084      bmWidth := 0 ;
5085      bmHeight := 0;
5086      {bmWidthBytes: Longint;}
5087      bmPlanes := 1;//Does Bitmap Format support more?
5088      bmBitsPixel := 1;
5089      bmBits := nil;
5090
5091      {dsBmih - BITMAPINFOHEADER}
5092      biSize := 40;
5093      biWidth := 0;
5094      biHeight := 0;
5095      biPlanes := bmPlanes;
5096      biBitCount := 1;
5097
5098      biCompression := 0;
5099      biSizeImage := 0;
5100
5101      biXPelsPerMeter := 0;
5102      biYPelsPerMeter := 0;
5103
5104      biClrUsed   := 0;
5105      biClrImportant := 0;
5106
5107      {dsBitfields: array[0..2] of DWORD;
5108      dshSection: THandle;
5109      dsOffset: DWORD;}
5110
5111      {$ifdef DebugGDKTraps}BeginGDKErrorTrap;{$endif}
5112      case GDIBitmapType of
5113        gbBitmap:
5114          if GDIBitmapObject <> nil
5115          then begin
5116            gdk_window_get_size(GDIBitmapObject, @biWidth, @biHeight);
5117            NumColors := 2;
5118            biBitCount := 1;
5119          end;
5120        gbPixmap:
5121          if GDIPixmapObject.Image <> nil
5122          then begin
5123            gdk_drawable_get_size(GDIPixmapObject.Image, @biWidth, @biHeight);
5124            ImageDepth := gdk_drawable_get_depth(GDIPixmapObject.Image);
5125            biBitCount := ImageDepth;
5126          end;
5127        gbPixbuf:
5128          if GDIPixbufObject <> nil
5129          then begin
5130            biWidth := gdk_pixbuf_get_width(GDIPixbufObject);
5131            biHeight := gdk_pixbuf_get_height(GDIPixbufObject);
5132            biBitCount := gdk_pixbuf_get_bits_per_sample(GDIPixbufObject) * gdk_pixbuf_get_n_channels(GDIPixbufObject);
5133          end;
5134      end;
5135
5136      if Visual = nil
5137      then begin
5138        Visual := gdk_visual_get_best_with_depth(biBitCount);
5139        if Visual = nil
5140        then  { Depth not supported }
5141          Visual := gdk_visual_get_system;
5142        SystemVisual := True; { This visual should not be referenced }
5143
5144        if Colormap <> nil then
5145          gdk_colormap_unref(Colormap);
5146        ColorMap := gdk_colormap_new(Visual, GdkTrue);
5147      end
5148      else
5149        biBitCount := Visual^.Depth;
5150
5151      {$ifdef DebugGDKTraps}EndGDKErrorTrap;{$enDIF}
5152
5153      if biBitCount < 16 then
5154        NumColors := Colormap^.Size;
5155
5156      biSizeImage := (((biBitCount*biWidth+31) shr 5) shl 2)*biHeight;
5157
5158      if GetSystemMetrics(SM_CXSCREEN) >= biWidth then
5159        biXPelsPerMeter := GetDeviceCaps(0, LOGPIXELSX)
5160      else
5161        biXPelsPerMeter :=
5162          RoundToInt((single(biWidth) / GetSystemMetrics(SM_CXSCREEN)) *
5163                GetDeviceCaps(0, LOGPIXELSX));
5164
5165      if GetSystemMetrics(SM_CYSCREEN) >= biHeight then
5166        biYPelsPerMeter := GetDeviceCaps(0, LOGPIXELSY)
5167      else
5168        biYPelsPerMeter :=
5169          RoundToInt((Single(biHeight) / GetSystemMetrics(SM_CYSCREEN))*
5170                GetDeviceCaps(0, LOGPIXELSY));
5171
5172      bmWidth := biWidth;
5173      bmHeight := biHeight;
5174      bmBitsPixel := biBitCount;
5175
5176      //Need to retrieve actual Number of Colors if Indexed Image
5177      if bmBitsPixel < 16
5178      then begin
5179        biClrUsed   := NumColors;
5180        biClrImportant := biClrUsed;
5181      end;
5182    end;
5183
5184    if BufSize >= SizeOf(BitmapSection)
5185    then begin
5186      PDIBSECTION(Buf)^ := BitmapSection;
5187      Result := SizeOf(TDIBSECTION);
5188    end
5189    else if BufSize>0
5190    then begin
5191      Move(BitmapSection,Buf^,BufSize);
5192      Result := BufSize;
5193    end;
5194  end;
5195
5196var
5197  GDIObject: PGDIObject absolute GDIObj;
5198  ALogPen: PLogPen absolute Buf;
5199  AExtLogPen: PExtLogPen absolute Buf;
5200  AFont: PPangoLayout;
5201  AFontName: String;
5202  PangoDesc: PPangoFontDescription;
5203  i, RequiredSize: Integer;
5204  AFontSize: gint;
5205begin
5206  Result := 0;
5207  if not IsValidGDIObject(GDIObj) then Exit;
5208
5209  case GDIObject^.GDIType of
5210    gdiBitmap:
5211      Result := GetObject_Bitmap;
5212    gdiBrush:
5213      begin
5214        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetObject] gdiBrush');
5215      end;
5216    gdiFont:
5217      begin
5218        if Buf = nil
5219        then begin
5220          Result := SizeOf(GDIObject^.LogFont);
5221          Exit;
5222        end;
5223        if BufSize >= SizeOf(GDIObject^.LogFont) then
5224        begin
5225          PLogfont(Buf)^ := GDIObject^.LogFont;
5226          Result:= SizeOf(TLogFont);
5227          if IsFontNameDefault(GDIObject^.LogFont.lfFaceName) then
5228          begin
5229            AFontName := GetDefaultFontName;
5230
5231            if (AFontName = '') or IsFontNameDefault(AFontName) then
5232            begin
5233              AFont := GetDefaultGtkFont(False);
5234              if PANGO_IS_LAYOUT(AFont) then
5235              begin
5236                PangoDesc := pango_layout_get_font_description(AFont);
5237                if PangoDesc = nil then
5238                  PangoDesc := pango_context_get_font_description(pango_layout_get_context(AFont));
5239                AFontName := StrPas(pango_font_description_get_family(PangoDesc));
5240              end;
5241            end;
5242
5243            if AFontName <> '' then
5244              PLogfont(Buf)^.lfFaceName := AFontName;
5245          end;
5246
5247          if (GDIObject^.GDIFontObject <> nil) then
5248          begin
5249            AFont := GDIObject^.GDIFontObject;
5250            if PANGO_IS_LAYOUT(AFont) then
5251            begin
5252              PangoDesc := pango_layout_get_font_description(GDIObject^.GDIFontObject);
5253              if PangoDesc = nil then
5254                PangoDesc := pango_context_get_font_description(pango_layout_get_context(AFont));
5255
5256              AFontSize := pango_font_description_get_size(PangoDesc);
5257              if not pango_font_description_get_size_is_absolute(PangoDesc) then
5258                AFontSize := MulDiv(AFontSize, Screen.PixelsPerInch, 72 * PANGO_SCALE)
5259              else
5260                AFontSize := AFontSize div PANGO_SCALE;;
5261
5262              PLogfont(Buf)^.lfHeight := AFontSize;
5263            end;
5264          end;
5265        end else
5266        if BufSize > 0 then
5267        begin
5268          Move(GDIObject^.LogFont,Buf^,BufSize);
5269          Result:=BufSize;
5270        end;
5271      end;
5272    gdiPen:
5273      begin
5274        if GDIObject^.IsExtPen then
5275        begin
5276          RequiredSize := SizeOf(TExtLogPen);
5277          if GDIObject^.GDIPenDashesCount > 1 then
5278            RequiredSize := RequiredSize + (GDIObject^.GDIPenDashesCount - 1) * SizeOf(DWord);
5279
5280          if Buf = nil then
5281            Result := RequiredSize
5282          else
5283          if BufSize >= RequiredSize then
5284          begin
5285            Result := RequiredSize;
5286
5287            AExtLogPen^.elpPenStyle := GDIObject^.GDIPenStyle;
5288            AExtLogPen^.elpWidth := GDIObject^.GDIPenWidth;
5289            AExtLogPen^.elpBrushStyle := BS_SOLID;
5290            AExtLogPen^.elpColor := GDIObject^.GDIPenColor.ColorRef;
5291            AExtLogPen^.elpHatch := 0;
5292            AExtLogPen^.elpNumEntries := GDIObject^.GDIPenDashesCount;
5293            if GDIObject^.GDIPenDashesCount > 0 then
5294            begin
5295              for i := 0 to GDIObject^.GDIPenDashesCount - 1 do
5296                PDWord(@AExtLogPen^.elpStyleEntry)[i] := GDIObject^.GDIPenDashes[i];
5297            end
5298            else
5299              AExtLogPen^.elpStyleEntry[0] := 0;
5300          end;
5301        end
5302        else
5303        begin
5304          if Buf = nil then
5305            Result := SizeOf(TLogPen)
5306          else
5307          if BufSize >= SizeOf(TLogPen) then
5308          begin
5309            Result := SizeOf(TLogPen);
5310            ALogPen^.lopnColor := GDIObject^.GDIPenColor.ColorRef;
5311            ALogPen^.lopnWidth := Point(GDIObject^.GDIPenWidth, 0);
5312            ALogPen^.lopnStyle := GDIObject^.GDIPenStyle;
5313          end;
5314        end;
5315      end;
5316    gdiRegion:
5317      begin
5318        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetObject] gdiRegion');
5319      end;
5320  else
5321    DebugLn('WARNING: [TGtk2WidgetSet.GetObject] Unknown type %d', [Integer(GDIObject^.GDIType)]);
5322  end;
5323end;
5324
5325{------------------------------------------------------------------------------
5326  Function: GetParent
5327  Params: Handle:
5328  Returns:
5329
5330 ------------------------------------------------------------------------------}
5331function TGtk2WidgetSet.GetParent(Handle : HWND): HWND;
5332begin
5333  if Handle <> 0 then
5334    Result := {%H-}HWnd({%H-}PGtkWidget(Handle)^.Parent)
5335  else
5336    Result := 0;
5337end;
5338
5339
5340{------------------------------------------------------------------------------
5341  Function: GetProp
5342  Params: Handle: Str
5343  Returns: Pointer
5344
5345 ------------------------------------------------------------------------------}
5346function TGtk2WidgetSet.GetProp(Handle : hwnd; Str : PChar): Pointer;
5347Begin
5348  Result := g_object_get_data({%H-}PGObject(Handle),Str);
5349end;
5350
5351{------------------------------------------------------------------------------
5352  function TGtk2WidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer): integer;
5353
5354  Returns the current width of the scrollbar of the widget.
5355 ------------------------------------------------------------------------------}
5356function TGtk2WidgetSet.GetScrollBarSize(Handle: HWND; BarKind: Integer): integer;
5357var
5358  Widget, ScrollWidget, BarWidget: PGtkWidget;
5359begin
5360  Result:=0;
5361  Widget:={%H-}PGtkWidget(Handle);
5362  if GtkWidgetIsA(Widget,GTK_TYPE_SCROLLED_WINDOW) then begin
5363    ScrollWidget:=Widget;
5364  end else begin
5365    ScrollWidget:=PGtkWidget(g_object_get_data(PGObject(Widget),odnScrollArea));
5366  end;
5367  if ScrollWidget=nil then exit;
5368  if BarKind=SM_CYVSCROLL then begin
5369    BarWidget:=PGtkScrolledWindow(ScrollWidget)^.vscrollbar;
5370    if BarWidget<>nil then
5371      Result:=BarWidget^.Requisition.Width;
5372  end else begin
5373    BarWidget:=PGtkScrolledWindow(ScrollWidget)^.hscrollbar;
5374    if BarWidget<>nil then
5375      Result:=BarWidget^.Requisition.Height;
5376  end;
5377end;
5378
5379{------------------------------------------------------------------------------
5380  function TGtk2WidgetSet.GetScrollbarVisible(Handle: HWND;
5381    SBStyle: Integer): boolean;
5382 ------------------------------------------------------------------------------}
5383function TGtk2WidgetSet.GetScrollbarVisible(Handle: HWND; SBStyle: Integer): boolean;
5384var
5385  Widget, ScrollWidget, BarWidget: PGtkWidget;
5386begin
5387  Result:=false;
5388  if Handle=0 then exit;
5389  Widget:={%H-}PGtkWidget(Handle);
5390  if GtkWidgetIsA(Widget,GTK_TYPE_SCROLLED_WINDOW) then begin
5391    ScrollWidget:=Widget;
5392  end else begin
5393    ScrollWidget:=PGtkWidget(g_object_get_data(PGObject(Widget),odnScrollArea));
5394  end;
5395  if ScrollWidget=nil then exit;
5396  if SBStyle=SB_VERT then begin
5397    BarWidget:=PGtkScrolledWindow(ScrollWidget)^.vscrollbar;
5398  end else begin
5399    BarWidget:=PGtkScrolledWindow(ScrollWidget)^.hscrollbar;
5400  end;
5401  if BarWidget<>nil then
5402    Result:=GTK_WIDGET_VISIBLE(BarWidget);
5403end;
5404
5405{------------------------------------------------------------------------------
5406  Function: GetScrollInfo
5407  Params:  Handle, BarFlag, ScrollInfo
5408  Returns: Nothing
5409
5410 ------------------------------------------------------------------------------}
5411function TGtk2WidgetSet.GetScrollInfo(Handle: HWND; SBStyle: Integer;
5412  var ScrollInfo: TScrollInfo): Boolean;
5413var
5414  Adjustment: PGtkAdjustment;
5415  Scroll : PGTKWidget;
5416  IsScrollWindow: Boolean;
5417begin
5418  Result := false;
5419  if (Handle = 0) then exit;
5420
5421
5422  Scroll := g_object_get_data({%H-}PGObject(Handle), odnScrollArea);
5423  if GtkWidgetIsA(Scroll, gtk_scrolled_window_get_type)
5424  then begin
5425    IsScrollWindow := True;
5426  end
5427  else begin
5428    Scroll := {%H-}PGTKWidget(Handle);
5429    IsScrollWindow := GtkWidgetIsA(Scroll, gtk_scrolled_window_get_type);
5430  end;
5431
5432  Adjustment := nil;
5433
5434  case SBStyle of
5435    SB_HORZ:
5436      if IsScrollWindow
5437      then begin
5438        Adjustment := gtk_scrolled_window_get_hadjustment(
5439                         PGTKScrolledWindow(Scroll));
5440      end
5441      else if GtkWidgetIsA(PGtkWidget(Scroll),gtk_clist_get_type)
5442      then begin
5443        //clist
5444        {TODO check is this is needed for listviews}
5445        DebugLn('[GetScrollInfo] Possible obsolete get use of CList (Listview ?)');
5446        Adjustment := gtk_clist_get_hadjustment(PgtkCList(Scroll));
5447      end
5448      // obsolete stuff
5449      else if GtkWidgetIsA(PGtkWidget(Scroll),gtk_hscrollbar_get_type)
5450      then begin
5451        // this one shouldn't be possible, scrolbar messages are sent to the CTL
5452        DebugLN('!!! direct SB_HORZ get call to scrollbar');
5453        Adjustment :=  PgtkhScrollBar(Scroll)^.Scrollbar.Range.Adjustment;
5454      end;
5455
5456    SB_VERT:
5457      if GtkWidgetIsA(PGtkWidget(Scroll),gtk_scrolled_window_get_type)
5458      then begin
5459        Adjustment := gtk_scrolled_window_get_vadjustment(
5460                         PGTKScrolledWindow(Scroll));
5461      end
5462      else if GtkWidgetIsA(PGtkWidget(Scroll), gtk_clist_get_type)
5463      then begin
5464        //clist
5465        //TODO: check is this is needed for listviews
5466        DebugLn('[GetScrollInfo] Possible obsolete get use of CList (Listview ?)');
5467        Adjustment := gtk_clist_get_vadjustment(PgtkCList(Scroll));
5468      end
5469      // obsolete stuff
5470      else if GtkWidgetIsA(PGtkWidget(Scroll),gtk_vscrollbar_get_type)
5471      then begin
5472        // this one shouldn't be possible, scrolbar messages are sent to the CTL
5473        DebugLN('!!! direct SB_HORZ get call to scrollbar');
5474        Adjustment :=  PgtkvScrollBar(Scroll)^.Scrollbar.Range.Adjustment;
5475      end;
5476
5477    SB_CTL:
5478      if GtkWidgetIsA(PGtkWidget(Scroll),gtk_vscrollbar_get_type) then
5479        Adjustment :=  PgtkvScrollBar(Scroll)^.Scrollbar.Range.Adjustment
5480      else
5481      if GtkWidgetIsA(PGtkWidget(Scroll),gtk_hscrollbar_get_type) then
5482        Adjustment :=  PgtkhScrollBar(Scroll)^.Scrollbar.Range.Adjustment
5483      else
5484      if GtkWidgetIsA(PGtkWidget(Scroll), gtk_range_get_type) then
5485        Adjustment := gtk_range_get_adjustment(PGTKRange(Scroll));
5486
5487    SB_BOTH:
5488       DebugLn('[GetScrollInfo] Got SB_BOTH ???');
5489  end;
5490
5491  if Adjustment = nil then Exit;
5492
5493  // POS
5494  if (ScrollInfo.fMask and SIF_POS) <> 0
5495  then begin
5496    ScrollInfo.nPos := Round(Adjustment^.Value);
5497  end;
5498  // RANGE
5499  if (ScrollInfo.fMask and SIF_RANGE) <> 0
5500  then begin
5501    ScrollInfo.nMin:= Round(Adjustment^.Lower);
5502    ScrollInfo.nMax:= Round(Adjustment^.Upper);
5503  end;
5504  // PAGE
5505  if (ScrollInfo.fMask and SIF_PAGE) <> 0
5506  then begin
5507    ScrollInfo.nPage := Round(Adjustment^.Page_Size);
5508  end;
5509  // TRACKPOS
5510  if (ScrollInfo.fMask and SIF_TRACKPOS) <> 0
5511  then begin
5512    ScrollInfo.nTrackPos := Round(Adjustment^.Value);
5513  end;
5514
5515  Result := true;
5516end;
5517
5518{------------------------------------------------------------------------------
5519  Function: GetStockObject
5520  Params:
5521  Returns: Nothing
5522
5523
5524 ------------------------------------------------------------------------------}
5525function TGtk2WidgetSet.GetStockObject(Value: Integer): THandle;
5526begin
5527  Result := 0;
5528  case Value of
5529    BLACK_BRUSH:         // Black brush.
5530      Result := FStockBlackBrush;
5531    DKGRAY_BRUSH:        // Dark gray brush.
5532      Result := FStockDKGrayBrush;
5533    GRAY_BRUSH:          // Gray brush.
5534      Result := FStockGrayBrush;
5535    LTGRAY_BRUSH:        // Light gray brush.
5536      Result := FStockLtGrayBrush;
5537    NULL_BRUSH:          // Null brush (equivalent to HOLLOW_BRUSH).
5538      Result := FStockNullBrush;
5539    WHITE_BRUSH:         // White brush.
5540      Result := FStockWhiteBrush;
5541
5542    BLACK_PEN:           // Black pen.
5543      Result := FStockBlackPen;
5544    NULL_PEN:            // Null pen.
5545      Result := FStockNullPen;
5546    WHITE_PEN:           // White pen.
5547      Result := FStockWhitePen;
5548
5549   (* ANSI_FIXED_FONT:     // Fixed-pitch (monospace) system font.
5550      begin
5551        {If FStockFixedFont = 0 then
5552          FStockFixedFont := GetStockFixedFont;
5553        Result := FStockFixedFont;}
5554      end;
5555    ANSI_VAR_FONT:       // Variable-pitch (proportional space) system font.
5556      begin
5557      end;
5558    DEVICE_DEFAULT_FONT: // Device-dependent font.
5559      begin
5560      end;  *)
5561(*    OEM_FIXED_FONT:      // Original equipment manufacturer (OEM) dependent fixed-pitch (monospace) font.
5562      begin
5563      end;
5564*)
5565    DEFAULT_GUI_FONT, SYSTEM_FONT:         // System font. By default, Windows uses the system font to draw menus, dialog box controls, and text. In Windows versions 3.0 and later, the system font is a proportionally spaced font; earlier versions of Windows used a monospace system font.
5566      begin
5567        // MG: this should only be done, when theme changed:
5568        {If FStockSystemFont <> 0 then begin //This is a Temporary Hack!!! This
5569          DeleteObject(FStockSystemFont);   //should really only be done on
5570          FStockSystemFont := 0;            //theme change.
5571        end;}
5572
5573        If FStockSystemFont = 0 then
5574          FStockSystemFont := HFont({%H-}PtrUInt(CreateDefaultFont));
5575        Result := FStockSystemFont;
5576      end;
5577(*    SYSTEM_FIXED_FONT:   // Fixed-pitch (monospace) system font used in Windows versions earlier than 3.0. This stock object is provided for compatibility with earlier versions of Windows.
5578      begin
5579        Result := GetStockObject(ANSI_FIXED_FONT);
5580      end;
5581    DEFAULT_PALETTE:     // Default palette. This palette consists of the static colors in the system palette.
5582      begin
5583      end;
5584*)
5585  end;
5586end;
5587
5588{------------------------------------------------------------------------------
5589  Function: GetSysColor
5590  Params:   index to the syscolors array
5591  Returns:  RGB value
5592
5593 ------------------------------------------------------------------------------}
5594function TGtk2WidgetSet.GetSysColor(nIndex: Integer): DWORD;
5595begin
5596  if (nIndex < 0) or (nIndex > MAX_SYS_COLORS)
5597  then begin
5598    Result := 0;
5599    DumpStack;
5600    DebugLn(Format('ERROR: [TGtk2WidgetSet.GetSysColor] Bad Value: %d. Valid Range between 0 and %d', [nIndex, MAX_SYS_COLORS]));
5601  end
5602  else
5603    Result := SysColorMap[nIndex];
5604end;
5605
5606function TGtk2WidgetSet.GetSysColorBrush(nIndex: Integer): HBrush;
5607begin
5608  if (nIndex < 0) or (nIndex > MAX_SYS_COLORS)
5609  then begin
5610    Result := 0;
5611    DumpStack;
5612    DebugLn(Format('ERROR: [TGtk2WidgetSet.GetSysColorBrush] Bad Value: %d. Valid Range between 0 and %d', [nIndex, MAX_SYS_COLORS]));
5613  end
5614  else
5615    Result := FSysColorBrushes[nIndex];
5616end;
5617
5618{------------------------------------------------------------------------------
5619  Function: GetSystemMetrics
5620  Params:
5621  Returns: Nothing
5622
5623
5624 ------------------------------------------------------------------------------}
5625function TGtk2WidgetSet.GetSystemMetrics(nIndex: Integer): Integer;
5626var
5627  P: Pointer;
5628{$ifdef HasX}
5629  ax,ay,ah,aw: gint;
5630{$endif}
5631{$IFDEF Win32}
5632  auw, auh: guint;
5633{$ENDIF}
5634  screen: PGdkScreen;
5635  ARect: TGdkRectangle;
5636  AValue: TGValue;
5637begin
5638  Result := 0;
5639  case nIndex of
5640    SM_ARRANGE:
5641      begin
5642        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_ARRANGE          ');
5643      end;
5644    SM_CLEANBOOT:
5645      begin
5646        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CLEANBOOT        ');
5647      end;
5648    SM_CMOUSEBUTTONS:
5649      begin
5650        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CMOUSEBUTTONS    ');
5651      end;
5652    SM_CXBORDER:
5653      begin
5654        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXBORDER         ');
5655        Result := Max(FCachedBorderSize, 0);
5656      end;
5657    SM_CYBORDER:
5658      begin
5659        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYBORDER         ');
5660        Result := Max(FCachedBorderSize, 0);
5661      end;
5662    SM_CXCURSOR,
5663    SM_CYCURSOR:
5664      begin
5665        {$IFDEF Win32}
5666          // Width and height of a cursor, in pixels. For win32 system cannot create cursors of other sizes.
5667          // For gtk this should be maximal cursor sizes
5668          gdk_display_get_maximal_cursor_size(gdk_display_get_default, @auw, @auh);
5669          if nIndex = SM_CXCURSOR
5670          then Result := auw // return width
5671          else Result := auh; // return height
5672        {$ELSE}
5673          // At least on Linux, the default size should be taken: Issue #32385
5674          Result := gdk_display_get_default_cursor_size(gdk_display_get_default);
5675        {$ENDIF}
5676      end;
5677    SM_CXDOUBLECLK:
5678      begin
5679        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXDOUBLECLK      ');
5680      end;
5681    SM_CYDOUBLECLK:
5682      begin
5683        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYDOUBLECLK      ');
5684      end;
5685    SM_CXDRAG:
5686      begin
5687        Result := 2;
5688      end;
5689    SM_CYDRAG:
5690      begin
5691        Result := 2;
5692      end;
5693    SM_CXEDGE:
5694      begin
5695        Result := 2;
5696      end;
5697    SM_CYEDGE:
5698      begin
5699        Result := 2;
5700      end;
5701    SM_CXFIXEDFRAME:
5702      begin
5703        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXFIXEDFRAME     ');
5704      end;
5705    SM_CYFIXEDFRAME:
5706      begin
5707        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYFIXEDFRAME     ');
5708      end;
5709    SM_CXHSCROLL:
5710      begin
5711        P := GetStyleWidget(lgsVerticalScrollbar);
5712        if P <> nil then
5713          Result := GTK_Widget(P)^.requisition.Width;
5714      end;
5715    SM_CYHSCROLL:
5716      begin
5717        P := GetStyleWidget(lgsHorizontalScrollbar);
5718        if P <> nil then
5719          Result := GTK_Widget(P)^.requisition.Height;
5720      end;
5721    SM_CXHTHUMB,
5722    SM_CYVTHUMB:
5723      begin
5724        P := GetStyleWidget(lgsHorizontalScrollbar);
5725        if P <> nil then
5726        begin
5727          FillChar(AValue{%H-}, SizeOf(AValue), 0);
5728          g_value_init(@AValue, G_TYPE_INT);
5729          gtk_widget_style_get_property(P, 'slider-width', @AValue);
5730          Result := AValue.data[0].v_int;
5731        end;
5732      end;
5733    SM_CXICON,
5734    SM_CYICON:
5735      // big icon size
5736      // gtk recommends sizes 16,32,48. optional: 64 and 128
5737      Result := 128;
5738    SM_CXICONSPACING:
5739      begin
5740        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXICONSPACING    ');
5741      end;
5742    SM_CYICONSPACING:
5743      begin
5744        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYICONSPACING    ');
5745      end;
5746    SM_CXMAXIMIZED:
5747      begin
5748        {$IFDEF HasX}
5749        if XGetWorkarea(ax,ay,aw,ah)>=0 then
5750          Result := aw
5751        else
5752          Result := getSystemMetrics(SM_CXSCREEN);
5753        {$ENDIF}
5754      end;
5755    SM_CYMAXIMIZED:
5756      begin
5757        {$IFDEF HasX}
5758        if XGetWorkarea(ax,ay,aw,ah)>=0 then
5759          Result := ah
5760        else
5761          Result := getSystemMetrics(SM_CYSCREEN);
5762        {$ENDIF}
5763      end;
5764    SM_CXMAXTRACK:
5765      begin
5766        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXMAXTRACK       ');
5767      end;
5768    SM_CYMAXTRACK:
5769      begin
5770        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYMAXTRACK       ');
5771      end;
5772    SM_CXMENUCHECK:
5773      begin
5774        Result := 19;
5775        P := GetStyleWidget(lgsCheckbox);
5776        if P <> nil then
5777          Result := GTK_Widget(P)^.requisition.Width;
5778      end;
5779    SM_CYMENUCHECK:
5780      begin
5781        Result := 19;
5782        P := GetStyleWidget(lgsCheckbox);
5783        if P <> nil then
5784          Result := GTK_Widget(P)^.requisition.Height;
5785      end;
5786    SM_CXMENUSIZE,
5787    SM_CYMENUSIZE:
5788      begin
5789        Result := GetTitleBarHeight - (FCachedBorderSize * 2);
5790      end;
5791    SM_CXMIN:
5792      begin
5793        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXMIN            ');
5794      end;
5795    SM_CYMIN:
5796      begin
5797        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYMIN            ');
5798      end;
5799    SM_CXMINIMIZED:
5800      begin
5801        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXMINIMIZED      ');
5802      end;
5803    SM_CYMINIMIZED:
5804      begin
5805        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYMINIMIZED      ');
5806      end;
5807    SM_CXMINSPACING:
5808      begin
5809        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXMINSPACING     ');
5810      end;
5811    SM_CYMINSPACING:
5812      begin
5813        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYMINSPACING     ');
5814      end;
5815    SM_CXMINTRACK:
5816      begin
5817        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXMINTRACK       ');
5818      end;
5819    SM_CYMINTRACK:
5820      begin
5821        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYMINTRACK       ');
5822      end;
5823    SM_CXFULLSCREEN,
5824    SM_CXSCREEN:
5825      begin
5826        screen := gdk_screen_get_default();
5827        gdk_screen_get_monitor_geometry(screen, 0, @ARect);
5828        Result := ARect.width;
5829      end;
5830    SM_CXVIRTUALSCREEN:
5831      begin
5832        Result := gdk_Screen_Width;
5833      end;
5834    SM_CYFULLSCREEN,
5835    SM_CYSCREEN:
5836      begin
5837        screen := gdk_screen_get_default();
5838        gdk_screen_get_monitor_geometry(screen, 0, @ARect);
5839        Result := ARect.height;
5840      end;
5841    SM_CYVIRTUALSCREEN:
5842      begin
5843        result := gdk_Screen_Height;
5844      end;
5845    SM_CXSIZE:
5846      begin
5847        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXSIZE           ');
5848      end;
5849    SM_CYSIZE:
5850      begin
5851        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYSIZE           ');
5852      end;
5853    SM_CXSIZEFRAME,
5854    SM_CYSIZEFRAME:
5855      begin
5856        Result := FCachedBorderSize;
5857      end;
5858    SM_CXSMICON,
5859    SM_CYSMICON:
5860      // small icon size
5861      // gtk recommends sizes 16,32,48. optional: 64 and 128
5862      Result := 16;
5863    SM_CXSMSIZE:
5864      begin
5865        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CXSMSIZE         ');
5866      end;
5867    SM_CYSMSIZE:
5868      begin
5869        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYSMSIZE         ');
5870      end;
5871    SM_CXVSCROLL:
5872      begin
5873        P := GetStyleWidget(lgsVerticalScrollbar);
5874        if P <> nil then
5875          Result := GTK_Widget(P)^.requisition.Width;
5876      end;
5877    SM_CYVSCROLL:
5878      begin
5879        P := GetStyleWidget(lgsHorizontalScrollbar);
5880        if P <> nil then
5881          Result := GTK_Widget(P)^.requisition.Height;
5882      end;
5883    SM_CYCAPTION:
5884      begin
5885        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYCAPTION        ');
5886        Result := GetTitleBarHeight;
5887      end;
5888    SM_CYKANJIWINDOW:
5889      begin
5890        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYKANJIWINDOW    ');
5891      end;
5892    SM_CYMENU:
5893      begin
5894        Result := 24; // default gtk2 menusize inside menubar.
5895        P := GetStyleWidget(lgsMenu);
5896        if P <> nil then
5897          Result := GTK_Widget(P)^.requisition.Height;
5898      end;
5899    SM_CYSMCAPTION:
5900      begin
5901        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_CYSMCAPTION      ');
5902      end;
5903    SM_DBCSENABLED:
5904      begin
5905        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_DBCSENABLED      ');
5906      end;
5907    SM_DEBUG:
5908      begin
5909        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_DEBUG            ');
5910      end;
5911    SM_MENUDROPALIGNMENT:
5912      begin
5913        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_MENUDROPALIGNMENT');
5914      end;
5915    SM_MIDEASTENABLED:
5916      begin
5917        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_MIDEASTENABLED   ');
5918      end;
5919    SM_MOUSEPRESENT:
5920      begin
5921        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_MOUSEPRESENT     ');
5922      end;
5923    SM_MOUSEWHEELPRESENT:
5924      begin
5925        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_MOUSEWHEELPRESENT');
5926      end;
5927    SM_NETWORK:
5928      begin
5929        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_NETWORK          ');
5930      end;
5931    SM_PENWINDOWS:
5932      begin
5933        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_PENWINDOWS       ');
5934      end;
5935    SM_SECURE:
5936      begin
5937        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_SECURE           ');
5938      end;
5939    SM_SHOWSOUNDS:
5940      begin
5941        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_SHOWSOUNDS       ');
5942      end;
5943    SM_SLOWMACHINE:
5944      begin
5945        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_SLOWMACHINE      ');
5946      end;
5947    SM_SWAPBUTTON:
5948      begin
5949        //DebugLn('Trace:TODO: [TGtk2WidgetSet.GetSystemMetrics] --> SM_SWAPBUTTON       ');
5950      end;
5951    SM_SWSCROLLBARSPACING:
5952      begin
5953        P := GetStyleWidget(lgsScrolledWindow);
5954        if P <> nil then begin
5955          result := GTK_SCROLLED_WINDOW_CLASS(gtk_widget_get_class(P))^.scrollbar_spacing;
5956          if result<0 then
5957            gtk_widget_style_get(P, 'scrollbar-spacing', @result, nil);
5958        end;
5959      end;
5960
5961    SM_LCLMAXIMIZEDWIDTH:
5962      begin
5963        Result := GetSystemMetrics(SM_CXMAXIMIZED);
5964      end;
5965    SM_LCLMAXIMIZEDHEIGHT:
5966      begin
5967        Result := GetSystemMetrics(SM_CYMAXIMIZED) - 1 -
5968          (GetSystemMetrics(SM_CYCAPTION) - (GetSystemMetrics(SM_CYSIZEFRAME) * 2));
5969      end;
5970    SM_LCLHasFormAlphaBlend:
5971      begin
5972        Result:=1;
5973      end;
5974  end;
5975end;
5976
5977{------------------------------------------------------------------------------
5978  Function: GetTextColor
5979  Params:  DC
5980  Returns: TColorRef
5981
5982  Gets the Font Color currently assigned to the Device Context
5983 ------------------------------------------------------------------------------}
5984function TGtk2WidgetSet.GetTextColor(DC: HDC) : TColorRef;
5985begin
5986  Result := 0;
5987  if IsValidDC(DC) then
5988    with TGtkDeviceContext(DC) do
5989    begin
5990      Result := CurrentTextColor.ColorRef;
5991    end;
5992end;
5993
5994{------------------------------------------------------------------------------
5995  Function: GetTextExtentExPoint
5996  Params:
5997  Returns:
5998
5999 ------------------------------------------------------------------------------}
6000function TGtk2WidgetSet.GetTextExtentExPoint(DC: HDC; Str: PChar;
6001  Count, MaxWidth: Integer; MaxCount, PartialWidths: PInteger;
6002  var Size: TSize): Boolean;
6003var
6004  DevCtx: TGtkDeviceContext absolute DC;
6005  UseFont : TGtkIntfFont;
6006  Utf8Len, Accu, I: PtrInt;
6007  Iter: PPangoLayoutIter;
6008  CharRect: TPangoRectangle;
6009begin
6010  if not IsValidDC(DC) then
6011    Exit(False);
6012
6013  Size.cx := 0;
6014  Size.cy := 0;
6015  if MaxCount <> nil then
6016    MaxCount^ := 0;
6017
6018  if Count = 0 then
6019    Exit(True);
6020  if (Count < -1) or (Str = nil) then
6021    Exit(False);
6022
6023  if Count = -1 then
6024    Count := Length(Str);
6025  Utf8Len := UTF8Length(Str, Count);
6026  if Utf8Len = 0 then
6027    Exit(True);
6028
6029  UseFont := GetGtkFont(DevCtx);
6030  UpdateDCTextMetric(DevCtx);
6031  SetLayoutText(UseFont, Str, Count);
6032  pango_layout_get_pixel_size(UseFont, @Size.cx, @Size.cy);
6033  if DevCtx.HasTransf then
6034  begin
6035    DevCtx.InvTransfExtent(Size.cx, Size.cy);
6036    Size.cx := Abs(Size.cx);
6037    Size.cy := Abs(Size.cy);
6038  end;
6039
6040  if PartialWidths = nil then
6041  begin
6042    if MaxCount = nil then
6043      Exit(True);
6044    if Size.cx <= MaxWidth then
6045    begin
6046      MaxCount^ := Utf8Len;
6047      Exit(True);
6048    end;
6049  end;
6050
6051  I := 1;
6052  Accu := 0;
6053  Iter := pango_layout_get_iter(UseFont);
6054  repeat
6055    pango_layout_iter_get_char_extents(Iter, @CharRect);
6056    Inc(Accu, CharRect.Width);
6057
6058    CharRect.Width := Accu;
6059    pango_extents_to_pixels(nil, @CharRect);
6060    if DevCtx.HasTransf then
6061    begin
6062      DevCtx.InvTransfExtent(CharRect.Width, CharRect.Height);
6063      CharRect.Width := Abs(CharRect.Width);
6064    end;
6065
6066    if MaxCount <> nil then
6067    begin
6068      if CharRect.Width > MaxWidth then
6069        Break;
6070      MaxCount^ := I;
6071    end;
6072    if PartialWidths <> nil then
6073      PartialWidths[I - 1] := CharRect.Width;
6074
6075    Inc(I);
6076  until not pango_layout_iter_next_char(Iter);
6077  pango_layout_iter_free(Iter);
6078
6079  Exit(True);
6080end;
6081
6082{------------------------------------------------------------------------------
6083  Function: GetTextExtentPoint
6084  Params:  none
6085  Returns: Nothing
6086
6087
6088 ------------------------------------------------------------------------------}
6089function TGtk2WidgetSet.GetTextExtentPoint(DC: HDC; Str: PChar; Count: Integer;
6090  var Size: TSize): Boolean;
6091begin
6092  Result := GetTextExtentExPoint(DC, Str, Count, 0, nil, nil, Size);
6093end;
6094
6095{------------------------------------------------------------------------------
6096  Function: GetTextMetrics
6097  Params:  none
6098  Returns: Nothing
6099
6100
6101 ------------------------------------------------------------------------------}
6102function TGtk2WidgetSet.GetTextMetrics(DC: HDC; var TM: TTextMetric): Boolean;
6103var
6104  DevCtx: TGtkDeviceContext absolute DC;
6105begin
6106  Result := IsValidDC(DC);
6107  if Result then
6108  begin
6109    UpdateDCTextMetric(DevCtx);
6110    TM := DevCtx.DCTextMetric.TextMetric;
6111  end;
6112end;
6113
6114function TGtk2WidgetSet.GetViewPortExtEx(DC: HDC; Size: PSize): Integer;
6115var
6116  DevCtx: TGtkDeviceContext absolute DC;
6117begin
6118  if IsValidDC(DC) and (Size <> nil) then
6119  begin
6120    Size^.cx := DevCtx.ViewPortExt.x;
6121    Size^.cy := DevCtx.ViewPortExt.y;
6122    Result := Integer(True);
6123  end else
6124    Result := Integer(False);
6125end;
6126
6127function TGtk2WidgetSet.GetViewPortOrgEx(DC: HDC; P: PPoint): Integer;
6128var
6129  DevCtx: TGtkDeviceContext absolute DC;
6130begin
6131  if IsValidDC(DC) and (P <> nil) then
6132  begin
6133    P^.x := DevCtx.ViewPortOrg.x;
6134    P^.y := DevCtx.ViewPortOrg.y;
6135    Result := Integer(True);
6136  end else
6137    Result := Integer(False);
6138end;
6139
6140function TGtk2WidgetSet.GetWindowExtEx(DC: HDC; Size: PSize): Integer;
6141var
6142  DevCtx: TGtkDeviceContext absolute DC;
6143begin
6144  if IsValidDC(DC) and (Size <> nil) then
6145  begin
6146    Size^.cx := DevCtx.WindowExt.x;
6147    Size^.cy := DevCtx.WindowExt.y;
6148    Result := Integer(True);
6149  end else
6150    Result := Integer(False);
6151end;
6152
6153{------------------------------------------------------------------------------
6154  Function: GetWindowLong
6155  Params:  none
6156  Returns: Nothing
6157 ------------------------------------------------------------------------------}
6158function TGtk2WidgetSet.GetWindowLong(Handle: HWND; int: Integer): PtrInt;
6159
6160  function GetObjectData(Name: PChar): PtrInt;
6161  begin
6162    Result := PtrInt({%H-}PtrUInt({%H-}g_object_get_data({%H-}PGObject(Handle),Name)));
6163  end;
6164var
6165  WidgetInfo: PWidgetInfo;
6166begin
6167  //TODO:Started but not finished
6168
6169  case int of
6170    GWL_WNDPROC :
6171      begin
6172        WidgetInfo := GetWidgetInfo({%H-}Pointer(Handle));
6173        if WidgetInfo <> nil then
6174          Result := WidgetInfo^.WndProc
6175        else
6176          Result := 0;
6177      end;
6178    GWL_HINSTANCE :
6179      begin
6180        Result := GetObjectData('HINSTANCE');
6181      end;
6182    GWL_HWNDPARENT :
6183      begin
6184        Result := GetObjectData('HWNDPARENT');
6185      end;
6186
6187{    GWL_WNDPROC :
6188      begin
6189        Data := GetLCLObject(Pointer(Handle));
6190        if Data is TControl
6191        then Result := PtrInt(@(TControl(Data).WindowProc));
6192        // TODO fix this, a method pointer (2 pointers) can not be casted to a longint
6193      end;
6194}
6195{    GWL_HWNDPARENT :
6196      begin
6197        Data := GetLCLObject(Pointer(Handle));
6198        if (Data is TWinControl)
6199        then Result := PtrInt(TWincontrol(Data).Handle)
6200        else Result := 0;
6201      end;
6202 }
6203    GWL_STYLE :
6204      begin
6205        WidgetInfo := GetWidgetInfo({%H-}Pointer(Handle));
6206        if WidgetInfo <> nil then
6207          Result := WidgetInfo^.Style
6208        else
6209          Result := 0;
6210      end;
6211    GWL_EXSTYLE :
6212      begin
6213        WidgetInfo := GetWidgetInfo({%H-}Pointer(Handle));
6214        if WidgetInfo <> nil then
6215          Result := WidgetInfo^.ExStyle
6216        else
6217          Result := 0;
6218      end;
6219    GWL_USERDATA :
6220      begin
6221        Result := GetObjectData('Userdata');
6222      end;
6223    GWL_ID :
6224      begin
6225        Result := GetObjectData('ID');
6226      end;
6227    else Result := 0;
6228  end; //case
6229end;
6230
6231{------------------------------------------------------------------------------
6232  Function: GetWindowOrgEx
6233  Params:  none
6234  Returns: Nothing
6235
6236  Returns the current offset of the DC.
6237 ------------------------------------------------------------------------------}
6238function TGtk2WidgetSet.GetWindowOrgEx(dc: hdc; P: PPoint): Integer;
6239var
6240  DevCtx: TGtkDeviceContext absolute DC;
6241begin
6242  if P = nil then Exit(0);
6243  P^ := Point(0,0);
6244  if not IsValidDC(DC) then exit(0);
6245
6246  P^ := DevCtx.WindowOrg;
6247  Result := 1;
6248end;
6249
6250{------------------------------------------------------------------------------
6251  Function: GetWindowRect
6252  Params:  none
6253  Returns: 0
6254
6255  After the call, ARect will be the control area in screen coordinates.
6256  That means, Left and Top will be the screen coordinate of the TopLeft pixel
6257  of the Handle object and Right and Bottom will be the screen coordinate of
6258  the BottomRight pixel.
6259 ------------------------------------------------------------------------------}
6260function TGtk2WidgetSet.GetWindowRect(Handle: hwnd; var ARect: TRect): Integer;
6261var
6262  Widget: PGTKWidget;
6263  GRect: TGdkRectangle;
6264  P: TPoint;
6265  AInfo: PWidgetInfo;
6266  AForm: TCustomForm;
6267  R, AFrame: TRect;
6268begin
6269  Result := 0; // error
6270  if Handle = 0 then
6271    Exit;
6272
6273  Widget := {%H-}PGtkWidget(Handle);
6274
6275  if GTK_IS_WINDOW(Widget) and Assigned(Widget^.window)
6276  and GTK_WIDGET_VISIBLE(Widget) // Gtk2 returns invalid origin/frame for invisible widgets
6277  then
6278  begin
6279    P := GetWidgetOrigin(Widget);
6280    gdk_window_get_frame_extents(Widget^.window, @GRect);
6281    ARect := Bounds(P.X,P.Y,GRect.width,GRect.height);
6282    // writeln('Frame extents are: ',dbgs(R),' ARECT=',dbgs(ARect));
6283    Result := 1; // success
6284  end else
6285  begin
6286    {$IFDEF HASX}
6287    AInfo := GetWidgetInfo(Widget);
6288    if (AInfo^.LCLObject is TCustomForm) and not AInfo^.FirstPaint then
6289    begin
6290      AForm := TCustomForm(AInfo^.LCLObject);
6291      if not IsFormDesign(AForm) and (AForm.BorderStyle <> bsNone) and
6292        not (AForm.FormStyle in [fsMDIChild, fsSplash])
6293      and (Gtk2WidgetSet.GetDummyWidgetFrame <> Rect(0, 0, 0, 0)) then
6294      begin
6295        R := AForm.BoundsRect;
6296        AFrame := Gtk2WidgetSet.GetDummyWidgetFrame;
6297        // apply frame size to lcl form.
6298        R.Right += AFrame.Left + AFrame.Right;
6299        R.Bottom += AFrame.Top + AFrame.Bottom;
6300        ARect := R; //this is now real size under x11 even on unmapped window :)
6301        exit(-1);
6302      end;
6303    end;
6304    {$ENDIF}
6305    ARect.TopLeft := GetWidgetOrigin(Widget);
6306    if (ARect.Top <> -1) or (ARect.Left <> -1)
6307    or (Widget^.allocation.width <> 1) or (Widget^.allocation.height <> 1) then
6308    begin
6309      ARect.BottomRight := Point(
6310        ARect.Left + Widget^.allocation.width,
6311        ARect.Top + Widget^.allocation.height);
6312      Result := 1; // success
6313    end;
6314  end;
6315end;
6316{------------------------------------------------------------------------------
6317  Function: GetWindowRelativePosition
6318  Params:  Handle : hwnd;
6319  Returns: true on success
6320
6321  Returns the Left, Top, relative to the client origin of its parent
6322 ------------------------------------------------------------------------------}
6323function TGtk2WidgetSet.GetWindowRelativePosition(Handle : hwnd;
6324  var Left, Top: integer): boolean;
6325var
6326  aWidget: PGtkWidget;
6327begin
6328  aWidget := {%H-}PGtkWidget(Handle);
6329  if GtkWidgetIsA(aWidget, GTK_TYPE_WIDGET) then
6330  begin
6331    Result := true;
6332    GetWidgetRelativePosition(aWidget, Left, Top);
6333  end else
6334    Result := false;
6335end;
6336
6337{------------------------------------------------------------------------------
6338  Function: GetWindowSize
6339  Params:  Handle : hwnd;
6340  Returns: true on success
6341
6342  Returns the current widget Width and Height
6343 ------------------------------------------------------------------------------}
6344function TGtk2WidgetSet.GetWindowSize(Handle : hwnd;
6345  var Width, Height: integer): boolean;
6346begin
6347  if GtkWidgetIsA({%H-}PGtkWidget(Handle),GTK_TYPE_WIDGET) then begin
6348    Result:=true;
6349    Width:=Max(0,{%H-}PGtkWidget(Handle)^.Allocation.Width);
6350    Height:=Max(0,{%H-}PGtkWidget(Handle)^.Allocation.Height);
6351    //DebugLn(['TGtk2WidgetSet.GetWindowSize ',DbgSName(GetLCLOwnerObject(Handle)),' Allocation=',Width,'x',Height]);
6352  end else
6353    Result:=false;
6354end;
6355
6356{------------------------------------------------------------------------------
6357  Function: HideCaret
6358  Params:  none
6359  Returns: Nothing
6360
6361
6362 ------------------------------------------------------------------------------}
6363function TGtk2WidgetSet.HideCaret(hWnd: HWND): Boolean;
6364var
6365  GTKObject: PGTKObject;
6366  WasVisible: boolean;
6367begin
6368  GTKObject := {%H-}PGTKObject(HWND);
6369  Result := GTKObject <> nil;
6370
6371  if Result
6372  then begin
6373    if gtk_type_is_a(g_object_type(GTKObject), GTKAPIWidget_GetType)
6374    then begin
6375      WasVisible:=false;
6376      GTKAPIWidget_HideCaret(PGTKAPIWidget(GTKObject),WasVisible);
6377    end
6378//    else if // TODO: other widgettypes
6379    else begin
6380      Result := False;
6381    end;
6382  end
6383  else DebugLn('WARNING: [TGtk2WidgetSet.HideCaret] Got null HWND');
6384
6385end;
6386
6387{------------------------------------------------------------------------------
6388  Function: InvalidateRect
6389  Params: aHandle:
6390          Rect:
6391          bErase:
6392  Returns:
6393
6394 ------------------------------------------------------------------------------}
6395function TGtk2WidgetSet.InvalidateRect(aHandle : HWND; Rect : pRect;
6396  bErase : Boolean) : Boolean;
6397var
6398  gdkRect : TGDKRectangle;
6399  Widget, PaintWidget: PGtkWidget;
6400  LCLObject: TObject;
6401  WidgetInfo: PWidgetInfo;
6402  r: TRect;
6403  Adjustment: PGtkAdjustment;
6404  Pt: TPoint;
6405begin
6406  //  DebugLn(format('Rect = %d,%d,%d,%d',[rect^.left,rect^.top,rect^.Right,rect^.Bottom]));
6407  Widget:={%H-}PGtkWidget(aHandle);
6408  LCLObject:=GetLCLObject(Widget);
6409  if (LCLObject<>nil) then
6410  begin
6411    if (LCLObject=CurrentSentPaintMessageTarget) then
6412    begin
6413      DebugLn('WARNING: TGtk2WidgetSet.InvalidateRect refused invalidating during paint message: ',
6414        LCLObject.ClassName);
6415      exit(False);
6416    end;
6417    {$IFDEF VerboseDsgnPaintMsg}
6418    if (LCLObject is TComponent)
6419    and (csDesigning in TComponent(LCLObject).ComponentState) then begin
6420      write('TGtk2WidgetSet.InvalidateRect A ');
6421      write(TComponent(LCLObject).Name,':');
6422      write(LCLObject.ClassName);
6423      with Rect^ do
6424        write(' Rect=',Left,',',Top,',',Right,',',Bottom);
6425      DebugLn(' Erase=',bErase);
6426    end;
6427    {$ENDIF}
6428  end;
6429  Result := True;
6430  PaintWidget:=GetFixedWidget(Widget);
6431  if PaintWidget=nil then PaintWidget:=Widget;
6432
6433  if Rect = nil then
6434  begin
6435    Rect := @r;
6436    Rect^.Left := 0;//PaintWidget^.Allocation.X;
6437    Rect^.Top := 0;//PaintWidget^.Allocation.Y;
6438    Rect^.Right := PaintWidget^.Allocation.Width;
6439    Rect^.Bottom := PaintWidget^.Allocation.Height;
6440  end else
6441  begin
6442    // normalize rect
6443    r := Rect^;
6444    if r.Left>r.Right then
6445    begin
6446      r.Left := r.Right;
6447      r.Right := Rect^.Left;
6448    end;
6449    if r.Top>r.Bottom then
6450    begin
6451      r.Top := r.Bottom;
6452      r.Bottom := Rect^.Top;
6453    end;
6454    Rect := @r;
6455  end;
6456
6457  gdkRect.X := Rect^.Left;
6458  gdkRect.Y := Rect^.Top;
6459  gdkRect.Width := (Rect^.Right - Rect^.Left);
6460  gdkRect.Height := (Rect^.Bottom - Rect^.Top);
6461
6462  if (PaintWidget<>nil) and GTK_WIDGET_NO_WINDOW(PaintWidget) and (Rect<>nil) and
6463    (not GtkWidgetIsA(PGTKWidget(PaintWidget),GTKAPIWidget_GetType)) then
6464  begin
6465    Inc(gdkRect.X, PaintWidget^.Allocation.x);
6466    Inc(gdkRect.Y, PaintWidget^.Allocation.y);
6467    // issue #25572
6468    if GTK_IS_FIXED(PaintWidget) and GTK_IS_EVENT_BOX(PaintWidget^.parent) then
6469    begin
6470      Inc(gdkRect.Width, PaintWidget^.Allocation.x);
6471      Inc(gdkRect.Height, PaintWidget^.Allocation.y);
6472      // DebugLn('#25572 PATCH FOR ',dbgsName(LCLObject),' GdkRect=',dbgs(gdkRect),' Alloc=',dbgs(TGdkRectangle(PaintWidget^.allocation)));
6473      {GtkWidget isn't yet allocated to LCL size, do not call invalid area update - update complete gtkwidget}
6474      if (gdkRect.Width > PaintWidget^.allocation.width) or (gdkRect.Height > PaintWidget^.allocation.Height) then
6475      begin
6476        // DebugLn('*** WARNING: Rect to paint is bigger than widget Width diff=',dbgs(gdkRect.Width - PaintWidget^.allocation.width),
6477        //  ' Height diff=',dbgs(gdkRect.Height - PaintWidget^.allocation.height));
6478        if bErase then
6479          gtk_widget_queue_clear(PaintWidget);
6480        gtk_widget_queue_draw(PaintWidget);
6481        exit;
6482      end;
6483    end;
6484  end;
6485  if (LCLObject is TScrollingWinControl) and GTK_IS_SCROLLED_WINDOW(Widget) then
6486  begin
6487    Pt := Point(0, 0);
6488    Adjustment := gtk_scrolled_window_get_vadjustment(PGtkScrolledWindow(Widget));
6489    if Adjustment <> nil then
6490      Pt.Y := Round(Adjustment^.value);
6491    Adjustment := gtk_scrolled_window_get_hadjustment(PGtkScrolledWindow(Widget));
6492    if Adjustment <> nil then
6493      Pt.X := Round(Adjustment^.value);
6494    dec(gdkRect.x, Pt.X);
6495    dec(gdkRect.y, Pt.Y);
6496    OffsetRect(Rect^, -Pt.X, -Pt.Y);
6497  end;
6498  WidgetInfo := GetWidgetInfo(Widget); // GetOrCreateWidgetInfo() ??
6499  if WidgetInfo <> nil then
6500    UnionRect(WidgetInfo^.UpdateRect, WidgetInfo^.UpdateRect, Rect^);
6501
6502  if bErase then
6503    gtk_widget_queue_clear_area(PaintWidget,
6504      gdkRect.X,gdkRect.Y,gdkRect.Width,gdkRect.Height);
6505
6506  gtk_widget_queue_draw_area(PaintWidget,
6507    gdkRect.X,gdkRect.Y,gdkRect.Width,gdkRect.Height);
6508
6509  //DebugLn(['TGtk2WidgetSet.InvalidateRect ',GetWidgetDebugReport(Widget),' IsAPI=',GtkWidgetIsA(PGTKWidget(Widget),GTKAPIWidget_GetType)]);
6510  if GtkWidgetIsA(PGTKWidget(Widget),GTKAPIWidget_GetType) then
6511    GTKAPIWidget_InvalidateCaret(PGTKAPIWidget(Widget));
6512end;
6513
6514function TGtk2WidgetSet.InvalidateRgn(Handle: HWND; Rgn: HRGN; Erase: Boolean
6515  ): Boolean;
6516var
6517  R: TRect;
6518begin
6519  // TODO: use gdk_window_invalidate_region to implement this function
6520  Result:=GetRgnBox(Rgn, @R)=0;
6521  InvalidateRect(Handle, @R, Erase);
6522end;
6523
6524function TGtk2WidgetSet.IsIconic(handle: HWND): boolean;
6525var
6526  GtkWindow: PGtkWindow absolute handle;
6527begin
6528  Result := False;
6529  if GtkWindow = nil then
6530    Exit;
6531
6532  Result := (PGtkWidget(GtkWindow)^.Window<>nil)
6533      and (gdk_window_get_state(PGtkWidget(GtkWindow)^.Window)
6534           and GDK_WINDOW_STATE_ICONIFIED <> 0);
6535end;
6536
6537function TGtk2WidgetSet.IsWindow(handle: HWND): boolean;
6538begin
6539  if Handle = 0 then
6540    Exit(False);
6541
6542  Result := GtkWidgetIsA({%H-}PGtkWidget(Handle), GTK_TYPE_WIDGET);
6543end;
6544
6545{------------------------------------------------------------------------------
6546  function TGtk2WidgetSet.IsWindowEnabled(handle: HWND): boolean;
6547
6548 ------------------------------------------------------------------------------}
6549function TGtk2WidgetSet.IsWindowEnabled(handle: HWND): boolean;
6550var
6551  LCLObject: TObject;
6552  Widget: PGtkWidget;
6553  AForm: TCustomForm;
6554  //i: Integer;
6555begin
6556  Widget:={%H-}PGtkWidget(handle);
6557  Result:=(Widget<>nil) and GTK_WIDGET_SENSITIVE(Widget)
6558          and GTK_WIDGET_PARENT_SENSITIVE(Widget) and GTK_WIDGET_VISIBLE(Widget);
6559  LCLObject:=GetLCLObject({%H-}PGtkWidget(Handle));
6560  //debugln('TGtk2WidgetSet.IsWindowEnabled A ',DbgSName(LCLObject),' Result=',dbgs(Result),
6561  //  ' SENSITIVE=',dbgs(GTK_WIDGET_SENSITIVE(Widget)),
6562  //  ' PARENT_SENSITIVE=',dbgs(GTK_WIDGET_PARENT_SENSITIVE(Widget)),
6563  //  ' TOPLEVEL=',dbgs(GTK_WIDGET_TOPLEVEL(Widget)),
6564  //  '');
6565  if Result and GtkWidgetIsA(Widget,GTK_TYPE_WINDOW) then begin
6566    LCLObject:=GetLCLObject(Widget);
6567    if (LCLObject is TCustomForm) then begin
6568      AForm:=TCustomForm(LCLObject);
6569      if not Screen.CustomFormBelongsToActiveGroup(AForm) then
6570        Result:=false;
6571      //debugln('TGtk2WidgetSet.IsWindowEnabled B ',dbgs(Screen.CustomFormBelongsToActiveGroup(AForm)));
6572      //for i:=0 to Screen.CustomFormCount-1 do begin
6573      //  debugln('  ',dbgs(i),' ',DbgSName(Screen.CustomFormsZOrdered[i]));
6574      //end;
6575    end;
6576  end;
6577end;
6578
6579{------------------------------------------------------------------------------
6580  function TGtk2WidgetSet.IsWindowVisible(handle: HWND): boolean;
6581
6582 ------------------------------------------------------------------------------}
6583function TGtk2WidgetSet.IsWindowVisible(handle: HWND): boolean;
6584begin
6585  Result := (handle <> 0) and GTK_WIDGET_VISIBLE({%H-}PGtkWidget(handle));
6586end;
6587
6588function TGtk2WidgetSet.IsZoomed(handle: HWND): boolean;
6589var
6590  GtkWindow: PGtkWindow absolute handle;
6591begin
6592  Result := False;
6593  if GtkWindow = nil then
6594    Exit;
6595
6596  Result := gdk_window_get_state(PGtkWidget(GtkWindow)^.Window) and GDK_WINDOW_STATE_MAXIMIZED <> 0;
6597end;
6598
6599{------------------------------------------------------------------------------
6600  Function: LineTo
6601  Params:  none
6602  Returns: Nothing
6603
6604
6605 ------------------------------------------------------------------------------}
6606function TGtk2WidgetSet.LineTo(DC: HDC; X, Y: Integer): Boolean;
6607var
6608  DevCtx: TGtkDeviceContext absolute DC;
6609  FromPt: TPoint;
6610  ToPt: TPoint;
6611begin
6612  if not IsValidDC(DC) then Exit(False);
6613
6614  DevCtx.SelectPenProps;
6615  if not (dcfPenSelected in DevCtx.Flags) then Exit(False);
6616
6617  if DevCtx.IsNullPen then Exit(True);
6618
6619  FromPt := Point(DevCtx.PenPos.X + DevCtx.Offset.X, DevCtx.PenPos.Y + DevCtx.Offset.Y);
6620  LPtoDP(DC, FromPt, 1);
6621  ToPt := Point(X+DevCtx.Offset.X, Y+DevCtx.Offset.Y);
6622  LPToDP(DC, ToPt, 1);
6623
6624  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
6625  DevCtx.RemovePixbuf;
6626  gdk_draw_line(DevCtx.Drawable, DevCtx.GC, FromPt.X, FromPt.Y, ToPt.X, ToPt.Y);
6627  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
6628
6629  DevCtx.PenPos := Point(X, Y);
6630
6631  Result := True;
6632end;
6633
6634function TGtk2WidgetSet.LPtoDP(DC: HDC; var Points; Count: Integer): BOOL;
6635var
6636  DevCtx: TGtkDeviceContext absolute DC;
6637  P: PPoint;
6638begin
6639  Result := False;
6640
6641  if not IsValidDC(DC) then Exit(False);
6642
6643  if not DevCtx.HasTransf then Exit(True);
6644
6645  P := @Points;
6646  while Count > 0 do
6647  begin
6648    Dec(Count);
6649    DevCtx.TransfPoint(P^.X, P^.Y);
6650    Inc(P);
6651  end;
6652
6653  Result := True;
6654end;
6655
6656{------------------------------------------------------------------------------
6657  Function: MessageBox
6658  Params:  hWnd:                  The handle of parent window
6659  Returns: 0 if not successful (out of memory), otherwise one of the defined value :
6660      IDABORT, IDCANCEL, IDIGNORE, IDNO, IDOK, IDRETRY, IDYES
6661
6662 The MessageBox function displays a modal dialog, with text and caption defined,
6663 and includes buttons.
6664 ------------------------------------------------------------------------------}
6665
6666function MessageButtonClicked(Widget : PGtkWidget; data: gPointer) : GBoolean; cdecl;
6667begin
6668  //DebugLn('[MessageButtonClicked] ',dbgs(data),' ',dbgs(g_object_get_data(PGtkObject(Widget), 'modal_result')));
6669  if PInteger(data)^ = 0 then
6670    PInteger(data)^:={%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result'));
6671  Result:=false;
6672end;
6673
6674function MessageBoxClosed(Widget : PGtkWidget; {%H-}Event : PGdkEvent;
6675  data: gPointer) : GBoolean; cdecl;
6676var ModalResult : PtrUInt;
6677begin
6678  { We were requested by window manager to close }
6679  if PInteger(data)^ = 0 then begin
6680    ModalResult:= {%H-}PtrUInt(g_object_get_data(PGObject(Widget), 'modal_result'));
6681    { Don't allow to close if we don't have a default return value }
6682    Result:= (ModalResult = 0);
6683    if not Result then PInteger(data)^:= ModalResult
6684    else DebugLn('Do not close !!!');
6685  end else Result:= false;
6686end;
6687
6688function TGtk2WidgetSet.MessageBox(hWnd: HWND; lpText, lpCaption: PChar;
6689  uType : Cardinal): integer;
6690var Dialog, ALabel : PGtkWidget;
6691    ButtonCount, DefButton, ADialogResult : Integer;
6692
6693    procedure CreateButton(const ALabel : PChar; const RetValue : integer);
6694    var AButton : PGtkWidget;
6695    begin
6696      AButton:= gtk_button_new_with_mnemonic(Ampersands2Underscore(ALabel));
6697      Inc(ButtonCount);
6698      if ButtonCount = DefButton then begin
6699        gtk_window_set_focus(PGtkWindow(Dialog), AButton);
6700      end;
6701      { If there is the Cancel button, allow the dialog to close }
6702      if RetValue = IDCANCEL then begin
6703        g_object_set_data(PGObject(Dialog), 'modal_result', Pointer(IDCANCEL));
6704      end;
6705      g_object_set_data(PGObject(AButton), 'modal_result',
6706                          {%H-}Pointer(PtrInt(RetValue)));
6707      g_signal_connect(PGtkObject(AButton), 'clicked',
6708                       TGtkSignalFunc(@MessageButtonClicked), @ADialogResult);
6709      gtk_container_add (PGtkContainer(PGtkDialog(Dialog)^.action_area), AButton);
6710    end;
6711
6712begin
6713  ButtonCount:= 0;
6714  { Determine which is the default button }
6715  DefButton:= ((uType and $00000300) shr 8) + 1;
6716  //DebugLn('Trace:Default button is ' + IntToStr(DefButton));
6717
6718  ADialogResult:= 0;
6719  Dialog:= gtk_dialog_new;
6720  {$IFDEF DebugLCLComponents}
6721  DebugGtkWidgets.MarkCreated(Dialog,'TGtk2WidgetSet.MessageBox');
6722  {$ENDIF}
6723  g_signal_connect(PGtkObject(Dialog), 'delete-event', TGtkSignalFunc(@MessageBoxClosed), @ADialogResult);
6724  gtk_window_set_default_size(PGtkWindow(Dialog), 100, 100);
6725  ALabel:= gtk_label_new(lpText);
6726  gtk_container_add (PGtkContainer(PGtkDialog(Dialog)^.vbox), ALabel);
6727  case (uType and $0000000F) of
6728    MB_OKCANCEL:
6729      begin
6730        CreateButton(PChar(rsMbOK), IDOK);
6731        CreateButton(PChar(rsMbCancel), IDCANCEL);
6732      end;
6733    MB_ABORTRETRYIGNORE:
6734      begin
6735        CreateButton(PChar(rsMbAbort), IDABORT);
6736        CreateButton(PChar(rsMbRetry), IDRETRY);
6737        CreateButton(PChar(rsMbIgnore), IDIGNORE);
6738      end;
6739    MB_YESNOCANCEL:
6740      begin
6741        CreateButton(PChar(rsMbYes), IDYES);
6742        CreateButton(PChar(rsMbNo), IDNO);
6743        CreateButton(PChar(rsMbCancel), IDCANCEL);
6744      end;
6745    MB_YESNO:
6746      begin
6747        CreateButton(PChar(rsMbYes), IDYES);
6748        CreateButton(PChar(rsMbNo), IDNO);
6749      end;
6750    MB_RETRYCANCEL:
6751      begin
6752        CreateButton(PChar(rsMbRetry), IDRETRY);
6753        CreateButton(PChar(rsMbCancel), IDCANCEL);
6754      end;
6755    else
6756      begin
6757        { We have no buttons to show. Create the default of OK button }
6758        CreateButton(PChar(rsMbOK), IDOK);
6759      end;
6760  end;
6761  gtk_window_set_title(PGtkWindow(Dialog), lpCaption);
6762  gtk_window_set_position(PGtkWindow(Dialog), GTK_WIN_POS_CENTER);
6763  gtk_window_set_modal(PGtkWindow(Dialog), true);
6764  gtk_widget_show_all(Dialog);
6765  while ADialogResult = 0 do begin
6766    Application.HandleMessage;
6767  end;
6768  DestroyConnectedWidget(Dialog,true);
6769  Result:= ADialogResult;
6770end;
6771
6772{------------------------------------------------------------------------------
6773  Function: MoveToEx
6774  Params:  none
6775  Returns: Nothing
6776
6777
6778 ------------------------------------------------------------------------------}
6779function TGtk2WidgetSet.MoveToEx(DC: HDC; X, Y: Integer; OldPoint: PPoint): Boolean;
6780var
6781  DevCtx: TGtkDeviceContext absolute DC;
6782begin
6783  Result := IsValidDC(DC);
6784  if Result then
6785    with DevCtx do
6786    begin
6787      if Assigned(OldPoint) then
6788        OldPoint^ := PenPos;
6789      PenPos := Point(X, Y)
6790    end;
6791end;
6792
6793function TGtk2WidgetSet.OffsetRgn(RGN: HRGN; nXOffset, nYOffset: Integer): Integer;
6794var
6795  GdkRGN: PGDKRegion;
6796begin
6797  if not IsValidGDIObject(RGN) then
6798    Exit(Error);
6799
6800  GdkRGN := {%H-}PGdiObject(RGN)^.GDIRegionObject;
6801  gdk_region_offset(GdkRGN, nXOffset, nYOffset);
6802  Result := RegionType(GdkRGN);
6803end;
6804
6805{------------------------------------------------------------------------------
6806  Method:  PaintRgn
6807  Params:  DC: HDC; RGN: HRGN
6808  Returns: if the function succeeds
6809
6810  Paints the specified region by using the brush currently selected into the
6811  device context.
6812 ------------------------------------------------------------------------------}
6813function TGtk2WidgetSet.PaintRgn(DC: HDC; RGN: HRGN): Boolean;
6814var
6815  DevCtx: TGtkDeviceContext absolute DC;
6816  CurGdiBrush: PGdiObject;
6817  CurHBrush: HBRUSH absolute CurGdiBrush;
6818begin
6819  CurGdiBrush := DevCtx.CurrentBrush;
6820  Result := IsValidDC(DC) and IsValidGDIObject(RGN) and IsValidGDIObject(CurHBrush);
6821  if Result then
6822    Result := FillRgn(DC, RGN, CurHBrush);
6823end;
6824
6825{------------------------------------------------------------------------------
6826  Function: PeekMessage
6827  Params:  lpMsg        - Where it should put the message
6828           Handle       - Handle of the window (thread)
6829           wMsgFilterMin- Lowest MSG to grab
6830           wMsgFilterMax- Highest MSG to grab
6831           wRemoveMsg   - Should message be pulled out of the queue
6832
6833  Returns: Boolean if an event was there
6834 ------------------------------------------------------------------------------}
6835function TGtk2WidgetSet.PeekMessage(var lpMsg: TMsg; Handle : HWND;
6836  wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): Boolean;
6837var
6838  vlItem : TGtkMessageQueueItem;
6839begin
6840  //TODO Filtering
6841  fMessageQueue.Lock;
6842  try
6843    vlItem := fMessageQueue.FirstMessageItem;
6844    Result := vlItem <> nil;
6845    if Result then begin
6846      lpMsg := vlItem.Msg^;
6847      if (wRemoveMsg and PM_REMOVE) = PM_REMOVE then
6848        fMessageQueue.RemoveMessage(vlItem,FPMF_Internal,true);
6849    end;
6850  finally
6851    fMessageQueue.UnLock;
6852  end;
6853end;
6854
6855{------------------------------------------------------------------------------
6856  Method:  PolyBezier
6857  Params:  DC, Points, NumPts, Filled, Continous
6858  Returns: Boolean
6859
6860  Use Polybezier to draw cubic Bézier curves. The first curve is drawn from the
6861  first point to the fourth point with the second and third points being the
6862  control points. If the Continuous flag is TRUE then each subsequent curve
6863  requires three more points, using the end-point of the previous Curve as its
6864  starting point, the first and second points being used as its control points,
6865  and the third point its end-point. If the continous flag is set to FALSE,
6866  then each subsequent Curve requires 4 additional points, which are used
6867  excatly as in the first curve. Any additonal points which do not add up to
6868  a full bezier(4 for Continuous, 3 otherwise) are ingored. There must be at
6869  least 4 points for an drawing to occur. If the Filled Flag is set to TRUE
6870  then the resulting Poly-Bézier will be drawn as a Polygon.
6871
6872 ------------------------------------------------------------------------------}
6873function TGtk2WidgetSet.PolyBezier(DC: HDC; Points: PPoint; NumPts: Integer;
6874  Filled, Continuous: boolean): boolean;
6875begin
6876  Result := inherited PolyBezier(DC, Points, NumPts, Filled, Continuous);
6877end;
6878
6879{------------------------------------------------------------------------------
6880  Method:   TGtk2WidgetSet.Polygon
6881  Params:   DC: HDC; Points: ^TPoint; NumPts: integer; Winding: Boolean;
6882  Returns:  Nothing
6883
6884  Use Polygon to draw a closed, many-sided shape on the canvas, using the value
6885  of Pen. After drawing the complete shape, Polygon fills the shape using the
6886  value of Brush.
6887  The Points parameter is an array of points that give the vertices of the
6888  polygon.
6889  Winding determines how the polygon is filled. When Winding is True, Polygon
6890  fills the shape using the Winding fill algorithm. When Winding is False,
6891  Polygon uses the even-odd (alternative) fill algorithm.
6892  NumPts indicates the number of points to use.
6893  The first point is always connected to the last point.
6894  To draw a polygon on the canvas, without filling it, use the Polyline method,
6895  specifying the first point a second time at the end.
6896}
6897function TGtk2WidgetSet.Polygon(DC: HDC; Points: PPoint; NumPts: Integer;
6898  Winding: boolean): boolean;
6899var
6900  DevCtx: TGtkDeviceContext absolute DC;
6901  i: integer;
6902  PointArray: PGDKPoint;
6903  Tmp, RGN : hRGN;
6904  ClipRect : TRect;
6905  DCOrigin: TPoint;
6906  OldNumPts: integer;
6907  ThePoints: array of types.TPoint;
6908  PThePoints: PPoint;
6909begin
6910  if not IsValidDC(DC) then Exit(False);
6911
6912  if NumPts <= 0 then Exit(True);
6913
6914  //Create a copy of the points so we can freely alter them
6915  SetLength(ThePoints{%H-}, NumPts);
6916  for i := 0 to NumPts - 1 do ThePoints[i] := Points[i];
6917  PThePoints := @ThePoints[0];
6918
6919  DCOrigin := DevCtx.Offset;
6920  OldNumPts := NumPts;
6921
6922  // create the PointsArray, which is a copy of Points moved by the DCOrigin
6923  // only if needed
6924  if DevCtx.IsNullPen and DevCtx.IsNullBrush then
6925    PointArray := nil
6926  else
6927  begin
6928    GetMem(PointArray, SizeOf(TGdkPoint) * (NumPts + 1)); // +1 for return line
6929    for i := 0 to NumPts - 1 do
6930    begin
6931      if DevCtx.HasTransf then
6932        ThePoints[I] := DevCtx.TransfPointIndirect(ThePoints[I]);
6933      PointArray[i].x := ThePoints[I].x + DCOrigin.X;
6934      PointArray[i].y := ThePoints[I].y + DCOrigin.Y;
6935    end;
6936
6937    if (Points[NumPts-1].X <> Points[0].X) or
6938       (Points[NumPts-1].Y <> Points[0].Y) then
6939    begin
6940      // add last point to return to first
6941      PointArray[NumPts].x := PointArray[0].x;
6942      PointArray[NumPts].y := PointArray[0].y;
6943      Inc(NumPts);
6944    end;
6945  end;
6946
6947  // first draw interior in brush color
6948
6949  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
6950  if not DevCtx.IsNullBrush then
6951  begin
6952    if Winding then
6953    begin
6954      // store old clipping
6955      Tmp := CreateEmptyRegion;
6956      GetClipRGN(DC, Tmp);
6957      // apply new clipping
6958      RGN := CreatePolygonRgn(PThePoints, OldNumPts, LCLType.Winding);
6959      ExtSelectClipRGN(DC, RGN, RGN_AND);
6960      DeleteObject(RGN);
6961      GetClipBox(DC, @ClipRect);
6962
6963      // draw polygon area
6964      DevCtx.FillRect(ClipRect, HBrush({%H-}PtrUInt(DevCtx.GetBrush)), False);
6965      // restore old clipping
6966      SelectClipRGN(DC, Tmp);
6967      DeleteObject(Tmp);
6968    end else
6969    begin
6970      DevCtx.SelectBrushProps;
6971      DevCtx.RemovePixbuf;
6972      gdk_draw_polygon(DevCtx.Drawable, DevCtx.GC, 1, PointArray, NumPts);
6973    end;
6974  end;
6975
6976  // draw outline
6977  if not DevCtx.IsNullPen
6978  then begin
6979    DevCtx.SelectPenProps;
6980    DevCtx.RemovePixbuf;
6981    gdk_draw_polygon(DevCtx.Drawable, DevCtx.GC, 0, PointArray, NumPts);
6982  end;
6983
6984  {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
6985
6986  if PointArray <> nil then FreeMem(PointArray);
6987  SetLength(ThePoints,0);
6988  Result := True;
6989end;
6990
6991
6992function TGtk2WidgetSet.Polyline(DC: HDC; Points: PPoint; NumPts: Integer): boolean;
6993var
6994  DevCtx: TGtkDeviceContext absolute DC;
6995
6996  i: integer;
6997  PointArray: PGDKPoint;
6998  DCOrigin, P: TPoint;
6999begin
7000  if not IsValidDC(DC) then Exit(False);
7001
7002  if NumPts <= 0 then Exit(True);
7003  if DevCtx.IsNullPen then Exit(True);
7004
7005  DCOrigin := DevCtx.Offset;
7006
7007  GetMem(PointArray, SizeOf(TGdkPoint)*NumPts);
7008  for i:=0 to NumPts-1 do
7009  begin
7010    if DevCtx.HasTransf then
7011      P := DevCtx.TransfPointIndirect(Points[I])
7012    else
7013      P := Points[i];
7014    PointArray[i].x := P.x + DCOrigin.X;
7015    PointArray[i].y := P.y + DCOrigin.Y;
7016  end;
7017
7018  // draw line
7019  DevCtx.SelectPenProps;
7020  Result := dcfPenSelected in DevCtx.Flags;
7021  if Result and not DevCtx.IsNullPen
7022  then begin
7023    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
7024    DevCtx.RemovePixbuf;
7025    gdk_draw_lines(DevCtx.Drawable, DevCtx.GC, PointArray, NumPts);
7026    {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
7027  end;
7028
7029  FreeMem(PointArray);
7030end;
7031
7032{------------------------------------------------------------------------------
7033  Function: PostMessage
7034  Params: Handle:
7035          Msg:
7036          wParam:
7037          lParam:
7038  Returns: True if succesful
7039
7040  The PostMessage function places (posts) a message in the message queue and
7041  then returns without waiting.
7042 ------------------------------------------------------------------------------}
7043function TGtk2WidgetSet.PostMessage(Handle: HWND; Msg: Cardinal; wParam: WParam;
7044  lParam: LParam): Boolean;
7045
7046  function ParentPaintMessageInQueue: boolean;
7047  var
7048    Target: TControl;
7049    Parent: TWinControl;
7050    ParentHandle: hWnd;
7051  begin
7052    Result:=false;
7053    Target:=TControl(GetLCLObject({%H-}Pointer(Handle)));
7054    if not (Target is TControl) then exit;
7055    Parent:=Target.Parent;
7056    if (Target is TControl) then begin
7057      Parent:=Target.Parent;
7058      while Parent<>nil do begin
7059        ParentHandle:=Parent.Handle;
7060        if fMessageQueue.FindPaintMessage(ParentHandle)<>nil then begin
7061          Result:=true;
7062        end;
7063        Parent:=Parent.Parent;
7064      end;
7065    end;
7066  end;
7067
7068  procedure CombinePaintMessages(NewMsg:PMsg);
7069  // combine NewMsg and OldMsg paint message into NewMsg and free OldMsg
7070  var
7071    vlItem : TGtkMessageQueueItem;
7072    NewData: TLMGtkPaintData;
7073    OldData: TLMGtkPaintData;
7074    OldMsg : PMsg;
7075  begin
7076    vlItem := fMessageQueue.FindPaintMessage(NewMsg^.Hwnd);
7077    if vlItem = nil then exit;
7078    OldMsg := vlItem.Msg;
7079    if OldMsg = nil then exit;
7080    if (NewMsg^.Message = LM_PAINT) or (OldMsg^.Message = LM_PAINT) then
7081    begin
7082      // LM_PAINT means: repaint all
7083      // convert NewMsg into a LM_PAINT if not already done
7084      if NewMsg^.Message <> LM_PAINT then
7085      begin
7086        FinalizePaintTagMsg(NewMsg);
7087        NewMsg^.Message:=LM_PAINT;
7088      end;
7089    end
7090    else
7091    if (NewMsg^.Message <> LM_GTKPAINT) then
7092      RaiseGDBException('CombinePaintMessages A unknown paint message')
7093    else
7094    if (OldMsg^.Message<>LM_GtkPAINT) then
7095      RaiseGDBException('CombinePaintMessages B unknown paint message')
7096    else
7097    begin
7098      // combine the two LM_GtkPAINT messages
7099      NewData := TLMGtkPaintData(NewMsg^.WParam);
7100      OldData := TLMGtkPaintData(OldMsg^.WParam);
7101      NewData.RepaintAll := NewData.RepaintAll or OldData.RepaintAll;
7102      if not NewData.RepaintAll then
7103      begin
7104        NewData.Rect.Left := Min(NewData.Rect.Left, OldData.Rect.Left);
7105        NewData.Rect.Top := Min(NewData.Rect.Top, OldData.Rect.Top);
7106        NewData.Rect.Right := Max(NewData.Rect.Right, OldData.Rect.Right);
7107        NewData.Rect.Bottom := Max(NewData.Rect.Bottom, OldData.Rect.Bottom);
7108      end;
7109    end;
7110    fMessageQueue.RemoveMessage(vlItem, FPMF_All, True);
7111  end;
7112
7113var
7114  AMessage: PMsg;
7115begin
7116  Result := True;
7117
7118  //debugln(['TGtk2WidgetSet.PostMessage ',dbgsname(GetLCLObject(Pointer(Handle)))]);
7119  New(AMessage);
7120  FillByte(AMessage^,SizeOf(TMsg),0);
7121  AMessage^.HWnd := Handle; // this is normally the main gtk widget
7122  AMessage^.Message := Msg;
7123  AMessage^.WParam := WParam;
7124  AMessage^.LParam := LParam;
7125
7126  FMessageQueue.Lock;
7127  try
7128    if (AMessage^.Message = LM_PAINT) or (AMessage^.Message = LM_GTKPAINT) then
7129    begin
7130      { Obsolete, because InvalidateRectangle now works.
7131
7132      // paint messages are the most expensive messages in the LCL
7133      // A paint message to a control will also repaint all child controls.
7134      // -> check if there is already a paint message for one of its parents
7135      // if yes, then skip this message
7136      if ParentPaintMessageInQueue then begin
7137        FinalizePaintTagMsg(AMessage^);
7138        exit;
7139      end;}
7140
7141      // delete old paint message to this widget,
7142      // so that the widget repaints only once
7143
7144      CombinePaintMessages(AMessage);
7145    end;
7146
7147    FMessageQueue.AddMessage(AMessage);
7148
7149    {$IFDEF USE_GTK_MAIN_OLD_ITERATION}
7150    if GetCurrentThreadId <> MainThreadID then
7151    begin
7152      // awake gtk loop
7153      // when the main thread is currently processing messages it will process
7154      // fMessageQueue.
7155      // But when the main thread is waiting for the next gtk message it will
7156      // wait for the next external event before processing fMessageQueue.
7157      // A g_idle_add can only be used if glib multithreading has been enabled
7158      // ToDo: Find out what we loose when enabling multithreading
7159      //       or find another way to wake up the gtk loop
7160      {$IFDEF EnabledGtkThreading}
7161        gdk_flush();
7162        g_main_context_wakeup(nil);
7163      {$ELSE}
7164        DebugLn(['TGtk2WidgetSet.PostMessage ToDo: wake up gtk']);
7165      {$ENDIF}
7166    end;
7167    {$ENDIF}
7168  finally
7169    FMessageQueue.UnLock;
7170  end;
7171
7172  {$IFNDEF USE_GTK_MAIN_OLD_ITERATION}
7173  if GetCurrentThreadId <> MainThreadID then
7174  begin
7175    // old glib versions needs another way to wake up.
7176    if (glib_major_version = 2) and
7177      (glib_minor_version < 24) and (FMainPoll <> nil) then
7178      FMainPoll^.revents := 1;
7179    g_main_context_wakeup(g_main_context_default);
7180  end;
7181  {$ENDIF}
7182end;
7183
7184{------------------------------------------------------------------------------
7185  Function: PtInRegion
7186  Params:   RGN: HRGN; X, Y: Integer
7187  Returns:  True if the specified point is in the region.
7188
7189  Determines whether the specified point is inside the specified region.
7190 ------------------------------------------------------------------------------}
7191function TGtk2WidgetSet.PtInRegion(RGN: HRGN; X, Y: Integer): Boolean;
7192begin
7193  Result := False;
7194  if not IsValidGDIObject(RGN) then
7195    exit;
7196  if ({%H-}PGdiObject(RGN)^.GDIBitmapObject <> nil) or
7197    ({%H-}PGdiObject(RGN)^.GDIPixbufObject <> nil) or
7198    ({%H-}PGdiObject(RGN)^.GDIPixmapObject.Image <> nil) then
7199  begin
7200    // issue #27080
7201    Result := False;
7202  end else
7203    Result := gdk_region_point_in({%H-}PGdiObject(RGN)^.GDIRegionObject, X, Y);
7204end;
7205
7206{------------------------------------------------------------------------------
7207  Method:   RadialArc
7208  Params:   DC, left, top, right, bottom, sx, sy, ex, ey
7209  Returns:  Nothing
7210
7211  Use RadialArc to draw an elliptically curved line with the current Pen. The
7212  values sx,sy, and ex,ey represent the starting and ending radial-points
7213  between which the Arc is drawn.
7214------------------------------------------------------------------------------}
7215function TGtk2WidgetSet.RadialArc(DC: HDC; left, top, right, bottom,
7216  sx, sy, ex, ey: Integer): Boolean;
7217begin
7218  Result := inherited RadialArc(DC, left, top, right, bottom, sx, sy, ex, ey);
7219end;
7220
7221{------------------------------------------------------------------------------
7222  Method:   RadialChord
7223  Params:   DC, x1, y1, x2, y2, sx, sy, ex, ey
7224  Returns:  Nothing
7225
7226  Use RadialChord to draw a filled Chord-shape on the canvas. The values sx,sy,
7227  and ex,ey represent the starting and ending radial-points between which
7228  the bounding-Arc is drawn.
7229------------------------------------------------------------------------------}
7230function TGtk2WidgetSet.RadialChord(DC: HDC; x1, y1, x2, y2,
7231  sx, sy, ex, ey: Integer): Boolean;
7232begin
7233  Result := inherited RadialChord(DC, x1, y1, x2, y2, sx, sy, ex, ey);
7234end;
7235
7236{------------------------------------------------------------------------------
7237  Function: RealizePalette
7238  Params:  DC: HDC
7239  Returns: Nothing
7240 ------------------------------------------------------------------------------}
7241function TGtk2WidgetSet.RealizePalette(DC: HDC): Cardinal;
7242begin
7243  Result := 0;
7244  if IsValidDC(DC)
7245  then with TGtkDeviceContext(DC) do
7246  begin
7247
7248  end;
7249end;
7250
7251{------------------------------------------------------------------------------
7252  Function: Rectangle
7253  Params:  DC: HDC; X1, Y1, X2, Y2: Integer
7254  Returns: Nothing
7255 ------------------------------------------------------------------------------}
7256function TGtk2WidgetSet.Rectangle(DC: HDC; X1, Y1, X2, Y2: Integer): Boolean;
7257var
7258  DevCtx: TGtkDeviceContext absolute DC;
7259
7260  Left, Top, Width, Height: Integer;
7261  DCOrigin: TPoint;
7262  Brush: PGdiObject;
7263  ClipArea: TGdkRectangle;
7264begin
7265  if not IsValidDC(DC) then Exit(False);
7266
7267  if DevCtx.HasTransf then
7268    DevCtx.TransfRect(X1, Y1, X2, Y2);
7269
7270  CalculateLeftTopWidthHeight(X1, Y1, X2, Y2, Left, Top, Width, Height);
7271  if (Width = 0) or (Height = 0) then Exit(True);
7272  // X2, Y2 is not part of the rectangle
7273  dec(Width);
7274  dec(Height);
7275
7276  // first draw interior in brush color
7277  DevCtx.SelectBrushProps;
7278  DCOrigin := DevCtx.Offset;
7279
7280  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
7281
7282  if not DevCtx.IsNullBrush then
7283  begin
7284    ClipArea := DevCtx.ClipRect;
7285    Brush := DevCtx.GetBrush;
7286    DevCtx.RemovePixbuf;
7287    if  (Brush^.GDIBrushFill = GDK_SOLID) and
7288      (IsBackgroundColor(TColor(Brush^.GDIBrushColor.ColorRef)))
7289    then
7290      StyleFillRectangle(DevCtx.Drawable, DevCtx.GC, Brush^.GDIBrushColor.ColorRef,
7291                         Left+DCOrigin.X, Top+DCOrigin.Y, Width, Height, @ClipArea)
7292    else
7293      gdk_draw_rectangle(DevCtx.Drawable, DevCtx.GC, 1,
7294                         Left+DCOrigin.X, Top+DCOrigin.Y, Width, Height);
7295  end;
7296
7297  // Draw outline
7298  DevCtx.SelectPenProps;
7299  Result := dcfPenSelected in DevCtx.Flags;
7300  if Result and not DevCtx.IsNullPen
7301  then begin
7302    DevCtx.RemovePixbuf;
7303    gdk_draw_rectangle(DevCtx.Drawable, DevCtx.GC, 0,
7304                       Left+DCOrigin.X, Top+DCOrigin.Y, Width, Height);
7305  end;
7306
7307  {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
7308end;
7309
7310{------------------------------------------------------------------------------
7311  Function: RectInRegion
7312  Params:   RGN: HRGN; ARect: TRect
7313  Returns:  True if any part of the specified rectangle lies within the
7314            boundaries of the region.
7315
7316  Determines whether any part of the specified rectangle is within the boundaries
7317  of a region.
7318
7319 ------------------------------------------------------------------------------}
7320function TGtk2WidgetSet.RectInRegion(RGN: HRGN; ARect: TRect): Boolean;
7321var
7322  AGdkRect: TGdkRectangle;
7323begin
7324  //todo: sanity checks for valid handle etc.
7325  AGdkRect := GdkRectFromRect(ARect);
7326  Result := gdk_region_rect_in({%H-}PGdiObject(RGN)^.GDIRegionObject, @AGdkRect)
7327             <> GDK_OVERLAP_RECTANGLE_OUT;
7328end;
7329
7330{------------------------------------------------------------------------------
7331  Function: RectVisible
7332  Params:  dc : hdc; ARect: TRect
7333  Returns: True if ARect is not completely clipped away.
7334 ------------------------------------------------------------------------------}
7335function TGtk2WidgetSet.RectVisible(dc: hdc; const ARect: TRect): Boolean;
7336begin
7337  Result := inherited RectVisible(dc,ARect);
7338end;
7339
7340{------------------------------------------------------------------------------
7341  Function: RegroupMenuItem
7342  Params:  hndMenu: HMENU; GroupIndex: integer
7343  Returns: Nothing
7344
7345  Move a menuitem into its group
7346  This function is called by the LCL, after some menuitems were regrouped to
7347  GroupIndex. The hndMenu is one of them.
7348  Update all radio groups.
7349 ------------------------------------------------------------------------------}
7350function TGtk2WidgetSet.RegroupMenuItem(hndMenu: HMENU; GroupIndex: integer
7351  ): Boolean;
7352
7353const
7354  GROUPIDX_DATANAME = 'GroupIndex';
7355
7356  function GetGroup: PGSList;
7357  var
7358    Item, orgList: PGList;
7359    parent : PGTKWidget;
7360  begin
7361    Result := nil;
7362    parent := gtk_widget_get_parent({%H-}Pointer(hndMenu));
7363    if parent = nil then Exit;
7364
7365    Item := gtk_container_get_children(PGTKContainer(parent));
7366    orgList := Item;
7367    while Item <> nil do
7368    begin
7369      if (Item^.Data <> {%H-}Pointer(hndMenu)) // exclude ourself
7370      and gtk_is_radio_menu_item(Item^.Data)
7371      and (GroupIndex = Integer({%H-}PtrUInt(g_object_get_data(Item^.Data, GROUPIDX_DATANAME))))
7372      then begin
7373        Result := gtk_radio_menu_item_get_group (PGtkRadioMenuItem(Item^.Data));
7374        Exit;
7375      end;
7376      Item := Item^.Next;
7377    end;
7378    if Assigned(orgList) then
7379      g_list_free(orgList);
7380  end;
7381
7382var
7383  RadioGroup: PGSList;
7384  //CurrentGroupIndex: Integer;
7385begin
7386  Result := False;
7387
7388  if not gtk_is_radio_menu_item({%H-}Pointer(hndMenu))
7389  then begin
7390    DebugLn('WARNING: TGtk2WidgetSet.RegroupMenuItem: handle is not a GTK_RADIO_MENU_ITEM');
7391    Exit;
7392  end;
7393
7394  //CurrentGroupIndex := integer({%H-}PtrUInt(g_object_get_data({%H-}Pointer(hndMenu), GROUPIDX_DATANAME)));
7395
7396  // Update needed ?
7397 { if GroupIndex = CurrentGroupIndex
7398  then begin
7399    Result := True;
7400    Exit;
7401  end;}
7402
7403  // Remove current group
7404  gtk_radio_menu_item_set_group({%H-}PGtkRadioMenuItem(hndMenu), nil);
7405  g_object_set_data({%H-}Pointer(hndMenu), GROUPIDX_DATANAME, nil);
7406
7407  // Check remove only
7408 { if GroupIndex = 0
7409  then begin
7410    Result := True;
7411    Exit;
7412  end;  }
7413
7414  // Try to find new group
7415  RadioGroup := GetGroup;
7416
7417  // Set new group
7418  g_object_set_data({%H-}Pointer(hndMenu), GROUPIDX_DATANAME, {%H-}Pointer(PtrInt(GroupIndex)));
7419  if RadioGroup = nil
7420  then begin
7421    // We're the only member, get a group
7422    RadioGroup := gtk_radio_menu_item_group({%H-}PGtkRadioMenuItem(hndMenu))
7423  end
7424  else begin
7425    gtk_radio_menu_item_set_group({%H-}PGtkRadioMenuItem(hndMenu), RadioGroup);
7426  end;
7427                                                                    //radiogroup^.data
7428                                                                    //radiogroup^.next
7429  // Refetch newgroup list
7430  RadioGroup := gtk_radio_menu_item_group({%H-}PGtkRadioMenuItem(hndMenu));
7431  // Update checks
7432  UpdateRadioGroupChecks(RadioGroup);
7433  Result := True;
7434end;
7435
7436
7437{------------------------------------------------------------------------------
7438  Function: ReleaseCapture
7439  Params:  none
7440  Returns: True if succesful
7441
7442  The ReleaseCapture function releases the mouse capture from a window
7443  and restores normal mouse input processing.
7444 ------------------------------------------------------------------------------}
7445function TGtk2WidgetSet.ReleaseCapture: Boolean;
7446begin
7447  SetCapture(0);
7448  Result := True;
7449end;
7450
7451function TGtk2WidgetSet.ReleaseDC(hWnd: HWND; DC: HDC): Integer;
7452var
7453  aDC, pSavedDC: TGtkDeviceContext;
7454  g: TGDIType;
7455  CurGDIObject: PGDIObject;
7456begin
7457  //DebugLn(['[TGtk2WidgetSet.ReleaseDC] ',DC,'  ',FDeviceContexts.Count]);
7458  Result := 0;
7459
7460  if (DC <> 0)
7461  then begin
7462    if FDeviceContexts.Contains({%H-}Pointer(DC))
7463    then begin
7464      aDC := TGtkDeviceContext(DC);
7465
7466      // clear references to all GDI objects
7467      for g:=Low(TGDIType) to high(TGDIType) do begin
7468        {if aDC.GDIObjects[g]<>nil then
7469          if FindDCWithGDIObject(aDC.GDIObjects[g])=nil then
7470            RaiseGDBException('');}
7471        aDC.GDIObjects[g]:=nil; // clear the reference, decrease DCCount
7472      end;
7473
7474      // Release all saved device contexts (the owned GDI objects will be freed)
7475      pSavedDC:=aDC.SavedContext;
7476      if pSavedDC<>nil then begin
7477        ReleaseDC(0,HDC(pSavedDC));
7478        aDC.SavedContext:=nil;
7479      end;
7480
7481      //DebugLn(['TGtk2WidgetSet.ReleaseDC DC=',dbgs(TGtkDeviceContext(aDC)),' ClipRegion=',dbgs(aDC.ClipRegion)]);
7482      // free all owned GDI objects
7483      for g:=Low(TGDIType) to high(TGDIType) do begin
7484        CurGDIObject:=aDC.OwnedGDIObjects[g];
7485        if CurGDIObject<>nil then begin
7486          if CurGDIObject^.Owner<>aDC then
7487            RaiseGDBException('');
7488          DeleteObject(HGDIOBJ({%H-}PtrUInt(CurGDIObject)));
7489          if aDC.OwnedGDIObjects[g]<>nil then
7490            RaiseGDBException('');
7491        end;
7492      end;
7493
7494      //DebugLn(['TGtk2WidgetSet.ReleaseDC DC=',dbghex(PtrInt(DC)),' Font=',dbghex(PtrInt(aDC.CurrentFont))]);
7495
7496      {FreeGDIColor(aDC.CurrentTextColor);
7497      FreeGDIColor(aDC.CurrentBackColor);}
7498
7499      try
7500        { On root window, we don't allocate a graphics context and so we do not free}
7501        if aDC.HasGC then
7502        begin
7503          gdk_gc_unref(aDC.GC);
7504          aDC.GC:=nil;
7505        end;
7506      except
7507        on E:Exception do begin
7508          // Nothing, just try to unref it
7509          // (it segfaults if the window doesnt exist anymore :-)
7510          DebugLn('TGtk2WidgetSet.ReleaseDC: ',E.Message);
7511        end;
7512      end;
7513
7514      DisposeDC(aDC);
7515      Result := 1;
7516    end;
7517  end;
7518end;
7519
7520{------------------------------------------------------------------------------
7521  Function: RemoveProp
7522  Params: Handle: Handle of the object
7523          Str: Name of the property to remove
7524  Returns: The handle of the property (0=failure)
7525
7526 ------------------------------------------------------------------------------}
7527function TGtk2WidgetSet.RemoveProp(Handle: hwnd; Str: PChar): THandle;
7528begin
7529  g_object_set_data({%H-}PGObject(handle), Str, nil);
7530  Result := 1;
7531end;
7532
7533{------------------------------------------------------------------------------
7534  Function: RestoreDC
7535  Params:  none
7536  Returns: Nothing
7537
7538
7539-------------------------------------------------------------------------------}
7540function TGtk2WidgetSet.RestoreDC(DC: HDC; SavedDC: Integer): Boolean;
7541var
7542  DevCtx: TGtkDeviceContext absolute DC;
7543  SavedDevCtx: TGtkDeviceContext;
7544begin
7545  if not IsValidDC(DC) then Exit(False);
7546  if SavedDC <= 0 then Exit(False);
7547  repeat
7548    SavedDevCtx := DevCtx.SavedContext;
7549    Dec(SavedDC);
7550
7551    // TODO copy bitmap too
7552    // clear the GDIObjects in pSavedDC, so they are not freed by DeleteDC
7553    Result := DevCtx.CopyDataFrom(SavedDevCtx, True, True, True);
7554    DevCtx.SavedContext := SavedDevCtx.SavedContext;
7555    SavedDevCtx.SavedContext := nil;
7556    DevCtx.SelectRegion;
7557
7558    // free saved DC
7559    DeleteDC(HDC(SavedDevCtx));
7560  until SavedDC <= 0;
7561end;
7562
7563{------------------------------------------------------------------------------
7564  Method:   RoundRect
7565  Params:   X1, Y1, X2, Y2, RX, RY
7566  Returns:  If succesfull
7567
7568  Draws a Rectangle with optional rounded corners. RY is the radial height
7569  of the corner arcs, RX is the radial width. If either is less than or equal to
7570  0, the routine simly calls to standard Rectangle.
7571 ------------------------------------------------------------------------------}
7572function TGtk2WidgetSet.RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer;
7573  RX,RY : Integer): Boolean;
7574begin
7575  Result := inherited RoundRect(DC, X1, Y1, X2, Y2, RX, RY);
7576end;
7577
7578{------------------------------------------------------------------------------
7579  Function: SaveDc
7580  Params:  DC: a DC to save
7581  Returns: 0 if the functions fails otherwise a positive integer identifing
7582           the saved DC
7583
7584  The SaveDC function saves the current state of the specified device
7585  context (DC) by copying its elements to a context stack.
7586-------------------------------------------------------------------------------}
7587function TGtk2WidgetSet.SaveDC(DC: HDC): Integer;
7588var
7589  DevCtx: TGtkDeviceContext absolute DC;
7590  aSavedDC: TGtkDeviceContext;
7591begin
7592  Result := 0;
7593  if IsValidDC(DC) then
7594  begin
7595    aSavedDC := NewDC;
7596    aSavedDC.CopyDataFrom(DevCtx, False, True, False);
7597    aSavedDC.SavedContext := DevCtx.SavedContext;
7598    DevCtx.SavedContext:= aSavedDC;
7599    Result := 1;
7600  end;
7601end;
7602
7603{------------------------------------------------------------------------------
7604  Function: ScreenToClient
7605  Params: Handle:
7606          P:
7607  Returns:
7608
7609 ------------------------------------------------------------------------------}
7610function TGtk2WidgetSet.ScreenToClient(Handle : HWND; var P : TPoint) : Integer;
7611var
7612  X, Y: Integer;
7613  Widget: PGTKWidget;
7614  Window: PGdkWindow;
7615Begin
7616  if Handle = 0 then
7617  begin
7618    X := 0;
7619    Y := 0;
7620  end else
7621  begin
7622    Widget := GetFixedWidget({%H-}pgtkwidget(Handle));
7623    if Widget = nil then
7624      Widget := {%H-}pgtkwidget(Handle);
7625    if Widget = nil then
7626    begin
7627      X := 0;
7628      Y := 0;
7629    end else
7630    begin
7631      Window := GetControlWindow(Widget);
7632      {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
7633      if Window <> nil then
7634      begin
7635        gdk_window_get_origin(Window, @X, @Y);
7636        // set pos to client coords. issue #21366
7637        if GTK_WIDGET_NO_WINDOW(Widget) and (gtk_widget_get_parent(Widget) <> nil) then
7638        begin
7639          P.X := P.X - X - Widget^.allocation.x;
7640          P.Y := P.Y - Y - Widget^.allocation.y;
7641          Result := -1;
7642          exit;
7643        end;
7644
7645      end else
7646      begin
7647        X:=0;
7648        Y:=0;
7649      end;
7650      {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
7651    end;
7652  end;
7653
7654  //DebugLn('[TGtk2WidgetSet.ScreenToClient] ',x,',',y,' P=',P.X,',',P.Y);
7655  dec(P.X, X);
7656  dec(P.Y, Y);
7657  Result := -1;
7658end;
7659
7660{------------------------------------------------------------------------------
7661  Function: ScrollWindowEx
7662  Params:  hWnd:       handle of window to scroll
7663           dx:         horizontal amount to scroll
7664           dy:         vertical amount to scroll
7665           prcScroll:  pointer to scroll rectangle
7666           prcClip:    pointer to clip rectangle
7667           hrgnUpdate: handle of update region
7668           prcUpdate:  pointer to update rectangle
7669           flags:      scrolling flags
7670
7671  Returns: True if succesfull;
7672
7673  The ScrollWindowEx function scrolls the content of the specified window's
7674  client area
7675 ------------------------------------------------------------------------------}
7676function TGtk2WidgetSet.ScrollWindowEx(hWnd: HWND; dx, dy: Integer; prcScroll, prcClip: PRect; hrgnUpdate: HRGN; prcUpdate: PRect; flags: UINT): Boolean;
7677var
7678  Widget: PGtkWidget;
7679  Window: PGdkWindow;
7680  {$ifdef GTK_2_8}
7681  Region: PGdkRegion;
7682  RClient, RFullSource, RUsableSource, RTarget, RUsableTarget: TRect;
7683  Rect1: TGdkRectangle;
7684  Rect2: TRect; // area to invalidate
7685  WidgetInfo: PWidgetInfo;
7686  {$ENDIF}
7687begin
7688  Result := False;
7689  if (dy = 0) and (dx = 0) then exit;
7690  {$IFDEF DisableGtk2ScrollWindow}
7691  exit;
7692  {$ENDIF}
7693  // prcScroll, prcClip are not supported under gdk yet
7694  if (hWnd = 0) then
7695    exit;
7696  // or (prcScroll <> nil) or (prcClip <> nil) then Exit;
7697
7698  Widget := {%H-}pgtkwidget(hWnd);
7699  Widget := GetFixedWidget(Widget);
7700  if Widget = nil then exit;
7701  Window:=GetControlWindow(Widget);
7702  if Window = nil then exit;
7703
7704  Result := true;
7705
7706  {$ifdef GTK_2_8}
7707  RClient.Left := 0;//Widget^.Allocation.Left;
7708  RClient.Top := 0; //Widget^.Allocation.Top;
7709  RClient.Right := Widget^.Allocation.width;
7710  RClient.Bottom := Widget^.Allocation.height;
7711  RFullSource := RClient;
7712  {$ifdef VerboseScrollWindowEx}
7713  DebugLn(['ScrollWindowEx A RClient=', dbgs(RClient),' dy=',dy, ' scroll=',dbgs(prcScroll^), ' clip=',dbgs(prcClip^)]);
7714  {$ENDIF}
7715
7716  // Any part of RFullSource, that is not targeted by the move must later be invalidated
7717  if PrcScroll <> nil then
7718  begin
7719    RFullSource.Left   := Max(RClient.Left,   PrcScroll^.Left);
7720    RFullSource.Top    := Max(RClient.Top,    PrcScroll^.Top);
7721    RFullSource.Right  := Min(RClient.Right,  PrcScroll^.Right);
7722    RFullSource.Bottom := Min(RClient.Bottom, PrcScroll^.Bottom);
7723  end;
7724
7725  // Target is expected to be completly filled with valid content by move,
7726  // any part that can not be filled must be invalidated
7727  RTarget.Left   := Max(RClient.Left,   RFullSource.Left + dx);
7728  RTarget.Top    := Max(RClient.Top,    RFullSource.Top + dy);
7729  RTarget.Right  := Min(RClient.Right,  RFullSource.Right + dx);
7730  RTarget.Bottom := Min(RClient.Bottom, RFullSource.Bottom + dy);
7731  if (PrcClip <> nil) then begin
7732    RTarget.Left   := Max(RTarget.Left,   prcClip^.Left);
7733    RTarget.Top    := Max(RTarget.Top,    prcClip^.Top);
7734    RTarget.Right  := Min(RTarget.Right,  prcClip^.Right);
7735    RTarget.Bottom := Min(RTarget.Bottom, prcClip^.Bottom);
7736  end;
7737
7738  // Only Source that will fit into target
7739  RUsableSource.Left   := Max(RTarget.Left - dx,   RFullSource.Left);
7740  RUsableSource.Top    := Max(RTarget.Top - dy,    RFullSource.Top);
7741  RUsableSource.Right  := Min(RTarget.Right - dx,  RFullSource.Right);
7742  RUsableSource.Bottom := Min(RTarget.Bottom - dy, RFullSource.Bottom);
7743  {$ifdef VerboseScrollWindowEx}
7744  DebugLn(['ScrollWindowEx B RFullSource=', dbgs(RFullSource), ' RUsableSource=', dbgs(RUsableSource)]);
7745  {$ENDIF}
7746
7747  // And also, only Source that is valid
7748  WidgetInfo := GetWidgetInfo(Widget);
7749  if WidgetInfo <> nil then begin
7750    {$ifdef VerboseScrollWindowEx}
7751    DebugLn(['ScrollWindowEx C ', dbgs(WidgetInfo^.UpdateRect)]);
7752    {$ENDIF}
7753    // exclude allready invalidated area
7754    // "UpdateRect.Bottom > 0" => there is an UpdateRect / Top is valid
7755    if (dy < 0) and (WidgetInfo^.UpdateRect.Bottom > 0) then
7756      RUsableSource.Bottom := Min(RUsableSource.Bottom, WidgetInfo^.UpdateRect.Top);
7757    if (dy > 0) and (RUsableSource.Top < WidgetInfo^.UpdateRect.Bottom) then
7758      RUsableSource.Top := WidgetInfo^.UpdateRect.Bottom;
7759
7760    if (dx < 0) and (WidgetInfo^.UpdateRect.Right > 0) then
7761      RUsableSource.Right := Min(RUsableSource.Right, WidgetInfo^.UpdateRect.Left);
7762    if (dx > 0) and (RUsableSource.Left < WidgetInfo^.UpdateRect.Right) then
7763      RUsableSource.Left := WidgetInfo^.UpdateRect.Right;
7764  end;
7765  {$ifdef VerboseScrollWindowEx}
7766  DebugLn(['ScrollWindowEx D RUsableSource=', dbgs(RUsableSource)]);
7767  {$ENDIF}
7768
7769  // TODO: content moved into currently invalidated space, may reduce the inval rect
7770  // All of RUsableTarget should be validated;
7771  RUsableTarget.Left   := Max(RTarget.Left,   RUsableSource.Left + dx);
7772  RUsableTarget.Top    := Max(RTarget.Top,    RUsableSource.Top + dy);
7773  RUsableTarget.Right  := Min(RTarget.Right,  RUsableSource.Right + dx);
7774  RUsableTarget.Bottom := Min(RTarget.Bottom, RUsableSource.Bottom + dy);
7775  {$ifdef VerboseScrollWindowEx}
7776  DebugLn(['ScrollWindowEx D RUsableTarget=', dbgs(RUsableTarget)]);
7777  {$ENDIF}
7778
7779  Rect1 := GdkRectFromRect(RUsableSource);
7780
7781  if (Rect1.height > 0) and (Rect1.width > 0) then begin
7782    Region := gdk_region_rectangle(@Rect1);
7783    gdk_window_move_region(Window, Region, dx, dy);
7784    gdk_region_destroy(Region);
7785
7786    if (flags and SW_INVALIDATE) <> 0 then begin
7787      //invalidate
7788      If RUsableTarget.Left > RFullSource.Left then begin
7789        Rect2 := RFullSource;
7790        Rect2.Right:= RUsableTarget.Left;
7791        {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate Src Left', dbgs(Rect2)]);{$ENDIF}
7792        InvalidateRect(hWnd, @Rect2, false);
7793        if (prcUpdate <> nil) and (dx > 0) then prcUpdate^ := Rect2;
7794      end;
7795
7796      If RUsableTarget.Right < RFullSource.Right then begin
7797        Rect2 := RFullSource;
7798        Rect2.Left:= RUsableTarget.Right;
7799        {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate Src Right', dbgs(Rect2)]);{$ENDIF}
7800        InvalidateRect(hWnd, @Rect2, false);
7801        if (prcUpdate <> nil) and (dx < 0) then prcUpdate^ := Rect2;
7802      end;
7803
7804      If RUsableTarget.Top > RFullSource.Top then begin
7805        Rect2 := RFullSource;
7806        Rect2.Bottom:= RUsableTarget.Top;
7807        {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate Src Top', dbgs(Rect2)]);{$ENDIF}
7808        InvalidateRect(hWnd, @Rect2, false);
7809        if (prcUpdate <> nil) and (dy > 0) then prcUpdate^ := Rect2;
7810      end;
7811
7812      If RUsableTarget.Bottom < RFullSource.Bottom then begin
7813        Rect2 := RFullSource;
7814        Rect2.Top:= RUsableTarget.Bottom;
7815        {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate Src Bottom', dbgs(Rect2)]);{$ENDIF}
7816        InvalidateRect(hWnd, @Rect2, false);
7817        if (prcUpdate <> nil) and (dy < 0) then prcUpdate^ := Rect2;
7818      end;
7819
7820
7821      If RUsableTarget.Left > RTarget.Left then begin
7822        Rect2 := RTarget;
7823        Rect2.Right:= RUsableTarget.Left;
7824        {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate TARGET Left', dbgs(Rect2)]);{$ENDIF}
7825        InvalidateRect(hWnd, @Rect2, false);
7826      end;
7827
7828      If RUsableTarget.Right < RTarget.Right then begin
7829        Rect2 := RTarget;
7830        Rect2.Left:= RUsableTarget.Right;
7831        {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate TARGET Right', dbgs(Rect2)]);{$ENDIF}
7832        InvalidateRect(hWnd, @Rect2, false);
7833      end;
7834
7835      If RUsableTarget.Top > RTarget.Top then begin
7836        Rect2 := RTarget;
7837        Rect2.Bottom:= RUsableTarget.Top;
7838        {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate TARGET Top', dbgs(Rect2)]);{$ENDIF}
7839        InvalidateRect(hWnd, @Rect2, false);
7840      end;
7841
7842      If RUsableTarget.Bottom < RTarget.Bottom then begin
7843        Rect2 := RTarget;
7844        Rect2.Top:= RUsableTarget.Bottom;
7845        {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate TARGET Bottom', dbgs(Rect2)]);{$ENDIF}
7846        InvalidateRect(hWnd, @Rect2, false);
7847      end;
7848    end;
7849  end
7850  else begin
7851    if (flags and SW_INVALIDATE) <> 0 then begin
7852      // invalidate, nothing to scroll
7853      {$ifdef VerboseScrollWindowEx}DebugLn(['ScrollWindowEx Invalidate all', dbgs(RUsableSource)]);{$ENDIF}
7854      InvalidateRect(hWnd, @RFullSource, false);
7855      InvalidateRect(hWnd, @RTarget, false);
7856    end
7857    else
7858      Result := False;
7859  end;
7860  {$ELSE}
7861  gdk_window_scroll(Window, dx, dy);
7862  Result := true;
7863  {$ENDIF}
7864end;
7865
7866
7867{------------------------------------------------------------------------------
7868  Function: SelectClipRGN
7869  Params:  DC, RGN
7870  Returns: longint
7871
7872  Sets the DeviceContext's ClipRegion. The Return value
7873  is the new clip regions type, or ERROR.
7874
7875  The result can be one of the following constants
7876      Error
7877      NullRegion
7878      SimpleRegion
7879      ComplexRegion
7880
7881 ------------------------------------------------------------------------------}
7882function TGtk2WidgetSet.SelectClipRGN(DC: hDC; RGN: HRGN): Longint;
7883var
7884  DevCtx: TGtkDeviceContext absolute DC;
7885
7886  RegObj: PGdkRegion;
7887  DCOrigin: TPoint;
7888  OldClipRegion: PGDIObject;
7889begin
7890  if not IsValidDC(DC) then Exit(ERROR);
7891
7892  // clear old clipregion
7893  if Assigned(DevCtx.ClipRegion) then
7894  begin
7895    OldClipRegion := DevCtx.ClipRegion;
7896    DevCtx.ClipRegion := nil;// decrease DCCount
7897    if OldClipRegion = DevCtx.OwnedGDIObjects[gdiRegion] then
7898      DeleteObject(HGDIOBJ({%H-}PtrUInt(OldClipRegion)));
7899  end;
7900
7901  if RGN = 0 then
7902  begin
7903    DevCtx.SelectRegion;
7904    Exit(NULLREGION);
7905  end;
7906
7907  if IsValidGDIObject(RGN) then
7908  begin
7909    DevCtx.ClipRegion := {%H-}PGdiObject(CreateRegionCopy(RGN));
7910    DevCtx.OwnedGDIObjects[gdiRegion] := DevCtx.ClipRegion;
7911    RegObj := DevCtx.ClipRegion^.GDIRegionObject;
7912    DCOrigin := DevCtx.Offset;
7913
7914    gdk_region_offset(RegObj, DCOrigin.x, DCOrigin.Y);
7915    DevCtx.SelectRegion;
7916
7917    Exit(RegionType(RegObj));
7918  end;
7919
7920  // error handling
7921  Result := ERROR;
7922  DebugLn('WARNING: [TGtk2WidgetSet.SelectClipRGN] Invalid RGN');
7923  {$ifdef TraceGdiCalls}
7924  DebugLn();
7925  DebugLn('TraceCall for invalid object: ');
7926  DumpBackTrace(PgdiObject(RGN)^.StackAddrs);
7927  DebugLn();
7928  {$endif}
7929end;
7930
7931{------------------------------------------------------------------------------
7932  Function: SelectObject
7933  Params:  none
7934  Returns: Nothing
7935
7936
7937 ------------------------------------------------------------------------------}
7938function TGtk2WidgetSet.SelectObject(DC: HDC; GDIObj: HGDIOBJ): HGDIOBJ;
7939
7940var
7941  DevCtx: TGtkDeviceContext absolute DC;
7942  GDIObject: PGdiObject absolute GDIObj;
7943  ResultObj: PGdiObject absolute Result;
7944
7945
7946  procedure RaiseInvalidGDIType;
7947  begin
7948    RaiseGDBException('TGtk2WidgetSet.SelectObject Invalid GDIType '+IntToStr(ord({%H-}PGdiObject(GDIObj)^.GDIType)));
7949  end;
7950
7951  {$ifdef DebugLCLComponents}
7952  procedure DebugInvalidDC;
7953  begin
7954    DebugLn(['TGtk2WidgetSet.SelectObject DC=',dbghex(DC),' IsValidDC(DC)=',IsValidDC(DC),' GDIObj=',dbghex(GDIObj)]);
7955    DumpStack;
7956    DebugLn(['DebugInvalidGDIObject DC:']);
7957    Debugln(DebugDeviceContexts.GetInfo(Pointer(DC),true));
7958  end;
7959
7960  procedure DebugInvalidGDIObject;
7961  begin
7962    DebugLn(['TGtk2WidgetSet.SelectObject DC=',dbghex(DC),' GDIObj=',dbghex(GDIObj),' IsValidGDIObject(GDIObj)=',IsValidGDIObject(GDIObj)]);
7963    DumpStack;
7964    DebugLn(['DebugInvalidGDIObject GDIObj:']);
7965    Debugln(DebugGdiObjects.GetInfo(Pointer(GDIObj),true));
7966  end;
7967  {$endif}
7968
7969begin
7970  Result := 0;
7971
7972  if not IsValidDC(DC)
7973  then begin
7974    {$ifdef DebugLCLComponents}
7975    DebugInvalidDC;
7976    {$endif}
7977    Exit;
7978  end;
7979
7980  if not IsValidGDIObject(GDIObj)
7981  then begin
7982    {$ifdef DebugLCLComponents}
7983    DebugInvalidGDIObject;
7984    {$endif}
7985    Exit;
7986  end;
7987  case GDIObject^.GDIType of
7988    gdiPen,
7989    gdiBitmap:
7990      ResultObj := DevCtx.SelectObject(GDIObject);
7991
7992    gdiBrush: begin
7993      ResultObj := DevCtx.GetBrush;// always create, because a valid GDIObject is needed to restore
7994      if DevCtx.CurrentBrush = GDIObject then Exit;
7995
7996      DevCtx.CurrentBrush := GDIObject;
7997      DevCtx.SelectedColors := dcscCustom;
7998    end;
7999
8000    gdiFont: begin
8001      ResultObj := DevCtx.GetFont;// always create, because a valid GDIObject is needed to restore
8002      if (DevCtx.CurrentFont = GDIObject) and not DevCtx.HasTransf then Exit;
8003
8004      DevCtx.CurrentFont := GDIObject;
8005
8006      DevCtx.SetTextMetricsValid(False);
8007      DevCtx.SelectedColors := dcscCustom;
8008    end;
8009
8010    gdiRegion: begin
8011      ResultObj := DevCtx.ClipRegion;
8012      if DevCtx.GC <> nil
8013      then SelectClipRGN(DC, GDIObj)
8014      else DevCtx.ClipRegion := nil;
8015    end;
8016
8017  else
8018    RaiseInvalidGDIType;
8019  end;
8020end;
8021
8022{------------------------------------------------------------------------------
8023  Function: SelectPalette
8024  Params:  none
8025  Returns: Nothing
8026
8027
8028 ------------------------------------------------------------------------------}
8029function TGtk2WidgetSet.SelectPalette(DC: HDC; Palette: HPALETTE; ForceBackground: Boolean): HPALETTE;
8030begin
8031  //TODO: Implement this;
8032  Result := 0;
8033end;
8034
8035{------------------------------------------------------------------------------
8036  Function: SendMessage
8037  Params: hWnd:
8038          Msg:
8039          wParam:
8040          lParam:
8041  Returns:
8042
8043  The SendMessage function sends the specified message to a window or windows.
8044  The function calls the window procedure for the specified window and does
8045  not return until the window procedure has processed the message.
8046 ------------------------------------------------------------------------------}
8047function TGtk2WidgetSet.SendMessage(HandleWnd: HWND; Msg: Cardinal; wParam: WParam;
8048  lParam: LParam): LResult;
8049var
8050  OldMsg: Cardinal;
8051
8052  procedure PreparePaintMessage({%H-}TargetObject: TObject; var AMessage: TLMessage);
8053  var
8054    GtkPaintData: TLMGtkPaintData;
8055    OldGtkPaintMsg: TLMGtkPaint;
8056  begin
8057    (* MG: old trick. Not used anymore, but it might be, that someday there
8058           will be component, that works better with this, so it is kept.
8059    { The LCL repaints controls in a top-down hierachy. But the gtk sends
8060      gtkdraw events bottom-up. So, controls at the bottom are repainted
8061      many times. To avoid this the queue is checked for LM_PAINT messages
8062      for the parent control. If there is a parent LM_PAINT, this message
8063      is ignored.}
8064    if (Target is TControl) then begin
8065      ParentControl:=TControl(Target).Parent;
8066      while ParentControl<>nil do begin
8067        ParentHandle:=TWinControl(ParentControl).Handle;
8068        if FindPaintMessage(ParentHandle)<>nil then begin
8069          {$IFDEF VerboseDsgnPaintMsg}
8070          if (csDesigning in TComponent(Target).ComponentState) then begin
8071            DebugLn('TGtk2WidgetSet.SendMessage A ',
8072              TComponent(Target).Name,':',Target.ClassName,
8073              ' Parent Message found: ',ParentControl.Name,':',ParentControl.ClassName
8074              );
8075          end;
8076          {$ENDIF}
8077          if Msg=LM_PAINT then
8078            ReleaseDC(0,AMessage.WParam);
8079          //exit;
8080        end;
8081        ParentControl:=ParentControl.Parent;
8082      end;
8083    end; *)
8084    {$IFDEF VerboseDsgnPaintMsg}
8085    if (csDesigning in TComponent(TargetObject).ComponentState) then begin
8086      write('TGtk2WidgetSet.SendMessage B ',
8087        TComponent(TargetObject).Name,':',TargetObject.ClassName,
8088        ' GtkPaint=',AMessage.Msg=LM_GtkPAINT);
8089      if AMessage.Msg=LM_GtkPAINT then begin
8090        if AMessage.wParam<>0 then begin
8091          with TLMGtkPaintData(AMessage.wParam) do begin
8092            write(' GtkPaintData(',
8093              ' Widget=',DbgS(Widget),'=',GetWidgetClassName(Widget),
8094              ' State=',State,
8095              ' Rect=',Rect.Left,',',Rect.Top,',',Rect.Right,',',Rect.Bottom,
8096              ' RepaintAll=',RepaintAll,
8097              ')');
8098          end;
8099        end else begin
8100          write(' GtkPaintData=nil');
8101        end;
8102      end;
8103      DebugLn('');
8104    end;
8105    {$ENDIF}
8106
8107    if AMessage.Msg = LM_GTKPAINT
8108    then begin
8109      OldGtkPaintMsg := TLMGtkPaint(AMessage);
8110      GtkPaintData := OldGtkPaintMsg.Data;
8111      // convert LM_GTKPAINT to LM_PAINT
8112      AMessage := TLMessage(GtkPaintMessageToPaintMessage(
8113                                                TLMGtkPaint(AMessage), False));
8114      GtkPaintData.Free;
8115    end;
8116  end;
8117
8118  procedure DisposePaintMessage({%H-}TargetObject: TObject; var AMessage: TLMessage);
8119  begin
8120    if OldMsg = LM_GTKPAINT then
8121    begin
8122      FinalizePaintMessage(@AMessage);
8123    end
8124    else
8125    if (AMessage.Msg = LM_PAINT) and (AMessage.WParam <> 0) then
8126    begin
8127      // free DC
8128      ReleaseDC(0, AMessage.WParam);
8129      AMessage.WParam := 0;
8130    end;
8131  end;
8132
8133var
8134  AMessage: TLMessage;
8135  Target: TObject;
8136begin
8137  OldMsg := Msg;
8138
8139  AMessage.Msg := Msg;
8140  AMessage.WParam := WParam;
8141  AMessage.LParam := LParam;
8142  AMessage.Result := 0;
8143
8144  Target := GetLCLObject({%H-}Pointer(HandleWnd));
8145
8146  if Target <> nil then
8147  begin
8148    if (Msg = LM_PAINT) or (Msg = LM_GTKPAINT) then
8149    begin
8150      PreparePaintMessage(Target,AMessage);
8151      Result := DoDeliverPaintMessage(Target, TLMPaint(AMessage));
8152    end
8153    else
8154      Result := DeliverMessage(Target, AMessage); // deliver it
8155
8156    if (Msg = LM_PAINT) or (Msg = LM_GTKPAINT) then
8157      DisposePaintMessage(Target, AMessage);
8158  end;
8159end;
8160
8161{------------------------------------------------------------------------------
8162  function SetActiveWindow(Handle: HWND): HWND;
8163
8164
8165------------------------------------------------------------------------------}
8166function TGtk2WidgetSet.SetActiveWindow(Handle: HWND): HWND;
8167begin
8168  // ToDo
8169  Result := GetActiveWindow;
8170  if (Handle <> 0) and GtkWidgetIsA({%H-}PGtkWidget(Handle),GTK_TYPE_WINDOW) then
8171  begin
8172    if GTK_WIDGET_VISIBLE({%H-}PGtkWidget(Handle)) then
8173      gtk_window_present({%H-}PGtkWindow(Handle));
8174  end else
8175    Result := 0; // if not active window return error
8176end;
8177
8178{------------------------------------------------------------------------------
8179  Function: SetBkColor        pbd
8180  Params:  DC:    Device context to change the text background color
8181           Color: RGB Tuple
8182  Returns: Old Background color
8183
8184
8185 ------------------------------------------------------------------------------}
8186function TGtk2WidgetSet.SetBkColor(DC: HDC; Color: TColorRef): TColorRef;
8187begin
8188  Result := CLR_INVALID;
8189  if IsValidDC(DC)
8190  then begin
8191    with TGtkDeviceContext(DC) do
8192    begin
8193      Result := CurrentBackColor.ColorRef;
8194      SetGDIColorRef(CurrentBackColor,Color);
8195    end;
8196  end;
8197end;
8198
8199{------------------------------------------------------------------------------
8200  Function: SetBkMode
8201  Params: DC:
8202          bkMode:
8203  Returns:
8204
8205 ------------------------------------------------------------------------------}
8206function TGtk2WidgetSet.SetBkMode(DC: HDC; bkMode: Integer) : Integer;
8207var
8208  DevCtx: TGtkDeviceContext absolute DC;
8209begin
8210  // Your code here
8211  Result := DevCtx.BkMode;
8212  DevCtx.BkMode := bkMode;
8213end;
8214
8215{------------------------------------------------------------------------------
8216  Function: SetCapture
8217  Params:  Value: Handle of window to capture
8218  Returns: Nothing
8219
8220
8221 ------------------------------------------------------------------------------}
8222function TGtk2WidgetSet.SetCapture(AHandle: HWND): HWND;
8223var
8224  Widget: PGtkWidget;
8225  CaptureWidget: PGtkWidget;
8226  {$IfDef VerboseMouseCapture}
8227  toplevel: PGtkWidget;
8228  WndGroup: PGtkWindowGroup;
8229  DefWndGroup: PGtkWindowGroup;
8230  {$EndIf}
8231begin
8232  Widget := {%H-}PGtkWidget(AHandle);
8233  {$IfDef VerboseMouseCapture}
8234  DebugLn('TGtk2WidgetSet.SetCapture Widget=[',GetWidgetDebugReport(Widget),'] gtk=[',GetWidgetDebugReport(gtk_grab_get_current),'] MouseCaptureWidget=[',GetWidgetDebugReport(MouseCaptureWidget),']');
8235  {$EndIf}
8236
8237  // return old capture handle
8238  Result := GetCapture;
8239
8240  if (Result <> 0) then begin
8241    {$IfDef VerboseMouseCapture}
8242    DebugLn('TGtk2WidgetSet.SetCapture gtk_grab_remove=[',GetWidgetDebugReport(gtk_grab_get_current),']');
8243    {$EndIf}
8244    gtk_grab_remove(gtk_grab_get_current);
8245  end;
8246  if (MouseCaptureWidget<>nil) and (gtk_grab_get_current=nil)
8247  and (GTK_WIDGET_HAS_GRAB(MouseCaptureWidget))
8248  then begin
8249    {$IfDef VerboseMouseCapture}
8250    DebugLn('TGtk2WidgetSet.SetCapture gtk_grab_get_current=nil, but GTK_WIDGET_HAS_GRAB(MouseCaptureWidget)=true =>  gtk_grab_remove=[',GetWidgetDebugReport(MouseCaptureWidget),']');
8251    {$EndIf}
8252    gtk_grab_remove(MouseCaptureWidget);
8253  end;
8254
8255  MouseCaptureWidget := nil;
8256
8257  if Widget = nil then
8258    exit;
8259
8260  CaptureWidget := GetDefaultMouseCaptureWidget(Widget);
8261  if CaptureWidget = nil then begin
8262    {$IfDef VerboseMouseCapture}
8263    DebugLn('TGtk2WidgetSet.SetCapture GetDefaultMouseCaptureWidget failed for widget=[',GetWidgetDebugReport(Widget),']');
8264    {$EndIf}
8265    exit;
8266  end;
8267  {$IfDef VerboseMouseCapture}
8268  // ubuntu liboverlay intercepts gtk_grab_add for LCLWinapiClient
8269  // ToDo: find out how to grab LCLWinapiClient with ubuntu liboverlay
8270  if GtkWidgetIsA(Widget,GTK_TYPE_SCROLLED_WINDOW) then
8271  begin
8272    debugln(['TGtk2WidgetSet.SetCapture is api widget ',
8273      ' widget=',GetWidgetClassName(Widget),
8274      ' container.container.focus_child=',GetWidgetClassName(PGtkScrolledWindow(Widget)^.container.container.focus_child),
8275      ' container.child=',GetWidgetClassName(PGtkScrolledWindow(Widget)^.container.child),
8276      '']);
8277    //CaptureWidget:=PGtkScrolledWindow(Widget)^.container;
8278  end;
8279  {$EndIf}
8280
8281  {$IfDef VerboseMouseCapture}
8282  DebugLn(['TGtk2WidgetSet.SetCapture gtk_grab_add=[',GetWidgetDebugReport(CaptureWidget),'] has_grab=',gtk_widget_has_grab(CaptureWidget),' is_sensitive=',gtk_widget_is_sensitive(CaptureWidget)]);
8283  toplevel := gtk_widget_get_toplevel(CaptureWidget);
8284  if (toplevel<>nil)
8285  and (ord(gdk_window_get_window_type (toplevel^.window)) = GDK_WINDOW_OFFSCREEN_lcl)
8286  then begin
8287    debugln(['WARNING: TGtk2WidgetSet.SetCapture capturewidget is offscreen']);
8288  end;
8289  WndGroup := GetGtkWindowGroup(CaptureWidget);
8290  DefWndGroup:=GetGtkWindowGroup(CaptureWidget);
8291  debugln(['TGtk2WidgetSet.SetCapture WndGroup=',dbgs(WndGroup),' DefWndGroup=',dbgs(DefWndGroup),' same=',WndGroup=DefWndGroup]);
8292  // Note: liboverlay: gtk_grab_add sets gtk_widget_has_grab, but gtk_grab_get_current returns nil
8293  // ToDo: check window group
8294  {$EndIf}
8295  MouseCaptureWidget := CaptureWidget;
8296  gtk_grab_add(CaptureWidget);
8297  if gtk_grab_get_current=CaptureWidget then
8298  begin
8299    {$IfDef VerboseMouseCapture}
8300    DebugLn('TGtk2WidgetSet.SetCapture gtk_grab_add success: gtk_grab_get_current=[',GetWidgetDebugReport(gtk_grab_get_current),']')
8301    {$EndIf}
8302  end
8303  else begin
8304    {$IfDef VerboseMouseCapture}
8305    if gtk_widget_has_grab(CaptureWidget) then
8306      DebugLn('WARNING: TGtk2WidgetSet.SetCapture gtk_grab_add failed (partial success): gtk_grab_get_current=[',GetWidgetDebugReport(gtk_grab_get_current),'] has_grab=true')
8307    else
8308      DebugLn('WARNING: TGtk2WidgetSet.SetCapture gtk_grab_add failed (complete): gtk_grab_get_current=[',GetWidgetDebugReport(gtk_grab_get_current),'] has_grab=false');
8309    {$EndIf}
8310  end;
8311
8312  if MouseCaptureWidget<>nil then
8313    SendMessage(HWnd({%H-}PtrUInt(MouseCaptureWidget)), LM_CAPTURECHANGED, 0, Result);
8314end;
8315
8316{------------------------------------------------------------------------------
8317  Function: SetCaretPos
8318  Params:  new position x, y
8319  Returns: true on success
8320
8321 ------------------------------------------------------------------------------}
8322function TGtk2WidgetSet.SetCaretPos(X, Y: Integer): Boolean;
8323var
8324  FocusObject: PGTKObject;
8325begin
8326  FocusObject := {%H-}PGTKObject(GetFocus);
8327  Result:=SetCaretPosEx({%H-}PtrUInt(FocusObject),X,Y);
8328end;
8329
8330{------------------------------------------------------------------------------
8331  Function: SetCaretPos
8332  Params:  new position x, y
8333  Returns: true on success
8334
8335 ------------------------------------------------------------------------------}
8336function TGtk2WidgetSet.SetCaretPosEx(Handle: HWnd; X, Y: Integer): Boolean;
8337var
8338  GtkObject: PGTKObject;
8339begin
8340  GtkObject := {%H-}PGTKObject(Handle);
8341  Result := GtkObject <> nil;
8342
8343  if Result then begin
8344    if gtk_type_is_a(g_object_type(GtkObject), GTKAPIWidget_GetType)
8345    then begin
8346      GTKAPIWidget_SetCaretPos(PGTKAPIWidget(GtkObject), X, Y);
8347    end
8348//    else if // TODO: other widgettypes
8349    else begin
8350      Result := False;
8351    end;
8352  end;
8353end;
8354
8355{------------------------------------------------------------------------------
8356  Function: SetCaretRespondToFocus
8357  Params:  handle : Handle of a TWinControl
8358           ShowHideOnFocus: true = caret is hidden on focus lost
8359  Returns: true on success
8360
8361 ------------------------------------------------------------------------------}
8362function TGtk2WidgetSet.SetCaretRespondToFocus(handle: HWND;
8363  ShowHideOnFocus: boolean): Boolean;
8364begin
8365  if handle<>0 then begin
8366    if gtk_type_is_a(g_object_type({%H-}PGTKObject(handle)), GTKAPIWidget_GetType)
8367    then begin
8368      GTKAPIWidget_SetCaretRespondToFocus({%H-}PGTKAPIWidget(handle),
8369        ShowHideOnFocus);
8370      Result:=true;
8371    end
8372    else begin
8373      Result := False;
8374    end;
8375  end else
8376    Result:=false;
8377end;
8378
8379{------------------------------------------------------------------------------
8380  Function: SetCursor
8381  Params  : hCursor - cursor handle
8382  Returns : current cursor
8383 ------------------------------------------------------------------------------}
8384function TGtk2WidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
8385begin
8386  // set global gtk cursor
8387  Result := FGlobalCursor;
8388  if ACursor = FGlobalCursor then Exit;
8389  if ACursor = Screen.Cursors[crDefault]
8390  then SetGlobalCursor(0)
8391  else SetGlobalCursor(ACursor);
8392  FGlobalCursor := ACursor;
8393end;
8394
8395{------------------------------------------------------------------------------
8396  Function: SetCursorPos
8397  Params: X:
8398          Y:
8399  Returns:
8400
8401 ------------------------------------------------------------------------------}
8402function TGtk2WidgetSet.SetCursorPos(X, Y: Integer): Boolean;
8403{$ifdef GTK_2_8}
8404begin
8405  gdk_display_warp_pointer(gdk_display_get_default(), gdk_screen_get_default(), X, Y);
8406  Result := True;
8407end;
8408{$else GTK_2_8}
8409{$IFDEF HasX}
8410var
8411  dpy: PDisplay;
8412begin
8413  Result := False;
8414  {$IFDEF DebugGDKTraps}
8415  BeginGDKErrorTrap;
8416  {$ENDIF}
8417  try
8418    dpy := gdk_display;
8419    XWarpPointer(dpy, 0, RootWindow(dpy, DefaultScreen(dpy)), 0, 0, 0, 0, X, Y);
8420    Result := True;
8421    XFlush(dpy);
8422  finally
8423    {$IFDEF DebugGDKTraps}EndGDKErrorTrap;{$ENDIF}
8424  end;
8425end;
8426{$ELSE HasX}
8427begin
8428  Result := False;
8429  DebugLn('TGtk2WidgetSet.SetCursorPos not implemented for this platform');
8430  // Can this call TWin32WidgetSet.SetCursorPos?
8431end;
8432{$ENDIF HasX}
8433{$endif GTK_2_8}
8434
8435{------------------------------------------------------------------------------
8436  Function: SetFocus
8437  Params:  hWnd: Handle of new focus window
8438  Returns: The old focus window
8439
8440  The SetFocus function sets the keyboard focus to the specified window
8441 ------------------------------------------------------------------------------}
8442function TGtk2WidgetSet.SetFocus(hWnd: HWND): HWND;
8443{off $DEFINE VerboseFocus}
8444var
8445  Widget, TopLevel, NewFocusWidget: PGtkWidget;
8446  Info: PWidgetInfo;
8447  {$IfDef VerboseFocus}
8448  AWinControl: TWinControl;
8449  {$EndIf}
8450  NewTopLevelWidget: PGtkWidget;
8451  NewTopLevelObject: TObject;
8452  NewForm: TCustomForm;
8453begin
8454  if hwnd = 0 then
8455  begin
8456    Result:=0;
8457    exit;
8458  end;
8459  Widget:={%H-}PGtkWidget(hWnd);
8460  {$IfDef VerboseFocus}
8461  DebugLn('');
8462  DebuglnEnter('TGtk2WidgetSet.SetFocus INIT');
8463  DebugLn('A hWnd=',GetWidgetDebugReport(Widget));
8464  //DebugLn(getStackTrace(true));
8465  //if GtkWidgetIsA(Widget,GTK_TYPE_NOTEBOOK) then DumpStack;
8466  {$EndIf}
8467
8468  // return the old focus handle
8469  Result := GetFocus;
8470  NewFocusWidget := nil;
8471
8472  TopLevel := gtk_widget_get_toplevel(Widget);
8473  {$IfDef VerboseFocus}
8474  Debugln('B  TopLevel=',DbgS(TopLevel),' OldFocus=',GetWidgetDebugReport(PGtkWidget(Result)));
8475  if not GTK_WIDGET_VISIBLE(Widget) then begin
8476    DebugLnExit('TGtk2WidgetSet.SetFocus EXIT: Widget is not visible');
8477    raise Exception.Create('TGtk2WidgetSet.SetFocus: Widget is not visible');
8478  end;
8479  {$EndIf}
8480
8481  if Result=hWnd then begin
8482    {$IfDef VerboseFocus}
8483    DebugLnExit('TGtk2WidgetSet.SetFocus EXIT: focusing same control');
8484    {$EndIf}
8485    exit;
8486  end;
8487
8488  if GtkWidgetIsA(TopLevel, gtk_window_get_type) then
8489  begin
8490    // TopLevel is a gtkwindow
8491    {$IfDef VerboseFocus}
8492    AWinControl:=TWinControl(GetNearestLCLObject(PGtkWindow(TopLevel)^.focus_widget));
8493    DbgOut('C  TopLevel is a gtkwindow ');
8494    DbgOut(' focus_widget=',DbgS(PGtkWindow(TopLevel)^.focus_widget));
8495    DebugLn(' LCLParent=',dbgsName(AWinControl));
8496    {$EndIf}
8497
8498    NewTopLevelObject:=GetNearestLCLObject(TopLevel);
8499    if (NewTopLevelObject is TCustomForm) then
8500    begin
8501      NewForm := TCustomForm(NewTopLevelObject);
8502      if Screen.GetCurrentModalFormZIndex > Screen.CustomFormZIndex(NewForm) then
8503      begin
8504        // there is a modal form above -> focus forbidden
8505        {$IfDef VerboseFocus}
8506        DebugLn('  there is a modal form above -> focus forbidden');
8507        {$EndIf}
8508        exit;
8509      end;
8510    end;
8511
8512    NewFocusWidget := FindFocusWidget(Widget);
8513
8514    {$IfDef VerboseFocus}
8515    DbgOut('G NewFocusWidget=',DbgS(NewFocusWidget),' ',DbgSName(GetNearestLCLObject(NewFocusWidget)));
8516    DbgOut([' WidVisible=',GTK_WIDGET_VISIBLE(PGtkWidget(NewFocusWidget))]);
8517    DbgOut([' WidRealized=',GTK_WIDGET_REALIZED(PGtkWidget(NewFocusWidget))]);
8518    DbgOut([' WidMapped=',GTK_WIDGET_MAPPED(PGtkWidget(NewFocusWidget))]);
8519    DbgOut([' WidCanfocus=',GTK_WIDGET_CAN_FOCUS(PGtkWidget(NewFocusWidget))]);
8520    DbgOut([' TopLvlVisible=',GTK_WIDGET_VISIBLE(PGtkWidget(TopLevel))]);
8521    DebugLn('');
8522    {$EndIf}
8523    if (NewFocusWidget<>nil) and GTK_WIDGET_CAN_FOCUS(NewFocusWidget) then
8524    begin
8525      if (PGtkWindow(TopLevel)^.Focus_Widget<>NewFocusWidget) then
8526      begin
8527        {$IfDef VerboseFocus}
8528        DebugLn('H SETTING NewFocusWidget=',dbgs(NewFocusWidget),' ',DbgSName(GetNearestLCLObject(NewFocusWidget)));
8529        //DebugLn('TGtk2WidgetSet.SetFocus TopLevel[',DebugGtkWidgets.GetInfo(TopLevel,false),'] NewFocusWidget=[',DebugGtkWidgets.GetInfo(NewFocusWidget,false),']');
8530        DebugLnEnter('Recursive focus INIT');
8531        {$EndIf}
8532        gtk_window_set_focus(PGtkWindow(TopLevel), NewFocusWidget);
8533        {$IfDef VerboseFocus}
8534        DebugLnExit('Recursive focus DONE');
8535        DebugLn('I NewTopLevel FocusWidget=',DbgS(PGtkWindow(TopLevel)^.Focus_Widget),' Success=',dbgs(PGtkWindow(TopLevel)^.Focus_Widget=NewFocusWidget));
8536        {$EndIf}
8537      end;
8538    end;
8539  end
8540  else begin
8541    NewFocusWidget:=Widget;
8542  end;
8543
8544  if (NewFocusWidget <> nil) and not gtk_widget_has_focus(NewFocusWidget) then
8545  begin
8546    // grab the focus to the parent window
8547    NewTopLevelWidget := gtk_widget_get_toplevel(NewFocusWidget);
8548    NewTopLevelObject := GetNearestLCLObject(NewTopLevelWidget);
8549    if (Screen<>nil) and (Screen.GetCurrentModalForm<>nil) and (NewTopLevelObject <>Screen.GetCurrentModalForm) then
8550    begin
8551      {$IFDEF VerboseFocus}
8552      DebugLn('There is a modal form -> not grabbing');
8553      {$ENDIF}
8554    end
8555    else
8556    begin
8557      {$IfDef VerboseFocus}
8558      DebugLn('J Grabbing focus ',GetWidgetDebugReport(NewFocusWidget));
8559      {$EndIf}
8560      if NewTopLevelObject is TCustomForm then
8561      begin
8562        Info := GetWidgetInfo(NewTopLevelWidget);
8563        if (Info <> nil) and not (wwiActivating in  Info^.Flags) then
8564          SetForegroundWindow(TCustomForm(NewTopLevelObject).Handle);
8565      end;
8566      gtk_widget_grab_focus(NewFocusWidget);
8567    end;
8568  end;
8569
8570  {$IfDef VerboseFocus}
8571  AWinControl:=TWinControl(GetNearestLCLObject(NewFocusWidget));
8572  NewFocusWidget:=PGtkWidget(GetFocus);
8573  DebugLnExit('TGtk2WidgetSet.SetFocus END hWnd=',DbgS(hWnd),
8574    ' NewFocus=',DbgS(NewFocusWidget),
8575    ' NewLCLParent=',dbgsName(AWinControl));
8576  {$EndIf}
8577end;
8578
8579{------------------------------------------------------------------------------
8580  Function: SetForegroundWindow
8581  Params: hWnd:
8582  Returns:
8583
8584 ------------------------------------------------------------------------------}
8585function TGtk2WidgetSet.SetForegroundWindow(hWnd : HWND): boolean;
8586var
8587  {$IFDEF VerboseFocus}
8588  LCLObject: TControl;
8589  {$ENDIF}
8590  GdkWindow: PGdkWindow;
8591  AForm: TCustomForm;
8592begin
8593  {$IFDEF VerboseFocus}
8594  DbgOut('TGtk2WidgetSet.SetForegroundWindow hWnd=',DbgS(hWnd));
8595  LCLObject:=TControl(GetLCLObject(Pointer(hWnd)));
8596  if LCLObject<>nil then
8597    DebugLn(' LCLObject=',LCLObject.Name,':',LCLObject.ClassName)
8598  else
8599    DebugLn(' LCLObject=nil');
8600  {$ENDIF}
8601  Result := GtkWidgetIsA({%H-}PGtkWidget(hWnd),GTK_TYPE_WINDOW);
8602  if Result then
8603  begin
8604    GdkWindow := GetControlWindow({%H-}PgtkWidget(hwnd));
8605    if GdkWindow <> nil then
8606    begin
8607      if not gdk_window_is_visible(GdkWindow) then
8608      begin
8609        Result := False;
8610        Exit;
8611      end;
8612      AForm := TCustomForm(GetLCLObject({%H-}PgtkWidget(hwnd)));
8613      if (AForm is TCustomForm) and (AForm.Parent=nil) then
8614      begin
8615        if Screen.CustomFormZIndex(AForm) < Screen.GetCurrentModalFormZIndex then
8616        begin
8617          debugln('TGtk2WidgetSet.SetForegroundWindow Form=',DbgSName(AForm),
8618                  ' can not be raised, because ',
8619                  DbgSName(Screen.GetCurrentModalForm),
8620                  ' is modal and above.');
8621          Result := False;
8622          exit;
8623        end;
8624        Screen.MoveFormToZFront(AForm);
8625      end;
8626      {$IFDEF DebugGDKTraps}
8627      BeginGDKErrorTrap;
8628      {$ENDIF}
8629      gdk_window_show(GdkWindow);
8630      gdk_window_raise(GdkWindow);
8631      gdk_window_focus(GdkWindow, gtk_get_current_event_time);
8632      {$IFDEF DebugGDKTraps}
8633      EndGDKErrorTrap;
8634      {$ENDIF}
8635      // this currently will bring the window to the current desktop and focus it
8636      gtk_window_present({%H-}PGtkWindow(hWnd));
8637    end;
8638  end;
8639end;
8640
8641function TGtk2WidgetSet.SetMapMode(DC: HDC; fnMapMode : Integer): Integer;
8642var
8643  DevCtx: TGtkDeviceContext absolute DC;
8644begin
8645  Result := Integer(False);
8646  if not IsValidDC(DC) then Exit(0);
8647  DevCtx.MapMode := fnMapMode;
8648  Result := Integer(True);
8649end;
8650
8651function TGtk2WidgetSet.SetParent(hWndChild: HWND; hWndParent: HWND): HWND;
8652var
8653  Fixed: PGtkWidget;
8654  LCLObject: TObject;
8655begin
8656  Result := GetParent(hWndChild);
8657
8658  if Result = hWndParent then
8659    Exit;
8660
8661  // for window we need to move it content to HBox
8662  if GTK_IS_WINDOW({%H-}PGtkWidget(hWndChild)) then
8663  begin
8664    LCLObject := GetLCLObject({%H-}PGtkWidget(hWndChild));
8665    if LCLObject <> nil then
8666      Controls.RecreateWnd(TWinControl(LCLObject));
8667    Exit;
8668  end;
8669
8670  if Result <> 0 then
8671  begin
8672    // unparent first
8673    gtk_widget_ref({%H-}PGtkWidget(hWndChild));
8674    if GTK_IS_CONTAINER({%H-}Pointer(Result)) then
8675      gtk_container_remove({%H-}PGtkContainer(Result), {%H-}PGtkWidget(hWndChild))
8676    else
8677      gtk_widget_unparent({%H-}PGtkWidget(hWndChild));
8678  end;
8679
8680  Fixed := GetFixedWidget({%H-}PGtkWidget(hWndParent));
8681  if Fixed <> nil then
8682  begin
8683    FixedPutControl(Fixed, {%H-}PGtkWidget(hWndChild), {%H-}PGtkWidget(hWndChild)^.allocation.x, {%H-}PGtkWidget(hWndChild)^.allocation.y);
8684    RegroupAccelerator({%H-}PGtkWidget(hWndChild));
8685  end
8686  else
8687    gtk_widget_set_parent({%H-}PGtkWidget(hWndChild), {%H-}PGtkWidget(hWndParent));
8688
8689  if Result <> 0 then
8690    gtk_widget_unref({%H-}PGtkWidget(hWndChild));
8691end;
8692
8693{------------------------------------------------------------------------------
8694  function TGtk2WidgetSet.SetProp(Handle: hwnd; Str : PChar;
8695                              Data : Pointer) : Boolean;
8696 ------------------------------------------------------------------------------}
8697function TGtk2WidgetSet.SetProp(Handle: hwnd; Str : PChar; Data : Pointer) : Boolean;
8698begin
8699  g_object_set_data({%H-}pGObject(handle),Str,data);
8700  Result:=true;
8701end;
8702
8703{------------------------------------------------------------------------------
8704  Method: SetRectRgn
8705  Params:  aRGN: HRGN; X1, Y1, X2, Y2 : Integer
8706  Returns: True if the function succeeds
8707
8708  Converts a region into a rectangular region with the specified coordinates.
8709 ------------------------------------------------------------------------------}
8710function TGtk2WidgetSet.SetRectRgn(aRGN: HRGN; X1, Y1, X2, Y2 : Integer): Boolean;
8711
8712  procedure Swap(var A, B: Integer);
8713  var
8714    Tmp: Integer;
8715  begin
8716    Tmp := A;
8717    A := B;
8718    B := Tmp;
8719  end;
8720
8721var
8722  AGdiObject: PGdiObject absolute aRGN;
8723begin
8724  Result := IsValidGDIObject(aRGN);
8725  if Result then begin
8726    if (X1 > X2) then swap(X1, X2);
8727    if (Y1 > Y2) then swap(Y1, Y2);
8728    AGdiObject^.GDIRegionObject := CreateRectGDKRegion(Rect(X1,Y1,X2,Y2));
8729    Result := True;
8730  end;
8731end;
8732
8733{------------------------------------------------------------------------------
8734  function TGtk2WidgetSet.SetROPMode(Handle: hwnd; Str : PChar;
8735                              Data : Pointer) : Boolean;
8736 ------------------------------------------------------------------------------}
8737function TGtk2WidgetSet.SetROP2(DC: HDC; Mode: Integer) : Integer;
8738var
8739  DevCtx: TGtkDeviceContext absolute DC;
8740begin
8741  if not IsValidDC(DC) then Exit(0);
8742
8743  Result := DevCtx.ROP2;
8744  DevCtx.ROP2 := Mode;
8745end;
8746
8747{------------------------------------------------------------------------------
8748  Function: SetScrollInfo
8749  Params:  none
8750  Returns: The new position value
8751
8752  nPage >= 0
8753  nPage <= nMax-nMin+1
8754  nPos >= nMin
8755  nPos <= nMax - Max(nPage-1,0)
8756 ------------------------------------------------------------------------------}
8757function TGtk2WidgetSet.SetScrollInfo(Handle : HWND; SBStyle : Integer;
8758  ScrollInfo: TScrollInfo; bRedraw : Boolean): Integer;
8759var
8760  HasChanged: boolean;
8761
8762  procedure SetRangeUpdatePolicy(Range: PGtkRange);
8763  var
8764    UpdPolicy: TGTKUpdateType;
8765  begin
8766    case ScrollInfo.nTrackPos of
8767      SB_POLICY_DISCONTINUOUS: UpdPolicy := GTK_UPDATE_DISCONTINUOUS;
8768      SB_POLICY_DELAYED:       UpdPolicy := GTK_UPDATE_DELAYED;
8769      else                     UpdPolicy := GTK_UPDATE_CONTINUOUS;
8770    end;
8771    if gtk_range_get_update_policy(Range)=UpdPolicy then exit;
8772    gtk_range_set_update_policy(Range, UpdPolicy);
8773    HasChanged:=true;
8774  end;
8775
8776  procedure SetScrolledWindowUpdatePolicy(ScrolledWindow:PGTKScrolledWindow);
8777  var
8778    Range: PGtkRange;
8779  begin
8780    case SBStyle of
8781      SB_VERT: Range := PGtkRange(ScrolledWindow^.vscrollbar);
8782      SB_HORZ: Range := PGtkRange(ScrolledWindow^.hscrollbar);
8783      else exit;
8784    end;
8785    SetRangeUpdatePolicy(Range);
8786  end;
8787
8788  procedure SetLayoutSize(layout:PGtkLayout; width:guint; height:guint);
8789  var
8790    OldWidth: guint;
8791    OldHeight: guint;
8792  begin
8793    gtk_layout_get_size(layout,@OldWidth,@OldHeight);
8794    if (OldWidth=width) and (OldHeight=height) then exit;
8795    HasChanged:=true;
8796    gtk_layout_set_size(layout,width,height);
8797  end;
8798
8799  procedure SetGDouble(var v: gdouble; NewValue: gdouble);
8800  begin
8801    if v=NewValue then exit;
8802    v:=NewValue;
8803    HasChanged:=true;
8804  end;
8805
8806const
8807  POLICY: array[BOOLEAN] of TGTKPolicyType = (GTK_POLICY_NEVER, GTK_POLICY_ALWAYS);
8808var
8809  Layout: PgtkLayout;
8810  Scroll: PGTKWidget;
8811  IsScrollWindow: Boolean;
8812  IsScrollbarVis: boolean;
8813  Adjustment: PGtkAdjustment;
8814begin
8815  Result := 0;
8816  if (Handle = 0) then exit;
8817  HasChanged:=false;
8818
8819  {DebugLn(['TGtk2WidgetSet.SetScrollInfo A Widget=',GetWidgetDebugReport(PGtkWidget(Handle)),' SBStyle=',SBStyle,
8820    ' ScrollInfo=[',
8821      'cbSize=',ScrollInfo.cbSize,
8822      ',fMask=',ScrollInfo.fMask,
8823      ',nMin=',ScrollInfo.nMin,
8824      ',nMax=',ScrollInfo.nMax,
8825      ',nPage=',ScrollInfo.nPage,
8826      ',nPos=',ScrollInfo.nPos,
8827      ',nTrackPos=',ScrollInfo.nTrackPos,
8828      ']']);}
8829
8830  Scroll := g_object_get_data({%H-}PGObject(Handle), odnScrollArea);
8831  if GtkWidgetIsA(Scroll, gtk_scrolled_window_get_type)
8832  then begin
8833    IsScrollWindow := True;
8834  end
8835  else begin
8836    Scroll := {%H-}PGTKWidget(Handle);
8837    IsScrollWindow := GtkWidgetIsA(Scroll, gtk_scrolled_window_get_type);
8838  end;
8839
8840  if IsScrollWindow
8841  then begin
8842    Layout := GetFixedWidget({%H-}PGTKObject(Handle));
8843    if not GtkWidgetIsA(PGtkWidget(Layout), gtk_layout_get_type)
8844    then Layout := nil;
8845  end
8846  else begin
8847    Layout := nil;
8848  end;
8849
8850
8851  // scrollbar update policy
8852  if (Scrollinfo.fmask and SIF_UPDATEPOLICY <> 0) then begin
8853    if IsScrollWindow then
8854      SetScrolledWindowUpdatePolicy(PGTKScrolledWindow(Scroll))
8855    else if GtkWidgetIsA(PgtkWidget(Scroll), gtk_clist_get_type) then
8856      SetScrolledWindowUpdatePolicy(PGTKScrolledWindow(@PgtkCList(Scroll)^.container))
8857    else if GtkWidgetIsA(PGtkWidget(Scroll),gtk_hscrollbar_get_type) then
8858      SetRangeUpdatePolicy(PgtkRange(Scroll))
8859    else if GtkWidgetIsA(PGtkWidget(Scroll),gtk_vscrollbar_get_type) then
8860      SetRangeUpdatePolicy(PgtkRange(Scroll))
8861    else if GtkWidgetIsA(PGtkWidget(Scroll), gtk_range_get_type) then
8862      SetRangeUpdatePolicy(PGTKRange(Scroll));
8863  end;
8864
8865
8866  Adjustment:=nil;
8867  case SBStyle of
8868    SB_HORZ:
8869      if IsScrollWindow
8870      then begin
8871        Adjustment := gtk_scrolled_window_get_hadjustment(PGTKScrolledWindow(Scroll));
8872        if Layout <> nil
8873        then begin
8874          if (ScrollInfo.fMask and SIF_RANGE) <> 0 then
8875            SetLayoutSize(Layout, ScrollInfo.nMax - ScrollInfo.nMin, Layout^.height);
8876          Result := round(Layout^.hadjustment^.value);
8877        end;
8878      end
8879      // obsolete stuff
8880      else if GtkWidgetIsA(PGtkWidget(Scroll),gtk_hscrollbar_get_type)
8881      then begin
8882        // this one shouldn't be possible, scrollbar messages are sent to the CTL
8883        DebugLN('!!! direct SB_HORZ set call to scrollbar');
8884        Adjustment :=  PgtkhScrollBar(Scroll)^.Scrollbar.Range.Adjustment
8885      end
8886      else if GtkWidgetIsA(PGtkWidget(Scroll),gtk_clist_get_type)
8887      then begin
8888        //clist
8889        //TODO: check if this is needed for listviews
8890        DebugLn('[SetScrollInfo] Possible obsolete set use of CList (Listview ?)');
8891        Adjustment := gtk_clist_get_hadjustment(PgtkCList(Scroll));
8892      end;
8893
8894    SB_VERT:
8895      if IsScrollWindow
8896      then begin
8897        Adjustment := gtk_scrolled_window_get_vadjustment(PGTKScrolledWindow(Scroll));
8898        if Layout <> nil
8899        then begin
8900          if (ScrollInfo.fMask and SIF_RANGE) <> 0 then
8901            SetLayoutSize(Layout, Layout^.Width, ScrollInfo.nMax - ScrollInfo.nMin);
8902          Result := round(Layout^.vadjustment^.value);
8903        end;
8904      end
8905      // obsolete stuff
8906      else if GtkWidgetIsA(PGtkWidget(Scroll),gtk_vscrollbar_get_type)
8907      then begin
8908        // this one shouldn't be possible, scrollbar messages are sent to the CTL
8909        DebugLN('!!! direct SB_VERT call to scrollbar');
8910        Adjustment :=  PgtkvScrollBar(Scroll)^.Scrollbar.Range.Adjustment;
8911      end
8912      else if GtkWidgetIsA(PGtkWidget(Scroll), gtk_clist_get_type)
8913      then begin
8914        //TODO: check is this is needed for listviews
8915        DebugLn('[SetScrollInfo] Possible obsolete set use of CList (Listview ?)');
8916        Adjustment := gtk_clist_get_vadjustment(PgtkCList(Scroll));
8917      end;
8918
8919    SB_CTL:
8920      if GtkWidgetIsA(PGtkWidget(Scroll),gtk_vscrollbar_get_type) then
8921        Adjustment :=  PgtkvScrollBar(Scroll)^.Scrollbar.Range.Adjustment
8922      else
8923      if GtkWidgetIsA(PGtkWidget(Scroll),gtk_hscrollbar_get_type) then
8924        Adjustment :=  PgtkhScrollBar(Scroll)^.Scrollbar.Range.Adjustment
8925      else
8926      if GtkWidgetIsA(PGtkWidget(Scroll), gtk_range_get_type) then
8927        Adjustment := gtk_range_get_adjustment(PGTKRange(Scroll));
8928    SB_BOTH:
8929       DebugLn('[SetScrollInfo] Got SB_BOTH ???');
8930  end;
8931
8932
8933  if Adjustment = nil then
8934    exit;
8935
8936  if (ScrollInfo.fMask and SIF_RANGE) <> 0
8937  then begin
8938    SetGDouble(Adjustment^.lower,ScrollInfo.nMin);
8939    SetGDouble(Adjustment^.upper,ScrollInfo.nMax);
8940  end;
8941  if (ScrollInfo.fMask and SIF_PAGE) <> 0
8942  then begin
8943    // 0 <= nPage <= nMax-nMin+1
8944    SetGDouble(Adjustment^.page_size, ScrollInfo.nPage);
8945    SetGDouble(Adjustment^.page_size, Min(Max(Adjustment^.page_size,0),
8946                                 Adjustment^.upper-Adjustment^.lower+1));
8947    SetGDouble(Adjustment^.page_increment, (Adjustment^.page_size/6)+1);
8948  end;
8949  if (ScrollInfo.fMask and SIF_POS) <> 0
8950  then begin
8951    // nMin <= nPos <= nMax - Max(nPage-1,0)
8952    SetGDouble(Adjustment^.value, ScrollInfo.nPos);
8953    SetGDouble(Adjustment^.value, Max(Adjustment^.value,Adjustment^.lower));
8954    SetGDouble(Adjustment^.value, Min(Adjustment^.value,
8955                              Adjustment^.upper-Max(Adjustment^.page_size-1,0)));
8956  end;
8957
8958  // check if scrollbar should be hidden
8959  IsScrollbarVis := true;
8960  if ((ScrollInfo.fMask and (SIF_RANGE or SIF_PAGE)) <> 0) and
8961     ((SBStyle=SB_HORZ) or (SBStyle=SB_VERT))
8962  then begin
8963    if (Adjustment^.lower >= (Adjustment^.upper-Max(adjustment^.page_size-1,0)))
8964    then begin
8965      if (ScrollInfo.fMask and SIF_DISABLENOSCROLL) = 0 then
8966        IsScrollbarVis := false
8967      else
8968        ;// scrollbar should look disabled (no thumbbar and grayed appearance)
8969         // maybe not possible in gtk
8970    end;
8971  end;
8972
8973  Result := Round(Adjustment^.value);
8974
8975  if not HasChanged then exit;
8976
8977  {DebugLn('');
8978  DebugLn('[TGtk2WidgetSet.SetScrollInfo] Result=',Result,
8979  ' Lower=',RoundToInt(Lower),
8980  ' Upper=',RoundToInt(Upper),
8981  ' Page_Size=',RoundToInt(Page_Size),
8982  ' Page_Increment=',RoundToInt(Page_Increment),
8983  ' bRedraw=',bRedraw,
8984  ' Handle=',DbgS(Handle));}
8985
8986  // do we have to set this always ?
8987  // ??? what is this for code ????
8988  // why not change adjustment if we don't do a redraw ???
8989  if bRedraw then
8990  begin
8991    // immediate draw
8992
8993    if IsScrollWindow
8994    then begin
8995      case SBStyle of
8996        SB_HORZ:
8997          g_object_set(PGTKObject(Scroll),'hscrollbar_policy',[POLICY[IsScrollbarVis],nil]);
8998        SB_VERT:
8999          g_object_set(PGTKObject(Scroll),'vscrollbar_policy',[POLICY[IsScrollbarVis],nil]);
9000      end;
9001    end
9002    else
9003      gtk_widget_queue_draw(PGTKWidget(Scroll));
9004
9005(*
9006    DebugLn('TGtk2WidgetSet.SetScrollInfo:' +
9007     ' lower=%d/%d upper=%d/%d value=%d/%d' +
9008     ' step_increment=%d/1 page_increment=%d/%d page_size=%d/%d', [
9009     Round(lower),nMin, Round(upper),nMax, Round(value),nPos,
9010     Round(step_increment), Round(page_increment),nPage, Round(page_size),nPage]
9011    );
9012*)
9013    gtk_adjustment_changed(Adjustment);
9014  end;
9015end;
9016
9017{------------------------------------------------------------------------------
9018  Function: SetSysColors
9019  Params:  cElements: the number of elements
9020           lpaElements: array with element numbers
9021           lpaRgbValues: array with colors
9022  Returns: 0 if unsuccesful
9023
9024  The SetSysColors function sets the colors for one or more display elements.
9025 ------------------------------------------------------------------------------}
9026function TGtk2WidgetSet.SetSysColors(cElements: Integer; const lpaElements;
9027  const lpaRgbValues): Boolean;
9028var
9029  n: Integer;
9030  Element: LongInt;
9031begin
9032  Result := False;
9033  if cElements > MAX_SYS_COLORS then Exit;
9034
9035  for n := 0 to cElements - 1 do
9036  begin
9037    Element := PInteger(lpaElements)[n];
9038    if (Element > MAX_SYS_COLORS) or (Element < 0) then
9039      Exit;
9040    SysColorMap[Element] := PDword(@lpaRgbValues)[n];
9041    //DebugLn(Format('Trace:[TGtk2WidgetSet.SetSysColor] Index %d (%8x) --> %8x', [PLongArray(lpaElements)^[n], SysColorMap[PLongArray(lpaElements)^[n]], PLongArray(lpaRgbValues)^[n]]));
9042  end;
9043
9044  //TODO send WM_SYSCOLORCHANGE
9045  Result := True;
9046end;
9047
9048{------------------------------------------------------------------------------
9049  Function: SetTextCharacterExtra
9050  Params: _hdc:
9051          nCharExtra:
9052  Returns:
9053
9054 ------------------------------------------------------------------------------}
9055function TGtk2WidgetSet.SetTextCharacterExtra(DC : hdc; nCharExtra : Integer):Integer;
9056begin
9057  // Your code here
9058  Result:=0;
9059end;
9060
9061{------------------------------------------------------------------------------
9062  Function: SetTextColor
9063  Params:  hdc: Identifies the device context.
9064           Color: Specifies the color of the text.
9065  Returns: The previous color if succesful, CLR_INVALID otherwise
9066
9067  The SetTextColor function sets the text color for the specified device
9068  context to the specified color.
9069 ------------------------------------------------------------------------------}
9070function TGtk2WidgetSet.SetTextColor(DC: HDC; Color: TColorRef): TColorRef;
9071begin
9072  Result := CLR_INVALID;
9073  if IsValidDC(DC)
9074  then begin
9075    with TGtkDeviceContext(DC) do
9076    begin
9077      Result := CurrentTextColor.ColorRef;
9078      SetGDIColorRef(CurrentTextColor,Color);
9079      if Result<>Color then
9080        SelectedColors := dcscCustom; // force SelectGDKTextProps to ensure text color
9081    end;
9082  end;
9083end;
9084
9085function TGtk2WidgetSet.SetViewPortExtEx(DC: HDC; XExtent, YExtent : Integer; OldSize: PSize): Boolean;
9086var
9087  DevCtx: TGtkDeviceContext absolute DC;
9088begin
9089  Result := False;
9090  if not IsValidDC(DC) then Exit;
9091  if OldSize <> nil then
9092  begin
9093    OldSize^.cx := DevCtx.ViewPortExt.x;
9094    OldSize^.cy := DevCtx.ViewPortExt.y;
9095  end;
9096  if (XExtent <> DevCtx.ViewPortExt.x) or (YExtent <> DevCtx.ViewPortExt.y) then
9097  begin
9098    case DevCtx.MapMode of
9099      MM_ANISOTROPIC, MM_ISOTROPIC:
9100      begin
9101        DevCtx.ViewPortExt := Point(XExtent, YExtent);
9102        Result := True;
9103      end;
9104    end;
9105  end;
9106end;
9107
9108function TGtk2WidgetSet.SetViewPortOrgEx(DC: HDC; NewX, NewY: Integer; OldPoint: PPoint): Boolean;
9109var
9110  DevCtx: TGtkDeviceContext absolute DC;
9111begin
9112  Result := False;
9113  if not IsValidDC(DC) then Exit;
9114  if OldPoint <> nil then
9115  begin
9116    OldPoint^.x := DevCtx.ViewPortOrg.x;
9117    OldPoint^.y := DevCtx.ViewPortOrg.y;
9118  end;
9119  if (NewX <> DevCtx.ViewPortOrg.x) or (NewY <> DevCtx.ViewPortOrg.y) then
9120  begin
9121    DevCtx.ViewPortOrg := Point(NewX, NewY);
9122    Result := True;
9123  end;
9124end;
9125
9126function TGtk2WidgetSet.SetWindowExtEx(DC: HDC; XExtent, YExtent: Integer; OldSize: PSize): Boolean;
9127var
9128  DevCtx: TGtkDeviceContext absolute DC;
9129begin
9130  Result := False;
9131  if not IsValidDC(DC) then Exit;
9132  if OldSize <> nil then
9133  begin
9134    OldSize^.cx := DevCtx.WindowExt.x;
9135    OldSize^.cy := DevCtx.WindowExt.y;
9136  end;
9137  if (XExtent <> DevCtx.WindowExt.x) or (YExtent <> DevCtx.WindowExt.y) then
9138  begin
9139    case DevCtx.MapMode of
9140      MM_ANISOTROPIC, MM_ISOTROPIC:
9141      begin
9142        DevCtx.WindowExt := Point(XExtent, YExtent);
9143        Result := True;
9144      end;
9145    end;
9146  end;
9147  Result := True;
9148end;
9149
9150{------------------------------------------------------------------------------
9151  Function: TextOut
9152  Params: DC:
9153          X:
9154          Y:
9155          Str:
9156          Count:
9157  Returns:
9158
9159 ------------------------------------------------------------------------------}
9160function TGtk2WidgetSet.SetWindowLong(Handle: HWND; Idx: Integer;
9161  NewLong: PtrInt): PtrInt;
9162var
9163  Data: Pointer;
9164  WidgetInfo: PWidgetInfo;
9165begin
9166  //TODO: Finish this;
9167  Result:=0;
9168  Data := {%H-}Pointer(NewLong);
9169
9170  case idx of
9171    GWL_WNDPROC :
9172      begin
9173        WidgetInfo := GetWidgetInfo({%H-}Pointer(Handle));
9174        if WidgetInfo <> nil then
9175          WidgetInfo^.WndProc := NewLong;
9176      end;
9177    GWL_HINSTANCE :
9178      begin
9179        g_object_set_data({%H-}pgobject(Handle),'HINSTANCE',Data);
9180      end;
9181    GWL_HWNDPARENT :
9182      begin
9183        g_object_set_data({%H-}pgobject(Handle),'HWNDPARENT',Data);
9184      end;
9185    GWL_STYLE :
9186      begin
9187        WidgetInfo := GetWidgetInfo({%H-}Pointer(Handle));
9188        if WidgetInfo <> nil then
9189          WidgetInfo^.Style := NewLong;
9190      end;
9191    GWL_EXSTYLE :
9192      begin
9193        WidgetInfo := GetWidgetInfo({%H-}Pointer(Handle));
9194        if WidgetInfo <> nil then
9195          WidgetInfo^.ExStyle := NewLong;
9196      end;
9197    GWL_USERDATA :
9198      begin
9199        g_object_set_data({%H-}pgobject(Handle),'Userdata',Data);
9200      end;
9201    GWL_ID :
9202      begin
9203        g_object_set_data({%H-}pgobject(Handle),'ID',Data);
9204      end;
9205  end; //case
9206end;
9207
9208{------------------------------------------------------------------------------
9209  function TGtk2WidgetSet.SetWindowOrgEx(DC : HDC; NewX, NewY : Integer;
9210    OldPoint: PPoint) : Boolean;
9211
9212  Sets the DC offset for the specified device context.
9213 ------------------------------------------------------------------------------}
9214function TGtk2WidgetSet.SetWindowOrgEx(dc: hdc; NewX, NewY: Integer;
9215  OldPoint: PPoint): Boolean;
9216var
9217  DevCtx: TGtkDeviceContext absolute DC;
9218begin
9219  if Assigned(OldPoint) then
9220    GetWindowOrgEx(DC, OldPoint);
9221
9222  if not IsValidDC(DC) then exit(False);
9223
9224  DevCtx.WindowOrg := Point(NewX, NewY);
9225  Result := True;
9226end;
9227
9228{------------------------------------------------------------------------------
9229  function TGtk2WidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
9230    X, Y, cx, cy: Integer; uFlags: UINT): Boolean;
9231
9232  hWnd: Widget to move
9233  hWndInsertAfter:
9234    HWND_BOTTOM to move bottommost
9235    HWND_TOP to move topmost
9236    the Widget, that should lie just on top of hWnd
9237  uFlags:
9238    SWP_NOMOVE: ignore X, Y
9239    SWP_NOSIZE: ignore cx, cy
9240    SWP_NOZORDER: ignore hWndInsertAfter
9241    SWP_NOREDRAW: skip instant redraw
9242    SWP_NOACTIVATE: skip switching focus
9243
9244 ------------------------------------------------------------------------------}
9245function TGtk2WidgetSet.SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND;
9246  X, Y, cx, cy: Integer; uFlags: UINT): Boolean;
9247
9248  procedure SetZOrderOnFixedWidget(Widget, FixedWidget: PGtkWidget);
9249  var
9250    OldListItem: PGList;
9251    AfterWidget: PGtkWidget;
9252    AfterListItem: PGList;
9253  begin
9254    OldListItem:=FindFixedChildListItem(PGtkFixed(FixedWidget),Widget);
9255    if OldListItem=nil then begin
9256      DebugLn('TGtk2WidgetSet.SetWindowPos.SetZOrderOnFixedWidget WARNING: Widget not on parents fixed widget');
9257      exit;
9258    end;
9259    AfterWidget:=nil;
9260    AfterListItem:=nil;
9261    if hWndInsertAfter=HWND_BOTTOM then begin
9262      //debugln('HWND_BOTTOM');
9263      // HWND_BOTTOM
9264    end else if hWndInsertAfter=HWND_TOP then begin
9265      //debugln('HWND_TOP');
9266      // HWND_TOP
9267      AfterListItem:=FindFixedLastChildListItem(PGtkFixed(FixedWidget));
9268    end else if hWndInsertAfter=0 then begin
9269      DebugLn('TGtk2WidgetSet.SetWindowPos.SetZOrderOnFixedWidget WARNING: hWndInsertAfter=0');
9270      exit;
9271    end else begin
9272      // hWndInsertAfter
9273      AfterWidget:={%H-}PGtkWidget(hWndInsertAfter);
9274      AfterListItem:=FindFixedChildListItem(PGtkFixed(FixedWidget),AfterWidget);
9275      //debugln('AfterWidget=',GetWidgetDebugReport(AfterWidget));
9276    end;
9277    if (AfterListItem=nil) and (AfterWidget<>nil) then begin
9278      DebugLn('TGtk2WidgetSet.SetWindowPos.SetZOrderOnFixedWidget WARNING: AfterWidget not on parents fixed widget');
9279      exit;
9280    end;
9281    if (OldListItem=AfterListItem) or (OldListItem^.next=AfterListItem) then
9282    begin
9283      {$IFDEF EnableGtkZReordering}
9284      DebugLn('TGtk2WidgetSet.SetWindowPos.SetZOrderOnFixedWidget Hint: Already there');
9285      {$ENDIF}
9286      exit;
9287    end;
9288    //DebugLn('TGtk2WidgetSet.SetWindowPos Moving GList entry');
9289
9290    // reorder
9291    {$IFDEF EnableGtkZReordering}
9292    // MG: This trick does not work properly
9293    debugln('SetZOrderOnFixedWidget FixedWidget=['+GetWidgetDebugReport(FixedWidget)+']',
9294      ' Widget=['+GetWidgetDebugReport(Widget)+']',
9295      ' AfterWidget=['+GetWidgetDebugReport(AfterWidget)+']');
9296    MoveGListLinkBehind(PGtkFixed(FixedWidget)^.children,
9297                        OldListItem,AfterListItem);
9298    if GTK_WIDGET_VISIBLE(FixedWidget) and GTK_WIDGET_VISIBLE(Widget)
9299    and GTK_WIDGET_MAPPED(Widget) then begin
9300      DebugLn('TGtk2WidgetSet.SetWindowPos.SetZOrderOnFixedWidget resize ..');
9301      gtk_widget_queue_resize(FixedWidget);
9302      AfterListItem:=PGtkFixed(FixedWidget)^.children;
9303      while AfterListItem<>nil do begin
9304        AfterWidget:=GetFixedChildListWidget(AfterListItem);
9305        DebugLn('TGtk2WidgetSet.SetWindowPos.SetZOrderOnFixedWidget A ',GetWidgetDebugReport(AfterWidget));
9306        AfterListItem:=AfterListItem^.next;
9307      end;
9308    end;
9309    {$ENDIF}
9310  end;
9311
9312  procedure SetZOrderOnLayoutWidget({%H-}Widget, {%H-}LayoutWidget: PGtkWidget);
9313  begin
9314    //DebugLn('TGtk2WidgetSet.SetWindowPos.SetZOrderOnLayoutWidget Not implemented: ZOrdering .. on ',GetWidgetDebugReport(LayoutWidget));
9315  end;
9316
9317var
9318  Widget: PGTKWidget;
9319  FixedWidget: PGtkWidget;
9320  Allocation: TGTKAllocation;
9321begin
9322  Result:=false;
9323  Widget:={%H-}PGtkWidget(hWnd);
9324  {DebugLn('[TGtk2WidgetSet.SetWindowPos] ',GetWidgetDebugReport(Widget),
9325    ' Top=',hWndInsertAfter=HWND_TOP,
9326    ' SWP_NOZORDER=',(SWP_NOZORDER and uFlags)<>0,
9327    ' SWP_NOSIZE=',(SWP_NOSIZE and uFlags)<>0,
9328    ' SWP_NOMOVE=',(SWP_NOMOVE and uFlags)<>0,
9329    '');}
9330  if GtkWidgetIsA(Widget,GTK_TYPE_WINDOW) then
9331  begin
9332    Result := True;
9333    exit;
9334    { case hWndInsertAfter of
9335        HWND_BOTTOM: ;  //gdk_window_lower(Widget^.Window);
9336        HWND_TOP:    gtk_window_set_position(PGtkWindow(hWnd),GTK_WIN_POS_CENTER);
9337                    //gdk_window_raise(Widget^.Window);
9338      end;
9339    }
9340  end;
9341
9342  if (SWP_NOMOVE and uFlags = 0) and (SWP_NOSIZE and uFlags = 0) then
9343  begin
9344    // optimize if pos & size needed, so we allocate in one shot.
9345    Allocation.X := X;
9346    Allocation.Y := Y;
9347    Allocation.Width := cx;
9348    Allocation.Height := cy;
9349    gtk_widget_size_allocate(Widget, @Allocation);
9350  end else
9351  begin
9352    if (SWP_NOMOVE and uFlags = 0) then
9353    begin
9354      Allocation.X := X;
9355      Allocation.Y := Y;
9356      Allocation.Width := Widget^.Allocation.Width;
9357      Allocation.Height := Widget^.Allocation.Height;
9358      gtk_widget_size_allocate(Widget, @Allocation);
9359    end;
9360
9361    if (SWP_NOSIZE and uFlags = 0) then
9362    begin
9363      Allocation.X := Widget^.Allocation.x;
9364      Allocation.Y := Widget^.Allocation.y;
9365      Allocation.Width := cx;
9366      Allocation.Height := cy;
9367      gtk_widget_size_allocate(Widget, @Allocation);
9368    end;
9369  end;
9370
9371  if (SWP_NOZORDER and uFlags)=0 then
9372  begin
9373    FixedWidget:=Widget^.Parent;
9374    if FixedWidget=nil then exit;
9375
9376    //DebugLn('TGtk2WidgetSet.SetWindowPos ZOrdering .. on ',GetWidgetDebugReport(FixedWidget));
9377    if GtkWidgetIsA(FixedWidget,GTK_Fixed_Get_Type) then begin
9378      // parent's client area is a gtk_fixed widget
9379      SetZOrderOnFixedWidget(Widget,FixedWidget);
9380    end else if GtkWidgetIsA(FixedWidget,GTK_Layout_Get_Type) then begin
9381      // parent's client area is a gtk_layout widget
9382      SetZOrderOnLayoutWidget(Widget,FixedWidget);
9383    end else begin
9384      //DebugLn('TGtk2WidgetSet.SetWindowPos Not implemented: ZOrdering .. on ',GetWidgetDebugReport(FixedWidget));
9385      exit;
9386    end;
9387  end;
9388  Result:=true;
9389end;
9390
9391{------------------------------------------------------------------------------
9392  Function SetWindowRgn
9393  Params: hWnd: HWND;  hRgn: HRGN; bRedraw: Boolean
9394  Returns: 0 - fails, in other case success
9395------------------------------------------------------------------------------}
9396function TGtk2WidgetSet.SetWindowRgn(hWnd: HWND; hRgn: HRGN; bRedraw: Boolean): longint;
9397var
9398  Widget: PGtkWidget;
9399  Window: PGdkWindow;
9400  ShapeRegion: PGdkRegion;
9401  LCLObject: TObject;
9402begin
9403  // For normal widgets we should use GetFixedWidget,
9404  // but for TForm we should apply the region in the raw hWnd
9405  LCLObject := GetLCLObject({%H-}PGtkWidget(hWnd));
9406  if LCLObject is TCustomForm then
9407  begin
9408    Widget := {%H-}PGtkWidget(hWnd);
9409  end
9410  else
9411  begin
9412    Widget := GetFixedWidget({%H-}PGtkWidget(hWnd));
9413    if Widget = nil then
9414      Widget := {%H-}PGtkWidget(hWnd);
9415  end;
9416  if Widget = nil then
9417    Exit(0);
9418  if GtkWidgetIsA(gtk_widget_get_toplevel(Widget), gtk_window_get_type)
9419      and not gtk_widget_realized(Widget) then
9420    gtk_widget_realize(Widget); // associate with window
9421  Window := GetControlWindow(Widget);
9422  if Window = nil then
9423    Exit(0);
9424  if hRgn = 0 then
9425    ShapeRegion := nil
9426  else
9427    ShapeRegion := {%H-}PGDIObject(hRgn)^.GDIRegionObject;
9428  gdk_window_shape_combine_region(Window, ShapeRegion, 0, 0);
9429  if bRedraw then
9430    gdk_window_invalidate_region(Window, ShapeRegion, True);
9431  Result := 1;
9432end;
9433
9434{------------------------------------------------------------------------------
9435  Function: ShowCaret
9436  Params:  none
9437  Returns: Nothing
9438
9439
9440 ------------------------------------------------------------------------------}
9441function TGtk2WidgetSet.ShowCaret(hWnd: HWND): Boolean;
9442var
9443  GTKObject: PGTKObject;
9444begin
9445  GTKObject := {%H-}PGTKObject(HWND);
9446  Result := GTKObject <> nil;
9447
9448  if Result
9449  then begin
9450    if gtk_type_is_a(g_object_type(GTKObject), GTKAPIWidget_GetType)
9451    then begin
9452      GTKAPIWidget_ShowCaret(PGTKAPIWidget(GTKObject));
9453    end
9454    else begin
9455      Result := False;
9456    end;
9457  end
9458  else DebugLn('WARNING: [TGtk2WidgetSet.ShowCaret] Got null HWND');
9459end;
9460
9461{------------------------------------------------------------------------------
9462  Function:  ShowScrollBar
9463  Params:  Wnd, wBar, bShow
9464  Returns: Nothing
9465
9466
9467 ------------------------------------------------------------------------------}
9468function TGtk2WidgetSet.ShowScrollBar(Handle: HWND; wBar: Integer;
9469  bShow: Boolean): Boolean;
9470var
9471  NewPolicy: Integer;
9472  Scroll: PGtkWidget;
9473  IsScrollWindow: Boolean;
9474begin
9475  Result := (Handle <> 0);
9476  if not Result then exit;
9477
9478  Scroll := PGtkWidget(g_object_get_data({%H-}PGObject(Handle), odnScrollArea));
9479  if GtkWidgetIsA(Scroll, gtk_scrolled_window_get_type)
9480  then begin
9481    IsScrollWindow := True;
9482  end
9483  else begin
9484    Scroll := {%H-}PGTKWidget(Handle);
9485    IsScrollWindow := GtkWidgetIsA(Scroll, gtk_scrolled_window_get_type);
9486  end;
9487
9488  //DebugLn(['TGtk2WidgetSet.ShowScrollBar ',GetWidgetDebugReport(Scroll),' wBar=',wBar,' bShow=',bShow]);
9489  if IsScrollWindow then begin
9490    if wBar in [SB_BOTH, SB_HORZ] then begin
9491      //DebugLn(['TGtk2WidgetSet.ShowScrollBar ',GetWidgetDebugReport(Widget),' bShow=',bShow]);
9492      if bShow then
9493        NewPolicy:=GTK_POLICY_ALWAYS
9494      else
9495        NewPolicy:=GTK_POLICY_NEVER;
9496      g_object_set(PGTKObject(Scroll), 'hscrollbar_policy', [NewPolicy,nil]);
9497    end;
9498    if wBar in [SB_BOTH, SB_VERT] then begin
9499      if bShow then
9500        NewPolicy:=GTK_POLICY_ALWAYS
9501      else
9502        NewPolicy:=GTK_POLICY_NEVER;
9503      g_object_set(PGTKObject(Scroll), 'vscrollbar_policy', [NewPolicy,nil]);
9504    end;
9505  end
9506  else begin
9507    if (wBar = SB_CTL)
9508    and gtk_type_is_a(g_object_type({%H-}PGTKObject(Handle)),gtk_widget_get_type)
9509    then begin
9510      if bShow
9511      then gtk_widget_show(Scroll)
9512      else gtk_widget_hide(Scroll);
9513    end;
9514  end;
9515end;
9516
9517{------------------------------------------------------------------------------
9518  function ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
9519
9520  nCmdShow:
9521    SW_SHOWNORMAL, SW_MINIMIZE, SW_SHOWMAXIMIZED
9522------------------------------------------------------------------------------}
9523function TGtk2WidgetSet.ShowWindow(hWnd: HWND; nCmdShow: Integer): Boolean;
9524var
9525  GtkWindow: PGtkWindow;
9526  B: Boolean;
9527  Widget: PGtkWidget;
9528  AFlags: TGdkWindowState;
9529  AWindow: PGdkWindow;
9530begin
9531  Result := False;
9532
9533  Widget := {%H-}PGtkWidget(HWND);
9534
9535  if Widget = nil then
9536    RaiseGDBException('TGtk2WidgetSet.ShowWindow  hWnd is nil');
9537
9538  if GTK_IS_WINDOW(Widget) then
9539    GtkWindow := {%H-}PGtkWindow(hWnd)
9540  else
9541  begin
9542    // we are pure gtkwidget so only SW_SHOW AND SW_HIDE CAN GO
9543    case nCmdShow of
9544      SW_SHOWNORMAL,
9545      SW_SHOW: gtk_widget_show(Widget);
9546      SW_HIDE: gtk_widget_hide(Widget);
9547    end;
9548    Result := nCmdShow in [SW_SHOW, SW_HIDE];
9549    exit;
9550  end;
9551
9552
9553  B := (PGtkWidget(GtkWindow)^.parent <> nil) and
9554    (PGtkWidget(GtkWindow)^.parent^.window <> nil) and
9555    (PGtkWidget(GtkWindow)^.parent^.window = PGtkWidget(GtkWindow)^.window);
9556
9557  if not B and not GTK_IS_WINDOW(PGtkWidget(GtkWindow)) then
9558  begin
9559    DebugLn(['TGtk2WidgetSet.ShowWindow ',GetWidgetDebugReport(PGTKWidget(GtkWindow))]);
9560    RaiseGDBException('TGtk2WidgetSet.ShowWindow  hWnd is not a gtkwindow');
9561  end;
9562
9563  //debugln('TGtk2WidgetSet.ShowWindow A ',GetWidgetDebugReport(PGtkWidget(GtkWindow)),' nCmdShow=',dbgs(nCmdShow),' SW_MINIMIZE=',dbgs(SW_MINIMIZE=nCmdShow));
9564
9565  case nCmdShow of
9566
9567  SW_SHOWNORMAL:
9568    begin
9569      if B then
9570        gtk_widget_show(PGtkWidget(GtkWindow))
9571      else
9572      begin
9573        if not GTK_WIDGET_VISIBLE(PGtkWidget(GtkWindow)) then
9574          gtk_widget_show(PGtkWidget(GtkWindow));
9575        AWindow := PGtkWidget(GtkWindow)^.window;
9576        if GDK_IS_WINDOW(AWindow) then
9577        begin
9578          AFlags := gdk_window_get_state(AWindow);
9579          if AFlags and GDK_WINDOW_STATE_ICONIFIED <> 0 then
9580            gtk_window_deiconify(GtkWindow);
9581          if AFlags and GDK_WINDOW_STATE_MAXIMIZED <> 0 then
9582            gtk_window_unmaximize(GtkWindow);
9583          if AFlags and GDK_WINDOW_STATE_FULLSCREEN <> 0 then
9584            gtk_window_unfullscreen(GtkWindow);
9585        end;
9586      end;
9587    end;
9588
9589  SW_HIDE:
9590      gtk_widget_hide(PGtkWidget(GtkWindow));
9591
9592  SW_MINIMIZE:
9593    if not B then
9594      gtk_window_iconify(GtkWindow);
9595
9596  SW_SHOWMAXIMIZED:
9597    if B then
9598      gtk_widget_show(PGtkWidget(GtkWindow))
9599    else
9600    begin
9601      AWindow := PGtkWidget(GtkWindow)^.window;
9602      if GDK_IS_WINDOW(AWindow) then
9603      begin
9604        AFlags := gdk_window_get_state(AWindow);
9605        if AFlags and GDK_WINDOW_STATE_ICONIFIED <> 0 then
9606          gtk_window_deiconify(GtkWindow);
9607        if AFlags and GDK_WINDOW_STATE_FULLSCREEN <> 0 then
9608          gtk_window_unfullscreen(GtkWindow);
9609        gtk_window_maximize(GtkWindow);
9610      end;
9611    end;
9612
9613  SW_SHOWFULLSCREEN:
9614    if B then
9615      gtk_widget_show(PGtkWidget(GtkWindow))
9616    else
9617      gtk_window_fullscreen(GtkWindow);
9618
9619  SW_RESTORE:
9620    begin
9621      AWindow := PGtkWidget(GtkWindow)^.window;
9622      if GDK_IS_WINDOW(AWindow) then
9623      begin
9624        AFlags := gdk_window_get_state(AWindow);
9625        if AFlags and GDK_WINDOW_STATE_ICONIFIED <> 0 then
9626          gtk_window_deiconify(GtkWindow);
9627        if AFlags and GDK_WINDOW_STATE_MAXIMIZED <> 0 then
9628          gtk_window_unmaximize(GtkWindow);
9629        if AFlags and GDK_WINDOW_STATE_FULLSCREEN <> 0 then
9630          gtk_window_unfullscreen(GtkWindow);
9631      end;
9632    end;
9633  end;
9634
9635  Result := True;
9636end;
9637
9638{------------------------------------------------------------------------------
9639  Function: StretchBlt
9640  Params:  DestDC:                The destination devicecontext
9641           X, Y:                  The left/top corner of the destination rectangle
9642           Width, Height:         The size of the destination rectangle
9643           SrcDC:                 The source devicecontext
9644           XSrc, YSrc:            The left/top corner of the source rectangle
9645           SrcWidth, SrcHeight:   The size of the source rectangle
9646           ROp:                   The raster operation to be performed
9647  Returns: True if succesful
9648
9649  The StretchBlt function copies a bitmap from a source rectangle into a
9650  destination rectangle using the specified raster operation. If needed it
9651  resizes the bitmap to fit the dimensions of the destination rectangle.
9652  Sizing is done according to the stretching mode currently set in the
9653  destination device context.
9654  If SrcDC contains a mask the pixmap will be copied with this transparency.
9655
9656  ToDo: Mirroring, extended NonDrawable support (Image, Bitmap, etc)
9657 ------------------------------------------------------------------------------}
9658function TGtk2WidgetSet.StretchBlt(DestDC: HDC; X, Y, Width, Height: Integer;
9659  SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; ROp: Cardinal): Boolean;
9660begin
9661  Result:=StretchCopyArea(DestDC,X,Y,Width,Height,
9662                          SrcDC,XSrc,YSrc,SrcWidth,SrcHeight,
9663                          0,0,0,
9664                          ROp);
9665end;
9666
9667{------------------------------------------------------------------------------
9668  Function: StretchMaskBlt
9669  Params:  DestDC:                The destination devicecontext
9670           X, Y:                  The left/top corner of the destination rectangle
9671           Width, Height:         The size of the destination rectangle
9672           SrcDC:                 The source devicecontext
9673           XSrc, YSrc:            The left/top corner of the source rectangle
9674           SrcWidth, SrcHeight:   The size of the source rectangle
9675           Mask:                  The handle of a monochrome bitmap
9676           XMask, YMask:          The left/top corner of the mask rectangle
9677           ROp:                   The raster operation to be performed
9678  Returns: True if succesful
9679
9680  The StretchMaskBlt function copies a bitmap from a source rectangle into a
9681  destination rectangle using the specified mask and raster operation. If needed
9682  it resizes the bitmap to fit the dimensions of the destination rectangle.
9683  Sizing is done according to the stretching mode currently set in the
9684  destination device context.
9685 ------------------------------------------------------------------------------}
9686function TGtk2WidgetSet.StretchMaskBlt(DestDC: HDC; X, Y, Width, Height: Integer;
9687  SrcDC: HDC; XSrc, YSrc, SrcWidth, SrcHeight: Integer; Mask: HBITMAP;
9688  XMask, YMask: Integer; Rop: DWORD): Boolean;
9689begin
9690  Result:=StretchCopyArea(DestDC,X,Y,Width,Height,
9691                          SrcDC,XSrc,YSrc,SrcWidth,SrcHeight,
9692                          Mask,XMask,YMask,
9693                          Rop);
9694end;
9695
9696function TGtk2WidgetSet.SystemParametersInfo(uiAction: DWord; uiParam: DWord;
9697  pvParam: Pointer; fWinIni: DWord): LongBool;
9698{$IFDEF HASX}
9699var
9700  ax, ay, awidth, aheight: gint;
9701{$ENDIF}
9702begin
9703  Result:=True;
9704  Case uiAction of
9705    SPI_GETWHEELSCROLLLINES: PDword(pvParam)^ := 3;
9706    SPI_GETWORKAREA:
9707    begin
9708      {$IFDEF HASX}
9709      if XGetWorkarea(ax, ay, awidth, aheight) <> -1 then
9710        TRect(pvParam^) := Bounds(ax, ay, awidth, aheight)
9711      else
9712      {$ENDIF}
9713      TRect(pvParam^):=Bounds(GetSystemMetrics(SM_XVIRTUALSCREEN),
9714                              GetSystemMetrics(SM_YVIRTUALSCREEN),
9715                              GetSystemMetrics(SM_CXVIRTUALSCREEN),
9716                              GetSystemMetrics(SM_CYVIRTUALSCREEN));
9717    end;
9718  else
9719    Result:=False;
9720  end;
9721end;
9722
9723{------------------------------------------------------------------------------
9724  Function: TextOut
9725  Params: DC:
9726          X:
9727          Y:
9728          Str:
9729          Count:
9730  Returns:
9731
9732 ------------------------------------------------------------------------------}
9733function TGtk2WidgetSet.TextOut(DC: HDC; X, Y: Integer; Str: Pchar;
9734  Count: Integer) : Boolean;
9735var
9736  DevCtx: TGtkDeviceContext absolute DC;
9737  DCOrigin: TPoint;
9738  yOffset: integer;
9739  BackGroundColor: PGdkColor;
9740begin
9741  Result := IsValidDC(DC);
9742  if not Result then Exit;
9743  if Count <= 0 then Exit;
9744
9745  if DevCtx.HasTransf then
9746    DevCtx.TransfPoint(X, Y);
9747
9748  UpdateDCTextMetric(DevCtx);
9749  DCOrigin := DevCtx.Offset;
9750
9751  with DevCtx.DCTextMetric.TextMetric do
9752    yOffset := tmHeight-tmDescent-tmAscent;
9753  if yOffset < 0 then
9754    yOffset := 0;
9755
9756  DevCtx.SelectedColors := dcscCustom;
9757  EnsureGCColor(DC, dccCurrentTextColor, True, False);
9758
9759  BackGroundColor := nil;
9760  if DevCtx.BkMode = OPAQUE then
9761  begin
9762    AllocGDIColor(DC, @DevCtx.CurrentBackColor);
9763    BackGroundColor := @DevCtx.CurrentBackColor.Color;
9764  end;
9765
9766  DevCtx.DrawTextWithColors(Str, Count,
9767    X + DCOrigin.X, Y + DCOrigin.Y + yOffset,
9768    nil, BackGroundColor);
9769end;
9770
9771function TGtk2WidgetSet.UpdateWindow(Handle: HWND): Boolean;
9772var
9773  CurWidget: PGtkWidget;
9774begin
9775  CurWidget:={%H-}PGTKWidget(Handle);
9776  //DebugLn(['TGtk2WidgetSet.UpdateWindow ',GetWidgetDebugReport(CurWidget)]);
9777  if GTK_WIDGET_DRAWABLE(CurWidget) then begin
9778    //DebugLn(['TGtk2WidgetSet.UpdateWindow DRAWING']);
9779    gtk_widget_queue_draw(CurWidget);
9780    if GDK_IS_WINDOW(CurWidget^.Window) then
9781      gdk_window_process_updates(CurWidget^.window,TRUE);
9782    Result:=true;
9783  end else
9784    Result:=false;
9785end;
9786
9787
9788{------------------------------------------------------------------------------
9789  Function: WindowFromPoint
9790  Params: Point: Specifies the x and y Coords
9791  Returns: The handle of the gtkwidget.  If none exist, then NULL is returned.
9792
9793 ------------------------------------------------------------------------------}
9794function TGtk2WidgetSet.WindowFromPoint(APoint: TPoint): HWND;
9795var
9796  ev: TgdkEvent;
9797  Window: PgdkWindow;
9798  Widget: PgtkWidget;
9799  p: TPoint;
9800  WidgetInfo: PWidgetInfo;
9801begin
9802  // return cached value to prevent heavy gdk_display_get_window_at_pointer call
9803  if (APoint = LastWFPMousePos) and GTK_IS_OBJECT({%H-}Pointer(LastWFPResult)) and
9804    GTK_WIDGET_VISIBLE({%H-}PGtkWidget(LastWFPResult)) and
9805    GTK_WIDGET_IS_SENSITIVE({%H-}PGtkWidget(LastWFPResult)) then
9806    Exit(LastWFPResult);
9807  Result := 0;
9808
9809  WidgetInfo := nil;
9810  // we are using gdk_display_get_window_at_pointer instead of
9811  // gdk_window_at_pointer because of multihead support.
9812  // !! changes the coordinates !! -> using local variable p
9813  p := APoint;
9814  Window := gdk_display_get_window_at_pointer(gdk_display_get_default,
9815    @p.x, @p.y);
9816  if window <> nil then
9817  begin
9818    FillChar(ev{%H-}, SizeOf(ev), 0);
9819    ev.any.window := Window;
9820    Widget := gtk_get_event_widget(@ev);
9821    Result := {%H-}PtrUInt(Widget);
9822    if Result <> 0 then
9823    begin
9824      WidgetInfo := GetWidgetInfo(Widget);
9825      if WidgetInfo = nil then
9826      begin
9827        // complex controls eg. ScrollBar of TTreeView
9828        WidgetInfo := GetWidgetInfo(Widget^.parent);
9829        if WidgetInfo <> nil then
9830          Result := {%H-}PtrUInt(Widget^.parent);
9831      end;
9832    end;
9833  end;
9834  // disconnect old handler
9835  if GTK_IS_OBJECT({%H-}Pointer(LastWFPResult)) then
9836  begin
9837    g_signal_handlers_disconnect_by_func({%H-}GPointer(LastWFPResult),
9838      TGTKSignalFunc(@DestroyWindowFromPointCB), nil);
9839  end;
9840
9841  // see issue #17389
9842  if (WidgetInfo <> nil) and (WidgetInfo^.LCLObject <> nil)
9843  and (WidgetInfo^.LCLObject is TWinControl) then
9844    Result := TWinControl(WidgetInfo^.LCLObject).Handle;
9845
9846  // now we must check if we are visible and enabled
9847  if Result <> 0 then
9848  begin
9849    if not GTK_WIDGET_VISIBLE({%H-}PGtkWidget(Result)) or
9850      not GTK_WIDGET_IS_SENSITIVE({%H-}PGtkWidget(Result)) then
9851        Result := 0;
9852  end;
9853
9854  LastWFPMousePos := APoint;
9855  LastWFPResult := Result;
9856  // connect handler
9857  if LastWFPResult <> 0 then
9858  begin
9859    g_signal_connect({%H-}GPointer(LastWFPResult), 'destroy',
9860      TGTKSignalFunc(@DestroyWindowFromPointCB), nil);
9861  end;
9862end;
9863
9864//##apiwiz##eps##   // Do not remove
9865
9866// Placed CriticalSectionSupport outside the API wizard bounds
9867// so it won't affect sorting etc.
9868
9869{$IfNDef DisableCriticalSections}
9870
9871  {$IfDef Unix}
9872
9873    {$Define pthread}
9874
9875    {Type
9876      _pthread_fastlock = packed record
9877        __status: Longint;
9878        __spinlock: Integer;
9879      end;
9880
9881      pthread_mutex_t = packed record
9882        __m_reserved: Integer;
9883        __m_count: Integer;
9884        __m_owner: Pointer;
9885        __m_kind: Integer;
9886        __m_lock: _pthread_fastlock;
9887      end;
9888      ppthread_mutex_t = ^pthread_mutex_t;
9889
9890      pthread_mutexattr_t = packed record
9891        __mutexkind: Integer;
9892      end;}
9893
9894    {$linklib pthread}
9895
9896    {function pthread_mutex_init(var Mutex: pthread_mutex_t;
9897      var Attr: pthread_mutexattr_t): Integer; cdecl;external;
9898    function pthread_mutexattr_settype(var Attr: pthread_mutexattr_t;
9899      Kind: Integer): Integer; cdecl;external;
9900    function pthread_mutex_lock(var Mutex: pthread_mutex_t):
9901      Integer; cdecl; external;
9902    function pthread_mutex_unlock(var Mutex: pthread_mutex_t):
9903      Integer; cdecl; external;
9904    function pthread_mutex_destroy(var Mutex: pthread_mutex_t):
9905      Integer; cdecl; external;}
9906  {$EndIf}
9907
9908{$EndIf}
9909
9910procedure TGtk2WidgetSet.InitializeCriticalSection(var CritSection: TCriticalSection);
9911{$IfDef pthread}
9912var
9913  ACritSec: System.PRTLCriticalSection;
9914begin
9915  New(ACritSec);
9916  System.InitCriticalSection(ACritSec^);
9917  CritSection:={%H-}TCriticalSection(ACritSec);
9918end;
9919{var
9920  Crit : ppthread_mutex_t;
9921  Attribute: pthread_mutexattr_t;
9922begin
9923  if pthread_mutexattr_settype(Attribute, 1) <> 0 then
9924    Exit;
9925  If CritSection <> 0 then
9926    Try
9927      Crit := ppthread_mutex_t(CritSection);
9928      Dispose(Crit);
9929    except
9930      CritSection := 0;
9931    end;
9932  New(Crit);
9933  pthread_mutex_init(Crit^, Attribute);
9934  CritSection := Longint(Crit);
9935end;}
9936{$Else}
9937begin
9938end;
9939{$EndIf}
9940
9941procedure TGtk2WidgetSet.EnterCriticalSection(var CritSection: TCriticalSection);
9942{$IfDef pthread}
9943var
9944  ACritSec: System.PRTLCriticalSection;
9945begin
9946  ACritSec:={%H-}System.PRTLCriticalSection(CritSection);
9947  System.EnterCriticalsection(ACritSec^);
9948end;
9949{$Else}
9950begin
9951end;
9952{$EndIf}
9953
9954procedure TGtk2WidgetSet.LeaveCriticalSection(var CritSection: TCriticalSection);
9955{$IfDef pthread}
9956var
9957  ACritSec: System.PRTLCriticalSection;
9958begin
9959  ACritSec:={%H-}System.PRTLCriticalSection(CritSection);
9960  System.LeaveCriticalsection(ACritSec^);
9961end;
9962{$Else}
9963begin
9964end;
9965{$EndIf}
9966
9967procedure TGtk2WidgetSet.DeleteCriticalSection(var CritSection: TCriticalSection);
9968{$IfDef pthread}
9969var
9970  ACritSec: System.PRTLCriticalSection;
9971begin
9972  ACritSec:={%H-}System.PRTLCriticalSection(CritSection);
9973  System.DoneCriticalsection(ACritSec^);
9974  Dispose(ACritSec);
9975  CritSection:=0;
9976end;
9977{$Else}
9978begin
9979end;
9980{$EndIf}
9981
9982{$IfDef ASSERT_IS_ON}
9983  {$UNDEF ASSERT_IS_ON}
9984  {$C-}
9985{$EndIf}
9986
9987
9988
9989