mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-06-26 13:08:39 +02:00
249 lines
8.3 KiB
ObjectPascal
249 lines
8.3 KiB
ObjectPascal
{
|
|
/***************************************************************************
|
|
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
|
|
}
|