Delphi Programming / Object Pascal
[掲載 2013年10月04日] [更新 2013年10月06日] Delphi サンプルプログラム集 |
040_ステータスバーへのコンポーネント配置と描画 |
動作確認等 |
Windows 7 U64(SP1) + Delphi XE Pro |
|
040_StatusBar.zip [1,110 KB] 2013年10月06日版 (EXE 同梱) |
- 2013年10月06日
- [02] EXE 実行開始と同時に,ステータスバーに画像を描画していたが,ボタンをクリックしたら,画像を描画するコードに変更
|
01_ステータスバーにコンポーネントを配置 - プログレスバー |
ステータスバー (TStatusBar) に他のコントロール配置する場合,設計時には,ステータスバーそのものを親コントロールとすることはできません.以下のように,実行時であれば親コントロールにすることができます.
以下のサンプルでは,プログレスバーを配置しています.この方法で,他のコントロール類もステータスバーに配置することができます.
このサンプルでは,TStatusBar の Panels プロパティで Panel を作成していません.しがって,ステータスバーに文字列を表示するのに,SimpleText を使用しています. |
|
図1
設計時画面 |
|
図2
実行画面 |
|
図3
プログレスバーの位置が終端になると |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
StatusBar1: TStatusBar;
ProgressBar1: TProgressBar;
procedure FormCreate(Sender: TObject);
procedure StatusBar1Resize(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
// プログレスバーをステータスバーに配置
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
ProgressBar1.Parent := StatusBar1;
ProgressBar1.Left := 4;
ProgressBar1.Top := 4;
ProgressBar1.Visible := True;
//描画更新
StatusBar1.Update;
end;
//=============================================================================
// プログレスバーを動作させてみる
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
ProgressBar1.Visible := True;
ProgressBar1.Position := 0;
for i := 0 to 99 do begin
ProgressBar1.Position := ProgressBar1.Position + 1;
Application.ProcessMessages;
Sleep(30);
//描画更新
ProgressBar1.Update;
end;
ProgressBar1.Visible := False;
//Pnaelsプロパティを設定していないのでSimplePanelを使用
StatusBar1.SimplePanel := True;
StatusBar1.SimpleText := ' 終了';
end;
//=============================================================================
// StatusBar1のOnResize(イベント
// ProgressBar1の幅も変えてみる
//=============================================================================
procedure TForm1.StatusBar1Resize(Sender: TObject);
begin
ProgressBar1.Width := StatusBar1.Width - ProgressBar1.Left * 2;
end;
end.
ステータスバー (TStatusBar) には Canvas プロパティがあり,自由に描画できます.実際の描画は,TStatusbar の Panel に対して行われるため,1 つでも Panel を追加しておく必要があります.
SimplePanel にはカスタム描画できません.
本サンプルでは,描画は,該当 Panel の Style の値を psOwnerDraw にして,OnDrawPanel イベント内で処理しています.Style プロパティの値を psOwnerDraw にすると,Text プロパティの値は描画されません.Text プロパティの値を表示するには,イベント内で描画コードを書きます.
他のコントロールの描画用のイベントと同じ様に,再描画が必要になった時に,OnDrawPanel イベント内のコードが実行されることになります.
イベントの引数の意味は,下記の Delphi のオンラインヘルプで確認できます.コードのサンプルも掲載されています. |
|
図4
設計時画面 |
|
図5
設計時に Panel を 1 つ追加しておく
- オブジェクトインスペクタの Panels プロパティまたは
- StatusBar1 を選択して,ポップアップメニューからもダイアログを表示して設定可能
- この Panel は実行時に Style := psOwnerDraw; (オーナードロー) にしているので,Text に文字列を設定しても表示されない
|
|
図6
EXE 実行 |
|
図7
Button1 をクリック |
|
図8
Button2 をクリック |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
StatusBar1: TStatusBar;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
ABitmap : TBitmap;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
ABitmap := TBitmap.Create;
//以下はオブジェクトインスペクタで設定可能
StatusBar1.Panels[0].Style := psOwnerDraw;
StatusBar1.Panels[0].Width := 150;
StatusBar1.Panels[0].Text := 'テスト';
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(ABitmap);
end;
//=============================================================================
// StatusBar1に画像を表示
// 再描画のためのRepaintが必要
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
ABitmap.LoadFromFile('ABC.bmp');
StatusBar1.Repaint;
end;
//=============================================================================
// StatusBar1のPanlesの数を変えてみる
// 再描画のためのRepaintは必要ない
// StatusBar1の状態を変更するコードを実行しているので,自動的に再描画される
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
if StatusBar1.Panels.Count = 2 then begin
StatusBar1.Panels.Delete(1);
end else begin
StatusBar1.Panels.Add;
StatusBar1.Panels[1].Text := 'DELPHI';
StatusBar1.Panels[1].Alignment := taCenter;
end;
end;
//=============================================================================
// StatusBar1のOnDrawPanelイベント処理
// 単なるCanvasの使用方法とも言える
//=============================================================================
procedure TForm1.StatusBar1DrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel;
const Rect: TRect);
var
TempRect : TRect;
begin
TempRect := Rect;
if Panel.ID = 0 then begin
StatusBar1.Canvas.Brush.Color := clSkyBlue;
StatusBar1.Canvas.FillRect(TempRect);
DrawText(StatusBar1.Canvas.Handle,
PChar(Panel.Text),
-1,
TempRect,
DT_CENTER or DT_VCENTER or DT_SINGLELINE);
//イベントの引数にRectがあるため使用不可なので,SetRectを使用
SetRect(TempRect, 10, 6, 62, StatusBar1.Height - 5);
StatusBar1.Canvas.StretchDraw(TempRect, ABitmap);
end;
end;
end.
|