lazarus-ccr/components/spktoolbar/demos/runtime/unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
  ImgList, ComCtrls, Menus, Grids, ExtCtrls, StdCtrls,
  SpkToolbar, SpkGUITools, SpkMath, SpkGraphTools, SpkPopup, spkt_Tab,
  spkt_Pane, spkt_Types, spkt_Tools, spkt_BaseItem, spkt_Buttons,
  spkt_Checkboxes;

type

  { TForm1 }

  TForm1 = class(TForm)
    ImageList: TImageList;
    LargeImageList: TImageList;
    SpkLargeButton1: TSpkLargeButton;
    SpkLargeButton2: TSpkLargeButton;
    SpkPane2: TSpkPane;
    SpkPane1: TSpkPane;
    SpkSmallButton1: TSpkSmallButton;
    SpkSmallButton2: TSpkSmallButton;
    SpkSmallButton3: TSpkSmallButton;
    SpkTab1: TSpkTab;
    StatusBar1: TStatusBar;
    StringGrid1: TStringGrid;
    procedure FormCreate(Sender: TObject);
    procedure StringGrid1PrepareCanvas(Sender: TObject; aCol, aRow: Integer;
      aState: TGridDrawState);
    procedure StyleChangeHandler(Sender: TObject);
  private
    { private declarations }
    SpkToolbar : TSpkToolbar;
    StylePopupMenu: TSpkPopupMenu;
    RecentFilesPopupMenu: TSpkPopupMenu;
    CbHorizGrid : TSpkCheckbox;
    CbVertGrid: TSpkCheckbox;
    CbRowSelect: TSpkCheckbox;
    procedure AboutHandler(Sender: TObject);
    function CreateRecentFilesPopup: TSpkPopupMenu;
    function CreateStylePopup: TSpkPopupMenu;
    procedure FileOpenHandler(Sender: TObject);
    procedure FileSaveHandler(Sender: TObject);
    procedure FileQuitHandler(Sender: TObject);
    procedure FormatGridHandler(Sender: TObject);
    procedure HorizontalGridLinesHandler(Sender: TObject);
    procedure VerticalGridLinesHandler(Sender: TObject);
    procedure RowSelectHandler(Sender: TObject);
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

uses
  LCLIntf, spkt_Appearance;

{ TAboutForm }
type
  TAboutForm = class(TForm)
  private
    FIconLink: TLabel;
    procedure LinkClickHandler(Sender: TObject);
    procedure LinkMouseEnterHandler(Sender: TObject);
    procedure LinkMouseLeaveHandler(Sender: TObject);
  public
    constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
  end;

constructor TAboutForm.CreateNew(AOwner: TComponent; Num: Integer = 0);
begin
  inherited;
  Width := 300;
  Height := 180;
  Caption := 'About';
  Position := poMainFormCenter;
  with TLabel.Create(self) do begin
    Caption := 'SpkToolbar demo';
    Parent := self;
    Align := alTop;
    BorderSpacing.Top := 16;
    Font.Size := 16;
    Alignment := taCenter;
  end;
  with TLabel.Create(self) do begin
    Caption := 'Icons kindly provided by';
    Parent := self;
    Align := alTop;
    Alignment := taCenter;
    BorderSpacing.Top := 16;
    Left := 16;
    Top := 999;
  end;
  FIconLink := TLabel.Create(self);
  with FIconLink do begin
    Caption := 'http://www.fatcow.com/free-icons';
    Font.Color := clBlue;
    Parent := self;
    Align := alTop;
    Alignment := taCenter;
    Top := 9999;
    OnClick := @LinkClickHandler;
    OnMouseEnter := @LinkMouseEnterHandler;
    OnMouseLeave := @LinkMouseLeaveHandler;
  end;
  with TButton.Create(self) do begin
    Caption := 'Close';
    Parent := Self;
    Left := (Self.Width - Width) div 2;
    Top := Self.Height - 16 - Height;
    ModalResult := mrOK;
    Default := true;
    Cancel := true;
  end;
end;

procedure TAboutForm.LinkClickHandler(Sender: TObject);
begin
  OpenURL((Sender as TLabel).Caption);
end;

procedure TAboutForm.LinkMouseEnterHandler(Sender: TObject);
begin
  FIconLink.Font.Style := [fsUnderline];
end;

procedure TAboutForm.LinkMouseLeaveHandler(Sender: TObject);
begin
  FIconLink.Font.Style := [];
end;


{ TForm1 }

procedure TForm1.AboutHandler(Sender: TObject);
var
  F: TForm;
begin
  F := TAboutForm.CreateNew(nil);
  try
    F.ShowModal;
  finally
    F.Free;
  end;
end;

function TForm1.CreateRecentFilesPopup: TSpkPopupMenu;
var
  item: TMenuItem;
begin
  Result := TSpkPopupMenu.Create(Self);

  item := TMenuItem.Create(Self);
  item.Caption := 'First file';
  item.ImageIndex := 15;
  Result.Items.Add(item);

  item := TMenuItem.Create(Self);
  item.Caption := 'Second file';
  item.ImageIndex := 16;
  Result.Items.Add(item);

  item := TMenuItem.Create(Self);
  item.Caption := 'Third file';
  item.ImageIndex := 17;
  Result.Items.Add(item);

  RecentFilesPopupMenu := Result;
end;

function TForm1.CreateStylePopup: TSpkPopupMenu;
var
  item: TMenuItem;
begin
  Result := TSpkPopupMenu.Create(Self);

  item := TMenuItem.Create(Self);
  item.Caption := 'Office2007 blue';
  item.GroupIndex := 10;
  item.Checked := true;
  item.Tag := ord(spkOffice2007Blue);
  item.OnClick := @StyleChangeHandler;
  Result.Items.Add(item);

  item := TMenuItem.Create(Self);
  item.Caption := 'Office2007 silver (yellow highlight)';
  item.GroupIndex := 10;
  item.Tag := ord(spkOffice2007Silver);
  item.OnClick := @StyleChangeHandler;
  Result.Items.Add(item);

  item := TMenuItem.Create(Self);
  item.Caption := 'Office2007 silver (turquoise highlight)';
  item.GroupIndex := 10;
  item.Tag := ord(spkOffice2007SilverTurquoise);
  item.OnClick := @StyleChangeHandler;
  Result.Items.Add(item);

  item := TMenuItem.Create(Self);
  item.Caption := 'Metro light';
  item.GroupIndex := 10;
  item.Tag := ord(spkMetroLight);
  item.OnClick := @StyleChangeHandler;
  Result.Items.Add(item);

  item := TMenuItem.Create(Self);
  item.Caption := 'Metro dark';
  item.GroupIndex := 10;
  item.Tag := ord(spkMetroDark);
  item.OnClick := @StyleChangeHandler;
  Result.Items.Add(item);

  StylePopupMenu := Result;
end;

procedure TForm1.FileOpenHandler(Sender: TObject);
begin
  Statusbar1.SimpleText := '"File" / "Open" clicked';
end;

procedure TForm1.FileSaveHandler(Sender: TObject);
begin
  Statusbar1.SimpleText := '"File" / "Save" clicked';
end;

procedure TForm1.FileQuitHandler(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormatGridHandler(Sender: TObject);
begin
  // Formatting is handled by the grid's OnPrepareCanvas event immediately
  // before painting.
  StringGrid1.Invalidate;
end;

procedure TForm1.HorizontalGridLinesHandler(Sender: TObject);
begin
  if CbHorizGrid.Checked then
    StringGrid1.Options := StringGrid1.Options + [goHorzLine]
  else
    StringGrid1.Options := StringGrid1.Options - [goHorzLine];
end;

procedure TForm1.VerticalGridLinesHandler(Sender: TObject);
begin
  if CbVertGrid.Checked then
    StringGrid1.Options := StringGrid1.Options + [goVertLine]
  else
    StringGrid1.Options := StringGrid1.Options - [goVertLine];
end;

procedure TForm1.RowSelectHandler(Sender: TObject);
begin
  if CbRowSelect.Checked then
    StringGrid1.Options := StringGrid1.Options + [goRowSelect]
  else
    StringGrid1.Options := StringGrid1.Options - [goRowSelect];
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SpkToolbar := TSpkToolbar.Create(self);

  with SpkToolbar do begin
    Parent := self;
    Appearance.Pane.CaptionFont.Style := [fsBold, fsItalic];
    Color := clSkyBlue;
    Images := ImageList;
    LargeImages := LargeImageList;
    ShowHint := true;

    with Tabs.Add do begin
      Caption := 'File';
      with Panes.Add do begin
        Caption := 'File commands';
        with Items.AddLargeButton do begin
          Caption := 'Open file';
          ButtonKind := bkButtonDropdown;
          DropdownMenu := CreateRecentFilesPopup;  //RecentFilesPopupMenu;
          LargeImageIndex := 1;
          Hint := 'Open a file';
          OnClick := @FileOpenHandler;
        end;
        with Items.AddLargeButton do begin
          Caption := 'Save file';
          LargeImageIndex := 2;
          Hint := 'Save file';
          OnClick := @FileSaveHandler;
        end;
        with Items.AddLargeButton do begin
          Caption := 'Quit program';
          LargeImageIndex := 0;
          Hint := 'Close application';
          OnClick := @FileQuitHandler;
        end;
      end;
    end;

    with Tabs.Add do begin
      Caption := 'Edit';
      with Panes.Add do begin
        Caption := 'Edit commands';
        with Items.AddSmallButton do begin
          Caption := 'Cut';
          HideFrameWhenIdle := true;
          TableBehaviour := tbBeginsRow;
          ImageIndex := 3;
          Hint := 'Cut to clipboard';
        end;
        with Items.AddSmallButton do begin
          Caption := 'Copy';
          HideFrameWhenIdle := true;
          TableBehaviour := tbBeginsRow;
          ImageIndex := 4;
          Hint := 'Copy to clipboard';
        end;
        with Items.AddSmallButton do begin
          Caption := 'Paste';
          HideFrameWhenIdle := true;
          TableBehaviour := tbBeginsColumn;
          ImageIndex := 5;
          Hint := 'Paste from clipboard';
        end;
      end;
    end;

    with Tabs.Add do begin
      Caption := 'Format';
      with Panes.Add do begin
        Caption := 'Format Settings';
        with Items.AddSmallButton do begin
          Caption := 'Bold';
          ButtonKind := bkToggle;
          GroupBehaviour := gbBeginsGroup;
          TableBehaviour := tbBeginsRow;
          ImageIndex := 6;
          ShowCaption := false;
          AllowAllUp := true;
          Hint := 'Bold';
          OnClick := @FormatGridHandler;
        end;
        with Items.AddSmallButton do begin
          Caption := 'Italic';
          ButtonKind := bkToggle;
          TableBehaviour := tbContinuesRow;
          GroupBehaviour := gbContinuesGroup;
          ImageIndex := 7;
          ShowCaption := false;
          AllowAllUp := true;
          Hint := 'Italic';
          OnClick := @FormatGridHandler;
        end;
        with Items.AddSmallButton do begin
          Caption := 'Underline';
          ButtonKind := bkToggle;
          TableBehaviour := tbContinuesRow;
          GroupBehaviour := gbEndsGroup;
          ImageIndex := 8;
          ShowCaption := false;
          AllowAllUp := true;
          Hint := 'Underlined';
          OnClick := @FormatGridHandler;
        end;

        with Items.AddSmallButton do begin
          Caption := 'Left-aligned';
          ButtonKind := bkToggle;
          GroupBehaviour := gbBeginsGroup;
          TableBehaviour := tbBeginsRow;
          ImageIndex := 11;
          ShowCaption := false;
          GroupIndex := 2;
          Checked := true;
          Hint := 'Left-aligned';
          OnClick := @FormatGridHandler;
        end;
        with Items.AddSmallButton do begin
          Caption := 'Centered';
          ButtonKind := bkToggle;
          TableBehaviour := tbContinuesRow;
          GroupBehaviour := gbContinuesGroup;
          ImageIndex := 12;
          ShowCaption := false;
          GroupIndex := 2;
          Checked := false;
          Hint := 'Centered';
          OnClick := @FormatGridHandler;
        end;
        with Items.AddSmallButton do begin
          Caption := 'Right-aligned';
          ButtonKind := bkToggle;
          TableBehaviour := tbContinuesRow;
          GroupBehaviour := gbContinuesGroup;
          ImageIndex := 13;
          ShowCaption := false;
          GroupIndex := 2;
          Hint := 'Right-aligned';
          OnClick := @FormatGridHandler;
        end;
        {
        // I don't have an event handler for these...

        with Items.AddSmallButton do begin
          Caption := 'Block';
          ButtonKind := bkToggle;
          TableBehaviour := tbContinuesRow;
          GroupBehaviour := gbEndsGroup;
          ImageIndex := 14;
          ShowCaption := false;
          GroupIndex := 2;
          Hint := 'Block';
        end;

        with Items.AddSmallButton do begin
          Caption := 'Subscript';
          ButtonKind := bkToggle;
          TableBehaviour := tbBeginsColumn;
          GroupBehaviour := gbBeginsGroup;
          ImageIndex := 9;
          ShowCaption := false;
          AllowAllUp := true;
          GroupIndex := 1;
          Hint := 'Subscript';
        end;
        with Items.AddSmallButton do begin
          Caption := 'Superscript';
          ButtonKind := bkToggle;
          TableBehaviour := tbContinuesRow;
          GroupBehaviour := gbEndsGroup;
          ImageIndex := 10;
          ShowCaption := false;
          AllowAllUp := true;
          GroupIndex := 1;
          Hint := 'Superscript';
        end;

        With Items.AddSmallButton do begin
          Enabled := false;
          TableBehaviour := tbBeginsRow;
          HideFrameWhenIdle := true;
          Caption := '';
        end;
        }
      end;
    end;

    with Tabs.Add do begin
      Caption := 'Options';
      with Panes.Add do begin
        Caption := 'Grid settings';
        CbHorizGrid := Items.AddCheckbox;
        with CbHorizGrid do begin
          Caption := 'Horizontal grid lines';
          TableBehaviour := tbBeginsRow;
          Checked := true;
          Hint := 'Show/hide horizontal grid lines';
          OnClick := @HorizontalGridLinesHandler;
        end;
        CbVertGrid := Items.AddCheckbox;
        with CbVertGrid do begin
          Caption := 'Vertical grid lines';
          Hint := 'Show/hide vertical grid lines';
          TableBehaviour := tbBeginsRow;
          Checked := true;
          OnClick := @VerticalGridLinesHandler;
        end;
        CbRowSelect := Items.AddCheckbox;
        with CbRowSelect do begin
          Caption := 'Row select';
          TableBehaviour := tbBeginsRow;
          Checked := false;
          Hint := 'Select entire row';
          OnClick := @RowSelectHandler;
        end;
      end;
      with Panes.Add do begin
        Caption := 'Themes';
        with Items.AddLargeButton do begin
          Caption := 'Change style';
          Hint := 'Change theme';
          ButtonKind := bkDropdown;
          DropdownMenu := CreateStylePopup; //StylePopupMenu;
          LargeImageIndex := 7;
        end;
      end;
      with Panes.Add do begin
        Caption := 'Save settings';
        with Items.AddSmallButton do begin
          Caption := 'Save now';
          Hint := 'Save settings now';
          HideFrameWhenIdle := true;
          ImageIndex := 2;
        end;
        with Items.AddCheckbox do begin
          Caption := 'Auto-save settings';
          Checked := true;
          Hint := 'Automatically save settings when program closes';
        end;
      end;
    end;

    with Tabs.Add do begin
      Caption := 'Help';
      with Panes.Add do begin
        Caption := 'Help commands';
        with Items.AddLargeButton do begin
          Caption := 'About...';
          LargeImageIndex := 6;
          Hint := 'About this program';
          OnClick := @AboutHandler;
        end;
      end;
    end;
  end;
end;

procedure TForm1.StringGrid1PrepareCanvas(Sender: TObject; aCol, aRow: Integer;
  aState: TGridDrawState);
var
  grid: TStringGrid;
  ts: TTextStyle;
  R: TRect;
begin
  if Sender is TStringGrid then
    grid := TStringGrid(Sender)
  else
    exit;

  if (ACol = 0) or (ARow = 0) then
    exit;

  // Button "bold"
  if TSpkBaseButton(SpkToolbar.Tabs[2].Panes[0].Items[0]).Checked then
    grid.Canvas.Font.Style := grid.Canvas.Font.Style + [fsBold]
  else
    grid.Canvas.Font.Style := grid.Canvas.Font.Style - [fsBold];

  // Button "italic"
  if TSpkBaseButton(SpkToolbar.Tabs[2].Panes[0].Items[1]).Checked then
    grid.Canvas.Font.Style := grid.Canvas.Font.Style + [fsItalic]
  else
    grid.Canvas.Font.Style := grid.Canvas.Font.Style - [fsItalic];

  // Button "underline"
  if TSpkBaseButton(SpkToolbar.Tabs[2].Panes[0].Items[2]).Checked then
    grid.Canvas.Font.Style := grid.Canvas.Font.Style + [fsUnderline]
  else
    grid.Canvas.Font.Style := grid.Canvas.Font.Style - [fsUnderline];

  ts := grid.Canvas.TextStyle;
  // Button "left-aligned"
  if TSpkBaseButton(SpkToolbar.Tabs[2].Panes[0].Items[3]).Checked then
    ts.Alignment := taLeftJustify;
  // Button "centered"
  if TSpkBaseButton(SpkToolbar.Tabs[2].Panes[0].Items[4]).Checked then
    ts.Alignment := taCenter;
  // Button "right-aligned"
  if TSpkBaseButton(SpkToolbar.Tabs[2].Panes[0].Items[5]).Checked then
    ts.Alignment := taRightJustify;

  grid.Canvas.Textstyle := ts;
end;

procedure TForm1.StyleChangeHandler(Sender: TObject);
var
  i: Integer;
begin
  for i:=0 to StylePopupMenu.Items.Count-1 do
    StylePopupMenu.Items[i].Checked := StylePopupMenu.Items[i] = TMenuItem(Sender);
  SpkToolbar.Style := TSpkStyle((Sender as TMenuItem).Tag);
  case SpkToolbar.Style of
    spkOffice2007Blue            : SpkToolbar.Color := clSkyBlue;
    spkOffice2007Silver          : SpkToolbar.Color := clWhite;
    spkOffice2007SilverTurquoise : SpkToolbar.Color := clWhite;
    spkMetroLight                : SpkToolbar.Color := clSilver;
    spkMetroDark                 : SpkToolbar.Color := $080808;
  end;
end;


end.