scolordialog.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

unit sColorDialog;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  sSkinProvider, StdCtrls, Buttons, sBitBtn, ExtCtrls, sPanel, Mask,
  sMaskEdit, sCurrencyEdit, sLabel, sConst, sSpeedButton, sGraphUtils,
  sCustomComboEdit, sCurrEdit;

type
  TColorArray = array of TColor;

  TsColorDialogForm = class(TForm)
    sSkinProvider1: TsSkinProvider;
    sBitBtn1: TsBitBtn;
    sBitBtn2: TsBitBtn;
    ColorPanel: TsPanel;
    GradPanel: TsPanel;
    SelectedPanel: TsPanel;
    sREdit: TsCurrencyEdit;
    sGEdit: TsCurrencyEdit;
    sBEdit: TsCurrencyEdit;
    sBitBtn3: TsBitBtn;
    sBitBtn4: TsBitBtn;
    sLabel1: TsLabel;
    sLabel2: TsLabel;
    sHEdit: TsCurrencyEdit;
    sSEdit: TsCurrencyEdit;
    sVEdit: TsCurrencyEdit;
    MainPal: TsColorsPanel;
    AddPal: TsColorsPanel;
    sEditDecimal: TsCurrencyEdit;
    sEditHex: TsMaskEdit;
    sLabel4: TsLabel;
    sLabel5: TsLabel;
    sLabel6: TsLabel;
    sBitBtn5: TsBitBtn;
    sSpeedButton1: TsSpeedButton;
    procedure sBitBtn2Click(Sender: TObject);
    procedure sBitBtn1Click(Sender: TObject);
    procedure CreateExtBmp;
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure ColorPanelPaint(Sender: TObject; Canvas: TCanvas);
    procedure ColorPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ColorPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ColorPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    procedure GradPanelPaint(Sender: TObject; Canvas: TCanvas);
    procedure GradPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure GradPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure GradPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    procedure MainPalChange(Sender: TObject);
    procedure sEditHexKeyPress(Sender: TObject; var Key: Char);
    function GetColorCoord(C : TsColor) : integer;
    procedure FormPaint(Sender: TObject);
    procedure sEditHexChange(Sender: TObject);
    procedure sEditDecimalChange(Sender: TObject);
    procedure sHEditChange(Sender: TObject);
    procedure sREditChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sBitBtn4Click(Sender: TObject);
    procedure sBitBtn5Click(Sender: TObject);
    procedure sBitBtn3Click(Sender: TObject);
    procedure sSpeedButton1Click(Sender: TObject);
    procedure PickFormPaint(Sender: TObject);
    procedure PickFormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PickFormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure PickFormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure MainPalDblClick(Sender: TObject);
    procedure AddPalDblClick(Sender: TObject);
  public
    TmpBmp : TBitmap;
    ExtBmp : TBitmap;
    TopColors : TColorArray;
    Owner : TColorDialog;
    PickPanel : TPanel;
    procedure SetMarker;
    procedure PaintMarker(mX, mY : integer);
    procedure PaintCursor(mX, mY : integer; Canvas : TCanvas);
    function GradToColor(Coord : integer) : TColor;
    procedure SetCurrentColor(c : TColor);
    procedure SetInternalColor(h : integer; s : real);
    procedure SetColorFromEdit(Color : TColor; var Flag : boolean);
    procedure ExitPanels;
    procedure InitLngCaptions;
    function MarkerRect : TRect;
  end;

const
  bWidth = 0;
  dblWidth = bWidth * 0;

var
  sColorDialogForm: TsColorDialogForm;
  InternalColor, PickColor : TColor;
  SelectedHsv : TsHSV;
  ColorCoord : TPoint;
  ExPressed, GradPressed : boolean;
  j, GradY, CurrCustomIndex : integer;
  UseCoords : boolean;
  ColorChanging, HexChanging, DecChanging, HsvChanging, RgbChanging : boolean;
  b : TBitmap;

implementation

uses math, sCommonData, acntUtils, sDialogs, sStrings;

{$R *.DFM}

{procedure AddColorToArray(A : TColorArray; C : TColor);
begin
  SetLength(A, Length(A) + 1);
  A[Length(A) - 1] := C;
end;}

procedure TsColorDialogForm.sBitBtn2Click(Sender: TObject);
begin
  ModalResult := mrCancel;
end;

procedure TsColorDialogForm.sBitBtn1Click(Sender: TObject);
begin
  ModalResult := mrOk;
end;

procedure TsColorDialogForm.ColorPanelPaint(Sender: TObject; Canvas: TCanvas);
begin
  BitBlt(Canvas.Handle, 0, 0, ExtBmp.Width, ExtBmp.Height, ExtBmp.Canvas.Handle, 0, 0, SRCCOPY);
  if ExPressed then exit;
  if UseCoords
    then PaintCursor(ColorCoord.x, ColorCoord.y, Canvas)
    else PaintCursor(SelectedHsv.h * ColorPanel.Width div 360, Round((1 - SelectedHsv.s) * ColorPanel.Height), Canvas)
end;

procedure TsColorDialogForm.CreateExtBmp;
var
  x, y : integer;
  ImgWidth, ImgHeight : integer;
begin
  ImgWidth := ColorPanel.Width - dblWidth;
  ImgHeight := ColorPanel.Height - dblWidth;

  ExtBmp := TBitmap.Create;
  ExtBmp.Width := ImgWidth;
  ExtBmp.Height := ImgHeight;
  ExtBmp.PixelFormat := pf24bit;

  for y := 0 to ImgHeight - 1 do begin
    for x := 0 to ImgWidth - 1 do begin
      ExtBmp.Canvas.Pixels[x, y] := Hsv2Rgb(x * 360 / ImgWidth, 1 - y / ImgHeight, 1 - y / (ImgHeight * 3)).C;
    end
  end;
end;

procedure TsColorDialogForm.FormShow(Sender: TObject);
begin
  SetCurrentColor(ColorToRGB(TsColorDialog(Owner).Color));
  TsColorDialog(Owner).DoShow
end;

procedure TsColorDialogForm.ColorPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  R : TRect;
  P : TPoint;
begin
  ColorPanel.SetFocus;
  ExPressed := True;
  SetInternalColor(Round(x * 360 / ColorPanel.Width), 1 - y / ColorPanel.Height);
  ColorPanel.SkinData.BGChanged := True;
  ColorPanel.Repaint;

  P := ColorPanel.ClientToScreen(Point(0, 0));
  R := Rect(0, 0, ColorPanel.Width, ColorPanel.Height);
  OffsetRect(R, P.x, P.y);
  ClipCursor(@R);
end;

procedure TsColorDialogForm.GradPanelPaint(Sender: TObject; Canvas: TCanvas);
var
  x, y : integer;
  RStep, GStep, BStep : real;
  R, G, B : real;
  c : TsColor;
  ImgWidth, ImgHeight : integer;
begin
  c.C := InternalColor;
  R := 255; G := 255; B := 255;
  ImgWidth := GradPanel.Width - dblWidth;
  ImgHeight := GradPanel.Height - dblWidth;
  y := 0;
  RStep := (255 - c.R) / (ImgHeight div 2); GStep := (255 - c.G) / (ImgHeight div 2); BStep := (255 - c.B) / (ImgHeight div 2);
  while y < (ImgHeight - 1) div 2 do begin
    R := R - RStep; G := G - GStep; B := B - BStep;
    c.R := max(min(round(R), 255), 0); c.G := max(min(round(G), 255), 0); c.B := max(min(round(B), 255), 0);
    for x := 0 to ImgWidth - 1 do Canvas.Pixels[x, y] := c.C;
    inc(y)
  end;
  RStep := c.R / (ImgHeight div 2); GStep := c.G / (ImgHeight div 2); BStep := c.B / (ImgHeight div 2);
  while y < ImgHeight do begin
    R := R - RStep; G := G - GStep; B := B - BStep;
    c.R := max(min(round(R), 255), 0); c.G := max(min(round(G), 255), 0); c.B := max(min(round(B), 255), 0);
    for x := 0 to ImgWidth - 1 do Canvas.Pixels[x, y] := c.C;
    inc(y)
  end;
end;

procedure TsColorDialogForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeAndNil(TmpBmp);
  FreeAndNil(ExtBmp);
end;

procedure TsColorDialogForm.ColorPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if not ExPressed then Exit;
  SetInternalColor(Round(x * 360 / ColorPanel.Width), 1 - y / ColorPanel.Height);
end;

procedure TsColorDialogForm.GradPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  R : TRect;
  P : TPoint;
  UR : TRect;
begin
  GradPanel.SetFocus;
  GradPressed := True;
  GradY := Y;
  UseCoords := True;
  SetCurrentColor(GradToColor(y));
  UseCoords := False;

  P := GradPanel.ClientToScreen(Point(0, 0));
  R := Rect(0, 0, 8, GradPanel.Height - 1);
  OffsetRect(R, P.x + GradPanel.Width, P.y);
  UR := MarkerRect;
  RedrawWindow(Handle, @UR, 0, RDW_INVALIDATE or RDW_ERASE or RDW_UPDATENOW);
  ClipCursor(@R);
end;

procedure TsColorDialogForm.SetMarker;
var
  CI : TCacheInfo;
  c : TsColor;
begin
  GradPanel.SkinData.BGChanged := True;
  GradPanel.Repaint;
  CI := GetParentCache(sBitBtn1.SkinData);
  BitBlt(Canvas.Handle, GradPanel.Left + GradPanel.Width, GradPanel.Top - 5, 20, GradPanel.Height + 10, sSkinProvider1.SkinData.FCacheBmp.Canvas.Handle, GradPanel.Left + GradPanel.Width + CI.X, GradPanel.Top + CI.Y - 5, SRCCOPY);
  c.C := SelectedPanel.Color;
  GradY := GetColorCoord(c);
  PaintMarker(GradPanel.Left + GradPanel.Width, GradPanel.top + GradY);
end;

procedure TsColorDialogForm.PaintMarker(mX, mY: integer);
var
  x, y : integer;
  CI : TCacheInfo;
begin
  CI := GetParentCache(sBitBtn1.SkinData);

  if TmpBmp <> nil then BitBlt(sSkinProvider1.SkinData.FCacheBmp.Canvas.Handle,
         GradPanel.Left + GradPanel.Width + CI.X,
         GradPanel.Top - 5 + CI.Y,
         20,
         TmpBmp.Height,
         TmpBmp.Canvas.Handle,
         0,
         0, SRCCOPY);
  for y := 0 to 5 do for x := 0 to 5 do if x > y then Canvas.Pixels[mX + X, my + Y] := 0;
  for y := 0 to 5 do for x := 0 to 5 do if x > 5 - y then Canvas.Pixels[mX + X, my + Y - 5] := 0;
end;

procedure TsColorDialogForm.GradPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  UR : TRect;
begin
  ClipCursor(nil);
  GradPressed := False;
  if (sSkinProvider1.SkinData.SkinManager = nil) or not sSkinProvider1.SkinData.SkinManager.Active then begin
    UR := MarkerRect;
    RedrawWindow(Handle, @UR, 0, RDW_INVALIDATE or RDW_ERASE or RDW_UPDATENOW);
  end;
end;

procedure TsColorDialogForm.GradPanelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  UR : TRect;
begin
  if not GradPressed then Exit;
  if (sSkinProvider1.SkinData.SkinManager = nil) or not sSkinProvider1.SkinData.SkinManager.Active then begin
    UR := MarkerRect;
    RedrawWindow(Handle, @UR, 0, RDW_INVALIDATE or RDW_ERASE or RDW_UPDATENOW);
  end;
  GradY := Y;
  UseCoords := True;
  SetCurrentColor(GradToColor(y));
  UseCoords := False;
end;

procedure TsColorDialogForm.ColorPanelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  ClipCursor(nil);
  ExPressed := False;
  ColorPanel.SkinData.BGChanged := True;
  ColorPanel.Repaint;
end;

function TsColorDialogForm.GradToColor(Coord: integer): TColor;
var
  y : integer;
  RStep, GStep, BStep : real;
  R, G, B, id2 : real;
  c : TsColor;
  ImgHeight : integer;
begin
  Result := clWhite;
  c.C := InternalColor;
  R := 255; G := 255; B := 255;
  ImgHeight := GradPanel.Height - dblWidth;
  id2 := ImgHeight / 2;

  RStep := (255 - c.R) / id2; GStep := (255 - c.G) / id2; BStep := (255 - c.B) / id2;

  y := 0;
  while y < (ImgHeight - 1) div 2 do begin
    R := R - RStep; G := G - GStep; B := B - BStep;
    c.R := round(R); c.G := round(G); c.B := round(B);
    if y = Coord then begin
      if c.R < 3 then c.R := 0; if c.G < 3 then c.G := 0; if c.B < 3 then c.B := 0;
      if c.R > 253 then c.R := 255; if c.G > 253 then c.G := 255; if c.B > 253 then c.B := 255;
      Result := c.C;
      Exit;
    end;
    inc(y)
  end;

  RStep := c.R / id2; GStep := c.G / id2; BStep := c.B / id2;
  while y < ImgHeight - 1 do begin
    R := R - RStep; G := G - GStep; B := B - BStep;
    c.R := round(R); c.G := round(G); c.B := round(B);
    if y = Coord then begin
      Result := c.C;
      Exit;
    end;
    inc(y)
  end;
end;

procedure TsColorDialogForm.SetCurrentColor(c: TColor);
var
  sColor : TsColor;