Title: ビットマップを徐々に変形して「渦巻き」にする

　ビットマップを徐々に変形して「渦巻き」にするサンプルコード
です。
　渦巻きの上流点の計算が少々手抜きですが、以下のコードでどう
でしょうか？

procedure VortexBitmap(bmpSrc: TBitmap; pointCenter: TPoint;
  iR, iCoef: Integer; clBkg: TColor);
var
  bmpTmp: TBitmap;
  x, y: Integer;
  pointA, PointB: TPoint;
  pdwDstLine: PDWORD;
  iDistance,tmpR: Integer;
begin
  // フォーマットを揃える
  bmpSrc.PixelFormat := pf32Bit;
 
  // 変形後の絵を入れるビットマップの作成
  bmpTmp := TBitmap.Create;
  try
    // フォーマットを揃える
    bmpTmp.PixelFormat := pf32Bit;
 
    // bmpSrc と同じサイズにする
    bmpTmp.Width := bmpSrc.Width;
    bmpTmp.Height := bmpSrc.Height;
 
    // 背景色で塗りつぶす。
    bmpTmp.Canvas.Brush.Color := clBkg;
    bmpTmp.Canvas.FillRect(Rect(0, 0, bmpTmp.Width, bmpTmp.Height));
 
    for y := 0 to bmpTmp.Height - 1 do
    begin
      pdwDstLine := bmpTmp.ScanLine[y];
      for x := 0 to bmpTmp.Width - 1 do
      begin
        // 渦巻きの中心からの相対座標をpointAに代入
        if(x = pointCenter.x)and(y = pointCenter.y)then
          pointA := Point(1, 1)
        else
          pointA := Point(x - pointCenter.x, y - pointCenter.y);
 
        // 中心に近いほどtmpRの値を大きくする
        iDistance :=
          Round(Sqrt(pointA.x * pointA.x + pointA.y * pointA.y));
        tmpR := iR + iR * iCoef div iDistance;
 
        // （どう説明しましょう？）
        // 渦巻きの上流の点を計算する
        // tmpRを掛けて、渦巻きの中心に近いほど流れを速く見せる
        pointB := Point(x + (pointA.y * tmpR) div 100,
                        y - (pointA.x * tmpR) div 100);
 
        // 上記の座標が変形元ビットマップの領域内ならコピーする
        if(pointB.x >= 0)and(pointB.x < bmpSrc.Width)and
          (pointB.y >= 0)and(pointB.y < bmpSrc.Height)then
          pdwDstLine^ := PDWORD(PChar(bmpSrc.ScanLine[pointB.y])
                                     + pointB.x * sizeof(DWORD))^;
        Inc(pdwDstLine);
      end;
    end;
    // 変形した絵を元のビットマップに描く
    bmpSrc.Canvas.Draw(0, 0, bmpTmp);
  finally
    bmpTmp.Free;
  end;
end;

// タイマーで徐々に渦巻きに変形する場合
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  VortexBitmap(FBitmap,
    Point(FBitmap.Width div 2, FBitmap.Height div 2),
    5, FBitmap.Width, // このくらいのパラメータでどうでしょう？
    clWhite);
  Canvas.Draw(0,0,FBitmap);
end;

　渦巻きの上流点の計算が少々手抜きのため、徐々に渦巻きになって
徐々に中心に吸い込まれて消えてしまいます(^^;)。


以上です。


            1998/01/16、河邦 正（GCC02240@niftyserve.or.jp)

Original document by 河邦 正         氏 ID:(GCC02240)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。