グラフィック／マルチメディア
Delphi には TMediaPlayer という便利なコンポーネントがあります。 これは AVI ファイルは再生できますが、QuickTime Movie（.mov ファイル）や MPEG ファイル(.mpg)は再生できません。 これらの動画を簡単に再生するには Microsoft が無償提供している ActiveMovie を使えばできますが、 これを Delphi から使うことはできるのでしょうか。
実はこれは簡単にできます。というのも ActiveMovie が OCX であるからです。 次の手順で ActiveMovie をコンポーネントパレットにインストールすることができます。
Delphi のメニューから [コンポーネント]－[インストール]－[OCX]－[MS ActiveMovie Control]と選択して、 [OK]を押すと、コンポーネントパレットの[OCX]ページにアクティブムービーが登録されます。
これをフォームに貼り附けるだけで、ActiveMovie がメディアプレイヤーのようにして利用できます。 もちろんこの方法は ActiveMovie がインストールされている環境でしか使えません。 また、作ったアプリケーションも ActiveMovie のインストールされている環境でないと動作しませんのでご注意を。
TPaintBox の OnPaint イベントにコードを記述して描画しているときに、 PaintBox を再描画したいとき Repaint を呼べばいいのですが、 全体が再ペイントされてしまいます。 しかし、OnPaint でたくさんの線を描いている時など、部分再描画したいときがあります。
こういうときには、API の InvalidateRect を使います。 この関数に再描画したいコントロールのハンドルと、 更新領域の矩形のポインタを渡せばよいのですが、 PaintBox はグラフィックコントロールですので、 ウィンドウハンドルを持っていません。
そこで、PaintBox の親のハンドルを渡してやれば、大抵の場合 OK です。
更新領域の矩形は TRect 型で指定し、そのポインタを渡すので、'@'をつけてやります。
以下の例は Form1 に TPaintBox と TButton を貼り附けた例です。
Button1 を押すと PaintBox が指定された領域だけ再描画されるのがわかると思います。
procedure TForm1.Button1Click(Sender: TObject);
var
R: TRect;
begin
R := Rect (100, 100, 200, 200);
InvalidateRect(PaintBox1.Parent.Handle, @R, True);
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
I: Integer;
begin
PaintBox1.Canvas.FillRect(PaintBox1.Canvas.ClipRect);
for I := 0 to 99 do begin
PaintBox1.Canvas.MoveTo(Random(500), Random(500));
PaintBox1.Canvas.LineTo(Random(500), Random(500));
end;
end;
Delphi の TImage コンポーネントは、ビットマップの他に、メタファイルやアイコン、さらに Delphi3 以降は JPEG も表示できるようになりました。
ですが、アイコンを表示できて、なぜファイルフォーマットがほとんど同じの カーソルを表示できないのか疑問に思ったことはないでしょうか。
でも、意外と簡単にできるんです。先に述べたとおり、 アイコンとカーソルって言うのはリソース的にはとても似ているので、 カーソルファイル (*.cur,*.ani) に対して ExtractIcon API を使うと、 アイコンとして取得できます。
uses ShellAPI;
……
Image1.Picture.Icon.Handle := ExtractIcon(hInstance, 'ファイル名.cur', 0);
としてやれば OK。 これはアニメーションカーソルファイルに対しても有効ですが、もちろんアニメーションはしません。
縁取り文字を描画するサンプルです。特に難しいことはやってません。
少しずつずらして重ねているだけです。図のように表示されます。簡単な割に演出効果は高いです。
procedure TForm1.FormPaint(Sender: TObject);
const
S = '縁取り文字';
begin
with Canvas do begin
Brush.Color := clBlack;
Brush.Style := bsSolid;
FillRect(ClientRect);
Brush.Style := bsClear;
Font.Size := 48;
Font.Color := clYellow;
TextOut(30, 29, S);
TextOut(30, 31, S);
TextOut(29, 30, S);
TextOut(31, 30, S);
Font.Color := clBlue;
TextOut(30, 30, S);
end;
end;
それではもっと高度に(^^;)、ビットマップを貼りつけた文字を描画するには、
どうすればよいでしょうか。これを簡単に実現するにはリージョンを使います。
パスをリージョンに変換する PathToRegion APIと、
リージョンをクリッピング領域に割り当てる SelectClipRgn という API を使うのがポイントです。
procedure TForm1.FormPaint(Sender: TObject);
const
S = '絵文字';
var
Rgn: HRGN;
R: TRect;
Bmp: TBitmap;
begin
with Canvas do begin
Brush.Style := bsClear;
Font.Size := 48;
Font.Style := [fsBold, fsItalic];
BeginPath(Handle);
TextOut(20, 20, S);
EndPath(Handle);
Rgn := PathToRegion(Handle);
SelectClipRgn(Handle, Rgn);
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile('C:\Program Files\Borland\Delphi 3\Images\Splash\256Color\Shipping.bmp');
R := Bounds(0, 0, Bmp.Width, Bmp.Height);
CopyRect(R, Bmp.Canvas, R);
finally
Bmp.Free;
DeleteObject(Rgn); //使った後はリージョンを解放すること
end;
end;
end;
イメージに格納されているビットマップを、エクスプローラで選択されたアイコンのように、
選択色で網掛け表示するにはどうすればよいでしょうか。
これはイメージリストを使えば簡単です。
TImage コンポーネントのキャンバスに直接網掛けしてしまうと、
イメージ内部のビットマップに書き込まれてしまうので、
TImage コンポーネントの上に TPaintBox コンポーネントを載っけておきます。
procedure TForm1.Button1Click(Sender: TObject);
begin
ImageList1.BlendColor := clHighlight; //お好みの色に
ImageList1.DrawingStyle := dsSelected;
//上の２行はオブジェクトインスペクタで設定しておけば書く必要はありません。
ImageList1.Width := Image1.Picture.Bitmap.Width;
ImageList1.Height := Image1.Picture.Bitmap.Height;
ImageList1.Add(Image1.Picture.Bitmap, nil);
PaintBox1.BoundsRect := Image1.BoundsRect;
ImageList1.Draw(PaintBox1.Canvas, 0, 0, 0);
end;
範囲選択した部分の画像のコピーを Windows API を使って実現します。
指定範囲のみコピーするために、
CopyRect の前に SelectClipRgn でクリッピング範囲にリージョンを割り当てます。
リージョンに多角形を割りつけるために、
BeginPath, EndPath, PathToRegion という API を使っています。
ついでに文字列を使う例も示しておきます。
procedure TForm1.Button1Click(Sender: TObject);
var
Rgn: HRGN;
begin
Image1.Picture.LoadFromFile('SHIPPING.BMP'); //適当に
Image2.AutoSize := False;
Image2.Width := Image1.Width;
Image2.Height := Image1.Height;
BeginPath(Image1.Canvas.Handle);
Image1.Canvas.Polygon([Point(50, 0), Point(0, 50), Point(50, 100)]);
Image1.Canvas.Font.Size := 50;
Image1.Canvas.TextOut(50, 100, 'Delphi');
EndPath(Image1.Canvas.Handle);
Rgn := PathToRegion(Image1.Canvas.Handle);
SelectClipRgn(Image2.Canvas.Handle, Rgn);
Image2.Canvas.CopyRect(Rect(0, 0, Image1.Width, Image1.Height),
Image1.Canvas,
Rect(0, 0, Image1.Width, Image1.Height));
DeleteObject(Rgn);
end;