coolor.pas

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

      Result:=HSBToRGB(HSB);
    end;
    pageRGB:
      Result:=MakeRGB(trbRed.Position,trbGreen.Position,trbBlue.Position);
    pageCMY:
      Result:=CMYToRGB(MakeCMY(trbCyan.Position,trbMagenta.Position,trbYellow.Position));
    pageCMYK:
      Result:=CMYKToRGB(MakeCMYK(trbKCyan.Position,trbKMagenta.Position,trbKYellow.Position,trbKBlack.Position));
    pageGray:
      Result:=MakeGrayRGB(trbGray.Position);
    pageWindows:
      with lsbWindows,Items do
        if (Perform(LB_GETCURSEL,0,0)<>LB_ERR) and (ItemIndex<Count) then
          Result:=ColorToRGB(GetSysColor(Integer(Objects[ItemIndex])));
  end;
end;

procedure TfrmCoolorDialog.SetRGB(TheColor: TRGB);
var
  i,X,Y: Integer;
  ICMYKColor: TCMYKColor;

  function EqualPoint(Point1,Point2: TPoint): Boolean;
  begin
    Result:=(Point1.X=Point2.X) and (Point1.Y=Point2.Y);
  end;

  function FMod(X1,X2: Real): Real;
  begin
    Result:=X1/X2;
    Result:=Result-Int(Result);
  end;

  function AboutColor(Color: TColor; RGB: TRGB; Error: Integer): Boolean;
  begin
    with ColorToRGB(Color) do
      Result:=
        (Abs(RGB.Red-Red)<=Error) and
        (Abs(RGB.Green-Green)<=Error) and
        (Abs(RGB.Blue-Blue)<=Error);
  end;

begin
  FLockRecurse:=True;
  try
    case TDialogPage(pgcSystems.ActivePage.Tag) of
      pageVGA:
      begin
        with pnlVGADark do
          for i:=0 to Pred(ControlCount) do
            with Controls[i] as TPanel do
              if AboutColor(Color,TheColor,1) then Caption:=chSelected
              else Caption:='';
        with pnlVGALight do
          for i:=0 to Pred(ControlCount) do
            with Controls[i] as TPanel do
              if AboutColor(Color,TheColor,1) then Caption:=chSelected
              else Caption:='';
      end;
      pageInternet:
      begin
        for Y:=0 to 11 do
          for X:=0 to 17 do
            if AboutColor(GetInternetColor(X,Y),TheColor,0) then
            begin
              if EqualPoint(InternetColor,Point(X,Y)) then Exit;
              InternetColor:=Point(X,Y);
              UpdateInternet;
              UpdateColor;
              Exit;
            end;
        if not EqualPoint(InternetColor,Point(-1,-1)) then
        begin
          InternetColor:=Point(-1,-1);
          UpdateInternet;
        end;
      end;
      pageHSB:
        if not RGBEqual(GetRGB,TheColor) then
          with RGBToHSB(TheColor) do
          begin
            trbHue.Position:=Round(Hue);
            trbSaturation.Position:=Round(Saturation);
            trbBrightness.Position:=Round(Brightness);
            UpdateHSBUpDown;
            UpdateSaturation;
            UpdateBrightness;
          end;
      pageRGB:
        if not RGBEqual(GetRGB,TheColor) then
          with TheColor do
          begin
            trbRed.Position:=Round(Red);
            trbGreen.Position:=Round(Green);
            trbBlue.Position:=Round(Blue);
            UpdateRGBUpDown;
          end;
      pageCMY:
        if not RGBEqual(GetRGB,TheColor) then
          with RGBToCMY(TheColor) do
          begin
            trbCyan.Position:=Round(Cyan);
            trbMagenta.Position:=Round(Magenta);
            trbYellow.Position:=Round(Yellow);
            UpdateCMYUpDown;
          end;
      pageCMYK:
      begin
        ICMYKColor:=CMYKToCMYKColor(RGBToCMYK(TheColor));
        {$IFDEF DIRECTCMYK}
        if Assigned(FCoolorDialog) then
          with FCoolorDialog do
            if Assigned(FOnSetCMYK) then FOnSetCMYK(Self,ICMYKColor);
        {$ENDIF}
        with ICMYKColor do
        begin
          trbKCyan.Position:=Cyan;
          trbKMagenta.Position:=Magenta;
          trbKYellow.Position:=Yellow;
          trbKBlack.Position:=Black;
          UpdateCMYKUpDown;
        end;
      end;
      pageGray:
        if not RGBEqual(GetRGB,TheColor) then
        begin
          trbGray.Position:=Round(255*RGBToHSB(TheColor).Brightness/100);
          UpdateGrayUpDown;
        end;
      pageWindows:
        with lsbWindows do
        begin
          if TopIndex>0 then TopIndex:=0;
          if Perform(LB_GETCURSEL,0,0)<>LB_ERR then
          begin
            Perform(LB_SETCURSEL,0,0);
            Perform(LB_SETCURSEL,-1,0);
          end;
          if Showing then SetFocus;
        end;
      pageInfo: UpdateInfo;
    end;
  finally
    FLockRecurse:=True;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.UpdateColor;
begin
  with pnlColor do
  begin
    FResultRGB:=GetRGB;
    Color:=RGBToColor(FResultRGB);
    Update;
    if Assigned(FCoolorDialog) then
      with FCoolorDialog do
      begin
        if (FColor<>pnlColor.Color) or (FReferenceColor<>pnlReferenceColor.Color) then
        begin
          FReferenceColor:=pnlReferenceColor.Color;
          FColor:=pnlColor.Color;
          DoApply(False);
        end;
      end;
  end;
end;

procedure TfrmCoolorDialog.UpdateSaturation;
var
  i: Integer;
begin
  case TDialogPage(pgcSystems.ActivePage.Tag) of
    pageHSB:
      with pntSaturation,Canvas do
      begin
        for i:=0 to Pred(Width) do
        begin
          Pen.Color:=HSBToColor(MakeHSB(trbHue.Position,100*i div Width,100));
          MoveTo(i,0);
          LineTo(i,Height);
        end;
      end;
  end;
end;

procedure TfrmCoolorDialog.UpdateBrightness;
var
  i: Integer;
begin
  case TDialogPage(pgcSystems.ActivePage.Tag) of
    pageHSB:
      with pntBrightness,Canvas do
      begin
        for i:=0 to Pred(Width) do
        begin
          Pen.Color:=HSBToColor(MakeHSB(trbHue.Position,trbSaturation.Position,100*i div Width));
          MoveTo(i,0);
          LineTo(i,Height);
        end;
      end;
  end;
end;

procedure TfrmCoolorDialog.UpdateHSBUpDown;
begin
  udnHue.Position:=trbHue.Position;
  edtHue.Update;
  udnSaturation.Position:=trbSaturation.Position;
  edtSaturation.Update;
  udnBrightness.Position:=trbBrightness.Position;
  edtBrightness.Update;
end;

procedure TfrmCoolorDialog.edtPress(Sender: TObject; var Key: Char);
begin
  if not (Key in LegalChars) then
  begin
    Key:=#0;
    MessageBeep(0);
  end;
end;

procedure TfrmCoolorDialog.udnHueChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbHue.Position:=udnHue.Position;
  UpdateSaturation;
  UpdateBrightness;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnSaturationChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbSaturation.Position:=udnSaturation.Position;
  UpdateBrightness;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnBrightnessChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbBrightness.Position:=udnBrightness.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtHueChange(Sender: TObject);
begin
  try
    trbHue.Position:=StrToInt(edtHue.Text);
  except
    trbHue.Position:=0;
  end;
  UpdateSaturation;
  UpdateBrightness;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnClick(Sender: TObject;
  Button: TUDBtnType);
begin
  with (Sender as TUpDown).Associate as TEdit do
  begin
    SetFocus;
    SelectAll;
  end;
end;

procedure TfrmCoolorDialog.edtSaturationChange(Sender: TObject);
begin
  try
    trbSaturation.Position:=StrToInt(edtSaturation.Text);
  except
    trbSaturation.Position:=0;
  end;
  UpdateBrightness;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtBrightnessChange(Sender: TObject);
begin
  try
    trbBrightness.Position:=StrToInt(edtBrightness.Text);
  except
    trbBrightness.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtHueExit(Sender: TObject);
begin
  edtHue.Text:=IntToStr(trbHue.Position);
end;

procedure TfrmCoolorDialog.edtSaturationExit(Sender: TObject);
begin
  edtSaturation.Text:=IntToStr(trbSaturation.Position);
end;

procedure TfrmCoolorDialog.edtBrightnessExit(Sender: TObject);
begin
  edtBrightness.Text:=IntToStr(trbBrightness.Position);
end;

procedure TfrmCoolorDialog.pnlDragOver(Sender, Source: TObject;
  X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept:=Source=pnlColor;
end;

procedure TfrmCoolorDialog.pnlDragDrop(Sender, Source: TObject;
  X, Y: Integer);
begin
  (Sender as TPanel).Color:=(Source as TPanel).Color;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pntHueMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  trbHue.Position:=359*X div (pntHue.Width);
  trbHue.SetFocus;
  UpdateHSBUpDown;
  UpdateSaturation;
  UpdateBrightness;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pntSaturationMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  trbSaturation.Position:=101*X div (pntSaturation.Width);
  trbSaturation.SetFocus;
  UpdateHSBUpDown;
  UpdateBrightness;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pntBrightnessMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  trbBrightness.Position:=101*X div (pntBrightness.Width);
  trbBrightness.SetFocus;
  UpdateHSBUpDown;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pnlVGAClick(Sender: TObject);
var
  i: Integer;
begin
  with pnlVGADark do
    for i:=0 to Pred(ControlCount) do
      if Controls[i] is TPanel then
        with TPanel(Controls[i]) do Caption:='';
  with pnlVGALight do
    for i:=0 to Pred(ControlCount) do
      if Controls[i] is TPanel then
        with TPanel(Controls[i]) do Caption:='';
  (Sender as TPanel).Caption:=chSelected;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pnlCollectionClick(Sender: TObject);
begin
  with Sender as TPanel do
  begin
    SetRGB(ColorToRGB(Color));
    if pnlColor.Color<>Color then
    begin
      pnlColor.Color:=Color;
      FResultRGB:=ColorToRGB(Color);
    end;
  end;
  UpdateColor;
  UpdateInfo;
end;

procedure TfrmCoolorDialog.pgcSystemsChange(Sender: TObject);
{$IFDEF DIRECTCMYK}
var
  ICMYKColor: TCMYKColor;
{$ENDIF}
begin
  SetRGB(FResultRGB);
  {$IFDEF DIRECTCMYK}
  ICMYKColor:=CMYKToCMYKColor(ColorToCMYK(pnlColor.Color));
  if (TDialogPage(pgcSystems.ActivePage)=pageCMYK) and Assigned(FCoolorDialog) then
    with FCoolorDialog do
      if Assigned(FOnSetCMYK) then FOnSetCMYK(Self,ICMYKColor);
  {$ENDIF}
end;

function TfrmCoolorDialog.GetInternetColor(X,Y: Integer): TColor;
begin
  Result:=RGB($33*(2*(X div 6)+(Y div 6)),$33*(X mod 6),$33*(Y mod 6));
end;

procedure TfrmCoolorDialog.pntInternetPaint(Sender: TObject);
begin
  UpdateInternet;
end;

procedure TfrmCoolorDialog.pntInternetMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  CX,CY: Integer;
begin
  with pntInternet do
  begin
    for CX:=0 to 17 do
      if CX*Pred(Width) div 18>X then Break;
    for CY:=0 to 11 do
      if CY*Pred(Height) div 12>Y then Break;
  end;
  InternetColor:=Point(Pred(CX),Pred(CY));
  UpdateInternet;
  UpdateColor;
end;

procedure TfrmCoolorDialog.UpdateInternet;
const
  ColorBorder = 192;
var
  X,Y: Integer;
  R: TRect;
begin
  with pntInternet,Canvas do
  begin
    Brush.Style:=bsClear;
    Rectangle(-1,-1,Width,Height);
    for Y:=0 to 11 do
      for X:=0 to 17 do
      begin
        Brush.Color:=GetInternetColor(X,Y);
        Rectangle(X*Pred(Width) div 18,Y*Pred(Height) div 12,Succ(X)*Pred(Width) div 18,Succ(Y)*Pred(Height) div 12);
        if (InternetColor.X=X) and (InternetColor.Y=Y) then
        begin
          with ColorToRGB(Brush.Color) do
            if Red+Green+Blue/4>ColorBorder then Font.Color:=clBlack
            else Font.Color:=clWhite;
          SetBkMode(Handle,TRANSPARENT);
          R:=Rect(X*Pred(Width) div 18,Y*Pred(Height) div 12,Succ(X)*Pred(Width) div 18,Succ(Y)*Pred(Height) div 12);
          DrawText(Handle,chSelected,1,R,DT_SINGLELINE or DT_CENTER or DT_VCENTER);
        end;
      end;
  end;
end;

procedure TfrmCoolorDialog.pntRGBPaint(Sender: TObject);

var
  i: Integer;

  function ScaleColor(C: TColor; Value: Integer): TColor;
  begin
    with ColorToRGB(C) do
      Result:=RGB(Round(Value*Red/255),Round(Value*Green/255),Round(Value*Blue/255));
  end;

begin
  with Sender as TPaintBox,Canvas do
    for i:=0 to Pred(Width) do
    begin
      Pen.Color:=ScaleColor(Color,255*i div Width);
      MoveTo(i,0);
      LineTo(i,Height);
    end;
end;

procedure TfrmCoolorDialog.UpdateRGBUpDown;
begin
  udnRed.Position:=trbRed.Position;
  edtRed.Update;
  udnGreen.Position:=trbGreen.Position;
  edtGreen.Update;
  udnBlue.Position:=trbBlue.Position;
  edtBlue.Update;
end;

procedure TfrmCoolorDialog.UpdateCMYUpDown;
begin
  udnCyan.Position:=trbCyan.Position;
  edtCyan.Update;
  udnMagenta.Position:=trbMagenta.Position;
  edtMagenta.Update;
  udnYellow.Position:=trbYellow.Position;
  edtYellow.Update;
end;

procedure TfrmCoolorDialog.UpdateCMYKUpDown;
begin
  udnKCyan.Position:=trbKCyan.Position;
  edtKCyan.Update;
  udnKMagenta.Position:=trbKMagenta.Position;
  edtKMagenta.Update;
  udnKYellow.Position:=trbKYellow.Position;
  edtKYellow.Update;
  udnKBlack.Position:=trbKBlack.Position;
  edtKBlack.Update;
end;

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

procedure TfrmCoolorDialog.edtRedExit(Sender: TObject);
begin
  edtRed.Text:=IntToStr(trbRed.Position);
end;

procedure TfrmCoolorDialog.edtGreenExit(Sender: TObject);
begin
  edtGreen.Text:=IntToStr(trbGreen.Position);
end;

procedure TfrmCoolorDialog.edtBlueExit(Sender: TObject);
begin
  edtBlue.Text:=IntToStr(trbBlue.Position);
end;

procedure TfrmCoolorDialog.udnRedChanging(Sender: TObject;
  var AllowChange: Boolean);