coolor.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

begin
  if not FLockRecurse then trbRed.Position:=udnRed.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnGreenChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbGreen.Position:=udnGreen.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnBlueChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbBlue.Position:=udnBlue.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.trbRGBChange(Sender: TObject);
begin
  UpdateRGBUpDown;
end;

procedure TfrmCoolorDialog.edtRedChange(Sender: TObject);
begin
  try
    trbRed.Position:=StrToInt(edtRed.Text);
  except
    trbRed.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtGreenChange(Sender: TObject);
begin
  try
    trbGreen.Position:=StrToInt(edtGreen.Text);
  except
    trbGreen.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtBlueChange(Sender: TObject);
begin
  try
    trbBlue.Position:=StrToInt(edtBlue.Text);
  except
    trbBlue.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pntCyanPaint(Sender: TObject);
var
  i: Integer;
begin
  with Sender as TPaintBox,Canvas do
    for i:=0 to Pred(Width) do
    begin
      Pen.Color:=RGB(255-255*i div Width,255,255);
      MoveTo(i,0);
      LineTo(i,Height);
    end;
end;

procedure TfrmCoolorDialog.pntMagentaPaint(Sender: TObject);
var
  i: Integer;
begin
  with Sender as TPaintBox,Canvas do
    for i:=0 to Pred(Width) do
    begin
      Pen.Color:=RGB(255,255-255*i div Width,255);
      MoveTo(i,0);
      LineTo(i,Height);
    end;
end;

procedure TfrmCoolorDialog.pntYellowPaint(Sender: TObject);
var
  i: Integer;
begin
  with Sender as TPaintBox,Canvas do
    for i:=0 to Pred(Width) do
    begin
      Pen.Color:=RGB(255,255,255-255*i div Width);
      MoveTo(i,0);
      LineTo(i,Height);
    end;
end;

procedure TfrmCoolorDialog.trbCMYChange(Sender: TObject);
begin
  UpdateCMYUpDown;
end;

procedure TfrmCoolorDialog.udnCyanChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbCyan.Position:=udnCyan.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnMagentaChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbMagenta.Position:=udnMagenta.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnYellowChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbYellow.Position:=udnYellow.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtCyanExit(Sender: TObject);
begin
  edtCyan.Text:=IntToStr(trbCyan.Position);
end;

procedure TfrmCoolorDialog.edtMagentaExit(Sender: TObject);
begin
  edtMagenta.Text:=IntToStr(trbMagenta.Position);
end;

procedure TfrmCoolorDialog.edtYellowExit(Sender: TObject);
begin
  edtYellow.Text:=IntToStr(trbYellow.Position);
end;

procedure TfrmCoolorDialog.edtCyanChange(Sender: TObject);
begin
  try
    trbCyan.Position:=StrToInt(edtCyan.Text);
  except
    trbCyan.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtMagentaChange(Sender: TObject);
begin
  try
    trbMagenta.Position:=StrToInt(edtMagenta.Text);
  except
    trbMagenta.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtYellowChange(Sender: TObject);
begin
  try
    trbYellow.Position:=StrToInt(edtYellow.Text);
  except
    trbYellow.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pntCMYMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  TRB: TTrackBar;
begin
  with Sender as TPaintBox do
  begin
    case Tag of
      1: TRB:=trbCyan;
      2: TRB:=trbMagenta;
    else TRB:=trbYellow;
    end;
    TRB.Position:=255*X div Width;
    TRB.SetFocus;
    UpdateCMYUpDown;
    UpdateColor;
  end;
end;

procedure TfrmCoolorDialog.pntGrayPaint(Sender: TObject);
var
  i: Integer;
begin
  with Sender as TPaintBox,Canvas do
    for i:=0 to Pred(Width) do
    begin
      Pen.Color:=MakeGrayColor(255*i div Width);
      MoveTo(i,0);
      LineTo(i,Height);
    end;
end;

procedure TfrmCoolorDialog.UpdateGrayUpDown;
begin
  udnGray.Position:=trbGray.Position;
  edtGray.Update;
end;

procedure TfrmCoolorDialog.trbGrayChange(Sender: TObject);
begin
  UpdateGrayUpDown;
end;

procedure TfrmCoolorDialog.edtGrayExit(Sender: TObject);
begin
  edtGray.Text:=IntToStr(trbGray.Position);
end;

procedure TfrmCoolorDialog.udnGrayChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbGray.Position:=udnGray.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pntGrayMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  with Sender as TPaintBox do
  begin
    trbGray.Position:=255*X div Width;
    trbGray.SetFocus;
    UpdateGrayUpDown;
    UpdateColor;
  end;
end;

procedure TfrmCoolorDialog.edtGrayChange(Sender: TObject);
begin
  try
    trbGray.Position:=StrToInt(edtGray.Text);
  except
    trbGray.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.FormCreate(Sender: TObject);
begin
  UpdateSysColors;
  SetRGB(FResultRGB);
  UpdateNamesCheckBox;
end;

function TfrmCoolorDialog.GetIndexColor(I: Integer): Integer;
begin
  case I of
    0: Result:=COLOR_3DDKSHADOW;
    1: Result:=COLOR_3DFACE;
    2: Result:=COLOR_3DHIGHLIGHT;
    3: Result:=COLOR_3DLIGHT;
    4: Result:=COLOR_3DSHADOW;
    5: Result:=COLOR_ACTIVEBORDER;
    6: Result:=COLOR_ACTIVECAPTION;
    7: Result:=COLOR_APPWORKSPACE;
    8: Result:=COLOR_DESKTOP;
    9: Result:=COLOR_BTNTEXT;
    10: Result:=COLOR_CAPTIONTEXT;
    11: Result:=COLOR_GRAYTEXT;
    12: Result:=COLOR_HIGHLIGHT	;
    13: Result:=COLOR_HIGHLIGHTTEXT;
    14: Result:=COLOR_INACTIVEBORDER;
    15: Result:=COLOR_INACTIVECAPTION;
    16: Result:=COLOR_INACTIVECAPTIONTEXT;
    17: Result:=COLOR_INFOBK;
    18: Result:=COLOR_INFOTEXT;
    19: Result:=COLOR_MENU;
    20: Result:=COLOR_MENUTEXT;
    21: Result:=COLOR_SCROLLBAR;
    22: Result:=COLOR_WINDOW;
    23: Result:=COLOR_WINDOWFRAME;
    24: Result:=COLOR_WINDOWTEXT;
  else Result:=0;
  end;
end;

procedure TfrmCoolorDialog.lsbWindowsDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  OldColor: TColor;
begin
  if not (odFocused in State) then
    with Control as TListBox,Items,Canvas,Rect do
    begin
      FillRect(Rect);
      TextOut(Left+ItemHeight+8,Top,Items[Index]);
      OldColor:=Brush.Color;
      Brush.Color:=GetSysColor(Integer(Objects[Index]));
      Pen.Color:=Font.Color;
      Rectangle(Left+2,Top+2,ItemHeight+2,Bottom-2);
      Brush.Color:=OldColor;
    end;
end;

procedure TfrmCoolorDialog.lsbWindowsClick(Sender: TObject);
begin
  UpdateColor;
end;

procedure TfrmCoolorDialog.WMSysColorChange(var Message: TMessage);
begin
  UpdateSysColors;
  UpdateColor;
end;

procedure TfrmCoolorDialog.UpdateSysColors;
var
  i: Integer;
begin
  with lsbWindows,Items do
    for i:=0 to Pred(Count) do Objects[i]:=Pointer(GetIndexColor(i));
end;

procedure TfrmCoolorDialog.UpdateInfo;

var
  GE: Boolean;

  function FormatColor(Names: array of string; Values: array of Real): string;
  var
    i: Integer;
  begin
    Result:='';
    for i:=0 to High(Names) do
    begin
      if chbNames.Checked then Result:=Result+Names[i]+'=';
      case rgrNumbers.ItemIndex of
        0: Result:=Result+IntToStr(Round(Values[i]));
        1: Result:=Result+IntToHex(Round(Values[i]),2);
      end;
      if i<>High(Names) then
      begin
        if chbComma.Checked then Result:=Result+',';
        if chbSpace.Checked then Result:=Result+' ';
      end;
    end;
  end;

begin
  with pnlColor do
  begin
    with ColorToHSB(Color) do lblHSBValue.Caption:=FormatColor(['Hue','Saturation','Brightness'],[Hue,Saturation,Brightness]);
    with ColorToRGB(Color) do lblRGBValue.Caption:=FormatColor(['Red','Green','Blue'],[Red,Green,Blue]);
    with ColorToCMY(Color) do lblCMYValue.Caption:=FormatColor(['Cyan','Magenta','Yellow'],[Cyan,Magenta,Yellow]);
    with ColorToCMYK(Color) do lblCMYKValue.Caption:=FormatColor(['Cyan','Magenta','Yellow','Black'],[Cyan,Magenta,Yellow,Black]);
    GE:=RGBGray(ColorToRGB(Color));
    sbtGray.Visible:=GE;
    lblGrayTitle.Visible:=GE;
    lblGrayValue.Visible:=GE;
    lblGrayValue.Caption:=FormatColor(['Brightness'],[FResultRGB.Red]);
  end;
end;

procedure TfrmCoolorDialog.UpdateNamesCheckBox;
var
  E: Boolean;
begin
  E:=chbSpace.Checked or chbComma.Checked;
  if not E then chbNames.Checked:=False;
  chbNames.Enabled:=E;
end;

procedure TfrmCoolorDialog.eveInfoClick(Sender: TObject);
begin
  UpdateNamesCheckBox;
  UpdateInfo;
end;

procedure TfrmCoolorDialog.chbNamesClick(Sender: TObject);
begin
  UpdateInfo;
end;

procedure TfrmCoolorDialog.sbtHSBClick(Sender: TObject);
begin
  Clipboard.AsText:=lblHSBValue.Caption;
end;

procedure TfrmCoolorDialog.sbtRGBClick(Sender: TObject);
begin
  Clipboard.AsText:=lblRGBValue.Caption;
end;

procedure TfrmCoolorDialog.sbtCMYClick(Sender: TObject);
begin
  Clipboard.AsText:=lblCMYValue.Caption;
end;

procedure TfrmCoolorDialog.sbtGrayClick(Sender: TObject);
begin
  Clipboard.AsText:=lblGrayValue.Caption;
end;

function TfrmCoolorDialog.GetCollectedColor(Index: Integer): TColor;
var
  PNL: TPanel;
begin
  PNL:=FindComponent('pnl'+IntToStr(Index)) as TPanel;
  Result:=PNL.Color;
end;

procedure TfrmCoolorDialog.SetCollectedColor(Index: Integer;
  Value: TColor);
var
  PNL: TPanel;
begin
  PNL:=FindComponent('pnl'+IntToStr(Index)) as TPanel;
  PNL.Color:=Value;
end;

function TfrmCoolorDialog.GetResultColor: TColor;
begin
  Result:=RGBToColor(GetRGB);
end;

procedure TfrmCoolorDialog.SetResultColor(Value: TColor);
begin
  FResultRGB:=ColorToRGB(Value);
  SetRGB(FResultRGB);
end;

procedure TfrmCoolorDialog.SetRefColor(Value: TColor);
begin
  if Value<>pnlReferenceColor.Color then
  begin
    pnlReferenceColor.Color:=Value;
    UpdateColor;
  end;
end;

function TfrmCoolorDialog.GetRefColor: TColor;
begin
  Result:=pnlReferenceColor.Color;
end;

procedure TfrmCoolorDialog.btnHelpClick(Sender: TObject);
begin
  if FAutoHelpContext then Application.HelpContext(Succ(HelpContext)+pgcSystems.ActivePage.Tag)
  else Application.HelpContext(HelpContext);
end;

function GetDelta(Color: TColor; RGB: TRGB): Real;
begin
  with ColorToRGB(Color) do
    Result:=RGB.Red*Abs(Red-RGB.Red)/255+RGB.Green*Abs(Green-RGB.Green)/255+RGB.Blue*Abs(Blue-RGB.Blue)/255;
end;

procedure TfrmCoolorDialog.sbtRoundClick(Sender: TObject);
var
  X,Y,XMin,YMin: Integer;
  Delta,DeltaMin: Real;
begin
  DeltaMin:=3*255;
  XMin:=-1;
  YMin:=-1;
  for Y:=0 to 11 do
    for X:=0 to 17 do
    begin
      Delta:=GetDelta(GetInternetColor(X,Y),FResultRGB);
      if Delta<DeltaMin then
      begin
        DeltaMin:=Delta;
        XMin:=X;
        YMin:=Y;
      end;
    end;
  SetRGB(ColorToRGB(GetInternetColor(XMin,YMin)));
end;

procedure TfrmCoolorDialog.sbtRoundGrayClick(Sender: TObject);
var
  X,Y,XMin,YMin: Integer;
  Delta,DeltaMin: Real;
  HSB: THSB;
begin
  DeltaMin:=3*255;
  XMin:=-1;
  YMin:=-1;
  for Y:=0 to 11 do
    for X:=0 to 17 do
    begin
      HSB:=RGBToHSB(FResultRGB);
      with HSB do HSB:=MakeHSB(Hue,0,Brightness);
      Delta:=GetDelta(GetInternetColor(X,Y),HSBToRGB(HSB));
      if Delta<DeltaMin then
      begin
        DeltaMin:=Delta;
        XMin:=X;
        YMin:=Y;
      end;
    end;
  SetRGB(ColorToRGB(GetInternetColor(XMin,YMin)));
end;

constructor TfrmCoolorDialog.Create(AOwner: TComponent);
begin
  inherited Create(Application);
  FCoolorDialog:=TCoolorDialog(AOwner);
end;

{ TCoolorDialog }

constructor TCoolorDialog.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited Create(AOwner);
  FVisiblePages:=[pageVGA,pageHSB,pageRGB,pageCMY,pageCMYK];
  FActivePage:=pageVGA;
  FCtl3D:=True;
  FReferenceColor:=clWhite;
  FCaption:='Color';
  for i:=1 to UserColorCount do FUserColors[i]:=clSilver;
end;

function TCoolorDialog.Execute: Boolean;
{$IFDEF DIRECTCMYK}
var
  ICMYKColor: TCMYKColor;
{$ENDIF}
begin
  if not Assigned(FDialog) then
  begin
    FDialog:=TfrmCoolorDialog.Create(Self);
    with FDialog do
    try
      btnOk.Caption:='OK';
      btnCancel.Caption:='Cancel';
      SetProperties;
      if Assigned(FOnShow) then FOnShow(Self);
      Result:=ShowModal=mrOk;
      if Assigned(FOnClose) then FOnClose(Self);
      if Result then
      begin
        {$IFDEF DIRECTCMYK}