setbutton.pas

DelphiDoc is a program for automatic generation of documentation on a Delphi-Project. At the momen

{  JADD - Just Another DelphiDoc: Documentation from Delphi Source Code

Copyright (C) 2004-2008   Gerold Veith

This file is part of JADD - Just Another DelphiDoc.

DelphiDoc is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License version 3 as
published by the Free Software Foundation.

DelphiDoc 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 General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit SetButton;

{Contains a component, ~[link TSetButton], to edit a set of options. The
 current bit mask is show as its label and when it is clicked a menu pop down
 to select an option to be toggled. }

interface

uses Classes,
{$IFNDEF LINUX}
     StdCtrls, Menus;
{$ELSE}
     QStdCtrls, QMenus;
{$ENDIF}




type

  {A component to edit a set of options. The current bit mask is show as its
   label and when it is clicked a menu pop down to select an option to be
   toggled. }
  TSetButton = class(TButton)
  private
    //menu to show all options
    FMenu: TPopupMenu;

    //Returns the value of the set of options.
    function GetValue: Longword;
    //Returns a string representing current value of the set of options.
    function GetValueString: String;

    //Called when a menu item of an option is selected.
    procedure MenuClick(Sender: TObject);
  public
    //Called when the button is clicked.
    procedure Click; override;

    //Called to initialize the button and set the set.
    procedure Init(List: TStrings; Value: Longword);

    property Value: Longword read GetValue;
  end;






implementation

uses Windows, SysUtils;



{Returns the value of the set of options.
~result the set }
function TSetButton.GetValue: Longword;
var      i         :Integer;     //counter through all items of the enumeration
begin
 Result := 0;
 for i := 0 to FMenu.Items.Count - 1 do  //for each item
  if FMenu.Items[i].Checked then           //if the option is in the set
   Result := Result or (1 shl i);            //set it
end;

{Returns a string representing current value of the set of options.
~result a string representing the set of options }
function TSetButton.GetValueString: String;
var      i         :Integer;     //counter through all items of the enumeration
begin
 Result := '';
 if FMenu.Items.Count <> 0 then           //not empty?
  if FMenu.Items[0].Tag = 0 then            //don't has short cuts?
   for i := 0 to FMenu.Items.Count - 1 do     //for each item, add a value
    Result := Char(Ord('0') + Ord(FMenu.Items[i].Checked)) + Result
  else
   begin
    for i := 0 to FMenu.Items.Count - 1 do     //for each item
     if FMenu.Items[i].Checked then              //that is in the set
      Result := Result + Char(FMenu.Items[i].Tag); //add its short cut
    Result := UpperCase(Result);  
   end;
end;



{Called when a menu item of an option is selected.
~param Sender the sender of the event, one of the menu items }
procedure TSetButton.MenuClick(Sender: TObject);
begin
 assert(Sender is TMenuItem);
 //toggle state of the clicked menu item
 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked;
 //show current state of the set
 Caption := GetValueString;
end;





{Called when the button is clicked. }
procedure TSetButton.Click;
var       Pos       :TPoint;          //position of the button on the screen
begin
 inherited Click;                     //handle the click, just in case

 Pos.x := 0;                          //get the top left position of the button
 Pos.y := 0;
 Pos := ClientToScreen(Pos);          //on the screen
 FMenu.Popup(Pos.x, Pos.y + Height);  //below the button show the popup menu
end;



{Called to initialize the button and set the set.
~param List  the list of items in the set
~param Value the value of the set as a bit mask }
procedure TSetButton.Init(List: TStrings; Value: Longword);

 {Returns the text with the access key set.
 ~param Text     the text to set the access key in
 ~param ShortCut the access key character
 ~result the text with the access key set }
 function AddShortcut(Text: String; ShortCut: Char): String;
 var      iMin       :Integer;        //index of lower case short cut character
          iMax       :Integer;        //index of upper case short cut character
 begin
  Result := Text;
  iMin := pos(ShortCut, Result);      //get index of short cut character
  iMax := pos(UpCase(ShortCut), Result);
  if (iMin = -1) or ((iMax <> -1) and (iMin > iMax)) then //get first position
   iMin := iMax;
  if iMin <> -1 then                  //short cut character found?
   Insert('&', Result, iMin);           //insert marker of access key
 end;

var       i         :Integer;               //counter through all items
          Bit       :Longword;              //bit of each item
          MenuItem  :TMenuItem;             //a menu item for each item
          ShortCut  :Char;                  //short-cut character
begin
 assert(List.Count <= 32);

 FMenu.Free;
 FMenu := TPopupMenu.Create(Self);          //create popup menu
 Bit := 1;
 for i := 0 to List.Count - 1 do            //for each item of the enumeration
  begin
   MenuItem := TMenuItem.Create(FMenu);       //create a menu item for it
   try
     FMenu.Items.Add(MenuItem);               //and add it
   except
     MenuItem.Free;
     raise;
   end;
   if assigned(List.Objects[i]) then          //has a short cut
    begin
     ShortCut := Char(List.Objects[i]);
     //use name of entry in the list and show the short cut
     MenuItem.Caption := AddShortcut(List[i] + Format(#8'(%s)',
                                                      [UpCase(ShortCut)]),
                                     ShortCut);
     MenuItem.Tag := Ord(Char(List.Objects[i]));
    end
   else
    MenuItem.Caption := List[i];                //use name of entry in the list
   MenuItem.HelpContext := HelpContext;
   MenuItem.OnClick := MenuClick;             //toggle bit on click
   MenuItem.Checked := (Value and Bit) <> 0;  //is enabled?
   Bit := Bit shl 1;                          //next bit
  end;
 Caption := GetValueString;                 //set the caption
end;



end.