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

名前

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

本文 裕子：「こんにちは〜、マコト居る？」 真琴：「えっ？ あ、ユウコかぁ、…遊びにきたの？」 裕子：「ナニよ、誰か待ってたの？ …ねぇマコト、この前のアレ、ユウスケに教えてあげたら、"3色だけじゃつまらない、それに試したら色も違うし、エラーも出る"だって」 真琴：「え？ そう？ 何のエラー？ 使ってるDelphiのバージョンは？」 裕子：「バージョン？ ユウスケが使ってるのは、たしか…D6のPersonalとか」 真琴：「あぁ〜、ソレねぇ、Windows.pasのTTriVertexの定義に間違いがあるの」 裕子：「間違い？ どんな？」 真琴：「メンバーのRed,Greenなどの型がナゼかShortInt、ホントはWORDじゃないと…」 COLOR16 = Shortint; // ShortIntは間違いで、WORDが正しい _TRIVERTEX = packed record x: Longint; y: Longint; Red: COLOR16; Green: COLOR16; Blue: COLOR16; Alpha: COLOR16; end; TTriVertex = _TRIVERTEX; 真琴：「だから、TriVertex[0].Red:=$7800;とか書くと"定数値が範囲外"のエラーも」 裕子：「じゃあ、Windows.pasの間違い部分を書き換えないとダメなの？」 真琴：「うん、そうしてもイイけど、自分のユニットで正しく定義し直してもＯＫ」 裕子：「あ、そう、…あと、ボタンの色は3種類じゃなくて、もっと増やせないの？」 真琴：「色は TColorで指定するように変更したから自由な色が使えるようになったよ」 http://makoto.me.land.to/img/snapshot2.png 【Delphi7以前で、ThemeManagerとマニフェストファイルを使う場合】 uses ..., ThemeMgr, ThemeSrv; type TButton = class(StdCtrls.TButton) private FButton: TThemedButton; FBtnColor: TColor; FBgnColor: TColor; FEndColor: TColor; procedure WndProc(var Msg: TMessage); override; procedure SetBtnColor(Value: TColor); procedure DrawButton; published property BtnColor: TColor read FBtnColor write SetBtnColor; public constructor Create(AOwner: TComponent); override; end; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; Button4: TButton; ............. implementation type TGradientDirection = (gdHorizontal, gdVertical); type PTriVertex = ^TTriVertex; TTriVertex = packed record X, Y: LongInt; Red, Green, Blue, Alpha: WORD; end; TRIVERTEX = TTriVertex; _TRIVERTEX = TTriVertex; function GradientFill(DC: HDC; var Vertex: TTriVertex; NumVertex: ULONG; Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall; external 'GDI32.DLL' name 'GdiGradientFill'; function ColorRGBToHLS(clrRGB: TColorRef; var Hue, Luminance, Saturation: Word): BOOL; stdcall; external 'SHLWAPI.DLL' name 'ColorRGBToHLS'; //function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef; stdcall; //external 'SHLWAPI.DLL' name 'ColorHLSToRGB'; threadvar CachedRGBToHLSclrRGB: TColorRef; CachedRGBToHLSHue: WORD; CachedRGBToHLSLum: WORD; CachedRGBToHLSSat: WORD; const HLSMAX = 240; RGBMAX = 255; HLSUndefined = (HLSMAX*2/3); function HueToRGB(Lum, Sat, Hue: Double): Integer; var ResultEx: Double; begin if (hue < 0) then hue := hue + HLSMAX; if (hue > HLSMAX) then hue := hue - HLSMAX; if (hue < (HLSMAX/6)) then ResultEx := Lum + (((Sat-Lum)*hue+(HLSMAX/12))/(HLSMAX/6)) else if (hue < (HLSMAX/2)) then ResultEx := Sat else if (hue < ((HLSMAX*2)/3)) then ResultEx := Lum + (((Sat-Lum)*(((HLSMAX*2)/3)-hue)+(HLSMAX/12))/(HLSMAX/6)) else ResultEx := Lum; result := Round(ResultEx); end; function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef; function RoundColor(Value: Double): Integer; begin if Value > 255 then result := 255 else result := Round(Value); end; var R,G,B: Double; Magic1,Magic2: Double; begin if (Saturation = 0) then begin R := (Luminance * RGBMAX) / HLSMAX; G := R; B := R; if (Hue <> HLSUndefined) then ; // ERROR end else begin if (Luminance <= (HLSMAX/2)) then Magic2 := (Luminance * (HLSMAX + Saturation) + (HLSMAX/2)) / HLSMAX else Magic2 := Luminance + Saturation - ((Luminance * Saturation) + (HLSMAX/2)) / HLSMAX; Magic1 := 2 * Luminance - Magic2; R := (HueToRGB(Magic1,Magic2,Hue+(HLSMAX/3))*RGBMAX + (HLSMAX/2))/HLSMAX; G := (HueToRGB(Magic1,Magic2,Hue)*RGBMAX + (HLSMAX/2)) / HLSMAX; B := (HueToRGB(Magic1,Magic2,Hue-(HLSMAX/3))*RGBMAX + (HLSMAX/2))/HLSMAX; end; result := RGB(RoundColor(R), RoundColor(G), RoundColor(B)); end; procedure GradientFillCanvas(Canvas: TCanvas; StartColor, EndColor: TColor; const ARect: TRect; Direction: TGradientDirection); const cGradientDirections: array[TGradientDirection] of Cardinal = (GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V); var Vertexes: array[0..1] of TTriVertex; GradientRect: TGradientRect; begin Vertexes[0].x := aRect.Left; Vertexes[0].y := aRect.Top; Vertexes[0].Red := (StartColor and $FF) shl 8; Vertexes[0].Green := (StartColor and $FF00); Vertexes[0].Blue := (StartColor and $FF0000) shr 8; Vertexes[0].Alpha := 0; Vertexes[1].x := aRect.Right; Vertexes[1].y := aRect.Bottom; Vertexes[1].Red := (EndColor and $FF) shl 8; Vertexes[1].Green := (EndColor and $FF00); Vertexes[1].Blue := (EndColor and $FF0000) shr 8; Vertexes[1].Alpha := 0; GradientRect.UpperLeft:=0; GradientRect.LowerRight:=1; GradientFill(Canvas.Handle, Vertexes[0], 2, @GradientRect, 1, cGradientDirections[Direction]); end; constructor TButton.Create(AOwner: TComponent); begin inherited; FButton := tbPushButtonNormal; FBtnColor := $ffddff; SetBtnColor(FBtnColor); 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.SetBtnColor(Value: TColor); var H, L, S: WORD; begin ColorRGBToHLS(Value, H, L, S); FBgnColor := ColorHLSToRGB(H, L+45, S); FEndColor := ColorHLSToRGB(H, L-45, S); end; procedure TButton.DrawButton; var R: TRect; Detail: TThemedElementDetails; c3, c4: TColor; DC: HDC; aCanvas: TCanvas; H, L, S: WORD; begin if not(ThemeServices.ThemesEnabled) then exit; ColorRGBToHLS(FBgnColor, H, L, S); c3 := ColorHLSToRGB(H, L+12, S); ColorRGBToHLS(FEndColor, H, L, S); c4 := ColorHLSToRGB(H, L+12, S); 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); R := ThemeServices.ContentRect(aCanvas.Handle, Detail, R); if Focused or (FButton = tbPushButtonHot) then InflateRect(R, -1, -1); case FButton of // 通常のボタン状態 tbPushButtonNormal : GradientFillCanvas(aCanvas, FBgnColor, FEndColor, R, gdVertical); // マウスがボタン上にある tbPushButtonHot : GradientFillCanvas(aCanvas, c3, c4, R, gdVertical); // ボタンが押されている tbPushButtonPressed : GradientFillCanvas(aCanvas, FEndColor, FBgnColor, R, gdVertical); // ボタンが無効状態 tbPushButtonDisabled : GradientFillCanvas(aCanvas, $eeeeee, $cccccc, R, gdVertical); // デフォルトのボタン tbPushButtonDefaulted: GradientFillCanvas(aCanvas, FBgnColor, FEndColor, 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.BtnColor := $ff88ff; Button2.BtnColor := $ffff66; Button3.BtnColor := $55ffff; Button4.BtnColor := $55ff55; Button5.BtnColor := $F5F0FF;// clWebLavenderBlush; Button6.BtnColor := $DDA0DD;// clWebPlum; Button7.BtnColor := $B469FF;// clWebHotPink; Button8.BtnColor := $4763FF;// clWebTomato; Button9.FBgnColor := $55ffff; Button9.FEndColor := $ff55ff; Button10.BtnColor := $FFFFE0;// clWebLightCyan; Button11.BtnColor := $D4FF7F;// clWebAquamarine; Button12.BtnColor := $FFF8F0;// clWebAliceBlue; Button13.BtnColor := $FAE6E6;// clWebLavender; Button14.FBgnColor := $55ffff; Button14.FEndColor := $ffdd00; Button15.BtnColor := $B5E4FF;// clWebMoccasin; Button16.BtnColor := $87B8DE;// clWebBurlywood; Button17.BtnColor := $00D7FF;// clWebGold; Button18.BtnColor := $60A4F4;// clWebSandyBrown; Button19.FBgnColor := $ff99ff; Button19.FEndColor := $ffcc00; Button20.BtnColor := $F0FFF0;// clWebHoneydew; Button21.BtnColor := $90EE90;// clWebLightGreen; Button22.BtnColor := $2FFFAD;// clWebGreenYellow; Button23.BtnColor := $00FF00;// clWebLime; Button24.FBgnColor := $00eeff; Button24.FEndColor := $00cc00; end; ------------------------------------------------------------------- 【Delphi8以降で、XPMan,Themes,GraphUtilを使う場合】 uses ..., XPMan, Themes, GraphUtil; type TButton = class(StdCtrls.TButton) private FButton: TThemedButton; FBtnColor: TColor; FBgnColor: TColor; FEndColor: TColor; procedure WndProc(var Msg: TMessage); override; procedure SetBtnColor(Value: TColor); procedure DrawButton; published property BtnColor: TColor read FBtnColor write SetBtnColor; 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; FBtnColor := $ffddff; FBtnColor := clWebFloralWhite; SetBtnColor(FBtnColor); 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.SetBtnColor(Value: TColor); var H, L, S: WORD; begin ColorRGBToHLS(Value, H, L, S); FBgnColor := ColorHLSToRGB(H, L+45, S); FEndColor := ColorHLSToRGB(H, L-45, S); end; procedure TButton.DrawButton; var R: TRect; Detail: TThemedElementDetails; c3, c4: TColor; DC: HDC; aCanvas: TCanvas; H, L, S: WORD; begin if not(ThemeServices.ThemesEnabled) then exit; ColorRGBToHLS(FBgnColor, H, L, S); c3 := ColorHLSToRGB(H, L+12, S); ColorRGBToHLS(FEndColor, H, L, S); c4 := ColorHLSToRGB(H, L+12, S); 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); R := ThemeServices.ContentRect(aCanvas.Handle, Detail, R); if Focused or (FButton = tbPushButtonHot) then InflateRect(R, -1, -1); case FButton of tbPushButtonNormal : GradientFillCanvas(aCanvas, FBgnColor, FEndColor, R, gdVertical); tbPushButtonHot : GradientFillCanvas(aCanvas, c3, c4, R, gdVertical); tbPushButtonPressed : GradientFillCanvas(aCanvas, FEndColor, FBgnColor, R, gdVertical); tbPushButtonDisabled : GradientFillCanvas(aCanvas, $eeeeee, $cccccc, R, gdVertical); tbPushButtonDefaulted: GradientFillCanvas(aCanvas, FBgnColor, FEndColor, 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.BtnColor := $ff88ff; Button2.BtnColor := $ffff66; Button3.BtnColor := $55ffff; Button4.BtnColor := $55ff55; Button5.BtnColor := clWebLavenderBlush; Button6.BtnColor := clWebPlum; Button7.BtnColor := clWebHotPink; Button8.BtnColor := clWebTomato; Button9.FBgnColor := $55ffff; Button9.FEndColor := $ff55ff; Button10.BtnColor := clWebLightCyan; Button11.BtnColor := clWebAquamarine; Button12.BtnColor := clWebAliceBlue; Button13.BtnColor := clWebLavender; Button14.FBgnColor := $55ffff; Button14.FEndColor := $ffdd00; Button15.BtnColor := clWebMoccasin; Button16.BtnColor := clWebBurlywood; Button17.BtnColor := clWebGold; Button18.BtnColor := clWebSandyBrown; Button19.FBgnColor := $ff99ff; Button19.FEndColor := $ffcc00; Button20.BtnColor := clWebHoneydew; Button21.BtnColor := clWebLightGreen; Button22.BtnColor := clWebGreenYellow; Button23.BtnColor := clWebLime; Button24.FBgnColor := $00eeff; Button24.FEndColor := $00cc00; end; 裕子：「じゃぁ、これをユウスケに教えてあげよう、…ところで、右側のカレンダーみたいなものナニ？」 真琴：「あ、コレはスケジュールとか日記とかを書き込めるカレンダーコンポ、今作ってる途中」 裕子：「こんなの、マコト 一人で？ スゴイじゃん」 真琴：「アタシが全部作ったんじゃないの、カイトさんのコンポを改造してるだけよ」 裕子：「カイトさんってダレ？ あ〜、もしかして、マコトの彼氏とか」 真琴：「そんなんじゃないよ、でも、アッチの宇宙では民宿に来なかったから、コッチの宇宙でも別の人生歩んでるか、存在すらしてないかも…」 裕子：「ナニそれ、SF小説も書いてるの？ マコト、面白そう、ねぇもっと聞かせて〜」 真琴：「また、今度ね^^;、それより、ハルコさんの声真似して入ってこないでよ」 裕子：「そういえば、ハルコさんはドコか旅行でも行ってるの？ 最近、見ないけど」 真琴：「うん、まぁ、そう…、旅行といっても間違いじゃないような…^^;」