{ /*************************************************************************** gtk2int.pas - GTK2 Interface Object ------------------------------------- ***************************************************************************/ ***************************************************************************** * * * This file is part of the Lazarus Component Library (LCL) * * * * See the file COPYING.LCL, included in this distribution, * * for details about the copyright. * * * * This program is distributed in the hope that it will be useful, * * but WITHOUT ANY WARRANTY; without even the implied warranty of * * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. * * * ***************************************************************************** } unit Gtk2Int; {$mode objfpc}{$H+} interface {$ifdef Trace} {$ASSERTIONS ON} {$endif} uses Classes, SysUtils, {$IfNDef GTK2_2} {$IfNDef Win32} X, XLib, XUtil, {$EndIf} {$EndIf} gdk2pixbuf, gtk2, gdk2, glib2, LMessages, Controls, Forms, VclGlobals, LCLProc, LCLStrConsts, LCLLinux, LCLType, DynHashArray, LazLinkedList, GraphType, GraphMath, Graphics, Buttons, Menus, GTKWinApiWindow, StdCtrls, ComCtrls, CListBox, KeyMap, Calendar, Arrow, Spin, CommCtrl, ExtCtrls, Dialogs, ExtDlgs, FileCtrl, LResources, Math, GTKGlobals, gtkDef, gtkProc, gtkInt; type TGtk2Object = class(TGtkObject) public function GetCursorPos(var lpPoint: TPoint ): Boolean; override; function LoadStockPixmap(StockID: longint) : HBitmap; override; end; {$IfDef GTK2_2}//we need a GTK2_2 FLAG somehow Procedure gdk_display_get_pointer(display : PGdkDisplay; screen :PGdkScreen; x :Pgint; y : Pgint; mask : PGdkModifierType); cdecl; external gdklib; function gdk_display_get_default:PGdkDisplay; cdecl; external gdklib; procedure gdk_draw_pixbuf(drawable : PGdkDrawable; gc : PGdkGC; pixbuf : PGdkPixbuf; src_x, src_y, dest_x, dest_y, width, height : gint; dither : TGdkRgbDither; x_dither, y_dither : gint); cdecl; external gdklib; {$Else} {$IfNDef Win32} Function gdk_x11_drawable_get_xdisplay(drawable : PGdkDrawable) : PDisplay; cdecl; external gdklib; Function gdk_x11_drawable_get_xid(drawable : PGdkDrawable) : Integer; cdecl; external gdklib; {$EndIf} {$EndIf} implementation {------------------------------------------------------------------------------ Function: GetCursorPos Params: lpPoint: The cursorposition Returns: True if succesful ------------------------------------------------------------------------------} function Tgtk2Object.GetCursorPos(var lpPoint: TPoint ): Boolean; {$IfnDef GTK2_2} //we need a GTK2_2 FLAG somehow {$IfNDef Win32} var root, child: pointer; winx, winy: Integer; xmask: Cardinal; TopList, List: PGList; {$EndIf} {$EndIf} begin Result := False; {$IfDef GTK2_2} //we need a GTK2_2 FLAG somehow gdk_display_get_pointer(gdk_display_get_default(), nil, @lpPoint.X, @lpPoint.Y, nil); Result := True; {$Else} {$IfNDef Win32} TopList := gdk_window_get_toplevels; List := TopList; while List <> nil do begin if (List^.Data <> nil) and gdk_window_is_visible(List^.Data) then begin XQueryPointer(gdk_x11_drawable_get_xdisplay (List^.Data), gdk_x11_drawable_get_xid(List^.Data), @root, @child, @lpPoint.X, @lpPoint.Y, @winx, @winy, @xmask); Result := True; Break; end; List := g_list_next(List); end; if TopList <> nil then g_list_free(TopList); {$Else} // Win32 Todo writeln('ToDo(Win32): Tgtk2object.GetCursorPos'); {$EndIf} {$EndIf} end; Function TGtk2Object.LoadStockPixmap(StockID: longint) : HBitmap; var Pixmap : PGDIObject; StockName : PChar; IconSet : PGtkIconSet; Pixbuf : PGDKPixbuf; begin Case StockID Of idButtonOk : StockName := GTK_STOCK_OK; idButtonCancel : StockName := GTK_STOCK_CANCEL; idButtonYes : StockName := GTK_STOCK_YES; idButtonNo : StockName := GTK_STOCK_NO; idButtonHelp : StockName := GTK_STOCK_HELP; idButtonAbort : StockName := GTK_STOCK_CANCEL; idButtonClose : StockName := GTK_STOCK_QUIT; idDialogWarning : StockName := GTK_STOCK_DIALOG_WARNING; idDialogError : StockName := GTK_STOCK_DIALOG_ERROR; idDialogInfo : StockName := GTK_STOCK_DIALOG_INFO; idDialogConfirm : StockName := GTK_STOCK_DIALOG_QUESTION; else begin Result := inherited LoadStockPixmap(StockID); exit; end; end; if (StockID >= idButtonBase) and (StockID <= idDialogBase) then IconSet := gtk_style_lookup_icon_set(GetStyle('button'), StockName) else IconSet := gtk_style_lookup_icon_set(GetStyle('window'), StockName); If (IconSet = nil) then begin Result := inherited LoadStockPixmap(StockID); exit; end; if (StockID >= idButtonBase) and (StockID <= idDialogBase) then pixbuf := gtk_icon_set_render_icon(IconSet, GetStyle('button'), GTK_TEXT_DIR_NONE, GTK_STATE_NORMAL, GTK_ICON_SIZE_BUTTON, GetStyleWidget('button'), nil) else pixbuf := gtk_icon_set_render_icon(IconSet, GetStyle('window'), GTK_TEXT_DIR_NONE, GTK_STATE_NORMAL, GTK_ICON_SIZE_DIALOG, GetStyleWidget('window'), nil); Pixmap := NewGDIObject(gdiBitmap); With Pixmap^ do begin GDIBitmapType := gbPixmap; visual := gdk_visual_get_system(); gdk_visual_ref(visual); colormap := gdk_colormap_get_system(); gdk_colormap_ref(colormap); gdk_pixbuf_render_pixmap_and_mask(pixbuf, GDIPixmapObject, GDIBitmapMaskObject, 128); end; gdk_pixbuf_unref(pixbuf); Result := HBitmap(Pixmap); end; end. { $Log$ Revision 1.6 2003/09/09 04:15:08 ajgenius more updates for GTK2, more GTK1 wrappers, removal of more ifdef's, partly fixed signals Revision 1.5 2003/09/06 22:56:03 ajgenius started gtk2 stock icon overrides partial/temp(?) workaround for dc paint offsets Revision 1.4 2003/09/06 20:23:53 ajgenius fixes for gtk2 added more wrappers for gtk1/gtk2 converstion and sanity removed pointless version $Ifdef GTK2 etc IDE now "runs" Tcontrol drawing/using problems renders it unuseable however Revision 1.3 2003/09/06 17:24:52 ajgenius gtk2 changes for pixmap, getcursorpos, mouse events workaround Revision 1.2 2003/08/27 20:55:51 mattias fixed updating codetools on changing pkg output dir Revision 1.1 2002/12/15 11:52:28 mattias started gtk2 interface Revision 1.15 2002/02/09 01:48:23 mattias renamed TinterfaceObject.Init to AppInit and TWinControls can now contain childs in gtk Revision 1.14 2002/11/03 22:40:00 lazarus MG: fixed ControlAtPos Revision 1.13 2002/10/30 18:45:52 lazarus AJ: fixed compiling & removed '_' from custom stock items Revision 1.12 2002/10/26 15:15:50 lazarus MG: broke LCL<->interface circles Revision 1.11 2002/10/25 15:27:02 lazarus AJ: Moved form contents creation to gtkproc for code reuse between GNOME and GTK, and to make GNOME MDI programming easier later on. Revision 1.10 2002/10/24 22:10:39 lazarus AJ: More changes for better code reuse between gnome & gtk interfaces Revision 1.9 2002/10/23 20:47:27 lazarus AJ: Started Form Scrolling Started StaticText FocusControl Fixed Misc Dialog Problems Added TApplication.Title Revision 1.8 2002/10/21 13:15:24 lazarus AJ:Try and fall back on default style if nil(aka default theme) Revision 1.7 2002/10/21 03:23:34 lazarus AJ: rearranged GTK init stuff for proper GNOME init & less duplication between interfaces Revision 1.6 2002/10/15 22:28:04 lazarus AJ: added forcelinebreaks Revision 1.5 2002/10/14 14:29:50 lazarus AJ: Improvements to TUpDown; Added TStaticText & GNOME DrawText Revision 1.4 2002/10/12 16:36:40 lazarus AJ: added new QueryUser/NotifyUser Revision 1.3 2002/10/10 13:29:08 lazarus AJ: added LoadStockPixmap routine & minor fixes to/for GNOMEInt }