coolor.pas.svn-base

来自「TFormDesigner allows you move and resize」· SVN-BASE 代码 · 共 2,148 行 · 第 1/4 页

      end;
      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
  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;
  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
  trbHue.Position:=udnHue.Position;
  UpdateSaturation;
  UpdateBrightness;
  UpdateColor;
end;

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

procedure TfrmCoolorDialog.udnBrightnessChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  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);
begin
  trbRed.Position:=udnRed.Position;