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,21 @@ 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.GetDigitFromColorsBindToKey(c);
+        if Length(s) > 0 then
+        begin
+          if GetLightness(c)/65535 > 0.5 then
+            cDigit := BGRABlack else cDigit := BGRAWhite;
+          Bitmap.FontHeight := Round(Height*2/3);
+          Bitmap.TextOut(CenterPoint.x,
+                         CenterPoint.y-Bitmap.TextSize(s).cy div 2,
+                         s, cDigit, taCenter);
+        end;
+      end;
     end;
   end;
 end;
@@ -1172,5 +1186,10 @@ begin
   Container.Height := round(h + FTextAreaHeight + ExternalMargin);
 end;
 
+procedure TChooseColorInterface.SimpleRedraw;
+begin
+  UpdateColorview(False, False, True);
+end;
+
 end.
 

lazpaint/lazpaintinstance.pas

@@ -240,6 +240,7 @@ type
     procedure ColorToFChooseColor; override;
     procedure ExitColorEditor; override;
     function ColorEditorActive: boolean; override;
+    procedure FChooseColorSimpleRedraw; override;
     function ShowSaveOptionDlg({%H-}AParameters: TVariableSet; AOutputFilenameUTF8: string;
       ASkipOptions: boolean; AExport: boolean): boolean; override;
     function ShowColorIntensityDlg(AParameters: TVariableSet): TScriptResult; override;
@@ -289,7 +290,10 @@ type
     procedure UpdateEditPicture(ADelayed: boolean); override;
     procedure AddColorToPalette(AColor: TBGRAPixel); override;
     procedure RemoveColorFromPalette(AColor: TBGRAPixel); override;
+    function GetDigitFromColorsBindToKey(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;
   end;
 
 implementation
@@ -1981,6 +1985,11 @@ begin
     else result := false;
 end;
 
+procedure TLazPaintInstance.FChooseColorSimpleRedraw;
+begin
+  if Assigned(FChooseColor) then FChooseColor.SimpleRedraw;
+end;
+
 function TLazPaintInstance.ShowSaveOptionDlg(AParameters: TVariableSet;
   AOutputFilenameUTF8: string; ASkipOptions: boolean; AExport: boolean): boolean;
 begin
@@ -2195,5 +2204,23 @@ begin
   if Assigned(FMain) then FMain.Layout.RemoveColorFromPalette(AColor);
 end;
 
+function TLazPaintInstance.GetDigitFromColorsBindToKey(const AColor: TBGRAPixel): string;
+begin
+  if Assigned(FMain) and
+     Assigned(FMain.Layout) and
+     Assigned(FMain.Layout.PaletteToolbar) then Result := FMain.Layout.PaletteToolbar.GetDigitFromColorsBindToKey(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;
+
 end.
 

lazpaint/lazpainttype.pas

@@ -271,6 +271,7 @@ type
     procedure ColorToFChooseColor; virtual; abstract;
     procedure ExitColorEditor; virtual; abstract;
     function ColorEditorActive: boolean; virtual; abstract;
+    procedure FChooseColorSimpleRedraw; 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 GetDigitFromColorsBindToKey(const AColor: TBGRAPixel): string; virtual; abstract;
 
     property BlackAndWhite: boolean read FBlackAndWhite write SetBlackAndWhite;
 
@@ -343,6 +345,8 @@ 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;
     property ImageListWindowWidth: integer read GetImageListWindowWidth write SetImageListWindowWidth;
     property ImageListWindowHeight: integer read GetImageListWindowHeight write SetImageListWindowHeight;
     property ImageListWindowVisible: boolean read GetImageListWindowVisible write SetImageListWindowVisible;

lazpaint/uchoosecolor.lfm

@@ -1,27 +1,28 @@
 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
   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

@@ -19,6 +19,8 @@ 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);
   private
     function GetColorTarget: TColorTarget;
@@ -37,6 +39,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,6 +72,18 @@ 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);
@@ -100,6 +115,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

@@ -70,6 +70,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 +86,9 @@ type
     procedure ApplyTheme;
     procedure ComputeMenuButtonGlyph;
     property PanelPalette: TBGRAVirtualScreen read GetPanelPalette;
+  protected
+    FColorsBindToKey: array[0..9] of TBGRAPixel;
+    FSnapPressed, FAltPressed: boolean;
   public
     constructor Create;
     destructor Destroy; override;
@@ -92,6 +96,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 GetDigitFromColorsBindToKey(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 +113,8 @@ implementation
 uses LCScaleDPI, Graphics, Forms, UGraph,
   UResourceStrings, BGRAColorQuantization,
   ULayerAction, UCursors, UFileSystem,
-  udarktheme, UTool, LCVectorialFill, math;
+  udarktheme, UTool, LCVectorialFill, math,
+  LCLType;
 
 { TPaletteToolbar }
 
@@ -311,6 +319,57 @@ begin
   glyphBmp.Free;
 end;
 
+function TPaletteToolbar.CatchToolKeyDown(var AKey: Word): boolean;
+var colorIndex: integer;
+  c: TBGRAPixel;
+begin
+  if AKey = VK_MENU then FAltPressed := True
+  else if (AKey = VK_SNAP) or (AKey = VK_SNAP2) then FSnapPressed := True;
+
+  colorIndex := -1;
+  if AKey in [VK_0..VK_9] then colorIndex := AKey - VK_0
+  {else if AKey in [VK_NUMPAD0..VK_NUMPAD9] then colorIndex := AKey - VK_NUMPAD0};
+
+  if colorIndex <> -1 then
+  begin
+    if FSnapPressed then
+    begin
+      c := FLazPaintInstance.GetColor(FLazPaintInstance.ChooseColorTarget);
+      FColorsBindToKey[colorIndex] := c;
+      PaletteChanged;
+      FLazPaintInstance.FChooseColorSimpleRedraw;
+    end else
+    begin
+      c := FColorsBindToKey[colorIndex];
+      if c <> BGRAPixelTransparent 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.GetDigitFromColorsBindToKey(const AColor: TBGRAPixel): string;
+var i: Integer;
+begin
+  for i := 0 to High(FColorsBindToKey) do
+    if FColorsBindToKey[i] = AColor then
+    begin
+      Result := i.ToString;
+      exit;
+    end;
+  Result := '';
+end;
+
 procedure TPaletteToolbar.DoClearPalette(Sender: TObject);
 begin
   FColors.Clear;
@@ -493,6 +552,7 @@ begin
 end;
 
 function TPaletteToolbar.GetPanelPalette: TBGRAVirtualScreen;
+var i: integer;
 begin
   if not Assigned(FPanelPalette) then
   begin
@@ -518,6 +578,9 @@ begin
     FTransparentPalette:= false;
     FMergePalette:= false;
 
+    for i := 0 to 9 do
+      FColorsBindToKey[i] := BGRAPixelTransparent;
+
     FMenuButton := TBCButton.Create(FPanelPalette);
     FMenuButton.Cursor := crArrow;
     DarkThemeInstance.Apply(FMenuButton, DarkTheme);
@@ -641,10 +704,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 +719,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 +733,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 +752,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 +810,7 @@ var i,x,y,w,aw,a,h: integer;
   c: TBGRAPixel;
   nbVisible, maxScroll, availHeight, minItemHeight, maxItemHeight: integer;
   clInterm, cSign: TBGRAPixel;
+  digit: string;
 begin
   FCanvasScale := (Sender as TControl).GetCanvasScaleFactor;
   TVolatileScrollBar.InitDPI(FCanvasScale);
@@ -785,6 +852,8 @@ begin
   FPaletteColorRect := rect(x,y,x+w,y);
   h := FPaletteColorItemHeight+1;
   nbVisible := (availHeight+h-2) div (h-1);
+  Bitmap.FontHeight := DoScaleX(12, OriginalDPI);
+  Bitmap.FontAntialias := True;
   for i := FScrollPos to FScrollPos+nbVisible-1 do
   if (i >= 0) and (i < FColors.Count) then
   begin
@@ -804,15 +873,25 @@ begin
     begin
       Bitmap.Rectangle(x,y,x+w,y+h,clInterm,c,dmSet);
     end;
+    if GetLightness(c)/65535 > 0.5 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;
+    digit := GetDigitFromColorsBindToKey(FColors.Color[i]);
+    if digit <> '' then
+    begin
+      if FTransparentPalette then
+        Bitmap.TextOut(x+w-aw-Bitmap.TextSize(digit).cx-DoScaleX(2, OriginalDPI),
+                       y+h-Bitmap.TextSize(digit).cy, digit, cSign, taLeftJustify)
+      else
+        Bitmap.TextOut(x+w-Bitmap.TextSize(digit).cx-DoScaleX(2, OriginalDPI),
+                       y+h-Bitmap.TextSize(digit).cy, digit, cSign, taLeftJustify);
+    end;
     y += h-1;
   end;
   FPaletteColorRect.Bottom := y;