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/GTKMenus.pas | 205 +++++++++++++++++++++++----------------------- 1 file changed, 103 insertions(+), 102 deletions(-) (limited to 'libgtk_kylix/GTKMenus.pas') 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