プログレスバーの枠だけ使う

さいとう 2010-08-09 09:15:06 No: 38958

いつもお世話になっております。
プログレスバーの枠の中だけを使い内部の描画を変更する
下コードを書いたのですが、プログレスバーのバーがposition
propertyで描画されるのを変更できません。

position propertyはそのまま利用したいのですが、何か良い
方法がありますでしょうか？

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Themes, ComCtrls, XPMan, Commctrls;

type
  TProgressbar = class(ComCtrls.TProgressBar)
    procedure DrawProgress;
end;
  省略

Procedure TProgressbar.DrawProgress;
var
  R: TRect;
  Detail: TThemedElementDetails;
   aCanvas: TCanvas;

begin
  if not(ThemeServices.ThemesEnabled) then exit;

  DC := GetDC(Self.Handle);
  aCanvas := TCanvas.Create;
  aCanvas.Handle := DC;
  aCanvas.Font.Assign(Self.Font);
  R := ClientRect;
  if not Enabled then FProgressBar := tpbar;
  Detail := ThemeServices.GetElementDetails(FProgressbar);

  R := ThemeServices.ContentRect(aCanvas.Handle, Detail, R);

  ここでCANVASの描画処理

R:=ThemeServices.DrawText(DC, Detail, Caption, R, DT_SINGLELINE or DT_CENTER or DT_VCENTER, 0);
  ReleaseDC(Self.Handle, DC);
  aCanvas.Free;

end;

KHE00221 2010-08-10 04:18:27 No: 38959

ためしてないけどこうかね？

  TProgressbar = class(ComCtrls.TProgressBar)
  private
    procedure PBM_SETPOS(var Message: TMessage); message PBM_SETPOS;
  protected
  public
    procedure DrawProgress;
  end;

procedure TProgressBar.PBM_SETPOS(var Message: TMessage);
begin
inherited;
DrawProgress;
end;

さいとう 2010-08-11 18:28:19 No: 38960

KHE00221さんへ回答ありがとうございます。
試してみましたが、うまくいかなかったので、ProgressBarの
サイズでColor色で塗りつぶしてみました。

R := ThemeServices.ContentRect(aCanvas.Handle, Detail, R);
     aCanvas.Brush.Color := Self.Color;
     acanvas.FillRect(R);
  ThemeServicesがTRUEの場合はこれでなんとかなったのですが、
    if not(ThemeServices.ThemesEnabled) then exit;
をコメントアウトして、ThemeServicesがFALSEの場合を試すと
やはり当初のBARが表示されますんぜでしょうか？
ThemeServicesがやっている下の行の部分の差と思うのですが
どうせればよいでしょうか？
R := ThemeServices.ContentRect(aCanvas.Handle, Detail, R);
ご存じの方よろしくお願いします。

KHE00221 2010-08-12 03:29:28 No: 38961

そもそも
最初の質問の時点で描画自体はうまくいっていたのかね？

もしかして
テーマサービスが止まってる状態でテーマで描画しようとしてる？

さいとう 2010-08-12 05:46:47 No: 38962

KHE00221さんへもちろんテーマサービスは動いていて
最初のコードの「ここでCANVASの描画処理」に
aCanvas.Brush.Color := Self.Color;
acanvas.FillRect(R);
あり、うまく枠だけになっています。
それ以外の処理はありません。
テーマサービスがOFFの場合は、下の部分は無意味と思うので
これに代わる何かをすればいいと考えたのですが。
どうでしょうか？
R := ThemeServices.ContentRect(aCanvas.Handle, Detail, R);

さいとう 2010-08-12 07:30:42 No: 38963

KHE00221さんすみませんこちらのチェックミスでした。
procedure TProgressBar.PBM_SETPOS(var Message: TMessage);
begin
inherited;
DrawProgress;
end;
のinherited;をコメントアウトしてやると思った動作になりました。
初心者なので合っているかどうか不安ですが？
枠だけの使用なので、元のバーの部分の描画を無視すれば良いと思い
こうしてみましたがどうでしょうか？

KHE00221 2010-08-13 04:13:16 No: 38964

わくだけ利用するなら

  TProgressBar = class(ComCtrls.TProgressBar)
  private
    procedure WMPAINT(var Message: TWMPAINT);message WM_PAINT;
  public
  end;

procedure TProgressBar.WMPAINT(var Message: TWMPAINT);
var
    ACanvas: TControlCanvas;
    Pos: Extended;
begin
    inherited;
    ACanvas := TControlCanvas.Create;
    ACanvas.Control := Self;
    ACanvas.Brush.Color := clWhite;
    ACanvas.FillRect(Rect(2,2,Width-3,Height-2));
    ACanvas.Brush.Color := clRed;
    Pos := (Width - 4) / (Max - Min) * Position;
    ACanvas.FillRect(Rect(2,2,Trunc(Pos),Height-2));
    ACanvas.Free;
end;

これでいいんじゃないか
テーマは使用していないけど