Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2003年07月20日] [更新 2015年01月29日] 均等割付グラデーションボタンコンポーネント
均等割付グラデーションボタンコンポーネント
テストプログラム Others
動作確認等 Windows 7 U64(SP1) + Delphi XE(UP1) Pro







ラベルな用途とイメージの表示等


  • (1) TPanel に TEdit を配置.その左にラベルとして
  • (2) 本コンポに TEdit を配置し,キャプション位置調整
  • (3) クリックで色変更.クリック時の [Shift], [Ctrl] [Alt] キー状態を表示
  • (4) 画像の表示例
  • (5) 画像の表示例.Enabled = False の場合
  • (6) 単なるグラデーションパネル

図1
ラベルな用途

リスト1
テストプログラムのコード
unit OthersUnit;

interface

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

type
  TForm1 = class(TForm)
    plButton10: TplButton;
    plButton107: TplButton;
    plButton200: TplButton;
    Panel1: TPanel;
    Edit1: TEdit;
    plButton1: TplButton;
    Panel2: TPanel;
    Edit2: TEdit;
    plButton2: TplButton;
    StatusBar1: TStatusBar;
    plButton3: TplButton;
    Edit3: TEdit;
    plButton4: TplButton;
    procedure plButton10Exit(Sender: TObject);
    procedure plButton10Click(Sender: TObject);
    procedure plButton107MouseEnter(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure plButton107MouseLeave(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
   S : String;
  end;

var
  Form1: TForm1;

implementation

const
  Button16OriginColor = clSilver;

{$R *.DFM}

//=============================================================================
//  ボタンをクリックすると表面の色が変わる
//  フォーカスが移動すると元の色に戻る
//
//  [Alt],[Shift]または[Ctrl]を押したままクリックするとステータスバーにそのキ
//  ーの名前を表示する.
//=============================================================================
procedure TForm1.plButton10Click(Sender: TObject);
var
  ARect    : TRect;
  KeyState : TKeyboardState;
begin
  TplButton(Sender).GradBeginColor := $00C5EFE9;
  TplButton(Sender).GradEndColor   := $00C5EFE9;

  Windows.GetClientRect(StatusBar1.Handle, ARect);

  if GetKeyboardState(KeyState) then begin
    S := '';
    if KeyState[VK_MENU]    and $80 <> 0 then S := S + '[Alt]';
    if KeyState[VK_SHIFT]   and $80 <> 0 then S := S + '[Shift]';
    if KeyState[VK_CONTROL] and $80 <> 0 then S := S + '[Ctrl]';
    if S<>'' then S := ' '+S else S := ' ';

    with StatusBar1.Canvas do begin
      ARect.Left := ARect.Left + 1;
      ARect.Top  := ARect.Top+((ARect.Bottom - ARect.Top) - TextHeight(S)) div 2;
      FillRect(ARect);
      Font.Color := clBlue;
      DrawText(Handle, PChar(S), -1, ARect, DT_LEFT);
    end;
  end;
end;

//=============================================================================
//   フォーカスが移動したら保存しておいた元の色に戻す
//=============================================================================
procedure TForm1.plButton10Exit(Sender: TObject);
begin
  TplButton(Sender).GradBeginColor := Button16OriginColor;
  TplButton(Sender).GradEndColor   := Button16OriginColor;
end;

//=============================================================================
//  ボタンの上にマウスがきたらグラデーションを反転
//=============================================================================
procedure TForm1.plButton107MouseEnter(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  Temp : TColor;
begin
  Temp := TplButton(Sender).GradBeginColor;
  TplButton(Sender).GradBeginColor := TplButton(Sender).GradEndColor;
  TplButton(Sender).GradEndColor   := Temp;
end;

//=============================================================================
//  マウスがボタンから離れたらグラデーションを元に戻す
//=============================================================================
procedure TForm1.plButton107MouseLeave(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  Temp : TColor;
begin
  Temp := TplButton(Sender).GradBeginColor;
  TplButton(Sender).GradBeginColor := TplButton(Sender).GradEndColor;
  TplButton(Sender).GradEndColor   := Temp;
end;

end.