fpc/packages/fpgtk/src/editor/buttonrow.pp

{
    This file is part of the fpgtk package
    Copyright (c) 1999-2000 by Michael van Canney, Sebastian Guenther
 
    Button row (bar) 

    See the file COPYING.FPC, 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.

 **********************************************************************}

{$mode objfpc}{$h+}
unit ButtonRow;

interface

{$IFDEF FPC_DOTTEDUNITS}
uses System.Classes, Api.Gtk1.Glib, Api.Gtk1.Gtk, Api.Gtk1.Gdk, Fpgtk;
{$ELSE FPC_DOTTEDUNITS}
uses classes, glib, gtk, gdk, FPgtk;
{$ENDIF FPC_DOTTEDUNITS}

type

  TRefreshProc = procedure (Selected:TCollectionItem; NeedFocus:boolean) of object;
  TCalcIconFunc = procedure (Item:TCollectionItem; var Pixmap:PGdkPixMap; var mask:PGdkBitmap) of object;

  TButtonRow = class (TFPGtkToolbar)
  private
    FMFirst, FMPrev, FMNext, FMLast,
    FMCopy, FMAdd, FMDelete, FMUp, FMDown : TFPGtkMenuItem;
    FCopy, FAdd, FDelete, FUp, FDown : TFPGtkWidget;
    ICopy, IUp, IDown, IDelete, IAdd : TFPgtkPixmap;
    FCollection : TCollection;
    FList : TFPgtkCList;
    FRefreshProc : TRefreshProc;
    FCalcIconFunc : TCalcIconFunc;
    FSelectIndex : integer;
    FNeedFocus : boolean;
    FTitle : AnsiString;
    AccelGroup : PGtkAccelGroup;
    procedure SetTitle (Value : AnsiString);
    procedure CreatePixmaps;
    procedure NewSelection (Sender : TFPgtkObject; row,column:integer;
                            event:PGdkEventButton; data : pointer);
    procedure ClickedAdd (Sender : TFPgtkObject; data : pointer);
    procedure ClickedCopy (Sender : TFPgtkObject; data : pointer);
    procedure ClickedDelete (Sender : TFPgtkObject; data : pointer);
    procedure ClickedUp (Sender : TFPgtkObject; data : pointer);
    procedure ClickedDown (Sender : TFPgtkObject; data : pointer);
    procedure ClickedFirst (Sender : TFPgtkObject; data : pointer);
    procedure ClickedPrevious (Sender : TFPgtkObject; data : pointer);
    procedure ClickedNext (Sender : TFPgtkObject; data : pointer);
    procedure ClickedLast (Sender : TFPgtkObject; data : pointer);
    procedure CheckSensitive (index : integer);
    procedure FillList;
  public
    constructor create;
    procedure Configure (TheList : TFPgtkCList;
                         CalcIconFunc : TCalcIconFunc;
                         RefreshProc : TRefreshProc;
                         TheSubMenu : TFPgtkMenuShell;
                         AG : PGtkAccelGroup;
                         Mods : TGdkModifierType);
    procedure ChangeCollection (ACollection : TCollection);
    function CurrentItem : TCollectionItem;
    property SelectedRow : integer read FSelectIndex;
    property Title : AnsiString read FTitle write SetTitle;

  end;

implementation

{$IFDEF FPC_DOTTEDUNITS}
uses Xpms, Gtkdeftexts, Fpgtkext;
{$ELSE FPC_DOTTEDUNITS}
uses XPMs, GtkDefTexts, FPgtkExt;
{$ENDIF FPC_DOTTEDUNITS}

var
  DefAdd, DefCopy, DefDel, DefUp, DefDown : PGdkPixmap;
  DefAddM, DefCopyM, DefDelM, DefUpM, DefDownM : PGdkBitmap;

{ TButtonRow }

procedure TButtonRow.SetTitle (Value : AnsiString);
begin
  FTitle := Value + ': ';
end;

procedure TButtonRow.CreatePixmaps;
begin
  IAdd := TFPgtkPixmap.Create;
  ICopy := TFPgtkPixmap.Create;
  IDelete := TFPgtkPixmap.Create;
  IUp := TFPgtkPixmap.Create;
  IDown := TFPgtkPixmap.Create;
  if assigned (DefAdd) then
    begin
    IAdd.SetPixmap (DefAdd, DefAddM);
    ICopy.SetPixmap (DefCopy, DefCopyM);
    IDelete.SetPixmap (DefDel, DefDelM);
    IUp.SetPixmap (DefUp, DefUpM);
    IDown.SetPixmap (DefDown, DefDownM);
    end
  else
    begin
    IAdd.LoadFromArray (XPMEditAdd);
    ICopy.LoadFromArray (XPMEditCopy);
    IDelete.LoadFromArray (XPMEditDelete);
    IUp.LoadFromArray (XPMEditUp);
    IDown.LoadFromArray (XPMEditDown);
    IAdd.GetPixmap (DefAdd, DefAddM);
    ICopy.GetPixmap (DefCopy, DefCopyM);
    IDelete.GetPixmap (DefDel, DefDelM);
    IUp.GetPixmap (DefUp, DefUpM);
    IDown.GetPixmap (DefDown, DefDownM);
    end;
end;

constructor TButtonRow.create;
begin
  inherited;
  // Create the Pixmaps
  CreatePixMaps;
  // Configure the toolbar
  ButtonRelief := Gtk_Relief_None;
  // Create the buttons with the pixmaps
  FAdd := AppendItem ('',RemoveUnderscore(smAdd),'',IAdd, @ClickedAdd, nil);
  FAdd.Sensitive := False;
  FCopy := AppendItem ('',RemoveUnderscore(smCopy),'',ICopy, @ClickedCopy, nil);
  FCopy.Sensitive := False;
  FDelete := AppendItem ('',RemoveUnderscore(smDelete),'',IDelete, @ClickedDelete, nil);
  FDelete.Sensitive := False;
  AppendSpace;
  FUp := AppendItem ('',RemoveUnderscore(smUp),'',IUp, @ClickedUp, nil);
  FUp.Sensitive := False;
  FDown := AppendItem ('',RemoveUnderscore(smDown),'',IDown, @ClickedDown, nil);
  FDown.Sensitive := False;
end;

procedure TButtonRow.Configure (TheList : TFPgtkCList;
                         CalcIconFunc : TCalcIconFunc;
                         RefreshProc : TRefreshProc;
                         TheSubMenu : TFPgtkMenuShell;
                         AG : PGtkAccelGroup;
                         Mods : TGdkModifierType);

  function MyKeyDef (Key : guint) : PAccelKeyDef;
  begin
    if Mods = 0 then
      result := nil
    else
      result := MakeAccelKeyDef (AG, Key, Mods);
  end;
begin
  FList := TheList;
  FCollection := nil;
  FRefreshProc := RefreshProc;
  FCalcIconFunc := CalcIconFunc;
  with FList do
    begin
    SelectionMode := Gtk_Selection_Browse;
    ConnectSelectRow (@NewSelection, nil);
    SetColumnAutoResize (0, true);
    if assigned (FCalcIconFunc) then
      SetColumnAutoResize (1, true);
    end;
  with TheSubMenu do
    begin
    FMAdd := NewMenuItem (smAdd, '', '', MyKeyDef (gdk_A), @ClickedAdd, nil);
    FMDelete := NewMenuItem (smDelete, '', '', MyKeyDef (gdk_D), @ClickedDelete, nil);
    FMCopy := NewMenuItem (smCopy, '', '', MyKeyDef (gdk_C), @ClickedCopy, nil);
    FMUp := NewMenuItem (smUp, '', '', MyKeyDef (gdk_U), @ClickedUp, nil);
    FMDown := NewMenuItem (smDown, '', '', MyKeyDef (gdk_O), @ClickedDown, nil);
    FMFirst := NewMenuItem (smFirst, '', '', MyKeyDef (gdk_F), @ClickedFirst, nil);
    FMLast := NewMenuItem (smLast, '', '', MyKeyDef (gdk_L), @ClickedLast, nil);
    FMPrev := NewMenuItem (smPrevious, '', '', MyKeyDef (gdk_P), @ClickedPrevious, nil);
    FMNext := NewMenuItem (smNext, '', '', MyKeyDef (gdk_N), @ClickedNext, nil);
    Add (FMAdd);
    Add (FMCopy);
    Add (FMDelete);
    Add (NewLine);
    Add (FMUp);
    Add (FMDown);
    Add (NewLine);
    Add (FMFirst);
    Add (FMPrev);
    Add (FMNext);
    Add (FMLast);
    end;
  CheckSensitive (-1);
end;

procedure TButtonRow.FillList;
var r : integer;
    pm : PGdkPixMap;
    m : PGdkBitmap;
begin
  FList.Freeze;
  try
    FList.Clear;
    if assigned (FCollection) and (FCollection.Count > 0) then
      with FCollection do
        begin
        if assigned (FCalcIconFunc) then
          for r := 0 to count-1 do
            begin
            FCalcIconFunc (Items[r], pm, m);
            FList.Append (['',Items[r].Displayname]);
            FList.SetPixmap (r, 0, pm, m);
            end
        else
          for r := 0 to count-1 do
            begin
            FList.Append (Items[r].Displayname, '~');
            end;
        end
    else
      begin
      FSelectIndex := -1;
      if assigned (FRefreshProc) then
        FRefreshProc (nil, false);
      end;
  finally
    FList.Thaw;
  end;
end;

procedure TButtonRow.ChangeCollection (ACollection : TCollection);
begin
  {$IFDEF debug}
  writeln (FTitle, 'ChangeCollection');
  {$ENDIF}
  FCollection := ACollection;
  FillList;
  if assigned(FCollection) and (FCollection.count > 0) then
    CheckSensitive (0)
  else
    CheckSensitive (-1);
  {$IFDEF debug}
  writeln (FTitle, 'ChangeCollection End');
  {$ENDIF}
end;

procedure TButtonRow.NewSelection (Sender : TFPgtkObject; row,column:integer;
                                   event:PGdkEventButton; data:pointer);
begin
  {$IFDEF debug}
  writeln (FTitle, 'NewSelection');
  {$ENDIF}
  if row >= 0 then
    begin
    FSelectIndex := row;
    CheckSensitive (row);
    if assigned (FRefreshProc) then
      FRefreshProc (FCollection.items[row], FNeedFocus);
    end;
  {$IFDEF debug}
  writeln (FTitle, 'NewSelection End');
  {$ENDIF}
end;

procedure TButtonRow.ClickedAdd (Sender : TFPgtkObject; data : pointer);
var i : TCollectionItem;
    pm : PGdkPixmap;
    m : PGdkBitmap;
begin
  {$IFDEF debug}
  writeln (FTitle, 'ClickedAdd');
  {$ENDIF}
  if assigned(FCollection) then
    begin
    i := FCollection.Add;
    i.displayname := sNew;
    if assigned (FCalcIconFunc) then
      begin
      FCalcIconFunc (I, pm, m);
      FList.Append (['',I.DisplayName]);
      FList.SetPixmap (Flist.count, 0, pm, m);
      end
    else
      FList.Append (i.displayName, '~');
    FNeedFocus := True;
    FList.SelectRow (FList.Count-1, 0);
    end;
  {$IFDEF debug}
  writeln (FTitle, 'ClickedAdd End');
  {$ENDIF}
end;

procedure TButtonRow.ClickedCopy (Sender : TFPgtkObject; data : pointer);
var c, i : TCollectionItem;
    pm : PGdkPixmap;
    m : PGdkBitmap;
begin
  {$IFDEF debug}
  writeln (FTitle, 'ClickedCopy');
  {$ENDIF}
  c := CurrentItem;
  if assigned(FCollection) and assigned (c) then
    begin
    i := FCollection.Add;
    i.assign(c);
    if assigned (FCalcIconFunc) then
      begin
      FCalcIconFunc (I, pm, m);
      FList.Append (['',I.DisplayName]);
      FList.SetPixmap (Flist.count-1, 0, pm, m);
      end
    else
      FList.Append (i.displayName, '~');
    FNeedFocus := True;
    FList.SelectRow (FList.Count-1,0);
    end;
  {$IFDEF debug}
  writeln (FTitle, 'ClickedCopy End');
  {$ENDIF}
end;

procedure TButtonRow.ClickedDelete (Sender : TFPgtkObject; data : pointer);
begin
  {$IFDEF debug}
  writeln (FTitle, 'ClickedDelete');
  {$ENDIF}
  if FSelectIndex >= 0 then
    begin
    FCollection.Items[FSelectIndex].Free;
    FList.Remove (FSelectIndex);
    FNeedFocus := False;
    FList.SelectRow (FSelectIndex, 0);
    end;
  {$IFDEF debug}
  writeln (FTitle, 'ClickedDelete End');
  {$ENDIF}
end;

procedure TButtonRow.ClickedUp (Sender : TFPgtkObject; data : pointer);
begin
  {$IFDEF debug}
  writeln (FTitle, 'ClickedUp');
  {$ENDIF}
  if FSelectIndex > 0 then
    begin
    with FCollection.Items[FSelectIndex] do
      Index := Index - 1;
    with FList do
      begin
      SwapRows (FSelectIndex, FSelectIndex-1);
      FNeedFocus := False;
      SelectRow (FSelectIndex-1, 0);
      end;
    //CheckSensitive (FSelectIndex-1);
    end;
  {$IFDEF debug}
  writeln (FTitle, 'ClickedUp End');
  {$ENDIF}
end;

procedure TButtonRow.ClickedDown (Sender : TFPgtkObject; data : pointer);
begin
  {$IFDEF debug}
  writeln (FTitle, 'ClickedDown');
  {$ENDIF}
  if (FSelectIndex >= 0) and (FSelectIndex < FCollection.count-1) then
    begin
    with FCollection.Items[FSelectIndex] do
      Index := Index + 1;
    with FList do
      begin
      SwapRows (FSelectIndex, FSelectIndex+1);
      FNeedFocus := False;
      SelectRow (FSelectIndex+1, 0);
      end;
    end;
  {$IFDEF debug}
  writeln (FTitle, 'ClickedDown End');
  {$ENDIF}
end;

procedure TButtonRow.ClickedFirst (Sender : TFPgtkObject; data : pointer);
begin
  FNeedFocus := False;
  with FList do
    SelectRow (0, 0);
end;

procedure TButtonRow.ClickedPrevious (Sender : TFPgtkObject; data : pointer);
begin
  FNeedFocus := False;
  if (FSelectIndex > 0) then
    with FList do
      SelectRow (FSelectIndex-1, 0);
end;


procedure TButtonRow.ClickedNext (Sender : TFPgtkObject; data : pointer);
begin
  FNeedFocus := False;
  if (FSelectIndex >= 0) and (FSelectIndex < FCollection.count-1) then
    with FList do
      SelectRow (FSelectIndex+1, 0);
end;

procedure TButtonRow.ClickedLast (Sender : TFPgtkObject; data : pointer);
begin
  FNeedFocus := False;
  with FList do
    SelectRow (FSelectIndex+1, 0);
end;

procedure TButtonRow.CheckSensitive (index : integer);
var b : boolean;
begin
  {$IFDEF debug}
  writeln (FTitle, 'CheckSensitive ', index);
  {$ENDIF}
  b := assigned(FCollection);
  FAdd.Sensitive := b;
  FMAdd.Sensitive := b;
  FMFirst.Sensitive := b;
  FMLast.Sensitive := b;
  b := assigned(FCollection) and (index >= 0) and (index < FCollection.Count);
  FCopy.Sensitive := b;
  FMCopy.Sensitive := b;
  b := assigned(FCollection) and (index >= 0) and (index < FCollection.count);
  FDelete.Sensitive := b;
  FMDelete.Sensitive := b;
  b := assigned(FCollection) and (index >= 0) and (index < FCollection.count-1);
  FDown.Sensitive := b;
  FMDown.Sensitive := b;
  FMNext.Sensitive := b;
  FUp.Sensitive := b;
  b := assigned(FCollection) and (index > 0) and (index < FCollection.count);
  FUp.Sensitive := b;
  FMUp.Sensitive := b;
  FMPrev.Sensitive := b;
  {$IFDEF debug}
  writeln (FTitle, 'CheckSensitive End');
  {$ENDIF}
end;

function TButtonRow.CurrentItem : TCollectionItem;
begin
  {$IFDEF debug}
  writeln (FTitle, 'CurrentItem');
  {$ENDIF}
  if FSelectIndex >= 0 then
    result := FCollection.Items[FSelectIndex]
  else
    result := nil;
  {$IFDEF debug}
  writeln (FTitle, 'CurrentItem End');
  {$ENDIF}
end;

end.