１６番会議室「玉石混淆みんなで作るSample蔵」に寄せられたサンプル
"画像表示を上下方向にフェード更新する"
【タイトル】画像表示を上下方向にフェード更新する
#827 で「ビットマップを半透明描画する」という題でコードを出させてい
ただきましたが、これをちょっと応用して、画像の上下左右方向へのフェード
更新するサンプルコードです。
上下方向と、左右方向は内部コードの共有が難しかったのでそれぞれ別の関
数にしました。また、発言の300行制限のため、上下方向にフェード更新する
サンプルコードと、左右方向に更新するサンプルコードを別々の発言に分けま
した。
全く同じタイトルで #837 に発言しましたが、ちょっと説明不足があったの
で出し直しました。
動作確認は Delphi4 で行いました。Delphi3、C++Builder3 でも大丈夫だと
思います。
この発言は上下方向にフェード更新するサンプルコードです。
type
TForm1 = class(TForm)
{ 省略 }
procedure FormCreate(Sender: TObject); // Bitmap を作成する
procedure FormDestroy(Sender: TObject);// Bitmap を破棄する
procedure FormPaint(Sender: TObject); // Bitmap を描画する
private
// 同じ大きさで PixelFormat = pf24bitにしておく
FBitmap, FNextBitmap: TBitmap;
procedure VertFade(FrameCount: Integer; Downward: Boolean);
end;
{ ここから implementation }
// 時間調整に timeGetTime を用いているため、
// GetTickCount を代わりに使えば MMSystem は不要です
uses MMSystem;
// Form1.OnPaintイベントハンドラでビットマップを表示
procedure TForm1.FormPaint(Sender: TObject);
begin
Canvas.Draw(0, 0, FBitmap);
end;
// FrameCount は表示更新にかかる時間の目標値（msec）です。
// FrameCount = 2000 にすると、約２秒かけて表示が更新されます。
// Downward は TRUE で上から下に、FALSE で下から上に表示を更新します
procedure TForm1.VertFade(FrameCount: Integer; Downward: Boolean);
const
BlockSize = 16;
NumSteps = 8;
var
bmpBlock: TBitmap;
rectStart, rectBlock: TRect;
pdwBlock, pdwNext, pdwPrev: PDWORD;
w, h, x, y, StepCount, LineIndex: Integer;
var
SaveIndex: Integer;
rgnTmp: HRGN;
var
Count, CountStep: DWORD;
begin
if(FBitmap.Width <> FNextBitmap.Width) or
(FBitmap.Height <> FNextBitmap.Height) or
(FBitmap.PixelFormat <> pf24bit) or
(FNextBitmap.PixelFormat <> pf24bit) then
begin
ShowMessage('フォーマットが一致しません');
Exit;
end;
w := FBitmap.Width;
h := FBitmap.Height;
SaveIndex := SaveDC(Canvas.Handle);
rgnTmp := CreateRectRgn(0, 0, w, h);
SelectClipRgn(Canvas.Handle, rgnTmp);
bmpBlock := TBitmap.Create;
bmpBlock.Width := w;
bmpBlock.Height := BlockSize;
bmpBlock.PixelFormat := pf24bit;
CountStep := FrameCount div (h div BlockSize + NumSteps - 1);
Count := timeGetTime; // 表示速度の調整
if Downward then
begin
rectStart := Rect(0, 0, w, BlockSize);
OffsetRect(rectStart, 0, -BlockSize * (NumSteps - 1));
end
else
begin
rectStart := Rect(0, h - BlockSize, w, h);
OffsetRect(rectStart, 0, BlockSize * (NumSteps - 1));
end;
// while rectStart.Top < h do
// while rectStart.Bottom > 0 do
while TRUE do
begin
if Downward then
begin
if rectStart.Top >= h then break
end
else
if rectStart.Bottom <= 0 then break;
rectBlock := rectStart;
for StepCount := 0 to NumSteps - 1 do
begin
for y := 0 to BlockSize - 1 do
begin
LineIndex := rectBlock.Top + y;
if(LineIndex >= 0)and(LineIndex < h)then
begin
pdwBlock := bmpBlock.ScanLine[y];
pdwPrev := FBitmap.ScanLine[LineIndex];
pdwNext := FNextBitmap.ScanLine[LineIndex];
case(StepCount)of
0: CopyMemory(pdwBlock, pdwNext, w * 3);
7:for x := 0 to (w * 3 + 3) div 4 - 1 do
begin
pdwBlock^ := pdwPrev^ - pdwPrev^ shr 3 and $1f1f1f1f
+ pdwNext^ shr 3 and $1f1f1f1f;
Inc(pdwBlock);
Inc(pdwPrev);
Inc(pdwNext);
end;
6:for x := 0 to (w * 3 + 3) div 4 - 1 do
begin
pdwBlock^ := pdwPrev^ - pdwPrev^ shr 2 and $3f3f3f3f
+ pdwNext^ shr 2 and $3f3f3f3f;
Inc(pdwBlock);
Inc(pdwPrev);
Inc(pdwNext);
end;
5:for x := 0 to (w * 3 + 3) div 4 - 1 do
begin
pdwBlock^ := pdwPrev^ - pdwPrev^ shr 3 and $1f1f1f1f
+ pdwNext^ shr 3 and $1f1f1f1f
- pdwPrev^ shr 2 and $3f3f3f3f
+ pdwNext^ shr 2 and $3f3f3f3f;
Inc(pdwBlock);
Inc(pdwPrev);
Inc(pdwNext);
end;
4:for x := 0 to (w * 3 + 3) div 4 - 1 do
begin
pdwBlock^ := pdwPrev^ - pdwPrev^ shr 1 and $7f7f7f7f
+ pdwNext^ shr 1 and $7f7f7f7f;
Inc(pdwBlock);
Inc(pdwPrev);
Inc(pdwNext);
end;
3:for x := 0 to (w * 3 + 3) div 4 - 1 do
begin
pdwBlock^ := pdwNext^ + pdwPrev^ shr 3 and $1f1f1f1f
- pdwNext^ shr 3 and $1f1f1f1f
+ pdwPrev^ shr 2 and $3f3f3f3f
- pdwNext^ shr 2 and $3f3f3f3f;
Inc(pdwBlock);
Inc(pdwPrev);
Inc(pdwNext);
end;
2:for x := 0 to (w * 3 + 3) div 4 - 1 do
begin
pdwBlock^ := pdwNext^ + pdwPrev^ shr 2 and $3f3f3f3f
- pdwNext^ shr 2 and $3f3f3f3f;
Inc(pdwBlock);
Inc(pdwPrev);
Inc(pdwNext);
end;
1:for x := 0 to (w * 3 + 3) div 4 - 1 do
begin
pdwBlock^ := pdwNext^ + pdwPrev^ shr 3 and $1f1f1f1f
- pdwNext^ shr 3 and $1f1f1f1f;
Inc(pdwBlock);
Inc(pdwPrev);
Inc(pdwNext);
end;
end;
end;
end;
Canvas.Draw(rectBlock.Left, rectBlock.Top, bmpBlock);
if Downward then
OffsetRect(rectBlock, 0, BlockSize)
else
OffsetRect(rectBlock, 0, -BlockSize);
end; // for StepCount := 0 to NumSteps - 1 do
if CheckBox2.Checked then // 表示速度の調整
while timeGetTime < Count do Sleep(1); Inc(Count, CountStep);
if Downward then
OffsetRect(rectStart, 0, BlockSize)
else
OffsetRect(rectStart, 0, -BlockSize);
end;
FBitmap.Canvas.Draw(0, 0, FNextBitmap);
RestoreDC(Canvas.Handle, SaveIndex);
DeleteObject(rgnTmp);
end;
【速度テスト】
ビットマップサイズ： 640 * 480 pixels（ＶＧＡサイズ）
ＣＰＵ： Pentium120MHz
ビデオカード：Sthealth64
上の条件＋表示速度調整を解除して（Wait無し）実行すると 1.0〜1.2秒
くらいかかりました。
ちょっとせわしないと感じたので FrameCount = 1500〜2000 の引数で実行
するのが目に優しいと思います。
1999/03/26、河邦 正（GCC02240@nifty.ne.jp）
Original document by 河邦 正 氏 ID:(GCC02240)
ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。