unit MyColorPic;
//カラーピックコンポーネント V1.1  by Arihiko.

interface

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

type
  TMyColorPic = class(TCustomControl)
  private
    { Private 宣言 }
    FIro:TColor;
    FGetIro:TColor;
    //procedure SetIro(const Value: TColor);
    procedure WMKEYDOWN( var Msg : TWMKEYDOWN ); message CM_CHILDKEY;
    procedure btnIroGetClick(Sender: TObject);
    procedure bbtnColorPatanClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure bbtnOkClick(Sender: TObject);
  protected
    { Protected 宣言 }
    procedure Paint; override;
  public
    { Public 宣言 }
    constructor Create(AOwner : TComponent); override;
    destructor Destroy; override;
  published
    { Published 宣言 }
    property keteiIro: TColor read FGetIro {write SetIro}; //外部へ対する色(読取り)    
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TMyColorPic]);
end;

{ TMyColorPic }

const
  IROGETMES = '色取得中：止める時は[スペースキー]を押してください。';
  WAKUHABA = 320;
  WAKUTAKA = 165;
  IMGWAKU = 120;
  KUBUN = 10;
  PATANHINT = 'カラーパターン変更';
  PNLIROCAP = '取得色';
  PNLIROGETCAP = '決定色';
  BTNIROGETCAP = '色取得';
  BBTNOKHINT = '色を決定する';
  MEMOTEXT = '「色取得」ボタンをクリックすると、'+#13#10+
             'マウスポイントの色を取得します。'+#13#10+
             '取得を止めるには[スペースキー]'+#13#10+
             'を押してください。';
  LBLMIGICAP = '->';

var
  btnIroGet:TButton;
  image1:TImage;
  irogeting: boolean;
  Timer1 : TTimer;
  pnlIro:TPanel;
  pnlGetIro:TPanel;
  pnlBar1 : TPanel;
  rediro,greeniro,blueiro{,zeniro}: longint;
  bbtnColorPatan : TBitBtn;
  bbtnOk : TBitBtn;
  lblMigi:TLabel;
  memo1:Tlabel;//memo1:TMemo;

procedure TMyColorPic.bbtnOkClick(Sender: TObject);
begin //色決定ボタン
  FGetIro := FIro;//取得した色を決定色にする
  pnlGetIro.color := FGetIro;
end;

procedure TMyColorPic.WMKEYDOWN(var Msg: TWMKEYDOWN);
begin //スペースキーが押されたら色取得ボタン(トグル式)をクリックする
  with Msg do begin
    case CharCode of
      VK_SPACE :
        begin {↓ここにキーが押された時の処理を記述}
          //ShowMessage( 'TAB キーが押されました' );
          if irogeting then begin
            btnIrogetClick(Self);
            Result := 1; {←1:本来の処理をさせたくない場合, 0:本来の処理をさせたい場合}
          end;
        end;
    end;//case end
  end;//with end
  inherited;
end;
  
procedure TMyColorPic.bbtnColorPatanClick(Sender: TObject);
var
  i,j,x,y:integer;
begin //カラーパターンを変更する(ブロックをランダムな色にする)
  with image1.canvas do begin
    for i := 0 to (IMGWAKU div KUBUN - 1) do begin
      for j := 0 to (IMGWAKU div KUBUN - 1) do begin
        x := i*KUBUN;
        y := j*KUBUN;
        brush.Color := rgb(random(255),random(255),random(255));
        fillRect(rect(x,y,x+KUBUN,y+KUBUN));
      end;
    end
  end;
end;
  
procedure TMyColorPic.btnIroGetClick(Sender: TObject);
var
  i:integer;
begin //色を取得する(トグルスイッチ形式)ボタン
  irogeting := not irogeting;
  if irogeting then begin
    timer1.Enabled := true;
    with pnlBar1 do begin
      Color := clYellow;
      caption := IROGETMES;//色取得中・・・のメッセージを表示する
    end;
  end else begin
    with pnlBar1 do begin
      Color := clBtnface;
      caption := '';//メッセージを消す
    end;
    timer1.Enabled := false;
  end;
end;

//procedure TMyColorPic.SetIro(const Value: TColor);
//begin
//  Firo := Value;
//end;

procedure TMyColorPic.Timer1Timer(Sender: TObject);
var
  poi: tpoint;
  cdmy: tcolor;
  sdmy: string;
  xdmy,ydmy,dmy: word;
  i:integer;
begin //マウスカーソルポイントの色を取得する(タイマー1/10秒ごとに)
  if (not irogeting) then exit;
  try
    getcursorpos(poi);
    cdmy := getpixel(getdc(0),poi.x,poi.y);//screen zentai
    rediro := GetrValue(cdmy);//赤色成分
    greeniro := GetgValue(cdmy);//緑色成分
    blueiro := GetbValue(cdmy);//青色成分
    FIro := rediro + greeniro*256 + blueiro*256*256;//取得した色
    pnlIro.Color := FIro;
  except end;
end;

constructor TMyColorPic.Create(AOwner: TComponent);
begin //コンポーネント作成
  inherited create(AOwner);//↓

  //↓この１行を追加★これがないと親コントロールが無いと言われるよ
  Parent  := AOwner as TWinControl;

  {if csDesigning in componentState then} FIro := clWhite;
  {if csDesigning in componentState then} FGetIro := clWhite;

  randomize;
  width := WAKUHABA;//コンポーネントの幅
  height := WAKUTAKA;//コンポーネントの高さ

  with image1 do begin image1 := TImage.create(self); parent := self;
    Left := 192; Top := 8; Width := IMGWAKU; Height := IMGWAKU;
    canvas.brush.color := clTeal;
    canvas.FillRect(rect(0,0,width,height));
  end; //カラーパターンイメージ

  with btnIroGet do begin btnIroGet := TButton.create(self); parent := self;
    Left := 8; Top := 72; Width := 65; Height := 25;
    Caption := BTNIROGETCAP;
    TabOrder := 0;//最初にこのボタンにフォーカスを当てる
    OnClick := btnIroGetClick;
  end; //色取得ボタン

  with bbtnColorPatan do begin bbtnColorPatan := TBitBtn.create(self); parent := self;
    Left := 160; Top := 72; Width := 25; Height := 25;
    Hint := PATANHINT;
    ParentShowHint := False;
    ShowHint := True;
    //TabOrder := -1;
    OnClick := bbtnColorPatanClick;
    kind := bkRetry;
    modalResult := 0;//モーダルで閉じない
    caption := '';
    hint := PATANHINT;
  end; //カラーパターン変更ボタン

  with Timer1 do begin Timer1 := TTimer.Create(self); {parentは必要なし}
    Enabled := False;
    Interval := 100;
    OnTimer := Timer1Timer;
  end; //色取得タイマー

  with pnlIro do begin pnlIro := TPanel.create(self); parent := self;
    Left := 80; Top := 72; Width := 73; Height := 25;
    BorderStyle := bsSingle;
    Caption := PNLIROCAP;
    color := FIro;
    //TabOrder := 1;
  end; //取得色パネルの色を取得した色にする

  with pnlGetIro do begin pnlGetIro := TPanel.create(self); parent := self;
    Left := 80; Top := 104; Width := 73; Height := 25;
    BorderStyle := bsSingle;
    Caption := PNLIROGETCAP;
    color := FGetIro;
    //TabOrder := 1;
  end; //決定色パネルの色を決定した色にする

  with pnlBar1 do begin pnlBar1 := TPanel.create(self); parent := self;
    Left := 8; Top := 135; Width := 305; Height := 25;
    BorderStyle := bsSingle;
  end; //お知らせメッセージ表示パネル

  with bbtnOk do begin bbtnOk := TBitBtn.create(self); parent := self;
    Left := 8; Top := 104; Width := 49; Height := 25;
    Hint:= BBTNOKHINT;
    ShowHint := True;
    //TabOrder := -1;
    OnClick := bbtnOkClick;
    Kind := bkOK;
    modalResult := 0;//モーダルで閉じない
  end; //色決定ボタン

  with lblMigi do begin lblMigi := TLabel.create(self); parent := self;
    Left := 60; Top := 110; Width := 10; Height := 25;
    font.Size := 11;
    caption := LBLMIGICAP;
  end; //右矢印表示ラベル

  with Memo1 do begin Memo1 := TLabel.create(self); parent := self;
    Left := 8; Top := 8; Width := 180; Height := 57;
    //wordwrap := true;
    caption := MEMOTEXT;
    //ReadOnly := True;
    //TabOrder := -1;
  end; //操作説明メモ

  bbtnColorPatanClick(Self);//カラーパターン変更
  irogeting := false; //色取得中を「取得中でない」にする
end;//create end

destructor TMyColorPic.Destroy;
begin //コンポーネント消去
  image1.free;
  btnIroGet.free;
  bbtnColorPatan.free;
  pnlIro.free;
  pnlGetIro.free;
  pnlBar1.free;
  Timer1.free;
  bbtnOk.free;
  lblMigi.free;
  memo1.free;

  inherited Destroy;//↑
end;//destroy end

procedure TMyColorPic.Paint;
begin //コンポーネントペイント
  width := WAKUHABA;
  height := WAKUTAKA;

  with canvas do begin //コンポーネント全体をボタンフェイスの色にする
    Brush.color := clBtnface;
    FillRect(rect(0,0,width,height));
    pen.color := clBlack; //コンポーネントに黒色の外枠を描く
    Polyline([Point(1, 1), Point(width-1, 1), Point(width-1, height-1),
      Point(1, height-1), Point(1, 1)]);
  end; 

  pnlIro.color := FIro;//取得色パネルの色を取得色にする
  pnlGetIro.color := FGetIro;//決定色パネルの色を決定色にする

  inherited Paint;//設計時に描画
end;// paint end

//V1.1 2024/10/19 色変更ボタンや決定ボタンでフォームを閉じないように変更。

end.
