⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 scolorselect.pas

📁 Alpha Controls 界面控件包
💻 PAS
字号:
unit sColorSelect;
{$I sDefs.inc}

interface

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

type
  TsColorSelect = class(TsSpeedButton)
{$IFNDEF NOTFORHELP}
  private
    FColorValue : TColor;
    FOnChange : TNotifyEvent;
    FImgWidth: integer;
    FImgHeight: integer;
    procedure SetColorValue(const Value: TColor);
    procedure SetImgHeight(const Value: integer);
    procedure SetImgWidth(const Value: integer);
//    procedure MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    ColorDialog : TColorDialog;
    constructor Create (AOwner: TComponent); override;
    procedure Click; override;
    procedure DrawGlyph; override;
    function GlyphWidth : integer; override;
    function GlyphHeight : integer; override;
    procedure Paint; override;
  published
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
{$ENDIF} // NOTFORHELP
    property ColorValue : TColor read FColorValue write SetColorValue;
    property ImgWidth : integer read FImgWidth write SetImgWidth default 15;
    property ImgHeight : integer read FImgHeight write SetImgHeight default 15;
  end;

implementation

uses sDialogs, sCommonData, sThirdParty;

{ TsColorSelect }

procedure TsColorSelect.Click;
var
  cd : TColorDialog;
begin
  if ColorDialog = nil then begin
    if not UseStdDialogs then cd := TsColorDialog.Create(Self) else cd := TColorDialog.Create(Self);
  end
  else cd := ColorDialog;
  cd.Color := ColorValue;
  if cd.Execute then begin
    ColorValue := cd.Color;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
  if ColorDialog <> cd then FreeAndNil(cd);
  inherited Click;
end;

constructor TsColorSelect.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FImgHeight := 15;
  FImgWidth := 15;
end;

procedure TsColorSelect.DrawGlyph;
begin
  SkinData.FCacheBmp.Canvas.Pen.Style := psClear;
  SkinData.FCacheBmp.Canvas.Brush.Color := ColorValue;
  SkinData.FCacheBmp.Canvas.Rectangle(ImgRect);
end;

function TsColorSelect.GlyphHeight: integer;
begin
  Result := ImgHeight;
end;

function TsColorSelect.GlyphWidth: integer;
begin
  Result := ImgWidth;
end;

{procedure TsColorSelect.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  cd : TColorDialog;
begin
  if PtInRect(ClientRect, Point(x, y)) then begin
    if ColorDialog = nil then begin
      if not UseStdDialogs then cd := TsColorDialog.Create(Self) else cd := TColorDialog.Create(Self);
    end
    else cd := ColorDialog;
    cd.Color := ColorValue;
    if cd.Execute then begin
      ColorValue := cd.Color;
      if Assigned(FOnChange) then FOnChange(Self);
    end;
    if ColorDialog <> cd then cd.Free;
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;}

procedure TsColorSelect.Paint;
begin
  inherited;
  if not SkinData.Skinned then begin
    Canvas.Pen.Style := psClear;
    Canvas.Brush.Color := ColorValue;
    Canvas.Rectangle(ImgRect);
  end;
end;

procedure TsColorSelect.SetColorValue(const Value: TColor);
begin
  FColorValue := Value;
  SkinData.Invalidate;
end;

procedure TsColorSelect.SetImgHeight(const Value: integer);
begin
  if FImgHeight <> Value then begin
    FImgHeight := Value;
    SkinData.Invalidate;
  end;
end;

procedure TsColorSelect.SetImgWidth(const Value: integer);
begin
  if FImgWidth <> Value then begin
    FImgWidth := Value;
    SkinData.Invalidate;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -