From c64f56fa977eaa96861cd5d8bac03c59552838df Mon Sep 17 00:00:00 2001 From: Tomas Bzatek Date: Tue, 11 Nov 2008 23:12:42 +0100 Subject: Right mouse button selection mode Patch by Nikola Radovanovic --- libgtk_kylix/GTKControls.pas | 41 ++++++++- libgtk_kylix/GTKMenus.pas | 205 ++++++++++++++++++++++--------------------- 2 files changed, 141 insertions(+), 105 deletions(-) (limited to 'libgtk_kylix') diff --git a/libgtk_kylix/GTKControls.pas b/libgtk_kylix/GTKControls.pas index 8004857..d839a65 100644 --- a/libgtk_kylix/GTKControls.pas +++ b/libgtk_kylix/GTKControls.pas @@ -1,6 +1,6 @@ (* GTK-Kylix Library: GTKControls - Basic objects - Version 0.6.22 (last updated 2007-12-19) + Version 0.6.23 (last updated 2008-11-11) Copyright (C) 2007 Tomas Bzatek This library is free software; you can redistribute it and/or @@ -62,7 +62,7 @@ type TGTKPosition = (poLeft, poRight, poTop, poBottom); (****************************************** TGTKCONTROL *************************************************************************) - TGDKMouseButton = (mbLeft, mbMiddle, mbRight); + TGDKMouseButton = (mbLeft, mbMiddle, mbRight, mbNoButton); TGDKKeyEvent = procedure (Sender: TObject; Key: Word; Shift: TShiftState; var Accept: boolean) of object; TGDKMouseEvent = procedure (Sender: TObject; Button: TGDKMouseButton; Shift: TShiftState; X, Y: Integer; var Accept: boolean) of object; TGDKFocusEvent = procedure (Sender: TObject; var Accept: boolean) of object; @@ -74,7 +74,7 @@ type FParent: TGTKControl; FPopupMenu: TGTKControl; FButtonPressSignalHandler, FButtonReleaseSignalHandler, FKeyDownSignalHandler, FKeyUpSignalHandler, - FFocusInSignalHandler, FFocusOutSignalHandler, FExposeSignalHandler: gulong; + FFocusInSignalHandler, FFocusOutSignalHandler, FExposeSignalHandler, FMotionNotifyHandler: gulong; FOnKeyDown: TGDKKeyEvent; FOnKeyUp: TGDKKeyEvent; FOnEnter: TGDKFocusEvent; @@ -83,6 +83,7 @@ type FOnMouseUp: TGDKMouseEvent; FOnDblClick: TGDKMouseEvent; FOnExpose: TGDKExposeEvent; + FOnMouseMove: TGDKMouseEvent; function GetWidth: Integer; function GetHeight: Integer; function GetLeft: Integer; @@ -111,6 +112,7 @@ type procedure SetCanFocus(Value: boolean); procedure SetOnExpose(Value: TGDKExposeEvent); procedure SetControlState(Value: TGTKControlState); + procedure SetOnMouseMove(Value: TGDKMouseEvent); protected procedure SetParent(const Value: TGTKControl); virtual; public @@ -159,6 +161,7 @@ type property OnExit: TGDKFocusEvent read FOnExit write SetOnExit; property OnMouseDown: TGDKMouseEvent read FOnMouseDown write SetOnMouseDown; property OnMouseUp: TGDKMouseEvent read FOnMouseUp write SetOnMouseUp; + property OnMouseMove: TGDKMouseEvent read FOnMouseMove write SetOnMouseMove; property OnDblClick: TGDKMouseEvent read FOnDblClick write SetOnDblClick; property OnExpose: TGDKExposeEvent read FOnExpose write SetOnExpose; property ComponentState; @@ -313,6 +316,9 @@ begin FOnEnter := nil; FOnExit := nil; FOnExpose := nil; + FOnMouseMove := nil; + FOnMouseDown := nil; + FOnMouseUp := nil; end; destructor TGTKControl.Destroy; @@ -702,6 +708,35 @@ begin end; end; +function TGTKControl_motion_notify_event(widget: PGtkWidget; event: PGdkEventMotion; user_data: gpointer): gboolean; cdecl; +var Shift: TShiftState; + Button: TGDKMouseButton; + Accept: boolean; +begin + Accept := True; + if event^.is_hint <> 0 then Exit; + Shift := []; + if event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift); + if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl); + if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt); + if event^.state and GDK_BUTTON1_MASK = GDK_BUTTON1_MASK then Button := mbLeft else + if event^.state and GDK_BUTTON2_MASK = GDK_BUTTON2_MASK then Button := mbMiddle else + if event^.state and GDK_BUTTON3_MASK = GDK_BUTTON3_MASK then Button := mbRight else + Button := mbNoButton; + if Assigned(TGTKControl(widget).FOnMouseMove) + then TGTKControl(widget).FOnMouseMove(TGTKControl(widget), Button, Shift, Trunc(event^.x), Trunc(event^.y), Accept); + Result := not Accept; +end; + +procedure TGTKControl.SetOnMouseMove(Value: TGDKMouseEvent); +begin + if @FOnMouseMove <> @Value then begin + FOnMouseMove := Value; + if Assigned(Value) then FMotionNotifyHandler := g_signal_connect_swapped(PGtkObject(FWidget), 'motion-notify-event', G_CALLBACK(@TGTKControl_motion_notify_event), Self) + else g_signal_handler_disconnect(PGtkObject(FWidget), FMotionNotifyHandler); + end; +end; + function TGTKControl.GetDefault: boolean; begin Result := False; diff --git a/libgtk_kylix/GTKMenus.pas b/libgtk_kylix/GTKMenus.pas index 2b6e190..2c5a4a3 100644 --- a/libgtk_kylix/GTKMenus.pas +++ b/libgtk_kylix/GTKMenus.pas @@ -1,24 +1,24 @@ (* GTK-Kylix Library: GTKMenus - Menu handling and related routines Version 0.6.13 (last updated 2003-07-10) - Copyright (C) 2003 Tomas Bzatek - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Library General Public - License as published by the Free Software Foundation; either - version 2 of the License, or (at your option) any later version. - - This library 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. See the GNU - Library General Public License for more details. - - You should have received a copy of the GNU Library General Public - License along with this library; if not, write to the - Free Software Foundation, Inc., 59 Temple Place - Suite 330, - Boston, MA 02111-1307 USA. - -*) + Copyright (C) 2003 Tomas Bzatek + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Library General Public + License as published by the Free Software Foundation; either + version 2 of the License, or (at your option) any later version. + + This library 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. See the GNU + Library General Public License for more details. + + You should have received a copy of the GNU Library General Public + License along with this library; if not, write to the + Free Software Foundation, Inc., 59 Temple Place - Suite 330, + Boston, MA 02111-1307 USA. + +*) unit GTKMenus; { $WEAKPACKAGEUNIT} @@ -165,9 +165,9 @@ end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TGTKMenuItem_activate(menuitem : PGtkMenuItem; user_data: pgpointer); cdecl; -begin - if Assigned(TGTKMenuItem(user_data).FOnClick) then TGTKMenuItem(user_data).FOnClick(TGTKMenuItem(user_data)); -end; +begin + if Assigned(TGTKMenuItem(user_data).FOnClick) then TGTKMenuItem(user_data).FOnClick(TGTKMenuItem(user_data)); +end; constructor TGTKMenuItem.Create(AOwner: TComponent); begin @@ -310,101 +310,102 @@ end; function TGTKMenuItem.GetCaption: string; begin - Result := ''; - if FItemType in [itSeparator, itTearOff] then Exit; - if Assigned(ChildControl) then Result := PgcharToString(gtk_label_get_text(PGtkLabel(ChildControl))); -end; + Result := ''; + if FItemType in [itSeparator, itTearOff] then Exit; + if Assigned(ChildControl) then Result := PgcharToString(gtk_label_get_text(PGtkLabel(ChildControl))); +end; procedure TGTKMenuItem.SetCaption(Value: string); begin if FItemType in [itSeparator, itTearOff] then Exit; gtk_label_set_markup_with_mnemonic(PGtkLabel(ChildControl), StringToPgchar(Value)); - if FTearOffTitle = '' then SetTearOffTitle(Value); -end; - -procedure TGTKMenuItem.SetCaptionPlain(Value: string); + if FTearOffTitle = '' then SetTearOffTitle(Value); +end; + +procedure TGTKMenuItem.SetCaptionPlain(Value: string); begin if FItemType in [itSeparator, itTearOff] then Exit; gtk_label_set_markup(PGtkLabel(ChildControl), StringToPgchar(Value)); - if FTearOffTitle = '' then SetTearOffTitle(Value); -end; - -procedure TGTKMenuItem.SetTearOffTitle(Value: string); -begin - FTearOffTitle := Value; - if FItemType = itTearOff then begin + if FTearOffTitle = '' then SetTearOffTitle(Value); +end; + +procedure TGTKMenuItem.SetTearOffTitle(Value: string); +begin + FTearOffTitle := Value; + if FItemType = itTearOff then begin if Assigned(FParentMenu) and (FParentMenu is TGTKMenuItem) and Assigned((FParentMenu as TGTKMenuItem).FMenu) - then gtk_menu_set_title(PGtkMenu((FParentMenu as TGTKMenuItem).FMenu), StringToPgchar(FTearOffTitle)) - end else if Assigned(FMenu) then gtk_menu_set_title(PGtkMenu(FMenu), StringToPgchar(FTearOffTitle)); - end; - -function TGTKMenuItem.GetRightJustified: boolean; -begin - Result := False; - if FItemType in [itSeparator, itTearOff] then Exit; - Result := gtk_menu_item_get_right_justified(PGtkMenuItem(FWidget)); -end; - + then gtk_menu_set_title(PGtkMenu((FParentMenu as TGTKMenuItem).FMenu), StringToPgchar(FTearOffTitle)) + end else if Assigned(FMenu) then gtk_menu_set_title(PGtkMenu(FMenu), StringToPgchar(FTearOffTitle)); +end; + +function TGTKMenuItem.GetRightJustified: boolean; +begin + Result := False; + if FItemType in [itSeparator, itTearOff] then Exit; + Result := gtk_menu_item_get_right_justified(PGtkMenuItem(FWidget)); +end; + procedure TGTKMenuItem.SetRightJustified(Value: boolean); begin if FItemType in [itSeparator, itTearOff] then Exit; gtk_menu_item_set_right_justified(PGtkMenuItem(FWidget), Value); end; - procedure TGTKMenuItem.SetItemType(Value: TGTKMenuItemType); - begin - if Value <> FItemType then begin - FItemType := Value; - Recreate; - end; - end; - - function TGTKMenuItem.GetTornOff: boolean; - begin - if FItemType = itTearOff then Result := Boolean(torn_off(PGTKTearOffMenuItem(FWidget)^)) else - if Assigned(FMenu) and (Count > 0) then Result := Boolean(torn_off(PGTKMenu(FMenu)^)) - else Result := False; - end; - - procedure TGTKMenuItem.SetTornOff(Value: boolean); - begin - if FItemType = itTearOff then begin - if Assigned(FParentMenu) and (FParentMenu is TGTKMenuItem) and Assigned((FParentMenu as TGTKMenuItem).FMenu) - then gtk_menu_set_tearoff_state(PGtkMenu((FParentMenu as TGTKMenuItem).FMenu), Value); - end else if Assigned(FMenu) then gtk_menu_set_tearoff_state(PGtkMenu(FMenu), Value); - end; - - procedure TGTKMenuItem.TearOff; - begin - SetTornOff(True); - end; - - procedure TGTKMenuItem.UnTearOff; -begin - SetTornOff(False); - end; - - function TGTKMenuItem.GetChecked: boolean; - begin - Result := False; - if (FItemType = itCheck) or (FItemType = itRadio) then - Result := Boolean(active(PGtkCheckMenuItem(FWidget)^)); - end; - - procedure TGTKMenuItem.SetChecked(Value: boolean); - begin - if (FItemType = itCheck) or (FItemType = itRadio) then - gtk_check_menu_item_set_active(PGtkCheckMenuItem(FWidget), Value); - end; - - procedure TGTKMenuItem.PopUp; - begin - if FItems.Count > 0 then gtk_menu_popup(PGtkMenu(FMenu), nil, nil, nil, nil, 3, 0); -end; - - procedure TGTKMenuItem.PopDown; - begin - if FItems.Count > 0 then gtk_menu_popdown(PGtkMenu(FMenu)); +procedure TGTKMenuItem.SetItemType(Value: TGTKMenuItemType); +begin + if Value <> FItemType then begin + FItemType := Value; + Recreate; + end; +end; + +function TGTKMenuItem.GetTornOff: boolean; +begin + if FItemType = itTearOff then Result := Boolean(torn_off(PGTKTearOffMenuItem(FWidget)^)) else + if Assigned(FMenu) and (Count > 0) then Result := Boolean(torn_off(PGTKMenu(FMenu)^)) + else Result := False; +end; + +procedure TGTKMenuItem.SetTornOff(Value: boolean); +begin + if FItemType = itTearOff then begin + if Assigned(FParentMenu) and (FParentMenu is TGTKMenuItem) and Assigned((FParentMenu as TGTKMenuItem).FMenu) + then gtk_menu_set_tearoff_state(PGtkMenu((FParentMenu as TGTKMenuItem).FMenu), Value); + end else if Assigned(FMenu) then gtk_menu_set_tearoff_state(PGtkMenu(FMenu), Value); +end; + +procedure TGTKMenuItem.TearOff; +begin + SetTornOff(True); +end; + +procedure TGTKMenuItem.UnTearOff; +begin + SetTornOff(False); +end; + +function TGTKMenuItem.GetChecked: boolean; +begin + Result := False; + if (FItemType = itCheck) or (FItemType = itRadio) then + Result := Boolean(active(PGtkCheckMenuItem(FWidget)^)); +end; + +procedure TGTKMenuItem.SetChecked(Value: boolean); +begin + if (FItemType = itCheck) or (FItemType = itRadio) then + gtk_check_menu_item_set_active(PGtkCheckMenuItem(FWidget), Value); +end; + +procedure TGTKMenuItem.PopUp; +begin + if Assigned(FOnPopup) then FOnPopup(Self); + if (FItems <> nil) and (FItems.Count > 0) then gtk_menu_popup(PGtkMenu(FMenu), nil, nil, nil, nil, 3, 0); +end; + +procedure TGTKMenuItem.PopDown; +begin + if (FItems <> nil) and (FItems.Count > 0) then gtk_menu_popdown(PGtkMenu(FMenu)); end; procedure TGTKMenuItem.SetStockIcon(Value: string); @@ -428,7 +429,7 @@ begin end; (********************************************************************************************************************************) - (********************************************************************************************************************************) +(********************************************************************************************************************************) constructor TGDKShortCuts.Create(AOwner: TComponent); begin inherited Create(AOwner); -- cgit v1.2.3