lazarus-ccr/components/colorpalette/demo/unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Spin, ExtCtrls, Menus, ColorBox, ColorPalette;

type

  { TMainForm }

  TMainForm = class(TForm)
    Bevel1: TBevel;
    Bevel2: TBevel;
    BtnDeleteColor: TButton;
    BtnLoadDefaultPal1: TButton;
    BtnLoadRndPalette: TButton;
    BtnCreateRndPalette: TButton;
    BtnAddColor: TButton;
    BtnLoadDefaultPal: TButton;
    BtnEditColor: TButton;
    CbBuiltinPalettes: TComboBox;
    CbShowSelection: TCheckBox;
    CbShowColorHints: TCheckBox;
    CbBorderColor: TColorBox;
    CbCustomHintText: TCheckBox;
    ColorDialog: TColorDialog;
    ColorPalette: TColorPalette;
    CbPickMode: TComboBox;
    EdBorderWidth: TSpinEdit;
    EdBoxSize: TSpinEdit;
    EdGradientSteps: TSpinEdit;
    Label3: TLabel;
    Label4: TLabel;
    LblGradientSteps: TLabel;
    LblPickMode: TLabel;
    EdColCount: TSpinEdit;
    Label2: TLabel;
    LblColorInfo: TLabel;
    LblPickMode1: TLabel;
    LblPickMode2: TLabel;
    MnuEditPickedColor: TMenuItem;
    MnuDeletePickedColor: TMenuItem;
    PalettePopupMenu: TPopupMenu;
    Panel1: TPanel;
    Panel2: TPanel;
    SaveDialog: TSaveDialog;
    ColorSample: TShape;
    ScrollBox1: TScrollBox;
    procedure BtnAddColorClick(Sender: TObject);
    procedure BtnCreateRndPaletteClick(Sender: TObject);
    procedure BtnDeleteColorClick(Sender: TObject);
    procedure BtnEditColorClick(Sender: TObject);
    procedure BtnLoadDefaultPalClick(Sender: TObject);
    procedure BtnLoadRndPaletteClick(Sender: TObject);
    procedure CbBuiltinPalettesSelect(Sender: TObject);
    procedure CbCustomHintTextChange(Sender: TObject);
    procedure CbPickModeSelect(Sender: TObject);
    procedure CbShowColorHintsChange(Sender: TObject);
    procedure CbShowSelectionChange(Sender: TObject);
    procedure CbBorderColorSelect(Sender: TObject);
    procedure ColorPaletteDblClick(Sender: TObject);
    procedure ColorPaletteGetHintText(Sender: TObject; AColor: TColor;
      var AText: String);
    procedure ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
    procedure EdBorderWidthChange(Sender: TObject);
    procedure EdBoxSizeChange(Sender: TObject);
    procedure EdColCountChange(Sender: TObject);
    procedure EdGradientStepsChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MnuDeletePickedColorClick(Sender: TObject);
    procedure MnuEditPickedColorClick(Sender: TObject);
  private
    { private declarations }
    procedure EditCurColor;
    procedure SetColorInfo(ATitle: string; AColor: TColor);
    procedure UpdateCaption;
    procedure UpdatePalette;
  public
    { public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.lfm}


{ TMainForm }

procedure TMainForm.BtnAddColorClick(Sender: TObject);
begin
  if ColorDialog.Execute then
    ColorPalette.AddColor(ColorDialog.Color);
  UpdateCaption;
end;

procedure TMainForm.BtnCreateRndPaletteClick(Sender: TObject);
const
  N = 64;
var
  i: Integer;
  R,G,B: Byte;
  L: TStringList;
begin
  L := TStringList.Create;
  try
    L.Add('$COLS 16');
    for i:=1 to N do begin
      R := Random(256);
      G := Random(256);
      B := Random(256);
      L.Add(Format('%d, %d, %d', [R, G, B]));
    end;
    L.SaveToFile('random_palette.pal');
  finally
    L.Free;
  end;
  BtnLoadRndPalette.Enabled := true;
end;

procedure TMainForm.BtnDeleteColorClick(Sender: TObject);
begin
  with ColorPalette do
  begin
    DeleteColor(SelectedIndex);
    if SelectedIndex = ColorCount then SelectedIndex := ColorCount-1;
    ColorSample.Brush.Color := Colors[SelectedColor];
    if Colors[SelectedColor] = clNone then
      ColorSample.Brush.Style := bsClear else
      ColorSample.Brush.Style := bsSolid;
    UpdateCaption;
    SetColorInfo('Current', Colors[SelectedIndex]);
  end;
end;

procedure TMainForm.BtnLoadDefaultPalClick(Sender: TObject);
begin
  if not FileExists('..\default.pal') then
  begin
    ShowMessage('File "default.pal" not found. Copy it from the TColorPalette folder to the current exe folder.');
    exit;
  end;
  ColorPalette.LoadPalette('..\default.pal');
  UpdateCaption;
  EdColCount.Value := ColorPalette.ColumnCount;
end;

procedure TMainForm.BtnLoadRndPaletteClick(Sender: TObject);
begin
  ColorPalette.LoadPalette('random_palette.pal');
  UpdateCaption;
  EdColCount.Value := ColorPalette.ColumnCount;
end;

procedure TMainForm.BtnEditColorClick(Sender: TObject);
begin
  if BtnEditColor.caption = 'Edit' then
    EditCurColor
  else
    UpdatePalette;
end;

procedure TMainForm.CbBorderColorSelect(Sender: TObject);
begin
  ColorPalette.BorderColor := CbBorderColor.Selected;
end;

procedure TMainForm.CbBuiltinPalettesSelect(Sender: TObject);
begin
  ColorPalette.PaletteKind := TPaletteKind(CbBuiltinPalettes.ItemIndex);
  UpdateCaption;
  EdColCount.Value := ColorPalette.ColumnCount;
  EdGradientSteps.Enabled := ColorPalette.PaletteKind = pkGradientPalette;
  LblGradientSteps.Enabled := EdGradientSteps.Enabled;
end;

procedure TMainForm.CbCustomHintTextChange(Sender: TObject);
begin
  if CbCustomHintText.Checked then
    ColorPalette.OnGetHintText := @ColorPaletteGetHintText
  else
    ColorPalette.OnGetHintText := nil;
end;

procedure TMainForm.CbPickModeSelect(Sender: TObject);
begin
  ColorPalette.PickMode := TPickMode(CbPickMode.ItemIndex);
end;

procedure TMainForm.CbShowColorHintsChange(Sender: TObject);
begin
  ColorPalette.ShowColorHint := CbShowColorHints.Checked;
end;

procedure TMainForm.CbShowSelectionChange(Sender: TObject);
begin
  ColorPalette.ShowSelection := CbShowSelection.Checked;
end;

procedure TMainForm.ColorPaletteDblClick(Sender: TObject);
begin
  with ColorDialog do
  begin
    Color := ColorPalette.Colors[ColorPalette.SelectedIndex];
    if Execute then
    begin
      ColorPalette.Colors[ColorPalette.SelectedIndex] := Color;
      ColorSample.Brush.Color := Color;
      ColorSample.Brush.Style := bsSolid;
      SetColorInfo('Current', Color);
      with  BtnEditColor do
      begin
        Caption := 'Edit';
        Hint := 'Edit current color';
      end;
    end;
  end;
end;

procedure TMainForm.ColorPaletteGetHintText(Sender: TObject; AColor: TColor;
  var AText: String);
begin
  AText := Format('This is HTML color #%0.2x%0.2x%0.2x', [
    Red(AColor), Green(AColor), Blue(AColor)
  ]);
end;

procedure TMainForm.ColorPaletteSelectColor(Sender: TObject; AColor: TColor);
begin
  ColorSample.Brush.Color := AColor;
  if AColor = clNone then
    ColorSample.Brush.Style := bsClear else
    ColorSample.Brush.Style := bsSolid;
  SetColorInfo('SelectedColor', AColor);
  BtnDeleteColor.Caption := 'Delete color #' + IntToStr(ColorPalette.SelectedIndex);
  UpdateCaption;
end;

procedure TMainForm.EdBorderWidthChange(Sender: TObject);
begin
  ColorPalette.BorderWidth := EdBorderWidth.Value;
end;

procedure TMainForm.EdBoxSizeChange(Sender: TObject);
begin
  ColorPalette.ButtonWidth := EdBoxSize.Value;
  ColorPalette.ButtonHeight := EdBoxSize.Value;
end;

procedure TMainForm.EdColCountChange(Sender: TObject);
begin
  ColorPalette.ColumnCount := EdColCount.Value;
end;

procedure TMainForm.EdGradientStepsChange(Sender: TObject);
begin
  ColorPalette.GradientSteps := EdGradientSteps.Value;
  UpdateCaption;
end;

procedure TMainForm.EditCurColor;
begin
  with ColorDialog do
  begin
    Color := ColorSample.Brush.color;
    if Execute then begin
      ColorSample.Brush.Color := Color;
      ColorSample.Brush.Style := bsSolid;
    end;
  end;
  if ColorSample.Brush.Color <> ColorPalette.SelectedColor then
  begin
    BtnEditColor.caption := 'Update >';
    BtnEditColor.hint := 'Update palette';
    SetColorInfo('New color', ColorSample.Brush.Color);
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  EdColCount.Value := ColorPalette.ColumnCount;
  EdGradientSteps.Value := ColorPalette.GradientSteps;
  CbPickMode.ItemIndex := ord(ColorPalette.PickMode);
  CbShowSelection.Checked := ColorPalette.ShowSelection;
  CbShowColorHints.Checked := ColorPalette.ShowColorHint;
  CbBorderColor.Selected := ColorPalette.SelectedColor;
  EdBorderWidth.Value := ColorPalette.BorderWidth;
  EdBoxSize.Value := ColorPalette.ButtonWidth;

  ColorSample.Brush.Color := ColorPalette.SelectedColor;
  SetColorInfo('Current', ColorPalette.SelectedColor);
  UpdateCaption;

  { ColorPalette.PickShift must contain ssRight in order to be able to select
    colors for the context menu. Use object inspector, or use this code:  }
  ColorPalette.PickShift := [ssLeft, ssRight];

  ColorPalette.OnGetHintText := nil;
end;

procedure TMainForm.MnuDeletePickedColorClick(Sender: TObject);
begin
  BtnDeleteColorClick(self);
end;

procedure TMainForm.MnuEditPickedColorClick(Sender: TObject);
begin
  BtnEditColorClick(self);
end;

procedure TMainForm.SetColorInfo(ATitle: string; AColor: TColor);
begin
  if AColor = clNone then
    LblColorInfo.Caption := Format(
      '%s: %s', [ATitle, ColorToString(AColor)]
    )
  else
    LblColorInfo.caption := Format(
      '%s: %s'#13+
      ' red = %d'#13+
      ' green = %d'#13+
      ' blue = %d',
      [ATitle, ColorToString(AColor), Red(AColor), Green(AColor), Blue(AColor)]
    );
end;

procedure TMainForm.UpdateCaption;
begin
  Caption := Format('ColorPalette demo - CurIndex: %d (%d colors available)',
    [ColorPalette.SelectedIndex, ColorPalette.ColorCount]
  );
end;

procedure TMainForm.UpdatePalette;
begin
  ColorPalette.Colors[ColorPalette.SelectedIndex] := ColorSample.Brush.Color;
  SetColorInfo('Current', ColorSample.Brush.Color);
  with  BtnEditColor do
  begin
    Caption := 'Edit';
    Hint := 'Edit current color';
  end;
end;

end.