pickcolor.pas

强大的皮肤控件 能做出美观的界面

unit pickcolor;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TfrmPickColor = class(TForm)
    Panel1: TPanel;
    Bevel1: TBevel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Edit1: TEdit;
    Label1: TLabel;
    procedure BitBtn2Click(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    FPickColor: TColor;
    FPicking: boolean;
    procedure SetPickColor(const Value: TColor);
  public
    { Public declarations }
    property PickColor: TColor read FPickColor write SetPickColor;
  end;

var
  frmPickColor: TfrmPickColor;

implementation

uses Clipbrd;

{$R *.dfm}

procedure TfrmPickColor.BitBtn2Click(Sender: TObject);
begin
  FPicking := true;
  Screen.Cursor := crHandPoint;
  SetCapture(Handle);
end;

procedure TfrmPickColor.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  Canvas: TCanvas;
  P: TPoint;
begin
  if FPicking then
  begin
    Canvas := TCanvas.Create;
    Canvas.Handle := GetDC(0);

    P := ClientToScreen(Point(X, Y));
    Panel1.Color := Canvas.Pixels[P.X, P.Y];

    ReleaseDC(0, Canvas.Handle);
    Canvas.Handle := 0;
    Canvas.Free;
  end;
end;

procedure TfrmPickColor.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FPickColor := Panel1.Color;
  Edit1.Text := IntToStr(FPickColor);

  Clipboard.AsText := Edit1.Text;

  FPicking := false;
  Screen.Cursor := crDefault;
end;

procedure TfrmPickColor.SetPickColor(const Value: TColor);
begin
  FPickColor := Value;
  Panel1.Color := FPickColor;
end;

end.