coolor.pas

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

        if Assigned(FDialog) then
          with FDialog do
          begin
            if TDialogPage(pgcSystems.ActivePage.Tag)=pageCMYK then
            begin
              ICMYKColor:=CMYKToCMYKColor(MakeCMYK(trbKCyan.Position,trbKMagenta.Position,trbKYellow.Position,trbKBlack.Position));
              with FCoolorDialog do
                if Assigned(FOnGetCMYK) then FOnGetCMYK(Self,ICMYKColor);
            end;
          end;
        {$ENDIF}
        GetProperties;
      end
      else
      begin
        FUserColors:=RUserColors;
        FColor:=RColor;
        FReferenceColor:=RReferenceColor;
      end;
      DoApply(True);
    finally
      Free;
      FDialog:=nil;
    end;
  end
  else
  begin
    raise ECoolorDialogException.Create('TCoolorDialog is already visible.');
    Result:=False;
  end;
end;

procedure TCoolorDialog.Show;
begin
  if not Assigned(FDialog) then
  begin
    FDialog:=TfrmCoolorDialog.Create(Self);
    with FDialog do
    begin
      ModalResult:=mrNone;
      if FAutoApply then
      begin
        btnOk.Caption:='O&K';
        btnCancel.Caption:='&Cancel'
      end
      else
      begin
        btnOk.Caption:='&Apply';
        btnCancel.Caption:='&Close';
      end;
      SetProperties;
      OnClose:=OnDialogClose;
      btnOk.OnClick:=OnApplyButton;
      btnCancel.OnClick:=OnCloseButton;
      if Assigned(FOnShow) then FOnShow(Self);
      Show;
    end;
  end
  else raise ECoolorDialogException.Create('TCoolorDialog is already visible.');
end;

procedure TCoolorDialog.DoApply(ForSure: Boolean);
begin
  if Assigned(FOnApply) and (ForSure or FAutoApply) then FOnApply(Self);
end;

procedure TCoolorDialog.OnDialogClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(FDialog) then
  begin
    if Assigned(FOnClose) then FOnClose(Self);
    if FDialog.ModalResult<>mrOk then
    begin
      FUserColors:=RUserColors;
      FColor:=RColor;
      FReferenceColor:=RReferenceColor;
      DoApply(False);
    end;
    FDialog.Release;
    FDialog:=nil;
  end;
end;

procedure TCoolorDialog.OnApplyButton(Sender: TObject);
{$IFDEF DIRECTCMYK}
var
  ICMYKColor: TCMYKColor;
{$ENDIF}
begin
  if  FAutoApply and Assigned(FDialog) then FDialog.ModalResult:=mrOk;
  {$IFDEF DIRECTCMYK}
  if Assigned(FDialog) then
    with FDialog do
    begin
      if TDialogPage(pgcSystems.ActivePage.Tag)=pageCMYK then
      begin
        ICMYKColor:=CMYKToCMYKColor(MakeCMYK(trbKCyan.Position,trbKMagenta.Position,trbKYellow.Position,trbKBlack.Position));
        with FCoolorDialog do
          if Assigned(FOnGetCMYK) then FOnGetCMYK(Self,ICMYKColor);
      end;
  end;
  {$ENDIF}
  GetProperties;
  DoApply(True);
  if FAutoApply and Assigned(FDialog) then FDialog.Close;
end;

procedure TCoolorDialog.OnCloseButton(Sender: TObject);
begin
  if Assigned(FDialog) then FDialog.Close;
end;

procedure TCoolorDialog.SetColor(const Value: TColor);
begin
  FColor:=Value;
  if Assigned(FDialog) then FDialog.SetResultColor(Value);
  DoApply(False);
end;

procedure TCoolorDialog.SetReferenceColor(const Value: TColor);
begin
  FReferenceColor:=Value;
  if Assigned(FDialog) then FDialog.SetRefColor(Value);
end;

function TCoolorDialog.GetHSBColor: THSBColor;
begin
  Result:=HSBToHSBColor(ColorToHSB(Color));
end;

procedure TCoolorDialog.SetHSBColor(const Value: THSBColor);
begin
  Color:=HSBToColor(HSBColorToHSB(Value));
end;

function TCoolorDialog.GetRGBColor: TRGBColor;
begin
  Result:=RGBToRGBColor(ColorToRGB(Color));
end;

procedure TCoolorDialog.SetRGBColor(const Value: TRGBColor);
begin
  Color:=RGBToColor(RGBColorToRGB(Value));
end;

function TCoolorDialog.GetRGBHex: TRGBHex;
begin
  Result:=ColorToRGBHex(Color);
end;

procedure TCoolorDialog.SetRGBHex(const Value: TRGBHex);
begin
  Color:=RGBHexToColor(Value);
end;

function TCoolorDialog.GetCMYColor: TCMYColor;
begin
  Result:=CMYToCMYColor(ColorToCMY(Color));
end;

procedure TCoolorDialog.SetCMYColor(const Value: TCMYColor);
begin
  Color:=CMYToColor(CMYColorToCMY(Value));
end;

function TCoolorDialog.GetCMYKColor: TCMYKColor;
begin
  Result:=CMYKToCMYKColor(ColorToCMYK(Color));
end;

procedure TCoolorDialog.SetCMYKColor(const Value: TCMYKColor);
begin
  Color:=CMYKToColor(CMYKColorToCMYK(Value));
end;

function TCoolorDialog.GetHTMLColor: THTMLColor;
begin
  Result:=ColorToHTML(Color);
end;

procedure TCoolorDialog.SetHTMLColor(const Value: THTMLColor);
begin
  Color:=HTMLToColor(Value);
end;

function TCoolorDialog.GetUserColor(Index: Integer): TColor;
begin
  Result:=FUserColors[Index];
end;

procedure TCoolorDialog.SetUserColor(Index: Integer;
  const Value: TColor);
begin
  FUserColors[Index]:=Value;
end;

procedure TCoolorDialog.SetAutoApply(const Value: Boolean);
begin
  if Value<>FAutoApply then
  begin
    FAutoApply:=Value;
    if Assigned(FDialog) then
      with FDialog do
        if FAutoApply then
        begin
          btnOk.Caption:='O&K';
          btnCancel.Caption:='&Cancel'
        end
        else
        begin
          btnOk.Caption:='&Apply';
          btnCancel.Caption:='&Close';
        end;
  end;
end;

procedure TCoolorDialog.SetStayOnTop(const Value: Boolean);
begin
  if Value<>FStayOnTop then
  begin
    FStayOnTop:=Value;
    if Assigned(FDialog) then
      with FDialog do
        if FStayOnTop then FormStyle:=fsStayOnTop
        else FormStyle:=fsNormal;
  end;
end;

procedure TCoolorDialog.SetVisiblePages(const Value: TDialogPages);
begin
  if Value<>FVisiblePages then
  begin
    FVisiblePages:=Value;
    if Assigned(FDialog) then
      with FDialog do
      begin
        tshVGA.TabVisible:=pageVGA in VisiblePages;
        tshInternet.TabVisible:=pageInternet in VisiblePages;
        tshHSB.TabVisible:=pageHSB in VisiblePages;
        tshRGB.TabVisible:=pageRGB in VisiblePages;
        tshCMY.TabVisible:=pageCMY in VisiblePages;
        tshCMYK.TabVisible:=pageCMYK in VisiblePages;
        tshGray.TabVisible:=pageGray in VisiblePages;
        tshWindows.TabVisible:=pageWindows in VisiblePages;
        tshInfo.TabVisible:=pageInfo in VisiblePages;
      end;
  end;
end;

procedure TCoolorDialog.SetActivePage(const Value: TDialogPage);
begin
  if Value<>FActivePage then
  begin
    FActivePage:=Value;
    if Assigned(FDialog) then
      with FDialog,pgcSystems do
        case Self.ActivePage of
          pageVGA: if tshVGA.TabVisible then ActivePage:=tshVGA;
          pageInternet: if tshInternet.TabVisible then ActivePage:=tshInternet;
          pageHSB: if tshHSB.TabVisible then ActivePage:=tshHSB;
          pageRGB: if tshRGB.TabVisible then ActivePage:=tshRGB;
          pageCMY: if tshCMY.TabVisible then ActivePage:=tshCMY;
          pageCMYK: if tshCMYK.TabVisible then ActivePage:=tshCMYK;
          pageGray: if tshGray.TabVisible then ActivePage:=tshGray;
          pageWindows: if tshWindows.TabVisible then ActivePage:=tshWindows;
          pageInfo: if tshInfo.TabVisible then ActivePage:=tshInfo;
        end;
  end;
end;

procedure TCoolorDialog.SetCtl3D(const Value: Boolean);
begin
  if Value<>FCtl3D then
  begin
    FCtl3D:=Value;
    if Assigned(FDialog) then FDialog.Ctl3D:=FCtl3D;
  end;
end;

procedure TCoolorDialog.SetHelpButton(const Value: Boolean);
begin
  if Value<>FHelpButton then
  begin
    FHelpButton:=Value;
    if Assigned(FDialog) then FDialog.btnHelp.Visible:=FHelpButton;
  end;
end;

procedure TCoolorDialog.SetAutoHelpContext(const Value: Boolean);
begin
  if Value<>FAutoHelpContext then
  begin
    FAutoHelpContext:=Value;
    if Assigned(FDialog) then FDialog.FAutoHelpContext:=AutoHelpContext;
  end;
end;

procedure TCoolorDialog.SetHelpContext(const Value: THelpContext);
begin
  if Value<>FHelpContext then
  begin
    FHelpContext:=Value;
    if Assigned(FDialog) then FDialog.HelpContext:=FHelpContext;
  end;
end;

procedure TCoolorDialog.SetCaption(const Value: string);
begin
  if Value<>Caption then
  begin
    FCaption:=Value;
    if Assigned(FDialog) then FDialog.Caption:=FCaption;
  end;
end;

function TCoolorDialog.GetDialog: TForm;
begin
  Result:=FDialog;
end;

function TCoolorDialog.GetHandle: HWND;
begin
  if Assigned(FDialog) then Result:=FDialog.Handle
  else Result:=0;
end;

procedure TCoolorDialog.SetProperties;
var
  i: Integer;
begin
  if Assigned(FDialog) then
    with FDialog do
    begin
      if FStayOnTop then FormStyle:=fsStayOnTop
      else FormStyle:=fsNormal;
      HelpContext:=Self.HelpContext;
      FAutoHelpContext:=AutoHelpContext;
      Ctl3D:=FCtl3D;
      btnHelp.Visible:=HelpButton;
      for i:=1 to UserColorCount do
        SetCollectedColor(i,UserColors[i]);
      RUserColors:=FUserColors;
      tshVGA.TabVisible:=pageVGA in VisiblePages;
      tshInternet.TabVisible:=pageInternet in VisiblePages;
      tshHSB.TabVisible:=pageHSB in VisiblePages;
      tshRGB.TabVisible:=pageRGB in VisiblePages;
      tshCMY.TabVisible:=pageCMY in VisiblePages;
      tshCMYK.TabVisible:=pageCMYK in VisiblePages;
      tshGray.TabVisible:=pageGray in VisiblePages;
      tshWindows.TabVisible:=pageWindows in VisiblePages;
      tshInfo.TabVisible:=pageInfo in VisiblePages;
      with pgcSystems do
        case Self.ActivePage of
          pageVGA: if tshVGA.TabVisible then ActivePage:=tshVGA;
          pageInternet: if tshInternet.TabVisible then ActivePage:=tshInternet;
          pageHSB: if tshHSB.TabVisible then ActivePage:=tshHSB;
          pageRGB: if tshRGB.TabVisible then ActivePage:=tshRGB;
          pageCMY: if tshCMY.TabVisible then ActivePage:=tshCMY;
          pageCMYK: if tshCMYK.TabVisible then ActivePage:=tshCMYK;
          pageGray: if tshGray.TabVisible then ActivePage:=tshGray;
          pageWindows: if tshWindows.TabVisible then ActivePage:=tshWindows;
          pageInfo: if tshInfo.TabVisible then ActivePage:=tshInfo;
        end;
      pnlReferenceColor.Color:=FReferenceColor;
      pnlColor.Color:=FColor;
      SetResultColor(Self.Color);
      RColor:=Self.Color;
      RReferenceColor:=Self.ReferenceColor;
      SetRefColor(ReferenceColor);
      UpdateInfo;
      Caption:=FCaption;
    end;
end;

procedure TCoolorDialog.GetProperties;
var
  i: Integer;
begin
  if Assigned(FDialog) then
    with FDialog do
    begin
      Self.ActivePage:=TDialogPage(pgcSystems.ActivePage.Tag);
      for i:=1 to UserColorCount do
        UserColors[i]:=GetCollectedColor(i);
      Self.FColor:=GetResultColor;
      FReferenceColor:=GetRefColor;
    end;
end;

procedure TfrmCoolorDialog.trbCMYKChange(Sender: TObject);
begin
  UpdateCMYKUpDown;
end;

procedure TfrmCoolorDialog.edtKCyanChange(Sender: TObject);
begin
  try
    trbKCyan.Position:=StrToInt(edtKCyan.Text);
  except
    trbKCyan.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtKMagentaChange(Sender: TObject);
begin
  try
    trbKMagenta.Position:=StrToInt(edtKMagenta.Text);
  except
    trbKMagenta.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtKYellowChange(Sender: TObject);
begin
  try
    trbKYellow.Position:=StrToInt(edtKYellow.Text);
  except
    trbKYellow.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtKBlackChange(Sender: TObject);
begin
  try
    trbKBlack.Position:=StrToInt(edtKBlack.Text);
  except
    trbKBlack.Position:=0;
  end;
  UpdateColor;
end;

procedure TfrmCoolorDialog.edtKCyanExit(Sender: TObject);
begin
  edtKCyan.Text:=IntToStr(trbKCyan.Position);
end;

procedure TfrmCoolorDialog.edtKMagentaExit(Sender: TObject);
begin
  edtKMagenta.Text:=IntToStr(trbKMagenta.Position);
end;

procedure TfrmCoolorDialog.edtKYellowExit(Sender: TObject);
begin
  edtKYellow.Text:=IntToStr(trbKYellow.Position);
end;

procedure TfrmCoolorDialog.edtKBlackExit(Sender: TObject);
begin
  edtKBlack.Text:=IntToStr(trbKBlack.Position);
end;

procedure TfrmCoolorDialog.udnKCyanChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbKCyan.Position:=udnKCyan.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnKMagentaChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbKMagenta.Position:=udnKMagenta.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnKYellowChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbKYellow.Position:=udnKYellow.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.udnKBlackChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  if not FLockRecurse then trbKBlack.Position:=udnKBlack.Position;
  UpdateColor;
end;

procedure TfrmCoolorDialog.pntCMYKMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  TRB: TTrackBar;
begin
  with Sender as TPaintBox do
  begin
    case Tag of
      1: TRB:=trbKCyan;
      2: TRB:=trbKMagenta;
      3: TRB:=trbKYellow;
    else TRB:=trbKBlack;
    end;
    TRB.Position:=100*X div Width;
    TRB.SetFocus;
    UpdateCMYKUpDown;
    UpdateColor;
  end;
end;

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

procedure TfrmCoolorDialog.pgcSystemsChanging(Sender: TObject;
  var AllowChange: Boolean);
{$IFDEF DIRECTCMYK}
var
  ICMYKColor: TCMYKColor;
{$ENDIF}
begin
  {$IFDEF DIRECTCMYK}
  if Assigned(FCoolorDialog) then
  begin
    if TDialogPage(pgcSystems.ActivePage.Tag)=pageCMYK then
    begin
      ICMYKColor:=CMYKToCMYKColor(MakeCMYK(trbKCyan.Position,trbKMagenta.Position,trbKYellow.Position,trbKBlack.Position));
      with FCoolorDialog do
        if Assigned(FOnGetCMYK) then FOnGetCMYK(Self,ICMYKColor);
    end;
  end;
  {$ENDIF}
end;

end.