お知らせ

電子会議

ライブラリ

パレット

Delphi FAQ検索

Delphi FAQ一覧

サンプル蔵





FDelphi FAQ
16番会議室「玉石混淆みんなで作る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 にすると、約2秒かけて表示が更新されます。
// 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(VGAサイズ)
  CPU: 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蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。

Copyright 1996-2002 Delphi Users' Forum