Merge pull request #566 from Lulu04/dev-changingcolorwithkeyboard

implementation of color association with keyboard digits

lazpaint/dialog/uchoosecolorinterface.pas

@@ -122,6 +122,7 @@ type
     procedure HideEditor;
     function GetPreferredSize: TSize;
     procedure AdjustControlHeight;
+    procedure SimpleRedraw;
 
     property DarkTheme: boolean read FDarkTheme write SetDarkTheme;
     property LazPaintInstance: TLazPaintCustomInstance read FLazPaintInstance write SetLazPaintInstance;
@@ -211,7 +212,7 @@ var
   bmpRect: TRect;
   previewSize: single;
   previewRect: TRectF;
-  c: TBGRAPixel;
+  c, cDigit: TBGRAPixel;
   bmpColorXYSize: integer;
   bmpCursorWidth, i: integer;
   bmpCursorOpacity: byte;
@@ -297,8 +298,19 @@ begin
       c := GetCurrentColor;
       c.alpha := 255;
       with InterfaceToPixel(previewRect) do
+      begin
         Bitmap.RoundRectAntialias(Left, Top, Right - 1, Bottom - 1,
             previewSize/6, previewSize/6, BGRA(0,0,0,192), bmpCursorWidth, c, []);
+        c := GetCurrentColor;
+        s := FLazPaintInstance.GetKeyAssociatedToColor(c);
+        if Length(s) > 0 then
+        begin
+          if GetLightness(c)/65535 > 0.5 then
+            cDigit := BGRABlack else cDigit := BGRAWhite;
+          Bitmap.FontFullHeight := Height;
+          Bitmap.TextOut(CenterPoint.x, CenterPoint.y-Height div 2, s, cDigit, taCenter);
+        end;
+      end;
     end;
   end;
 end;
@@ -1172,5 +1184,10 @@ begin
   Container.Height := round(h + FTextAreaHeight + ExternalMargin);
 end;
 
+procedure TChooseColorInterface.SimpleRedraw;
+begin
+  UpdateColorview(False, False, True);
+end;
+
 end.
 

lazpaint/lazpaintinstance.pas

@@ -7,7 +7,7 @@ interface
 
 uses
   Classes, SysUtils, LazPaintType, BGRABitmap, BGRABitmapTypes, BGRALayers, LCVectorialFill,
-  Menus, Forms, Controls, fgl,
+  Menus, Forms, Controls, fgl, LCLType,
 
   LazPaintMainForm, UMainFormLayout,
 
@@ -240,6 +240,7 @@ type
     procedure ColorToFChooseColor; override;
     procedure ExitColorEditor; override;
     function ColorEditorActive: boolean; override;
+    procedure NotifyColorBinding; override;
     function ShowSaveOptionDlg({%H-}AParameters: TVariableSet; AOutputFilenameUTF8: string;
       ASkipOptions: boolean; AExport: boolean): boolean; override;
     function ShowColorIntensityDlg(AParameters: TVariableSet): TScriptResult; override;
@@ -289,12 +290,16 @@ type
     procedure UpdateEditPicture(ADelayed: boolean); override;
     procedure AddColorToPalette(AColor: TBGRAPixel); override;
     procedure RemoveColorFromPalette(AColor: TBGRAPixel); override;
+    function GetKeyAssociatedToColor(const AColor: TBGRAPixel): string; override;
     property Initialized: boolean read GetInitialized;
+    procedure SendKeyDownEventToMainForm(var Key: Word; Shift: TShiftState); override;
+    procedure SendKeyUpEventToMainForm(var Key: Word; Shift: TShiftState); override;
+    procedure SendUTF8KeyPressEventToMainForm(var UTF8Key: TUTF8Char); override;
   end;
 
 implementation
 
-uses LCLType, Types, Dialogs, FileUtil, StdCtrls, LCLIntf, BGRAUTF8, UTranslation,
+uses Types, Dialogs, FileUtil, StdCtrls, LCLIntf, BGRAUTF8, UTranslation,
 
      URadialBlur, UMotionBlur, UEmboss, UTwirl, UWaveDisplacement,
      unewimage, uresample, UPixelate, unoisefilter, ufilters,
@@ -1981,6 +1986,11 @@ begin
     else result := false;
 end;
 
+procedure TLazPaintInstance.NotifyColorBinding;
+begin
+  if Assigned(FChooseColor) then FChooseColor.SimpleRedraw;
+end;
+
 function TLazPaintInstance.ShowSaveOptionDlg(AParameters: TVariableSet;
   AOutputFilenameUTF8: string; ASkipOptions: boolean; AExport: boolean): boolean;
 begin
@@ -2195,5 +2205,28 @@ begin
   if Assigned(FMain) then FMain.Layout.RemoveColorFromPalette(AColor);
 end;
 
+function TLazPaintInstance.GetKeyAssociatedToColor(const AColor: TBGRAPixel): string;
+begin
+  if Assigned(FMain) and
+     Assigned(FMain.Layout) and
+     Assigned(FMain.Layout.PaletteToolbar) then Result := FMain.Layout.PaletteToolbar.GetKeyAssociatedToColor(AColor)
+  else Result := '';
+end;
+
+procedure TLazPaintInstance.SendKeyDownEventToMainForm(var Key: Word; Shift: TShiftState);
+begin
+  if Assigned(FMain) then FMain.FormKeyDown(FMain, key, Shift);
+end;
+
+procedure TLazPaintInstance.SendKeyUpEventToMainForm(var Key: Word; Shift: TShiftState);
+begin
+  if Assigned(FMain) then FMain.FormKeyUp(FMain, key, Shift);
+end;
+
+procedure TLazPaintInstance.SendUTF8KeyPressEventToMainForm(var UTF8Key: TUTF8Char);
+begin
+  if Assigned(FMain) then FMain.FormUTF8KeyPress(FMain, UTF8Key);
+end;
+
 end.
 

lazpaint/lazpaintmainform.pas

@@ -522,6 +522,7 @@ type
       {%H-}Y: Integer);
     procedure Panel_TextMouseMove(Sender: TObject; {%H-}Shift: TShiftState; {%H-}X,
       {%H-}Y: Integer);
+    procedure Panel_ToolbarBackgroundClick(Sender: TObject);
     procedure PopupToolbarPopup(Sender: TObject);
     procedure PopupToolboxPopup(Sender: TObject);
     procedure SelectionHorizontalFlipUpdate(Sender: TObject);
@@ -783,7 +784,7 @@ type
     procedure UpdateFloodfillToolbar;
     procedure UpdatePerspectiveToolbar;
     function ShowOpenBrushDialog: boolean;
-    function TextSpinEditFocused: boolean;
+    function SpinEditFocused: boolean;
     procedure UpdateBrush;
     procedure UpdateBrushList;
     function CatchToolKeyDown(var AKey: Word): boolean;
@@ -1870,7 +1871,7 @@ begin
     else if (Key = VK_SNAP) or (Key = VK_SNAP2) then snapPressed:= true
     else if Key = VK_SHIFT then shiftPressed:= true;
     if Zoom.EditingZoom or EditingColors then exit;
-    if not ((CurrentTool = ptText) and TextSpinEditFocused and (Key = VK_BACK)) and CatchToolKeyDown(Key) then
+    if not ((CurrentTool = ptText) and SpinEditFocused and (Key = VK_BACK)) and CatchToolKeyDown(Key) then
     begin
       PaintPictureLater;
     end else
@@ -2323,7 +2324,7 @@ begin
     toolProcessKey:= true;
     if (CurrentTool in[ptText,ptEditShape]) and ((UTF8Key = #8) or ((length(UTF8Key)=1) and (UTF8Key[1] in['-','0'..'9']))) then
     begin
-      if TextSpinEditFocused then
+      if SpinEditFocused then
          toolProcessKey:= false;
     end;
     if toolProcessKey and CatchToolKeyPress(UTF8Key) then
@@ -4378,7 +4379,7 @@ begin
     else
       exit;
   end;
-  if (CurrentTool in[ptText,ptEditShape]) and TextSpinEditFocused then Layout.FocusImage;
+  if SpinEditFocused then Layout.FocusImage;
 end;
 
 procedure TFMain.PictureOnPaint(Sender: TObject);

lazpaint/lazpainttype.pas

@@ -7,7 +7,7 @@ interface
 
 uses
   Classes, SysUtils, Inifiles, BGRABitmap, BGRABitmapTypes, UConfig, UImage, UTool, Forms, BGRALayers, Graphics, Menus,
-  UScripting, Dialogs, Controls
+  UScripting, Dialogs, Controls, LCLType
   {$IFDEF LINUX}, InterfaceBase{$ENDIF};
 
 const
@@ -271,6 +271,7 @@ type
     procedure ColorToFChooseColor; virtual; abstract;
     procedure ExitColorEditor; virtual; abstract;
     function ColorEditorActive: boolean; virtual; abstract;
+    procedure NotifyColorBinding; virtual; abstract;
     function GetColor(ATarget: TColorTarget): TBGRAPixel;
     procedure SetColor(ATarget: TColorTarget; AColor: TBGRAPixel);
     function ShowSaveOptionDlg(AParameters: TVariableSet; AOutputFilenameUTF8: string;
@@ -313,6 +314,7 @@ type
     procedure Wait(ACheckActive: TCheckFunction; ADelayMs: integer); virtual; abstract;
     procedure AddColorToPalette(AColor: TBGRAPixel); virtual; abstract;
     procedure RemoveColorFromPalette(AColor: TBGRAPixel); virtual; abstract;
+    function GetKeyAssociatedToColor(const AColor: TBGRAPixel): string; virtual; abstract;
 
     property BlackAndWhite: boolean read FBlackAndWhite write SetBlackAndWhite;
 
@@ -343,6 +345,9 @@ type
 
     procedure ImageListWindowVisibleKeyDown(var Key: Word; Shift: TShiftState); virtual; abstract;
     procedure MoveImageListWindowTo(X,Y: integer); virtual; abstract;
+    procedure SendKeyDownEventToMainForm(var Key: Word; Shift: TShiftState); virtual; abstract;
+    procedure SendKeyUpEventToMainForm(var Key: Word; Shift: TShiftState); virtual; abstract;
+    procedure SendUTF8KeyPressEventToMainForm(var UTF8Key: TUTF8Char); virtual; abstract;
     property ImageListWindowWidth: integer read GetImageListWindowWidth write SetImageListWindowWidth;
     property ImageListWindowHeight: integer read GetImageListWindowHeight write SetImageListWindowHeight;
     property ImageListWindowVisible: boolean read GetImageListWindowVisible write SetImageListWindowVisible;
@@ -389,7 +394,7 @@ function CSSToPascalCase(AIdentifier: string): string;
 
 implementation
 
-uses LCLType, BGRAUTF8, LCLIntf, FileUtil, UResourceStrings, LCVectorialFill;
+uses BGRAUTF8, LCLIntf, FileUtil, UResourceStrings, LCVectorialFill;
 
 function LazPaintVersionStr: string;
 var numbers: TStringList;

lazpaint/maintoolbar.inc

@@ -658,11 +658,13 @@ begin
   end;
 end;
 
-function TFMain.TextSpinEditFocused: boolean;
+function TFMain.SpinEditFocused: boolean;
+var ctrl: TWinControl;
 begin
-  result := SpinEdit_TextSize.Focused or SpinEdit_TextBlur.Focused or SpinEdit_TextShadowX.Focused or
-           SpinEdit_TextShadowY.Focused or SpinEdit_ShapeAltitude.Focused or
-           SpinEdit_TextOutlineWidth.Focused;
+  ctrl := Screen.ActiveControl;
+  if Assigned(ctrl) and (ctrl is TBCTrackBarUpDown) then
+    Result := (ctrl as TBCTrackBarUpDown).Focused
+    else Result := False;
 end;
 
 procedure TFMain.UpdateBrush;
@@ -696,14 +698,14 @@ end;
 
 function TFMain.CatchToolKeyDown(var AKey: Word): boolean;
 begin
-  if Assigned(FLayout) then
+  if Assigned(FLayout) and not SpinEditFocused and (CurrentTool <> ptText) then
     result := FLayout.CatchToolKeyDown(AKey)
     else result := false;
 end;
 
 function TFMain.CatchToolKeyUp(var AKey: Word): boolean;
 begin
-  if Assigned(FLayout) then
+  if Assigned(FLayout) and not SpinEditFocused and (CurrentTool <> ptText) then
     result := FLayout.CatchToolKeyUp(AKey)
     else result := false;
 end;
@@ -1696,6 +1698,11 @@ begin
   ShowTextMore;
 end;
 
+procedure TFMain.Panel_ToolbarBackgroundClick(Sender: TObject);
+begin
+  Layout.FocusImage;
+end;
+
 procedure TFMain.PopupToolbarPopup(Sender: TObject);
 begin
   MenuFileToolbar.Checked := Config.DefaultFileToolbarVisible;

lazpaint/uchoosecolor.lfm

@@ -1,27 +1,29 @@
 object FChooseColor: TFChooseColor
   Left = 417
-  Height = 297
+  Height = 198
   Top = 234
-  Width = 396
+  Width = 264
   BorderIcons = [biSystemMenu]
   BorderStyle = bsSizeToolWin
   Caption = 'Color'
-  ClientHeight = 297
-  ClientWidth = 396
-  DesignTimePPI = 144
-  Font.Height = -18
+  ClientHeight = 198
+  ClientWidth = 264
+  Font.Height = -12
   FormStyle = fsStayOnTop
   OnCreate = FormCreate
   OnDeactivate = FormDeactivate
   OnDestroy = FormDestroy
+  OnKeyDown = FormKeyDown
+  OnKeyUp = FormKeyUp
   OnShow = FormShow
+  OnUTF8KeyPress = FormUTF8KeyPress
   ShowInTaskBar = stNever
-  LCLVersion = '2.0.2.0'
+  LCLVersion = '2.2.6.0'
   object ChooseColorControl: TPanel
     Left = 0
-    Height = 297
+    Height = 198
     Top = 0
-    Width = 396
+    Width = 264
     Align = alClient
     BevelOuter = bvNone
     TabOrder = 0

lazpaint/uchoosecolor.pas

@@ -8,7 +8,7 @@ interface
 uses
   Classes, SysUtils, FileUtil, LResources, Forms, Controls, ExtCtrls,
   BGRABitmap, BGRABitmapTypes,
-  LazPaintType, UChooseColorInterface;
+  LazPaintType, UChooseColorInterface, LCLType;
 
 type
 
@@ -19,7 +19,10 @@ type
     procedure FormCreate(Sender: TObject);
     procedure FormDeactivate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
+    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
     procedure FormShow(Sender: TObject);
+    procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
   private
     function GetColorTarget: TColorTarget;
     function GetDarkTheme: boolean;
@@ -37,6 +40,7 @@ type
     function GetCurrentColor: TBGRAPixel;
     procedure AdjustControlHeight;
     procedure HideEditor;
+    procedure SimpleRedraw;
     property DarkTheme: boolean read GetDarkTheme write SetDarkTheme;
     property LazPaintInstance: TLazPaintCustomInstance read GetLazPaintInstance write SetLazPaintInstance;
     property EditorVisible: boolean read GetEditorVisible;
@@ -69,11 +73,29 @@ begin
   FreeAndNil(FInterface);
 end;
 
+procedure TFChooseColor.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+  if not EditorVisible and Assigned(LazPaintInstance) then
+    LazPaintInstance.SendKeyDownEventToMainForm(Key, Shift);
+end;
+
+procedure TFChooseColor.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+begin
+  if not EditorVisible and Assigned(LazPaintInstance) then
+    LazPaintInstance.SendKeyUpEventToMainForm(Key, Shift);
+end;
+
 procedure TFChooseColor.FormShow(Sender: TObject);
 begin
   self.EnsureVisible(False);
 end;
 
+procedure TFChooseColor.FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
+begin
+  if not EditorVisible and Assigned(LazPaintInstance) then
+    LazPaintInstance.SendUTF8KeyPressEventToMainForm(UTF8Key);
+end;
+
 procedure TFChooseColor.SetCurrentColor(value: TBGRAPixel);
 begin
   if Assigned(FInterface) then
@@ -100,6 +122,11 @@ begin
     FInterface.HideEditor;
 end;
 
+procedure TFChooseColor.SimpleRedraw;
+begin
+  if Assigned(FInterface) then FInterface.SimpleRedraw;
+end;
+
 procedure TFChooseColor.SetDarkTheme(AValue: boolean);
 begin
   if Assigned(FInterface) then

lazpaint/umainformlayout.pas

@@ -126,6 +126,7 @@ type
     property LazPaintInstance: TLazPaintCustomInstance read FLazPaintInstance write SetLazPaintInstance;
     property ToolboxPopup: TPopupMenu read GetPopupToolbox write SetPopupToolbox;
     property PaletteVisible: boolean read GetPaletteVisible write SetPaletteVisible;
+    property PaletteToolbar: TPaletteToolbar read FPaletteToolbar;
     property StatusBarVisible: boolean read GetStatusBarVisible write SetStatusBarVisible;
     property StatusText: string read GetStatusText write SetStatusText;
     property DefaultToolboxDocking: TToolWindowDocking read GetDefaultToolboxDocking;
@@ -260,15 +261,21 @@ end;
 function TMainFormLayout.CatchToolKeyDown(var AKey: Word): boolean;
 begin
   if Assigned(FImageView) then
-    result := FImageView.CatchToolKeyDown(AKey)
-    else result := false;
+  begin
+    result := FImageView.CatchToolKeyDown(AKey);
+    if not result and Assigned(FPaletteToolbar) then
+      result := FPaletteToolbar.CatchToolKeyDown(AKey);
+  end  else result := false;
 end;
 
 function TMainFormLayout.CatchToolKeyUp(var AKey: Word): boolean;
 begin
   if Assigned(FImageView) then
-    result := FImageView.CatchToolKeyUp(AKey)
-    else result := false;
+  begin
+    result := FImageView.CatchToolKeyUp(AKey);
+    if not result and Assigned(FPaletteToolbar) then
+      result := FPaletteToolbar.CatchToolKeyUp(AKey);
+  end  else result := false;
 end;
 
 function TMainFormLayout.CatchToolKeyPress(var AKey: TUTF8Char): boolean;

lazpaint/upalettetoolbar.pas

@@ -10,10 +10,11 @@ uses
   BGRAVirtualScreen, BGRABitmap,
   LazPaintType, UVolatileScrollBar,
   BGRAPalette, BCButton, Menus,
-  Dialogs, BGRABitmapTypes;
+  Dialogs, BGRABitmapTypes, fgl;
 
 type
   TPaletteVisibilityChangedByUserHandler = procedure(Sender:TObject) of object;
+  TBGRAPixelBinding = specialize TFPGMap<integer, TBGRAPixel>;
 
   { TPaletteToolbar }
 
@@ -70,6 +71,7 @@ type
     procedure SetVisible(AValue: boolean);
     procedure TryLoadPaletteFrom(AFilename: string);
     procedure TrySavePaletteTo(AFilename: string);
+    procedure DoPickColor(Shift: TShiftState; AColor: TBGRAPixel);
   protected
     procedure PickColor(Shift: TShiftState; X, Y: Integer);
     procedure PaletteChanged;
@@ -85,6 +87,11 @@ type
     procedure ApplyTheme;
     procedure ComputeMenuButtonGlyph;
     property PanelPalette: TBGRAVirtualScreen read GetPanelPalette;
+  private
+    FColorsBindToKey: TBGRAPixelBinding;
+    FSnapPressed, FAltPressed: boolean;
+    procedure ToggleBindColorToKey(aColor: TBGRAPixel; aDigit: integer);
+    function TryToGetColorBindedToKey(aDigit: integer; out aColor: TBGRAPixel): boolean;
   public
     constructor Create;
     destructor Destroy; override;
@@ -92,6 +99,9 @@ type
     procedure AddColor(AColor: TBGRAPixel);
     procedure RemoveColor(AColor: TBGRAPixel);
     procedure SetBounds(ALeft,ATop,AWidth,AHeight: integer);
+    function CatchToolKeyDown(var AKey: Word): boolean;
+    function CatchToolKeyUp(var AKey: Word): boolean;
+    function GetKeyAssociatedToColor(const AColor: TBGRAPixel): string;
     property Container: TWinControl read FContainer write SetContainer;
     property LazPaintInstance: TLazPaintCustomInstance read FLazPaintInstance write SetLazPaintInstance;
     property Visible: boolean read FVisible write SetVisible;
@@ -106,7 +116,8 @@ implementation
 uses LCScaleDPI, Graphics, Forms, UGraph,
   UResourceStrings, BGRAColorQuantization,
   ULayerAction, UCursors, UFileSystem,
-  udarktheme, UTool, LCVectorialFill, math;
+  udarktheme, UTool, LCVectorialFill, math,
+  LCLType;
 
 { TPaletteToolbar }
 
@@ -311,6 +322,86 @@ begin
   glyphBmp.Free;
 end;
 
+procedure TPaletteToolbar.ToggleBindColorToKey(aColor: TBGRAPixel; aDigit: integer);
+var c: TBGRAPixel;
+  procedure RemoveBinding;
+  var idx: integer;
+  begin
+    idx := FColorsBindToKey.IndexOf(aDigit);
+    if idx <> -1 then FColorsBindToKey.Delete(idx);
+    idx := FColorsBindToKey.IndexOfData(aColor);
+    if idx <> -1 then FColorsBindToKey.Delete(idx);
+  end;
+begin
+  if not FTransparentPalette then aColor.alpha := 255;
+
+  if FColorsBindToKey.TryGetData(aDigit, c) then
+  begin
+    RemoveBinding;
+    if aColor <> c then FColorsBindToKey.Add(aDigit, aColor);
+  end else
+  begin
+    RemoveBinding;
+    FColorsBindToKey.Add(aDigit, aColor);
+  end;
+end;
+
+function TPaletteToolbar.TryToGetColorBindedToKey(aDigit: integer; out aColor: TBGRAPixel): boolean;
+begin
+  Result := FColorsBindToKey.TryGetData(aDigit, aColor);
+end;
+
+function TPaletteToolbar.CatchToolKeyDown(var AKey: Word): boolean;
+var digit: integer;
+  c: TBGRAPixel;
+begin
+  if AKey = VK_MENU then FAltPressed := True
+  else if (AKey = VK_SNAP) or (AKey = VK_SNAP2) then FSnapPressed := True;
+
+  digit := -1;
+  if AKey in [VK_0..VK_9] then digit := AKey - VK_0
+  else if AKey in [VK_NUMPAD0..VK_NUMPAD9] then digit := AKey - VK_NUMPAD0;
+
+  if digit <> -1 then
+  begin
+    if FSnapPressed then
+    begin
+      c := FLazPaintInstance.GetColor(FLazPaintInstance.ChooseColorTarget);
+      ToggleBindColorToKey(c, digit);
+      PaletteChanged;
+      FLazPaintInstance.NotifyColorBinding;
+    end else
+    begin
+      if TryToGetColorBindedToKey(digit, c) then
+      begin
+        if FAltPressed then DoPickColor([ssRight], c)
+        else DoPickColor([ssLeft], c);
+      end;
+    end;
+    Result := True;
+  end else Result := False;
+end;
+
+function TPaletteToolbar.CatchToolKeyUp(var AKey: Word): boolean;
+begin
+  if AKey = VK_MENU then FAltPressed := False
+  else if (AKey = VK_SNAP) or (AKey = VK_SNAP2) then FSnapPressed := False;
+  Result := False;
+end;
+
+function TPaletteToolbar.GetKeyAssociatedToColor(const AColor: TBGRAPixel): string;
+var idx: Integer;
+  c: TBGRAPixel;
+begin
+  c := AColor;
+  if not FTransparentPalette and (c.alpha <> 0) then c.alpha := 255;
+  idx := FColorsBindToKey.IndexOfData(c);
+  if idx <> -1 then
+    Result := FColorsBindToKey.Keys[idx].ToString
+  else
+    Result := '';
+end;
+
 procedure TPaletteToolbar.DoClearPalette(Sender: TObject);
 begin
   FColors.Clear;
@@ -641,10 +732,7 @@ begin
   end;
 end;
 
-procedure TPaletteToolbar.PickColor(Shift: TShiftState; X, Y: Integer);
-var idx: integer;
-  c : TBGRAPixel;
-
+procedure TPaletteToolbar.DoPickColor(Shift: TShiftState; AColor: TBGRAPixel);
   procedure NeedGradient(AFill: TVectorialFill);
   begin
     if AFill = LazPaintInstance.ToolManager.ForeFill then
@@ -659,8 +747,8 @@ var idx: integer;
   begin
     NeedGradient(AFill);
     if not (AFill.FillType = vftGradient) then exit;
-    if not FTransparentPalette then c.alpha := AFill.Gradient.StartColor.alpha;
-    AFill.Gradient.StartColor := c;
+    if not FTransparentPalette then AColor.alpha := AFill.Gradient.StartColor.alpha;
+    AFill.Gradient.StartColor := AColor;
     if AFill = LazPaintInstance.ToolManager.ForeFill then
       LazPaintInstance.ChooseColorTarget := ctForeColorStartGrad else
     if AFill = LazPaintInstance.ToolManager.BackFill then
@@ -673,8 +761,8 @@ var idx: integer;
   begin
     NeedGradient(AFill);
     if not (AFill.FillType = vftGradient) then exit;
-    if not FTransparentPalette then c.alpha := AFill.Gradient.EndColor.alpha;
-    AFill.Gradient.EndColor := c;
+    if not FTransparentPalette then AColor.alpha := AFill.Gradient.EndColor.alpha;
+    AFill.Gradient.EndColor := AColor;
     if AFill = LazPaintInstance.ToolManager.ForeFill then
       LazPaintInstance.ChooseColorTarget := ctForeColorEndGrad else
     if AFill = LazPaintInstance.ToolManager.BackFill then
@@ -692,44 +780,50 @@ var idx: integer;
         result := LazPaintInstance.ToolManager.ForeFill;
     end;
   end;
+begin
+  if (ssLeft in Shift) and not (ssRight in Shift) then
+  begin
+    if ssSnap in Shift then
+      ChangeStartColor(GetSelectedFill)
+    else
+    begin
+      if not FTransparentPalette then AColor.alpha := LazPaintInstance.ToolManager.ForeColor.alpha;
+      LazPaintInstance.ToolManager.ForeColor := AColor;
+      LazPaintInstance.ChooseColorTarget:= ctForeColorSolid;
+    end;
+  end else
+  if not (ssLeft in Shift) and (ssRight in Shift) then
+  begin
+    if ssSnap in Shift then
+      ChangeEndColor(GetSelectedFill)
+    else
+    begin
+      if LazPaintInstance.ToolManager.GetCurrentToolType = ptText then
+      begin
+        if not FTransparentPalette then AColor.alpha := LazPaintInstance.ToolManager.OutlineColor.alpha;
+        LazPaintInstance.ToolManager.OutlineColor := AColor;
+        LazPaintInstance.ChooseColorTarget:= ctOutlineColorSolid;
+      end else
+      begin
+        if not FTransparentPalette then AColor.alpha := LazPaintInstance.ToolManager.BackColor.alpha;
+        LazPaintInstance.ToolManager.BackColor := AColor;
+        LazPaintInstance.ChooseColorTarget:= ctBackColorSolid;
+      end;
+    end;
+  end else
+    exit;
+end;
 
+procedure TPaletteToolbar.PickColor(Shift: TShiftState; X, Y: Integer);
+var idx: integer;
+  c : TBGRAPixel;
 begin
   if PtInRect(Point(X,Y),FPaletteColorRect) then
   begin
     idx := (Y-FPaletteColorRect.Top) div FPaletteColorItemHeight + FScrollPos;
     if (idx < 0) or (idx >= FColors.Count) then exit;
     c := FColors.Color[idx];
-    if (ssLeft in Shift) and not (ssRight in Shift) then
-    begin
-      if ssSnap in Shift then
-        ChangeStartColor(GetSelectedFill)
-      else
-      begin
-        if not FTransparentPalette then c.alpha := LazPaintInstance.ToolManager.ForeColor.alpha;
-        LazPaintInstance.ToolManager.ForeColor := c;
-        LazPaintInstance.ChooseColorTarget:= ctForeColorSolid;
-      end;
-    end else
-    if not (ssLeft in Shift) and (ssRight in Shift) then
-    begin
-      if ssSnap in Shift then
-        ChangeEndColor(GetSelectedFill)
-      else
-      begin
-        if LazPaintInstance.ToolManager.GetCurrentToolType = ptText then
-        begin
-          if not FTransparentPalette then c.alpha := LazPaintInstance.ToolManager.OutlineColor.alpha;
-          LazPaintInstance.ToolManager.OutlineColor := c;
-          LazPaintInstance.ChooseColorTarget:= ctOutlineColorSolid;
-        end else
-        begin
-          if not FTransparentPalette then c.alpha := LazPaintInstance.ToolManager.BackColor.alpha;
-          LazPaintInstance.ToolManager.BackColor := c;
-          LazPaintInstance.ChooseColorTarget:= ctBackColorSolid;
-        end;
-      end;
-    end else
-      exit;
+    DoPickColor(Shift, c);
   end;
 end;
 
@@ -744,6 +838,7 @@ var i,x,y,w,aw,a,h: integer;
   c: TBGRAPixel;
   nbVisible, maxScroll, availHeight, minItemHeight, maxItemHeight: integer;
   clInterm, cSign: TBGRAPixel;
+  strKey: string;
 begin
   FCanvasScale := (Sender as TControl).GetCanvasScaleFactor;
   TVolatileScrollBar.InitDPI(FCanvasScale);
@@ -785,6 +880,8 @@ begin
   FPaletteColorRect := rect(x,y,x+w,y);
   h := FPaletteColorItemHeight+1;
   nbVisible := (availHeight+h-2) div (h-1);
+  Bitmap.FontFullHeight := Round(h*2/3);
+  Bitmap.FontAntialias := True;
   for i := FScrollPos to FScrollPos+nbVisible-1 do
   if (i >= 0) and (i < FColors.Count) then
   begin
@@ -804,15 +901,25 @@ begin
     begin
       Bitmap.Rectangle(x,y,x+w,y+h,clInterm,c,dmSet);
     end;
+    if (GetLightness(c)/65535 > 0.5) or (FColors.Color[i].alpha = 0) then
+      cSign := BGRABlack else cSign := BGRAWhite;
     if FColors.Color[i] = FLastAddedColor then
     begin
-      if GetLightness(c)/65535 > 0.5 then
-        cSign := BGRABlack else cSign := BGRAWhite;
       Bitmap.DrawPolyLineAntialias(
         Bitmap.ComputeOpenedSpline([PointF(x+(w-aw)*1 div 5, y+h div 4), PointF(x+(w-aw)*2 div 5, y+h*5 div 6),
             PointF(x+(w-aw)*3 div 5, y+h div 4), PointF(x+(w-aw)*4 div 5, y+h div 5)], ssEasyBezier),
             cSign, DoScaleX(15, OriginalDPI)/10);
     end;
+    strKey := GetKeyAssociatedToColor(FColors.Color[i]);
+    if strKey <> '' then
+    begin
+      if FTransparentPalette then
+        Bitmap.TextOut(x+w-aw-Bitmap.TextSize(strKey).cx-DoScaleX(2, OriginalDPI),
+                       y+h-Bitmap.TextSize(strKey).cy, strKey, cSign, taLeftJustify)
+      else
+        Bitmap.TextOut(x+w-Bitmap.TextSize(strKey).cx-DoScaleX(2, OriginalDPI),
+                       y+h-Bitmap.TextSize(strKey).cy, strKey, cSign, taLeftJustify);
+    end;
     y += h-1;
   end;
   FPaletteColorRect.Bottom := y;
@@ -854,6 +961,8 @@ constructor TPaletteToolbar.Create;
 begin
   FPanelPalette := nil;
   FLastAddedColor := BGRAPixelTransparent;
+  FColorsBindToKey := TBGRAPixelBinding.Create;
+  FColorsBindToKey.Duplicates := dupError;
 end;
 
 destructor TPaletteToolbar.Destroy;
@@ -862,6 +971,7 @@ begin
   FreeAndNil(FScrollbar);
   FreeAndNil(FPanelPalette);
   FreeAndNil(FColors);
+  FreeAndNil(FColorsBindToKey);
   inherited Destroy;
 end;