From ecde167da74c86bc047aaf84c5e548cf65a5da98 Mon Sep 17 00:00:00 2001 From: Tomas Bzatek Date: Sat, 7 Jun 2008 20:34:49 +0200 Subject: Initial commit --- libgtk_kylix/GTKMenus.pas | 530 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 530 insertions(+) create mode 100644 libgtk_kylix/GTKMenus.pas (limited to 'libgtk_kylix/GTKMenus.pas') diff --git a/libgtk_kylix/GTKMenus.pas b/libgtk_kylix/GTKMenus.pas new file mode 100644 index 0000000..2b6e190 --- /dev/null +++ b/libgtk_kylix/GTKMenus.pas @@ -0,0 +1,530 @@ +(* + 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. + +*) + +unit GTKMenus; +{ $WEAKPACKAGEUNIT} + +interface + +uses gtk2, gdk2, glib2, Classes, GTKControls, GTKConsts, GTKUtils, GTKPixbuf; + // Quick jump: QForms QControls QMenus + + +type +(****************************************** TGDKSHORTCUTS ***********************************************************************) + TGDKShortCut = record + Key: word; + Locked: boolean; + ModAlt: boolean; + ModShift: boolean; + ModCtrl: boolean; + end; + TGDKShortCuts = class(TComponent) + private + FList: TList; + FOwner: TGTKControl; + function GetCount: Integer; + function GetItem(Index: Integer): TGDKShortCut; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Add(Item: TGDKShortCut); + procedure AddName(Item: string); + procedure Clear; + procedure Delete(Index: Integer); + procedure Insert(Index: Integer; Item: TGDKShortCut); + function IndexOf(Item: TGDKShortCut): Integer; + property Count: Integer read GetCount; + property Items[Index: Integer]: TGDKShortCut read GetItem; default; + end; + +(****************************************** TGTKMENUITEM ************************************************************************) + TGTKMenuItemType = (itLabel, itSeparator, itTearOff, itCheck, itImageText, itRadio); + TGTKMenuItemGroup = PGSList; + TGTKMenuItem = class(TGTKBin) + private + FItems: TList; + FTearOffTitle: string; + FOnClick: TNotifyEvent; + FUKey: guint; + FItemType: TGTKMenuItemType; + FNotify: TNotifyEvent; + FImageWidget: PGtkWidget; + FData: Pointer; + FOnPopup: TNotifyEvent; + function GetCount: Integer; + function GetItem(Index: Integer): TGTKMenuItem; + function GetCaption: string; + function GetRightJustified: boolean; + function GetTornOff: boolean; + function GetChecked: boolean; + function GetGroup: TGTKMenuItemGroup; + procedure SetCaption(Value: string); + procedure SetTearOffTitle(Value: string); + procedure SetRightJustified(Value: boolean); + procedure SetItemType(Value: TGTKMenuItemType); + procedure SetTornOff(Value: boolean); + procedure SetChecked(Value: boolean); + procedure SetStockIcon(Value: string); + procedure SetIcon(Value: TGDKPixbuf); + procedure SetGroup(Value: TGTKMenuItemGroup); + protected + public + FMenu: PGtkWidget; + FParentMenu: TGTKControl; + ShortCuts: TGDKShortCuts; + constructor Create(AOwner: TComponent); override; + constructor CreateTyped(AOwner: TComponent; const ItemType: TGTKMenuItemType; AGroup: TGTKMenuItemGroup = nil); + destructor Destroy; override; + procedure Recreate(AGroup: TGTKMenuItemGroup = nil); + procedure Add(Item: TGTKMenuItem); + procedure Clear; + procedure Delete(Index: Integer); + procedure Insert(Index: Integer; Item: TGTKMenuItem); + procedure TearOff; + procedure UnTearOff; + procedure PopUp; + procedure PopDown; + procedure SetCaptionPlain(Value: string); + property Count: Integer read GetCount; + property Items[Index: Integer]: TGTKMenuItem read GetItem; default; + property Caption: string read GetCaption write SetCaption; + property TearOffTitle: string read FTearOffTitle write SetTearOffTitle; + property RightJustified: boolean read GetRightJustified write SetRightJustified default False; + property OnClick: TNotifyEvent read FOnClick write FOnClick; + property ItemType: TGTKMenuItemType read FItemType write SetItemType default itLabel; + property TornOff: boolean read GetTornOff write SetTornOff; + property Checked: boolean read GetChecked write SetChecked; + property Notify: TNotifyEvent read FNotify write FNotify; + property StockIcon: string write SetStockIcon; + property Icon: TGDKPixbuf write SetIcon; + property Data: Pointer read FData write FData; + property OnPopup: TNotifyEvent read FOnPopup write FOnPopup; + property Group: TGTKMenuItemGroup read GetGroup write SetGroup; + end; + + +(****************************************** TGTKMENUBAR *************************************************************************) + TGTKMenuBar = class(TGTKContainer) + private + FItems: TGTKMenuItem; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + published + property Items: TGTKMenuItem read FItems; + end; + + +function MakeGDKShortCut(Key: word; Locked, ModAlt, ModShift, ModCtrl : boolean): TGDKShortCut; + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +(********************************************************************************************************************************) +implementation + +uses GTKForms, GTKExtCtrls; + +(********************************************************************************************************************************) +(********************************************************************************************************************************) +constructor TGTKMenuBar.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FWidget := gtk_menu_bar_new; + Show; + FItems := TGTKMenuItem.Create(Self); + FItems.FParentMenu := Self; +end; + +destructor TGTKMenuBar.Destroy; +begin + if Assigned(FItems) then FItems.Free; + inherited Destroy; +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; + +constructor TGTKMenuItem.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FItemType := itLabel; + FImageWidget := nil; + FItems := nil; + FMenu := nil; + FOnClick := nil; + FWidget := nil; + FParentMenu := nil; + FNotify := nil; + FData := nil; + FOnPopup := nil; + ShortCuts := TGDKShortCuts.Create(Self); + FTearOffTitle := ''; + FUKey := 0; + Recreate; +end; + +constructor TGTKMenuItem.CreateTyped(AOwner: TComponent; const ItemType: TGTKMenuItemType; AGroup: TGTKMenuItemGroup = nil); +begin + inherited Create(AOwner); + FItemType := ItemType; + FImageWidget := nil; + FItems := nil; + FMenu := nil; + FOnClick := nil; + FWidget := nil; + FParentMenu := nil; + FNotify := nil; + FData := nil; + ShortCuts := TGDKShortCuts.Create(Self); + FTearOffTitle := ''; + FUKey := 0; + Recreate(AGroup); +end; + +destructor TGTKMenuItem.Destroy; +begin + if not (csDestroying in ComponentState) then begin + ShortCuts.Free; + if FItems <> nil then begin + Clear; + FItems.Free; + FItems := nil; + end; + end; + inherited Destroy; +end; + +procedure TGTKMenuItem.Recreate(AGroup: TGTKMenuItemGroup = nil); +begin + if Assigned(FWidget) then begin + gtk_widget_unparent(FWidget); + gtk_widget_hide(FWidget); + gtk_widget_destroy(FWidget); + end; + case FItemType of + itLabel: FWidget := gtk_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption)); + itSeparator: FWidget := gtk_menu_item_new; + itTearOff: FWidget := gtk_tearoff_menu_item_new; + itCheck: FWidget := gtk_check_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption)); + itImageText: begin + FWidget := gtk_image_menu_item_new_with_mnemonic(Pgchar(SCDefaultMenuItemCaption)); + FImageWidget := gtk_image_new; + gtk_widget_show(FImageWidget); + gtk_image_menu_item_set_image(PGtkImageMenuItem(FWidget), FImageWidget); + end; + itRadio: FWidget := gtk_radio_menu_item_new_with_mnemonic(AGroup, Pgchar(SCDefaultMenuItemCaption)); + end; + g_signal_connect(PGtkObject(FWidget), 'activate', G_CALLBACK(@TGTKMenuItem_activate), Self); + Show; +end; + +procedure TGTKMenuItem.Add(Item: TGTKMenuItem); +begin + Insert(GetCount, Item); +end; + +procedure TGTKMenuItem.Clear; +var i: Integer; +begin + if Count > 0 then + for i := Count - 1 downto 0 do Delete(i); +end; + +function TGTKMenuItem.GetCount: Integer; +begin + if FItems = nil then Result := 0 + else Result := FItems.Count; +end; + +function TGTKMenuItem.GetItem(Index: Integer): TGTKMenuItem; +begin + Result := nil; + if FItems = nil then Exit; + Result := FItems[Index]; +end; + +procedure TGTKMenuItem.Delete(Index: Integer); +begin + if (Index < 0) or (FItems = nil) or (Index >= GetCount) then Exit; + if FParentMenu is TGTKMenuBar + then gtk_container_remove(PGtkContainer(Parent.FWidget), TGTKMenuItem(FItems[Index]).FWidget) + else gtk_container_remove(PGtkContainer(FMenu), TGTKMenuItem(FItems[Index]).FWidget); +// Items[Index].Free; + FItems.Delete(Index); + if FItems.Count = 0 then begin + if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar) + then begin + if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar) + then gtk_menu_item_remove_submenu(PGtkMenuItem(FWidget)); + gtk_widget_destroy(FMenu); + FMenu := nil; + end; + FItems.Free; + FItems := nil; + end; + if Assigned(Notify) then Notify(Self); +end; + +procedure TGTKMenuItem.Insert(Index: Integer; Item: TGTKMenuItem); +begin + if (Item = Self) or (FItemType in [itSeparator, itTearOff]) then Exit; + if FItems = nil then begin + FItems := TList.Create; + if FMenu = nil then FMenu := gtk_menu_new; + if (FParentMenu is TGTKMenuItem) or (FParentMenu is TGTKMenuBar) + then gtk_menu_item_set_submenu(PGtkMenuItem(FWidget), FMenu); + SetTearOffTitle(FTearOffTitle); + end; + Item.FParentMenu := Self; + FItems.Insert(Index, Item); + if FParentMenu is TGTKMenuBar + then gtk_menu_shell_insert(PGtkMenuShell(FParentMenu.FWidget), Item.FWidget, Index) + else gtk_menu_shell_insert(PGtkMenuShell(FMenu), Item.FWidget, Index); + if Assigned(Notify) then Notify(Self); +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; + +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); +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 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; + +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)); +end; + +procedure TGTKMenuItem.SetStockIcon(Value: string); +begin + gtk_image_set_from_stock(PGtkImage(FImageWidget), PChar(Value), GTK_ICON_SIZE_MENU); +end; + +procedure TGTKMenuItem.SetIcon(Value: TGDKPixbuf); +begin + gtk_image_set_from_pixbuf(PGtkImage(FImageWidget), Value.FPixbuf); +end; + +function TGTKMenuItem.GetGroup: TGTKMenuItemGroup; +begin + Result := gtk_radio_menu_item_get_group(PGtkRadioMenuItem(FWidget)); +end; + +procedure TGTKMenuItem.SetGroup(Value: TGTKMenuItemGroup); +begin + gtk_radio_menu_item_set_group(PGtkRadioMenuItem(FWidget), Value); +end; + +(********************************************************************************************************************************) + (********************************************************************************************************************************) +constructor TGDKShortCuts.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FList := TList.Create; + FOwner := TGTKControl(AOwner); +end; + +destructor TGDKShortCuts.Destroy; +begin + if not (csDestroying in ComponentState) then Clear; + inherited Destroy; +end; + +function TGDKShortCuts.GetCount: Integer; +begin + Result := FList.Count; +end; + +procedure TGDKShortCuts.Add(Item: TGDKShortCut); +begin + Insert(GetCount, Item); +end; + +procedure TGDKShortCuts.AddName(Item: string); +var Key, Modifiers: guint; +begin + gtk_accelerator_parse(StringToPgchar(Item), @Key, @Modifiers); + if Key <> 0 then Add(MakeGDKShortCut(Key, False, Modifiers and GDK_MOD1_MASK = GDK_MOD1_MASK, Modifiers and GDK_SHIFT_MASK = GDK_SHIFT_MASK, Modifiers and GDK_CONTROL_MASK = GDK_CONTROL_MASK)); +end; + +procedure TGDKShortCuts.Clear; +var i: Integer; +begin + for i := Count - 1 downto 0 do Delete(i); +end; + +function GetAccelMods(SC: TGDKShortCut): guint; +begin + Result := 0; + if SC.ModShift then Inc(Result, GDK_SHIFT_MASK); + if SC.ModCtrl then Inc(Result, GDK_CONTROL_MASK); + if SC.ModAlt then Inc(Result, GDK_MOD1_MASK); +end; + +function GetAccelFlags(SC: TGDKShortCut): TGtkAccelFlags; +begin + Result := GTK_ACCEL_VISIBLE; + if SC.Locked then Result := GTK_ACCEL_LOCKED; +end; + +procedure TGDKShortCuts.Delete(Index: Integer); +begin + if (Index < 0) or (FList = nil) or (Index >= GetCount) then Exit; + if (GetParentForm(FOwner) <> nil) and (not (csDestroying in ComponentState)) + then gtk_widget_remove_accelerator(FOwner.FWidget, GetParentForm(FOwner).FAccelGroup, TGDKShortCut(FList[Index]^).Key, GetAccelMods(TGDKShortCut(FList[Index]^))); + FList.Delete(Index); +end; + +procedure TGDKShortCuts.Insert(Index: Integer; Item: TGDKShortCut); +begin + FList.Insert(Index, @Item); + if GetParentForm(FOwner) <> nil + then gtk_widget_add_accelerator(FOwner.FWidget, 'activate', GetParentForm(FOwner).FAccelGroup, Item.Key, GetAccelMods(Item), GetAccelFlags(Item)); +end; + +function TGDKShortCuts.GetItem(Index: Integer): TGDKShortCut; +begin + Result := TGDKShortCut(FList[Index]^); +end; + +function TGDKShortCuts.IndexOf(Item: TGDKShortCut): Integer; +var i : integer; +begin + Result := -1; + if FList.Count > 0 then + for i := 0 to FList.Count - 1 do + if (TGDKShortCut(FList[i]^).Key = Item.Key) and (TGDKShortCut(FList[i]^).Locked = Item.Locked) and + (TGDKShortCut(FList[i]^).ModAlt = Item.ModAlt) and (TGDKShortCut(FList[i]^).ModShift = Item.ModShift) and + (TGDKShortCut(FList[i]^).ModCtrl = Item.ModCtrl) then + begin + Result := i; + Break; + end; +end; + +function MakeGDKShortCut(Key: word; Locked, ModAlt, ModShift, ModCtrl : boolean): TGDKShortCut; +begin + Result.Key := Key; + Result.Locked := Locked; + Result.ModAlt := ModAlt; + Result.ModShift := ModShift; + Result.ModCtrl := ModCtrl; +end; + +(********************************************************************************************************************************) +(********************************************************************************************************************************) + + +end. -- cgit v1.2.3