lazarus/lcl/interfaces/gtk2/gtk2widgetset.inc

590 lines
18 KiB
PHP

{%MainUnit gtk2int.pas}
{******************************************************************************
TGtk2WidgetSet
******************************************************************************
*****************************************************************************
* *
* This file is part of the Lazarus Component Library (LCL) *
* *
* See the file COPYING.modifiedLGPL.txt, 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. *
* *
*****************************************************************************
}
{$IFOPT C-}
// Uncomment for local trace
// {$C+}
// {$DEFINE ASSERT_IS_ON}
{$ENDIF}
function GTK2FocusCB( widget: PGtkWidget; event:PGdkEventFocus;
data: gPointer) : GBoolean; cdecl;
var
Status : gBoolean;
begin
Status := GTKFocusCB(Widget, Event, Data);
if GtkWidgetIsA(Widget,GTK_APIWIDGETCLIENT_TYPE) then
Result := Status
else
Result := False;
end;
function GTK2FocusCBAfter(widget: PGtkWidget; event:PGdkEventFocus;
data: gPointer) : GBoolean; cdecl;
var
Status : gBoolean;
begin
Status := GTKFocusCBAfter(Widget, Event, Data);
if GtkWidgetIsA(Widget,GTK_APIWIDGETCLIENT_TYPE) then
Result := Status
else
Result := False;
end;
function gtk2HideCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Status : GBoolean;
begin
Status := gtkHideCB(Widget, Data);
if GtkWidgetIsA(Widget,GTK_APIWIDGETCLIENT_TYPE) then
Result := Status
else
Result := False;
end;
function GTK2KeyDown(Widget: PGtkWidget; Event : pgdkeventkey;
Data: gPointer) : GBoolean; cdecl;
begin
//debugln('GTK2KeyDown ',DbgSName(TObject(Data)));
Result := HandleGtkKeyUpDown(Widget, Event, Data, True, True);
end;
function GTK2KeyDownAfter(Widget: PGtkWidget; Event : pgdkeventkey;
Data: gPointer) : GBoolean; cdecl;
begin
//debugln('GTK2KeyDownAfter ',DbgSName(TObject(Data)));
Result := HandleGtkKeyUpDown(Widget, Event, Data, False, True);
end;
function GTK2KeyUp(Widget: PGtkWidget; Event : pgdkeventkey;
Data: gPointer) : GBoolean; cdecl;
begin
//debugln('GTK2KeyUp ',DbgSName(TObject(Data)));
Result := HandleGtkKeyUpDown(Widget, Event, Data, True, False);
end;
function GTK2KeyUpAfter(Widget: PGtkWidget; Event : pgdkeventkey;
Data: gPointer) : GBoolean; cdecl;
begin
//debugln('GTK2KeyUpAfter ',DbgSName(TObject(Data)));
Result := HandleGtkKeyUpDown(Widget, Event, Data, False, False);
end;
function GTK2KillFocusCB(widget: PGtkWidget; event:PGdkEventFocus;
data: gPointer) : GBoolean; cdecl;
var
Status : gBoolean;
begin
Status := GTKKillFocusCB(Widget, Event, Data);
if GtkWidgetIsA(Widget,GTK_APIWIDGETCLIENT_TYPE) then
Result := Status
else
Result := False;
end;
function GTK2KillFocusCBAfter(widget: PGtkWidget; event:PGdkEventFocus;
data: gPointer) : GBoolean; cdecl;
var
Status : gBoolean;
begin
Status := GTKKillFocusCBAfter(Widget, Event, Data);
if GtkWidgetIsA(Widget,GTK_APIWIDGETCLIENT_TYPE) then
Result := Status
else
Result := False;
end;
function gtk2showCB( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
var
Status : GBoolean;
begin
Status := gtkshowCB(Widget, Data);
if GtkWidgetIsA(Widget,GTK_APIWIDGETCLIENT_TYPE) then
Result := Status
else
Result := False;
end;
procedure gtk_clb_toggle(cellrenderertoggle : PGtkCellRendererToggle; arg1 : PGChar;
WinControl: TWinControl); cdecl;
var
aWidget : PGTKWidget;
aTreeModel : PGtkTreeModel;
aTreeIter : TGtkTreeIter;
value : pgValue;
begin
aWidget := GetWidgetInfo(Pointer(WinControl.Handle), True)^.CoreWidget;
aTreeModel := gtk_tree_view_get_model (GTK_TREE_VIEW(aWidget));
if (gtk_tree_model_get_iter_from_string (aTreeModel, @aTreeIter, arg1)) then begin
aTreeIter.stamp := GTK_LIST_STORE (aTreeModel)^.stamp; //strange hack
value := g_new0(SizeOf(TgValue), 1);
gtk_tree_model_get_value(aTreeModel, @aTreeIter, 0, value);
g_value_set_boolean(value, not g_value_get_boolean(value));
gtk_list_store_set_value (GTK_LIST_STORE (aTreeModel), @aTreeIter, 0, value);
g_value_unset(value);
g_free(value);
end;
end;
procedure gtk_clb_toggle_row_activated(treeview : PGtkTreeView; arg1 : PGtkTreePath;
arg2 : PGtkTreeViewColumn; data : gpointer); cdecl;
var
aTreeModel : PGtkTreeModel;
aTreeIter : TGtkTreeIter;
value : PGValue;
begin
aTreeModel := gtk_tree_view_get_model (treeview);
if (gtk_tree_model_get_iter (aTreeModel, @aTreeIter, arg1)) then begin
aTreeIter.stamp := GTK_LIST_STORE (aTreeModel)^.stamp; //strange hack
value := g_new0(SizeOf(TgValue), 1);
gtk_tree_model_get_value(aTreeModel, @aTreeIter, 0, value);
g_value_set_boolean(value, not g_value_get_boolean(value));
gtk_list_store_set_value (GTK_LIST_STORE (aTreeModel), @aTreeIter, 0, value);
g_value_unset(value);
g_free(value);
end;
end;
procedure gtk_commit_cb (context: PGtkIMContext; const Str: Pgchar;
Data: Pointer); cdecl;
begin
//DebugLn(['gtk_commit_cb ',dbgstr(Str),'="',Str,'"']);
im_context_string:=Str;
end;
{$IfNDef GTK2_2}
procedure gtkTreeSelectionCountSelectedRows(model : PGtkTreeModel; path : PGtkTreePath;
iter : PGtkTreeIter; data : PGint); cdecl;
begin
If Assigned(Data) then
Inc(Data^);
end;
Type
PPGList = ^PGList;
procedure gtkTreeSelectionGetSelectedRows(model : PGtkTreeModel; path : PGtkTreePath;
iter : PGtkTreeIter; data : PPGList); cdecl;
begin
If Assigned(Data) then
Data^ := g_list_append(Data^, gtk_tree_path_copy(path));
end;
{$EndIf}
{ TGtk2WidgetSet }
{------------------------------------------------------------------------------
procedure TGtk2WidgetSet.AppendText(Sender: TObject; Str: PChar);
------------------------------------------------------------------------------}
procedure TGtk2WidgetSet.AppendText(Sender: TObject; Str: PChar);
var
Widget : PGtkWidget;
aTextBuffer : PGtkTextBuffer;
aTextIter1 : TGtkTextIter;
aTextIter2 : TGtkTextIter;
begin
if Str=nil then exit;
if (Sender is TWinControl) then begin
case TWinControl(Sender).fCompStyle of
csMemo:
begin
Widget:= GetWidgetInfo(Pointer(TWinControl(Sender).Handle), True)^.CoreWidget;
aTextBuffer := gtk_text_view_get_buffer(GTK_TEXT_VIEW(Widget));
gtk_text_buffer_begin_user_action(aTextBuffer);
gtk_text_buffer_get_bounds(aTextBuffer, @aTextIter1, @aTextIter2);
gtk_text_buffer_insert(aTextBuffer, @aTextIter2, str, StrLen(str));
gtk_text_buffer_end_user_action(aTextBuffer);
end;
{else
inherited AppendText(Sender, Str);}
end;
end;
end;
function TGtk2WidgetSet.GetDeviceContextClass: TGtkDeviceContextClass;
begin
Result := TGtk2DeviceContext;
end;
function TGtk2WidgetSet.GetText(Sender: TComponent; var Text: String): Boolean;
var
CS: PChar;
Widget : PGtkWidget;
aTextBuffer : PGtkTextBuffer;
aTextIter1 : TGtkTextIter;
aTextIter2 : TGtkTextIter;
begin
Result := True;
case TControl(Sender).fCompStyle of
csEdit: begin
Widget:= GTK_WIDGET(Pointer(TWinControl(Sender).Handle));
CS := gtk_editable_get_chars(GTK_EDITABLE(Widget), 0, -1);
Text := StrPas(CS);
g_free(CS);
end;
csMemo : begin
Widget:= GetWidgetInfo(Pointer(TWinControl(Sender).Handle), True)^.CoreWidget;
aTextBuffer := gtk_text_view_get_buffer(GTK_TEXT_VIEW(Widget));
gtk_text_buffer_get_bounds(aTextBuffer, @aTextIter1, @aTextIter2);
CS := gtk_text_buffer_get_text(aTextBuffer, @aTextIter1, @aTextIter2, True);
Text := StrPas(CS);
g_free(CS);
end;
{else
Result := inherited GetText(Sender, Text);}
end;
end;
{------------------------------------------------------------------------------
Function: TGtk2WidgetSet.SetCallbackEx
Params: Msg - message for which to set a callback
sender - object to which callback will be send
Returns: nothing
Applies a Message to the sender
------------------------------------------------------------------------------}
procedure TGTK2WidgetSet.SetCallbackEx(const AMsg: LongInt;
const AGTKObject: PGTKObject; const ALCLObject: TObject; Direct: boolean);
procedure ConnectSenderSignal(const AnObject:PGTKObject; const ASignal: PChar;
const ACallBackProc: Pointer);
begin
ConnectSignal(AnObject,ASignal,ACallBackProc,TComponent(ALCLObject));
end;
procedure ConnectSenderSignalAfter(const AnObject:PGTKObject;
const ASignal: PChar; const ACallBackProc: Pointer);
begin
ConnectSignalAfter(AnObject,ASignal,ACallBackProc,TComponent(ALCLObject));
end;
procedure ConnectSenderSignal(const AnObject:PGTKObject; const ASignal: PChar;
const ACallBackProc: Pointer; const ReqSignalMask: TGdkEventMask);
begin
ConnectSignal(AnObject,ASignal,ACallBackProc,ALCLObject,
ReqSignalMask);
end;
procedure ConnectSenderSignalAfter(const AnObject:PGTKObject;
const ASignal: PChar; const ACallBackProc: Pointer;
const ReqSignalMask: TGdkEventMask);
begin
ConnectSignalAfter(AnObject,ASignal,ACallBackProc,ALCLObject,
ReqSignalMask);
end;
procedure ConnectFocusEvents(const AnObject: PGTKObject);
begin
//DebugLn(['ConnectFocusEvents ',GetWidgetDebugReport(PGtkWidget(AnObject))]);
ConnectSenderSignal(AnObject, 'focus-in-event', @gtk2FocusCB);
ConnectSenderSignalAfter(AnObject, 'focus-in-event', @gtk2FocusCBAfter);
ConnectSenderSignal(AnObject, 'focus-out-event', @gtk2KillFocusCB);
ConnectSenderSignalAfter(AnObject, 'focus-out-event', @gtk2KillFocusCBAfter);
end;
procedure ConnectKeyPressReleaseEvents(const AnObject: PGTKObject);
begin
//debugln('gtk2object ConnectKeyPressReleaseEvents A ALCLObject=',DbgSName(ALCLObject));
ConnectSenderSignal(AnObject,
'key-press-event', @GTK2KeyDown, GDK_KEY_PRESS_MASK);
ConnectSenderSignalAfter(AnObject,
'key-press-event', @GTK2KeyDownAfter, GDK_KEY_PRESS_MASK);
ConnectSenderSignal(AnObject,
'key-release-event', @GTK2KeyUp, GDK_KEY_RELEASE_MASK);
ConnectSenderSignalAfter(AnObject,
'key-release-event', @GTK2KeyUpAfter, GDK_KEY_RELEASE_MASK);
end;
var
gObject, gFixed, gCore: PGTKObject;
begin
//debugln('gtk2object.inc TGtkWidgetSet.SetCallback A ALCLObject=',DbgSName(ALCLObject),' AMsg=',dbgs(AMsg));
if Direct then
begin
gObject := AGTKObject;
gFixed := AGTKObject;
gCore := AGTKObject;
end
else
begin
// gObject
if AGTKObject = nil then gObject := ObjectToGTKObject(ALCLObject)
else gObject := AGTKObject;
if gObject = nil then Exit;
// gFixed is the widget with the client area (e.g. TGroupBox, TForm have this)
gFixed := PGTKObject(GetFixedWidget(gObject));
if gFixed = nil then gFixed := gObject;
// gCore is the main widget (e.g. TListView has this)
gCore:= PGtkObject(GetWidgetInfo(gObject, True)^.CoreWidget);
end;
case AMsg of
LM_FOCUS :
begin
ConnectFocusEvents(gCore);
end;
LM_GRABFOCUS:
begin
ConnectSenderSignal(gObject, 'grab_focus', @gtkActivateCB);
end;
LM_CHAR,
LM_KEYDOWN,
LM_KEYUP,
LM_SYSCHAR,
LM_SYSKEYDOWN,
LM_SYSKEYUP:
begin
if (ALCLObject is TCustomComboBox) then
ConnectKeyPressReleaseEvents(PgtkObject(PgtkCombo(gObject)^.entry))
else if (ALCLObject is TCustomForm) then
ConnectKeyPressReleaseEvents(gObject);
ConnectKeyPressReleaseEvents(gCore);
end;
LM_SHOWWINDOW :
begin
ConnectSenderSignal(gObject, 'show', @gtk2showCB);
ConnectSenderSignal(gObject, 'hide', @gtk2hideCB);
end;
else
inherited SetCallbackEx(AMsg, AGTKObject, ALCLObject, Direct);
end;
end;
function TGtk2WidgetSet.LoadStockPixmap(StockID: longint; var Mask: HBitmap) : HBitmap;
var
Pixmap : PGDIObject;
StockName : PChar;
IconSet : PGtkIconSet;
Pixbuf : PGDKPixbuf;
begin
Mask := 0;
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, Mask);
exit;
end;
end;
if (StockID >= idButtonBase) and (StockID <= idDialogBase) then
IconSet := gtk_style_lookup_icon_set(GetStyle(lgsButton), StockName)
else
IconSet := gtk_style_lookup_icon_set(GetStyle(lgsWindow), StockName);
if (IconSet = nil) then
begin
Result := inherited LoadStockPixmap(StockID,Mask);
exit;
end;
if (StockID >= idButtonBase) and (StockID <= idDialogBase) then
pixbuf := gtk_icon_set_render_icon(IconSet, GetStyle(lgsbutton),
GTK_TEXT_DIR_NONE, GTK_STATE_NORMAL, GTK_ICON_SIZE_BUTTON, GetStyleWidget(lgsbutton), nil)
else
pixbuf := gtk_icon_set_render_icon(IconSet, GetStyle(lgswindow),
GTK_TEXT_DIR_NONE, GTK_STATE_NORMAL, GTK_ICON_SIZE_DIALOG, GetStyleWidget(lgswindow), 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.Image,
GDIPixmapObject.Mask, 128);
end;
gdk_pixbuf_unref(pixbuf);
Result := HBitmap(PtrUInt(Pixmap));
end;
{------------------------------------------------------------------------------
procedure TGtk2WidgetSet.SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
MultiSelect, ExtendedSelect: boolean);
------------------------------------------------------------------------------}
procedure TGtk2WidgetSet.SetSelectionMode(Sender: TObject; Widget: PGtkWidget;
MultiSelect, ExtendedSelect: boolean);
var
AControl: TWinControl;
SelectionMode: TGtkSelectionMode;
Selection : PGtkTreeSelection;
begin
AControl:=TWinControl(Sender);
if (AControl is TWinControl) and
(AControl.fCompStyle in [csListBox, csCheckListBox]) then
begin
if MultiSelect then
SelectionMode:= GTK_SELECTION_MULTIPLE
else
SelectionMode:= GTK_SELECTION_SINGLE;
Selection := gtk_tree_view_get_selection(GTK_TREE_VIEW(
GetWidgetInfo(Widget, True)^.CoreWidget));
gtk_tree_selection_set_mode(Selection, SelectionMode);
end;
end;
procedure TGtk2WidgetSet.SetWidgetFont(const AWidget: PGtkWidget; const AFONT: tFont);
var
FontDesc: PPangoFontDescription;
UseFont: PPangoLayout;
begin
if GtkWidgetIsA(AWidget,GTKAPIWidget_GetType) then begin
// the GTKAPIWidget is self drawn, so no use to change the widget style.
exit;
end;
UseFont := PGdiObject(AFont.Reference.Handle)^.GDIFontObject;
FontDesc := pango_layout_get_font_description(UseFont);
gtk_widget_modify_font(AWidget, FontDesc);
end;
(*
{------------------------------------------------------------------------------
function TGtk2WidgetSet.SetTopIndex(Sender: TObject; NewTopIndex: integer
): integer;
------------------------------------------------------------------------------}
function TGtk2WidgetSet.SetTopIndex(Sender: TObject; NewTopIndex: integer
): integer;
var
aTreeView: PGtkTreeView;
aTreeModel : PGtkTreeModel;
aTreeColumn : PGtkTreeViewColumn;
aTreeIter : TGtkTreeIter;
aTreePath : PGtkTreePath;
Count : Integer;
begin
Result:=0;
if not (Sender is TWinControl) then exit;
case TWinControl(Sender).fCompStyle of
csListBox, csCheckListBox:
begin
aTreeView := GTK_TREE_VIEW(GetWidgetInfo(Pointer(TWinControl(Sender).Handle), True)^.CoreWidget);
aTreeModel := gtk_tree_view_get_model(aTreeView);
If NewTopIndex < 0 then
NewTopIndex := 0
else begin
Count := gtk_tree_model_iter_n_children(aTreeModel,nil);
If NewTopIndex >= Count then
NewTopIndex := Count - 1;
end;
if gtk_tree_model_iter_nth_child(aTreeModel,@aTreeIter, nil, NewTopIndex) then begin
aTreePath := gtk_tree_model_get_path(aTreeModel, @aTreeIter);
aTreeColumn := gtk_tree_view_get_column(aTreeView, 0);
gtk_tree_view_scroll_to_cell(aTreeView, aTreePath, aTreeColumn, False, 0.0, 0.0);
gtk_tree_path_free(aTreePath);
end;
end;
end;
end;
*)
function TGtk2WidgetSet.CreateThemeServices: TThemeServices;
begin
Result := TGtk2ThemeServices.Create;
end;
constructor TGtk2WidgetSet.Create;
begin
inherited Create;
im_context:=gtk_im_multicontext_new;
g_signal_connect (G_OBJECT (im_context), 'commit',
G_CALLBACK (@gtk_commit_cb), nil);
end;
destructor TGtk2WidgetSet.Destroy;
begin
g_object_unref(im_context);
im_context:=nil;
im_context_widget:=nil;
inherited Destroy;
end;
function TGtk2WidgetSet.LCLPlatform: TLCLPlatform;
begin
Result:= lpGtk2;
end;
procedure TGtk2WidgetSet.AppInit(var ScreenInfo: TScreenInfo);
begin
inherited AppInit(ScreenInfo);
{$if defined(cpui386) or defined(cpux86_64)}
// needed otherwise some gtk theme engines crash with division by zero
{$IFNDEF DisableGtkDivZeroFix}
{$IFDEF windows}
Set8087CW($133F);
{$ELSE}
SetExceptionMask(GetExceptionMask + [exZeroDivide]);
{$ENDIF}
{$ENDIF}
{$ifend}
end;
function TGtk2WidgetSet.AppHandle: Thandle;
begin
{$ifdef windows}
Result := GetAppHandle;
{$else}
Result := inherited AppHandle;
{$endif}
end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}
{$C-}
{$ENDIF}