Initial commitv0.6.36release-0.6.36-dev

1 files changed, 530 insertions, 0 deletions

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 <tbzatek@users.sourceforge.net>

+

+    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.