uCustomColorDlg.pas

{ uCustomColorDlg.pas
  Custom Color Picker Controls v1.9
  ==============================================================================
  Name      : TColorPickerDlg
  Version   : 1.9
  Developer : Shohanur Rahman
  Publisher : SR Studio 24 - BD
  Copyright : © 2026 SR Studio 24 - BD
  Website   : https://srstudio24.blogspot.com/
  ==============================================================================
  QUICK SETUP
  Structure: TColorPickerDlg.Execute(Title, OKCaption, Color);
  1. Add to uses: uCustomColorDlg;
  2. Button Click:
       procedure TForm1.Button2Click(Sender: TObject);
       var MyColor: TColor;
       begin
            MyColor := Label1.Font.Color;
            if TColorPickerDlg.Execute('Window Caption', 'OK', MyColor) then
            Label1.Font.Color := MyColor;
       end;
  Note:  MyColor contains the selected color after clicking OK.
  ------------------------------------------------------------------------------

  Custom Color Picker Dialog
  Adobe-style color selection dialog with integrated screen color picker.

  Features:
    - HSV / HSL color selection
    - Real-time SV and Hue interaction
    - RGB / HSL / HEX input
    - New / Current color preview
    - Screen Color Picker / Eye Dropper
    - Smooth real-time color updates
    - Keyboard support
    - Modal Execute() interface
  ------------------------------------------------------------------------------

  IMPORTANT:
  Conversion formulas, rounding behavior and value ranges are core logic.
  Do not modify without testing all dependent color-picker features.

  Internal project code.
  Unauthorized modification or redistribution is not permitted.

==============================================================================}




unit uCustomColorDlg;
interface
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Types,
  System.Math, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls,
  Vcl.ExtCtrls, uColorUtils, uColorPickerControls, System.SyncObjs;
type
  TColorPickerDlg = class(TForm)
  private
    FSV: TSVSquare;
    FHue: THueBar;
    FNewSwatch, FCurSwatch: TColorSwatch;
    FLblNew, FLblCur: TLabel;
    FLblH, FLblS, FLblL, FLblR, FLblG, FLblB, FLblHash: TLabel;
    FEditH, FEditS, FEditL, FEditR, FEditG, FEditB, FEditHex: TEdit;
    FRadioH, FRadioS, FRadioL: TRadioButton;
    FBtnOK, FBtnCancel, FBtnColorPick: TButton;
    FOriginal: TColor;
    FUpdating: Boolean;
    FEyeDropperActive: Boolean;
    FPrevCursor: TCursor;
    FOverlayForm: TForm;
    FLastPickedColor: TColor;
    FUpdateTimer: TTimer;
    FQueuedColor: TColor;
    FQueuedR, FQueuedG, FQueuedB: Byte;
    FColorReady: Boolean;
    FLastMouseX, FLastMouseY: Integer;
    FColorLock: TCriticalSection;
    FScreenBits: Pointer;
    FScreenWidth, FScreenHeight: Integer;
    FScreenCacheValid: Boolean;
    FVirtualLeft, FVirtualTop: Integer;
    FLastR, FLastG, FLastB: Byte;
    procedure BuildUI;
    procedure InitFromColor(const C: TColor);
    procedure ApplyRGB(R, G, B: Byte; UpdateRGBBoxes: Boolean; UpdateHexBox: Boolean = True);
    procedure ApplyHSL(H, S, L: Integer; UpdateHSLBoxes: Boolean; UpdateHexBox: Boolean = True);
    procedure UpdateEditsAndSwatch(R, G, B: Byte; UpdateRGBBoxes, UpdateHSLBoxes, UpdateHexBox: Boolean);
    procedure SVChanged(Sender: TObject);
    procedure HueChanged(Sender: TObject);
    procedure EditRGBChange(Sender: TObject);
    procedure EditHSLChange(Sender: TObject);
    procedure EditRGBExit(Sender: TObject);
    procedure EditHSLExit(Sender: TObject);
    procedure EditHexChange(Sender: TObject);
    procedure EditKeyPress(Sender: TObject; var Key: Char);
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EditHexExit(Sender: TObject);
    procedure RadioModeClick(Sender: TObject);
    procedure BtnColorPickClick(Sender: TObject);
    procedure ActivateEyeDropper;
    procedure DeactivateEyeDropper;
    procedure OverlayMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure OverlayMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure OverlayKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure UpdateTimerTick(Sender: TObject);
    procedure ProcessQueuedColor;
    procedure PickColorAtScreenPos(const ScreenPos: TPoint);
    procedure InitScreenCache;
    procedure FreeScreenCache;
    function GetPixelFast(X, Y: Integer; out R, G, B: Byte): Boolean;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class function Execute(const ATitle, AOKCaption: string; var AColor: TColor): Boolean;
  end;
implementation
constructor TColorPickerDlg.Create(AOwner: TComponent);
begin
  inherited CreateNew(AOwner);
  BorderStyle := bsDialog;
  BorderIcons := [biSystemMenu];
  Position := poScreenCenter;
  ClientWidth := 490;
  ClientHeight := 283;
  DoubleBuffered := True;
  KeyPreview := True;
  Visible := False;
  FUpdating := False;
  FEyeDropperActive := False;
  FPrevCursor := crDefault;
  FOverlayForm := nil;
  FLastPickedColor := clBlack;
  FColorReady := False;
  FLastMouseX := -1;
  FLastMouseY := -1;
  FColorLock := TCriticalSection.Create;
  FScreenBits := nil;
  FScreenCacheValid := False;
  FScreenWidth := 0;
  FScreenHeight := 0;
  FVirtualLeft := 0;
  FVirtualTop := 0;
  FUpdateTimer := TTimer.Create(Self);
  FUpdateTimer.Interval := 1;
  FUpdateTimer.Enabled := False;
  FUpdateTimer.OnTimer := UpdateTimerTick;
  BuildUI;
end;
destructor TColorPickerDlg.Destroy;
begin
  if FEyeDropperActive then DeactivateEyeDropper;
  if Assigned(FOverlayForm) then
  begin
    FOverlayForm.Free;
    FOverlayForm := nil;
  end;
  FreeScreenCache;
  FColorLock.Free;
  inherited;
end;
procedure TColorPickerDlg.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  if Showing then
  begin
    FSV.Invalidate;
    FHue.Invalidate;
    FNewSwatch.Invalidate;
    FCurSwatch.Invalidate;
  end;
end;
procedure TColorPickerDlg.CMDialogKey(var Message: TCMDialogKey);
begin
  if Message.CharCode = VK_RETURN then
  begin
    if (ActiveControl = FEditR) or (ActiveControl = FEditG) or (ActiveControl = FEditB) then
    begin
      EditRGBExit(ActiveControl);
      if not ((ActiveControl = FEditR) or (ActiveControl = FEditG) or (ActiveControl = FEditB)) then
        FBtnOK.SetFocus;
      Message.Result := 1;
      Exit;
    end
    else if (ActiveControl = FEditH) or (ActiveControl = FEditS) or (ActiveControl = FEditL) then
    begin
      EditHSLExit(ActiveControl);
      if not ((ActiveControl = FEditH) or (ActiveControl = FEditS) or (ActiveControl = FEditL)) then
        FBtnOK.SetFocus;
      Message.Result := 1;
      Exit;
    end
    else if ActiveControl = FEditHex then
    begin
      EditHexExit(FEditHex);
      FBtnOK.SetFocus;
      Message.Result := 1;
      Exit;
    end;
  end
  else if (Message.CharCode = VK_ESCAPE) and FEyeDropperActive then
  begin
    DeactivateEyeDropper;
    Message.Result := 1;
    Exit;
  end;
  inherited;
end;
procedure TColorPickerDlg.BuildUI;
var
  SwatchPanel: TPanel;
begin
  ClientWidth := 490;
  Color := clWhite;
  ClientHeight := 283;
  FSV := TSVSquare.Create(Self);
  with FSV do
  begin
    Parent := Self; Top := 12; Left := 12; Width := 256; Height := 256;
    OnChange := SVChanged;
  end;
  FHue := THueBar.Create(Self);
  with FHue do
  begin
    Parent := Self; Top := 12; Left := 274; Width := 22; Height := 256;
    OnChange := HueChanged;
  end;
  FLblNew := TLabel.Create(Self);
  with FLblNew do
  begin
    Parent := Self; Caption := 'New'; Transparent := True;
    Left := 305; Top := 12; Width := 80; Height := 14; Alignment := taCenter;
  end;
  SwatchPanel := TPanel.Create(Self);
  with SwatchPanel do
  begin
    Parent := Self; Left := 305; Top := 30; Width := 80; Height := 80;
    BevelOuter := bvRaised; BevelInner := bvLowered;
    ParentBackground := False; Color := clBtnFace; BorderStyle := bsNone;
    Padding.Left := 1; Padding.Top := 1; Padding.Right := 1; Padding.Bottom := 1;
  end;
  FNewSwatch := TColorSwatch.Create(Self);
  with FNewSwatch do
  begin
    Parent := SwatchPanel; Align := alTop; Height := 40; ShowBorder := False;
  end;
  FCurSwatch := TColorSwatch.Create(Self);
  with FCurSwatch do
  begin
    Parent := SwatchPanel; Align := alClient; ShowBorder := False;
  end;
  FLblCur := TLabel.Create(Self);
  with FLblCur do
  begin
    Parent := Self; Caption := 'Current'; Transparent := True;
    Left := 305; Top := 112; Width := 80; Height := 14; Alignment := taCenter;
  end;
  FBtnOK := TButton.Create(Self);
  with FBtnOK do
  begin
    Parent := Self; Caption := 'OK'; Default := True; ModalResult := mrOk;
    Left := 393; Top := 12; Width := 90; Height := 28;
  end;
  FBtnCancel := TButton.Create(Self);
  with FBtnCancel do
  begin
    Parent := Self; Caption := 'Cancel'; Cancel := True; ModalResult := mrCancel;
    Left := 393; Top := 45; Width := 90; Height := 28;
  end;
  FBtnColorPick := TButton.Create(Self);
  with FBtnColorPick do
  begin
    Parent := Self; Caption := 'Color Pick';
    Left := 393; Top := 80; Width := 90; Height := 28;
    OnClick := BtnColorPickClick;
    Hint := 'Click to pick color from screen'; ShowHint := True;
  end;
  FLblR := TLabel.Create(Self);
  with FLblR do begin Parent := Self; Caption := 'R:'; Transparent := True; Left := 305; Top := 140; Width := 20; Height := 14; end;
  FEditR := TEdit.Create(Self);
  with FEditR do begin Parent := Self; Left := 325; Top := 137; Width := 42; Height := 21; MaxLength := 3;
    OnChange := EditRGBChange; OnExit := EditRGBExit; OnKeyPress := EditKeyPress; OnKeyDown := EditKeyDown; end;
  FLblG := TLabel.Create(Self);
  with FLblG do begin Parent := Self; Caption := 'G:'; Transparent := True; Left := 305; Top := 166; Width := 20; Height := 14; end;
  FEditG := TEdit.Create(Self);
  with FEditG do begin Parent := Self; Left := 325; Top := 163; Width := 42; Height := 21; MaxLength := 3;
    OnChange := EditRGBChange; OnExit := EditRGBExit; OnKeyPress := EditKeyPress; OnKeyDown := EditKeyDown; end;
  FLblB := TLabel.Create(Self);
  with FLblB do begin Parent := Self; Caption := 'B:'; Transparent := True; Left := 305; Top := 192; Width := 20; Height := 14; end;
  FEditB := TEdit.Create(Self);
  with FEditB do begin Parent := Self; Left := 325; Top := 189; Width := 42; Height := 21; MaxLength := 3;
    OnChange := EditRGBChange; OnExit := EditRGBExit; OnKeyPress := EditKeyPress; OnKeyDown := EditKeyDown; end;
  FRadioH := TRadioButton.Create(Self);
  with FRadioH do begin Parent := Self; Caption := 'H:'; Checked := True; Left := 386; Top := 138; Width := 36; Height := 17; OnClick := RadioModeClick; end;
  FEditH := TEdit.Create(Self);
  with FEditH do begin Parent := Self; Left := 420; Top := 137; Width := 42; Height := 21; MaxLength := 3;
    OnChange := EditHSLChange; OnExit := EditHSLExit; OnKeyPress := EditKeyPress; OnKeyDown := EditKeyDown; end;
  FLblH := TLabel.Create(Self);
  with FLblH do begin Parent := Self; Caption := '°'; Transparent := True; Left := 465; Top := 140; Width := 12; Height := 14; end;
  FRadioS := TRadioButton.Create(Self);
  with FRadioS do begin Parent := Self; Caption := 'S:'; Left := 386; Top := 164; Width := 36; Height := 17; OnClick := RadioModeClick; end;
  FEditS := TEdit.Create(Self);
  with FEditS do begin Parent := Self; Left := 420; Top := 163; Width := 42; Height := 21; MaxLength := 3;
    OnChange := EditHSLChange; OnExit := EditHSLExit; OnKeyPress := EditKeyPress; OnKeyDown := EditKeyDown; end;
  FLblS := TLabel.Create(Self);
  with FLblS do begin Parent := Self; Caption := '%'; Transparent := True; Left := 465; Top := 166; Width := 12; Height := 14; end;
  FRadioL := TRadioButton.Create(Self);
  with FRadioL do begin Parent := Self; Caption := 'L:'; Left := 386; Top := 190; Width := 36; Height := 17; OnClick := RadioModeClick; end;
  FEditL := TEdit.Create(Self);
  with FEditL do begin Parent := Self; Left := 420; Top := 189; Width := 42; Height := 21; MaxLength := 3;
    OnChange := EditHSLChange; OnExit := EditHSLExit; OnKeyPress := EditKeyPress; OnKeyDown := EditKeyDown; end;
  FLblL := TLabel.Create(Self);
  with FLblL do begin Parent := Self; Caption := '%'; Transparent := True; Left := 465; Top := 192; Width := 12; Height := 14; end;
  FLblHash := TLabel.Create(Self);
  with FLblHash do begin Parent := Self; Caption := 'HEX: #'; Transparent := True; Left := 305; Top := 228; Width := 40; Height := 14; end;
  FEditHex := TEdit.Create(Self);
  with FEditHex do begin Parent := Self; Left := 345; Top := 225; Width := 117; Height := 21; MaxLength := 6; CharCase := ecUpperCase;
    OnChange := EditHexChange; OnKeyPress := EditKeyPress; OnExit := EditHexExit; OnKeyDown := EditKeyDown; end;
end;
procedure TColorPickerDlg.UpdateEditsAndSwatch(R, G, B: Byte; UpdateRGBBoxes, UpdateHSLBoxes, UpdateHexBox: Boolean);
var
  Hh, Ss, Ll: Integer;
begin
  FLastR := R; FLastG := G; FLastB := B;
  FNewSwatch.Color := RGB(R, G, B);
  if UpdateRGBBoxes then
  begin
    FEditR.Text := IntToStr(R);
    FEditG.Text := IntToStr(G);
    FEditB.Text := IntToStr(B);
  end;
  Hh := FHue.Hue;
  RGBtoHSLValues(R, G, B, Hh, Ss, Ll);
  if UpdateHSLBoxes then
  begin
    FEditH.Text := IntToStr(Hh);
    FEditS.Text := IntToStr(Ss);
    FEditL.Text := IntToStr(Ll);
  end;
  if UpdateHexBox then
    FEditHex.Text := Format('%.2X%.2X%.2X', [R, G, B]);
end;
// 1. RadioModeClick – force correct Sat / Bri for the CURRENT colour
//    before switching the mode, so the marker lands in the right place.

procedure TColorPickerDlg.RadioModeClick(Sender: TObject);
var
  H, S, L, Hh, Ss, Bb: Integer;
begin
  if FUpdating then Exit;
  FUpdating := True;
  try
    // Always recompute HSL / HSB from the live RGB so we never inherit
    // stale values from the previous mode.
    RGBtoHSLValues(FLastR, FLastG, FLastB, H, S, L);
    RGBtoHSBValues(FLastR, FLastG, FLastB, Hh, Ss, Bb);

    if FRadioH.Checked then
    begin
      FHue.Mode := hbmHue;
      FSV.Mode  := ssmSatBri;
      FSV.Hue   := Hh;
      FSV.Sat   := Ss;
      FSV.Bri   := Bb;
      FHue.Hue  := Hh;
      FHue.Sat  := S;
      FHue.Bri  := L;
    end
    else if FRadioS.Checked then
    begin
      FHue.Mode := hbmSat;
      FSV.Mode := ssmHueBri;
      // X = Hue%, Y = Sat, fixed = Bri
      FSV.Sat := Round(Hh * 100.0 / 359.0);
      FSV.Bri := Ss;
      FSV.Hue := Bb;
      FHue.Hue := Hh;
      FHue.Sat := Ss;
      FHue.Bri := Bb;          // মার্কার বর্তমান Bri-তে → উপরে গ্যাপ থাকবে
    end
    else if FRadioL.Checked then
    begin
      FHue.Mode := hbmLight;
      FSV.Mode  := ssmHueSat;

      FSV.Sat := Round(H * 100.0 / 359.0);
      FSV.Bri := S;
      FSV.Hue := L;

      FHue.Hue := H;
      FHue.Sat := S;
      FHue.Bri := L;
    end;
  finally
    FUpdating := False;
  end;
end;


procedure TColorPickerDlg.ApplyRGB(R, G, B: Byte; UpdateRGBBoxes: Boolean; UpdateHexBox: Boolean);
var
  Hh, Ss, Bb, H, S, L: Integer;
begin
  FLastR := R; FLastG := G; FLastB := B;
  Hh := FSV.Hue; // preserve for achromatic
  RGBtoHSBValues(R, G, B, Hh, Ss, Bb);
  H := FHue.Hue;
  RGBtoHSLValues(R, G, B, H, S, L);
  // Set controls according to CURRENT mode so markers stay correct
  case FSV.Mode of
    ssmSatBri: // H mode
      begin
        FSV.Hue := Hh;
        FSV.Sat := Ss;
        FSV.Bri := Bb;
        FHue.Hue := Hh;
        FHue.Sat := S;
        FHue.Bri := L;
      end;
    ssmHueBri: // S mode
      begin
        FSV.Hue := Bb;                             // fixed Bri
        FSV.Sat := Round(H * 100.0 / 359.0);       // X = Hue%
        FSV.Bri := Ss;                             // Y = Sat
        FHue.Hue := H;
        FHue.Sat := Ss;
        FHue.Bri := Bb;
      end;
    ssmHueSat: // L mode
      begin
        FSV.Hue := L; // fixed L
        FSV.Sat := Round(H * 100.0 / 359.0); // X = Hue%
        FSV.Bri := S; // Y = Sat
        FHue.Hue := H;
        FHue.Sat := S;
        FHue.Bri := L;
      end;
  end;
  UpdateEditsAndSwatch(R, G, B, UpdateRGBBoxes, True, UpdateHexBox);
end;
procedure TColorPickerDlg.ApplyHSL(H, S, L: Integer; UpdateHSLBoxes: Boolean; UpdateHexBox: Boolean);
var
  R, G, B: Byte;
  Hh, Ss, Bb: Integer;
begin
  HSLtoRGBValues(H, S, L, R, G, B);
  FLastR := R; FLastG := G; FLastB := B;
  Hh := FSV.Hue;
  RGBtoHSBValues(R, G, B, Hh, Ss, Bb);
  case FSV.Mode of
    ssmSatBri:
      begin
        FSV.Hue := Hh; FSV.Sat := Ss; FSV.Bri := Bb;
        FHue.Hue := H; FHue.Sat := S; FHue.Bri := L;
      end;
    ssmHueBri:
      begin
        FSV.Hue := Bb;
        FSV.Sat := Round(H * 100.0 / 359.0);
        FSV.Bri := Ss;
        FHue.Hue := H;
        FHue.Sat := Ss;
        FHue.Bri := Bb;
      end;
    ssmHueSat:
      begin
        FSV.Hue := L;
        FSV.Sat := Round(H * 100.0 / 359.0);
        FSV.Bri := S;
        FHue.Hue := H; FHue.Sat := S; FHue.Bri := L;
      end;
  end;
  UpdateEditsAndSwatch(R, G, B, True, UpdateHSLBoxes, UpdateHexBox);
end;
procedure TColorPickerDlg.InitFromColor(const C: TColor);
var
  RGBVal: Longint;
  R, G, B: Byte;
begin
  FOriginal := C;
  RGBVal := ColorToRGB(C);
  R := GetRValue(RGBVal);
  G := GetGValue(RGBVal);
  B := GetBValue(RGBVal);
  FUpdating := True;
  try
    FHue.Mode := hbmHue;
    FSV.Mode := ssmSatBri;
    FRadioH.Checked := True;
    ApplyRGB(R, G, B, True);
    FSV.ForceRebuild;
    FHue.Invalidate;
  finally
    FUpdating := False;
  end;
  FCurSwatch.Color := RGB(R, G, B);
  FNewSwatch.Color := RGB(R, G, B);
end;



// 4. SVChanged – same idea for the S-mode branch:
//    when the square moves, keep FHue.Bri (the fixed Lightness) unchanged.

procedure TColorPickerDlg.SVChanged(Sender: TObject);
var
  R, G, B: Byte;
  H, S, L, Hh, Ss, Bb: Integer;
begin
  if FUpdating then Exit;
  FUpdating := True;
  try
    case FSV.Mode of
      ssmSatBri:
        begin
          HSBtoRGBValues(FSV.Hue, FSV.Sat, FSV.Bri, R, G, B);
          Hh := FHue.Hue;
          RGBtoHSLValues(R, G, B, Hh, Ss, Bb);
          FHue.Sat := Ss;
          FHue.Bri := Bb;
        end;
      ssmHueBri:   // S mode
        begin
          Hh := Round(FSV.Sat * 359.0 / 100.0);
          Ss := FSV.Bri;
          Bb := FSV.Hue;           // fixed Bri
          HSBtoRGBValues(Hh, Ss, Bb, R, G, B);
          FHue.Hue := Hh;
          FHue.Sat := Ss;
          // FHue.Bri অপরিবর্তিত থাকবে
        end;
      ssmHueSat:
        begin
          H := Round(FSV.Sat * 359.0 / 100.0);
          S := FSV.Bri;
          L := FSV.Hue;
          HSLtoRGBValues(H, S, L, R, G, B);
          FHue.Hue := H;
          FHue.Sat := S;
        end;
    end;
    UpdateEditsAndSwatch(R, G, B, True, True, True);
    FNewSwatch.Repaint;
  finally
    FUpdating := False;
  end;
end;

// 3. HueChanged – when the Sat bar moves, keep the *fixed* Lightness
//    (FHue.Bri) that was set at mode-switch time.  Do not overwrite it
//    with the HSB Bri coming from the square.

procedure TColorPickerDlg.HueChanged(Sender: TObject);
var
  R, G, B: Byte;
  H, S, L: Integer;
begin
  if FUpdating then Exit;
  FUpdating := True;
  try
    case FHue.Mode of
      hbmHue:
        begin
          HSLtoRGBValues(FHue.Hue, FHue.Sat, FHue.Bri, R, G, B);
          FSV.Hue := FHue.Hue;          // source of truth
          FSV.ForceRebuild;
        end;
      hbmSat:
        begin
          // বার এখন Bri কন্ট্রোল করে
          FSV.Hue := FHue.Bri;     // fixed Bri আপডেট
          FSV.ForceRebuild;
          HSBtoRGBValues(FHue.Hue, FHue.Sat, FHue.Bri, R, G, B);
        end;
      hbmLight:
        begin
          H := Round(FSV.Sat * 359.0 / 100.0);
          S := FSV.Bri;
          L := FHue.Bri;
          HSLtoRGBValues(H, S, L, R, G, B);
          FSV.Hue := L;
          FSV.ForceRebuild;
        end;
    end;
    UpdateEditsAndSwatch(R, G, B, True, True, True);
    FSV.Repaint;
    FNewSwatch.Repaint;
  finally
    FUpdating := False;
  end;
end;




procedure TColorPickerDlg.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if ssCtrl in Shift then
  begin
    case Key of
      Ord('C'), Ord('c'): (Sender as TEdit).CopyToClipboard;
      Ord('V'), Ord('v'): (Sender as TEdit).PasteFromClipboard;
      Ord('X'), Ord('x'): (Sender as TEdit).CutToClipboard;
      Ord('A'), Ord('a'): (Sender as TEdit).SelectAll;
    end;
    Exit;
  end;
  if Key = VK_RETURN then Key := 0;
end;
procedure TColorPickerDlg.EditHexExit(Sender: TObject);
var
  S, Clean: string;
  i: Integer;
begin
  if FUpdating then Exit;
  S := Trim(FEditHex.Text);
  Clean := '';
  for i := 1 to Length(S) do
    if CharInSet(S[i], ['0'..'9', 'A'..'F', 'a'..'f']) then
      Clean := Clean + UpCase(S[i]);
  while Length(Clean) < 6 do Clean := '0' + Clean;
  if Length(Clean) > 6 then Clean := Copy(Clean, 1, 6);
  FUpdating := True;
  try
    FEditHex.Text := Clean;
  finally
    FUpdating := False;
  end;
end;
procedure TColorPickerDlg.EditKeyPress(Sender: TObject; var Key: Char);
begin
  if Sender = FEditHex then
  begin
    if not CharInSet(Key, ['0'..'9', 'A'..'F', 'a'..'f', #8, #13, #27]) then Key := #0;
  end
  else
    if not CharInSet(Key, ['0'..'9', #8, #13, #27]) then Key := #0;
end;
procedure TColorPickerDlg.EditRGBChange(Sender: TObject);
var
  R, G, B: Integer;
begin
  if FUpdating then Exit;
  R := StrToIntDef(FEditR.Text, -1);
  G := StrToIntDef(FEditG.Text, -1);
  B := StrToIntDef(FEditB.Text, -1);
  if (R >= 0) and (R <= 255) and (G >= 0) and (G <= 255) and (B >= 0) and (B <= 255) then
  begin
    FUpdating := True;
    try
      ApplyRGB(Byte(R), Byte(G), Byte(B), False);
    finally
      FUpdating := False;
    end;
  end;
end;
procedure TColorPickerDlg.EditRGBExit(Sender: TObject);
var
  R, G, B: Integer;
  FocusEdit: TEdit;
begin
  if FUpdating then Exit;
  FocusEdit := Sender as TEdit;
  R := StrToIntDef(FEditR.Text, -1);
  G := StrToIntDef(FEditG.Text, -1);
  B := StrToIntDef(FEditB.Text, -1);
  if (R < 0) or (R > 255) or (G < 0) or (G > 255) or (B < 0) or (B > 255) then
  begin
    Application.MessageBox(PChar('Invalid RGB value!' + sLineBreak +
      'Each component must be between 0 and 255.'), PChar('Error'), MB_OK or MB_ICONERROR);
    FUpdating := True;
    try
      ApplyRGB(FLastR, FLastG, FLastB, True);
    finally
      FUpdating := False;
    end;
    FocusEdit.SetFocus; FocusEdit.SelectAll;
    Exit;
  end;
  FUpdating := True;
  try
    ApplyRGB(Byte(R), Byte(G), Byte(B), True);
  finally
    FUpdating := False;
  end;
end;
procedure TColorPickerDlg.EditHSLChange(Sender: TObject);
var
  H, S, L: Integer;
begin
  if FUpdating then Exit;
  H := StrToIntDef(FEditH.Text, -1);
  S := StrToIntDef(FEditS.Text, -1);
  L := StrToIntDef(FEditL.Text, -1);
  if (H >= 0) and (H <= 359) and (S >= 0) and (S <= 100) and (L >= 0) and (L <= 100) then
  begin
    FUpdating := True;
    try
      ApplyHSL(H, S, L, False);
    finally
      FUpdating := False;
    end;
  end;
end;
procedure TColorPickerDlg.EditHSLExit(Sender: TObject);
var
  H, S, L: Integer;
  FocusEdit: TEdit;
begin
  if FUpdating then Exit;
  FocusEdit := Sender as TEdit;
  H := StrToIntDef(FEditH.Text, -1);
  S := StrToIntDef(FEditS.Text, -1);
  L := StrToIntDef(FEditL.Text, -1);
  if (H < 0) or (H > 359) or (S < 0) or (S > 100) or (L < 0) or (L > 100) then
  begin
    Application.MessageBox(PChar('Invalid HSL value!' + sLineBreak +
      'H = 0..359 S = 0..100 L = 0..100'), PChar('Error'), MB_OK or MB_ICONERROR);
    FUpdating := True;
    try
      ApplyRGB(FLastR, FLastG, FLastB, True);
    finally
      FUpdating := False;
    end;
    FocusEdit.SetFocus; FocusEdit.SelectAll;
    Exit;
  end;
  FUpdating := True;
  try
    ApplyHSL(H, S, L, True);
  finally
    FUpdating := False;
  end;
end;
procedure TColorPickerDlg.EditHexChange(Sender: TObject);
var
  Raw, Clean: string;
  i, Val: Integer;
  R, G, B: Byte;
  HasInvalid: Boolean;
begin
  if FUpdating then Exit;
  Raw := Trim(FEditHex.Text);
  Clean := '';
  HasInvalid := False;
  for i := 1 to Length(Raw) do
  begin
    if CharInSet(Raw[i], ['0'..'9', 'A'..'F', 'a'..'f']) then
      Clean := Clean + UpCase(Raw[i])
    else
      HasInvalid := True;
  end;
  if HasInvalid then
  begin
    Application.MessageBox(PChar('Invalid hexadecimal value!' + sLineBreak +
      'Only 0-9 and A-F are allowed.'), PChar('Error'), MB_OK or MB_ICONERROR);
    FUpdating := True;
    try
      ApplyRGB(FLastR, FLastG, FLastB, True);
    finally
      FUpdating := False;
    end;
    FEditHex.SetFocus; FEditHex.SelectAll;
    Exit;
  end;
  if Clean = '' then Exit;
  while Length(Clean) < 6 do Clean := '0' + Clean;
  if Length(Clean) > 6 then Clean := Copy(Clean, Length(Clean) - 5, 6);
  if not TryStrToInt('$' + Clean, Val) then Exit;
  R := Byte((Val shr 16) and $FF);
  G := Byte((Val shr 8) and $FF);
  B := Byte(Val and $FF);
  FUpdating := True;
  try
    ApplyRGB(R, G, B, True, False);
  finally
    FUpdating := False;
  end;
end;
procedure TColorPickerDlg.InitScreenCache;
var
  DC, MemDC: HDC;
  Bmp, OldBmp: HBITMAP;
  ScreenWidth, ScreenHeight: Integer;
  BitmapInfo: TBitmapInfo;
  BitsSize: Integer;
begin
  FreeScreenCache;
  FVirtualLeft := GetSystemMetrics(SM_XVIRTUALSCREEN);
  FVirtualTop := GetSystemMetrics(SM_YVIRTUALSCREEN);
  ScreenWidth := GetSystemMetrics(SM_CXVIRTUALSCREEN);
  ScreenHeight := GetSystemMetrics(SM_CYVIRTUALSCREEN);
  if ScreenWidth <= 0 then ScreenWidth := Screen.Width;
  if ScreenHeight <= 0 then ScreenHeight := Screen.Height;
  if (ScreenWidth <= 0) or (ScreenHeight <= 0) then Exit;
  FScreenWidth := ScreenWidth;
  FScreenHeight := ScreenHeight;
  DC := GetDC(0);
  if DC = 0 then Exit;
  try
    MemDC := CreateCompatibleDC(DC);
    if MemDC = 0 then Exit;
    try
      Bmp := CreateCompatibleBitmap(DC, ScreenWidth, ScreenHeight);
      if Bmp = 0 then Exit;
      try
        OldBmp := SelectObject(MemDC, Bmp);
        try
          if not BitBlt(MemDC, 0, 0, ScreenWidth, ScreenHeight, DC, FVirtualLeft, FVirtualTop, SRCCOPY) then Exit;
          FillChar(BitmapInfo, SizeOf(BitmapInfo), 0);
          BitmapInfo.bmiHeader.biSize := SizeOf(TBitmapInfoHeader);
          BitmapInfo.bmiHeader.biWidth := ScreenWidth;
          BitmapInfo.bmiHeader.biHeight := -ScreenHeight;
          BitmapInfo.bmiHeader.biPlanes := 1;
          BitmapInfo.bmiHeader.biBitCount := 32;
          BitmapInfo.bmiHeader.biCompression := BI_RGB;
          BitsSize := ScreenWidth * ScreenHeight * 4;
          GetMem(FScreenBits, BitsSize);
          if GetDIBits(MemDC, Bmp, 0, ScreenHeight, FScreenBits, BitmapInfo, DIB_RGB_COLORS) = 0 then
          begin
            FreeMem(FScreenBits);
            FScreenBits := nil;
            Exit;
          end;
          FScreenCacheValid := True;
        finally
          SelectObject(MemDC, OldBmp);
        end;
      finally
        DeleteObject(Bmp);
      end;
    finally
      DeleteDC(MemDC);
    end;
  finally
    ReleaseDC(0, DC);
  end;
end;
procedure TColorPickerDlg.FreeScreenCache;
begin
  if FScreenBits <> nil then
  begin
    FreeMem(FScreenBits);
    FScreenBits := nil;
  end;
  FScreenCacheValid := False;
  FScreenWidth := 0;
  FScreenHeight := 0;
end;
function TColorPickerDlg.GetPixelFast(X, Y: Integer; out R, G, B: Byte): Boolean;
var
  PixelPtr: PByte;
  Offset: Integer;
  LocalX, LocalY: Integer;
begin
  Result := False;
  R := 0; G := 0; B := 0;
  if not FScreenCacheValid or (FScreenBits = nil) then Exit;
  LocalX := X - FVirtualLeft;
  LocalY := Y - FVirtualTop;
  if (LocalX < 0) or (LocalX >= FScreenWidth) or (LocalY < 0) or (LocalY >= FScreenHeight) then Exit;
  Offset := (LocalY * FScreenWidth + LocalX) * 4;
  PixelPtr := PByte(NativeUInt(FScreenBits) + NativeUInt(Offset));
  B := PixelPtr^;
  G := (PixelPtr + 1)^;
  R := (PixelPtr + 2)^;
  Result := True;
end;
procedure TColorPickerDlg.BtnColorPickClick(Sender: TObject);
begin
  if FEyeDropperActive then DeactivateEyeDropper else ActivateEyeDropper;
end;
procedure TColorPickerDlg.ActivateEyeDropper;
begin
  if FEyeDropperActive then Exit;
  InitScreenCache;
  if not FScreenCacheValid then
  begin
    Application.MessageBox(PChar('Screen color could not be read. Please try again.'),
      PChar('Color Pick'), MB_OK or MB_ICONWARNING);
    Exit;
  end;
  FEyeDropperActive := True;
  FColorReady := False;
  FLastMouseX := -1;
  FLastMouseY := -1;
  FOverlayForm := TForm.CreateNew(Self);
  with FOverlayForm do
  begin
    BorderStyle := bsNone;
    FormStyle := fsStayOnTop;
    Position := poDesigned;
    Left := FVirtualLeft; Top := FVirtualTop;
    Width := FScreenWidth; Height := FScreenHeight;
    Color := clBlack;
    AlphaBlend := True;
    AlphaBlendValue := 1;
    DoubleBuffered := True;
    Cursor := crCross;
    ShowHint := False;
    OnMouseMove := OverlayMouseMove;
    OnMouseDown := OverlayMouseDown;
    OnKeyDown := OverlayKeyDown;
    KeyPreview := True;
    SetWindowPos(Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);
    Show;
    BringToFront;
    SetFocus;
  end;
  FUpdateTimer.Enabled := True;
  FPrevCursor := Screen.Cursor;
  Screen.Cursor := crCross;
  FBtnColorPick.Caption := 'Cancel';
  FBtnColorPick.Font.Color := clRed;
  Caption := 'Click anywhere to pick color – ESC or Right-click to cancel';
end;
procedure TColorPickerDlg.DeactivateEyeDropper;
begin
  if not FEyeDropperActive then Exit;
  FEyeDropperActive := False;
  FUpdateTimer.Enabled := False;
  FColorReady := False;
  if Assigned(FOverlayForm) then
  begin
    FOverlayForm.Hide;
    FreeAndNil(FOverlayForm);
  end;
  FreeScreenCache;
  Screen.Cursor := FPrevCursor;
  FBtnColorPick.Caption := 'Color Pick';
  FBtnColorPick.Font.Color := clWindowText;
  Caption := 'Color Picker';
end;
procedure TColorPickerDlg.OverlayMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  ScreenPos: TPoint;
  R, G, B: Byte;
  NewColor: TColor;
begin
  if not FEyeDropperActive or not Assigned(FOverlayForm) then Exit;
  ScreenPos := FOverlayForm.ClientToScreen(Point(X, Y));
  if (ScreenPos.X = FLastMouseX) and (ScreenPos.Y = FLastMouseY) then Exit;
  FLastMouseX := ScreenPos.X;
  FLastMouseY := ScreenPos.Y;
  if GetPixelFast(ScreenPos.X, ScreenPos.Y, R, G, B) then
  begin
    NewColor := RGB(R, G, B);
    if NewColor <> FLastPickedColor then
    begin
      FLastPickedColor := NewColor;
      FColorLock.Enter;
      try
        FQueuedColor := NewColor;
        FQueuedR := R; FQueuedG := G; FQueuedB := B;
        FColorReady := True;
      finally
        FColorLock.Leave;
      end;
    end;
  end;
end;
procedure TColorPickerDlg.OverlayMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ScreenPos: TPoint;
begin
  if not FEyeDropperActive or not Assigned(FOverlayForm) then Exit;
  if Button = mbLeft then
  begin
    ScreenPos := FOverlayForm.ClientToScreen(Point(X, Y));
    PickColorAtScreenPos(ScreenPos);
    DeactivateEyeDropper;
  end
  else if Button = mbRight then
    DeactivateEyeDropper;
end;
procedure TColorPickerDlg.OverlayKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
  begin
    DeactivateEyeDropper;
    Key := 0;
  end;
end;
procedure TColorPickerDlg.UpdateTimerTick(Sender: TObject);
begin
  ProcessQueuedColor;
end;
procedure TColorPickerDlg.ProcessQueuedColor;
var
  R, G, B: Byte;
  Hh, Ss, Ll: Integer;
begin
  // *** ONLY update New swatch + text fields. Never touch FSV / FHue ***
  if not FEyeDropperActive or not FColorReady then Exit;
  FColorLock.Enter;
  try
    if not FColorReady then Exit;
    R := FQueuedR; G := FQueuedG; B := FQueuedB;
    FColorReady := False;
  finally
    FColorLock.Leave;
  end;
  FNewSwatch.Color := RGB(R, G, B);
  FEditR.Text := IntToStr(R);
  FEditG.Text := IntToStr(G);
  FEditB.Text := IntToStr(B);
  FEditHex.Text := Format('%.2X%.2X%.2X', [R, G, B]);
  Hh := 0;
  RGBtoHSLValues(R, G, B, Hh, Ss, Ll);
  FEditH.Text := IntToStr(Hh);
  FEditS.Text := IntToStr(Ss);
  FEditL.Text := IntToStr(Ll);
  FNewSwatch.Invalidate;
end;
procedure TColorPickerDlg.PickColorAtScreenPos(const ScreenPos: TPoint);
var
  R, G, B: Byte;
begin
  if not FEyeDropperActive then Exit;
  if GetPixelFast(ScreenPos.X, ScreenPos.Y, R, G, B) then
  begin
    FLastPickedColor := RGB(R, G, B);
    FUpdating := True;
    try
      ApplyRGB(R, G, B, True);
    finally
      FUpdating := False;
    end;
  end;
end;
class function TColorPickerDlg.Execute(const ATitle, AOKCaption: string; var AColor: TColor): Boolean;
var
  Dlg: TColorPickerDlg;
  OwnerForm: TCustomForm;
begin
  OwnerForm := Screen.ActiveCustomForm;
  if (OwnerForm = nil) or (OwnerForm is TColorPickerDlg) then
    OwnerForm := Application.MainForm;
  Dlg := TColorPickerDlg.Create(OwnerForm);
  try
    Dlg.Caption := ATitle;
    Dlg.FBtnOK.Caption := AOKCaption;
    Dlg.Position := poOwnerFormCenter;
    Dlg.InitFromColor(AColor);
    Result := (Dlg.ShowModal = mrOk);
    if Result then AColor := Dlg.FNewSwatch.Color;
  finally
    Dlg.Free;
  end;
end;
end.