XPスタイルで色設定 (ID:37426)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

真琴：「はい、おじいちゃん、シャツのボタン付けたよ」
勝爺：「おぅ、そうか、ごくろうさん、同じ白い色のボタンあったのか？」
真琴：「それが、白のボタンがなくて…、だから、この色でもいいよね？」
勝爺：「ん？なんだ？ この色しかなかったのか？」
真琴：「明るいピンクだから見たカンジＯＫでしょ、うん大丈夫、カワイイし…^^」

http://makoto.me.land.to/img/snapshot.png

uses ..., GraphUtil, XPMan, Themes;

type
  TButtonColor = (bcNONE, bcRED, bcGREEN, bcBLUE);
  TButton = class(StdCtrls.TButton)
  private
    FButton: TThemedButton;
    ButtonColor: TButtonColor;
    procedure WndProc(var Msg: TMessage); override;
    procedure DrawButton;
  public
    constructor Create(AOwner: TComponent); override;
  end;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
 ........................

constructor TButton.Create(AOwner: TComponent);
begin
  inherited;
  FButton := tbPushButtonNormal;
  ButtonColor := bcRED;
end;

procedure TButton.WndProc(var Msg: TMessage);
begin
  inherited;
  case Msg.Msg of
   WM_PAINT: DrawButton;
   WM_MOUSEMOVE: FButton := tbPushButtonHot;
   WM_LBUTTONDOWN: FButton := tbPushButtonPressed;
   WM_LBUTTONUP: FButton := tbPushButtonHot;
   WM_MOUSELEAVE: FButton := tbPushButtonNormal;
  end;
end;

procedure TButton.DrawButton;
var
  R: TRect;
  Detail: TThemedElementDetails;
  c1, c2, c3, c4: TColor;
  DC: HDC;
  aCanvas: TCanvas;
begin
  if not(ThemeServices.ThemesEnabled) then exit;
  case ButtonColor of
   bcNONE : exit;
   bcRED  : begin c1 := $ffddff; c2 := $ff66ff; c3 := $ffeeff; c4 := $ff77ff; end;
   bcGREEN: begin c1 := $ddffdd; c2 := $77ff77; c3 := $eeffee; c4 := $88ff88; end;
   bcBLUE : begin c1 := $ffffcc; c2 := $ffdd66; c3 := $ffffdd; c4 := $ffff77; end;
  end;
  DC := GetDC(Self.Handle);
  aCanvas := TCanvas.Create;
  aCanvas.Handle := DC;
  aCanvas.Font.Assign(Self.Font);
  R := ClientRect;
  if not Enabled then FButton := tbPushButtonDisabled;
  Detail := ThemeServices.GetElementDetails(FButton);
  InflateRect(R, -3, -3);
  if Focused or (FButton = tbPushButtonHot) then InflateRect(R, -1, -1);
  case FButton of
   // 通常のボタン状態
   tbPushButtonNormal   : GradientFillCanvas(aCanvas, c1, c2, R, gdVertical);
   // カーソルがボタン上にある
   tbPushButtonHot      : GradientFillCanvas(aCanvas, c3, c4, R, gdVertical);
   // ボタンが押されている
   tbPushButtonPressed  : GradientFillCanvas(aCanvas, c2, c1, R, gdVertical);
   // ボタンが無効状態
   tbPushButtonDisabled : GradientFillCanvas(aCanvas, $eeeeee, $cccccc, R, gdVertical);
   // デフォルトのボタン
   tbPushButtonDefaulted: GradientFillCanvas(aCanvas, c1, c2, R, gdVertical);
  end;
  ThemeServices.DrawText(DC, Detail, Caption, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER, 0);
  ReleaseDC(Self.Handle, DC);
  aCanvas.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Button1.ButtonColor := bcRED;
  Button2.ButtonColor := bcBLUE;
  Button3.ButtonColor := bcGREEN;
end;

勝爺：「なに、カワイイだと？ …まぁいいか、…じゃチョット出かけてくるからな」
真琴：「夕方までには戻ってくるでしょ？ 晩ごはんの仕度しておくね？」
勝爺：「そうだな、じゃ、そうしてくれ、一人でも大丈夫か？」
真琴：「うん、いってらっしゃ〜い、…あれ？ 今ハルコさんの声が聞こえたような…」

←解決時は質問者本人がここをチェックしてください。

戻る