この発言は
#01142　Fermion         さんのDrawDibDraw （宣言）
に対するコメントです






■説明
　DrawDibDraw による描画のサンプルです。
　実行ファイルと同じフォルダ内にある 'Test.bmp' を読み込んで、Form1 の
クライアント領域に描画します。

■使い方
　１．Form1 に Button1 を適当に配置して下さい。
　２．Form1 の OnCreate, OnDestroy、Button1 の OnClick等を以下のように
　　　して下さい。

■注意事項
　データチェック等が省かれています。実際のご使用に当たっては十分ご注意
下さい。

■サンプルコード
//=========================================================================
{...略...}
implementation

uses DrawDibAPI;             {* 追加して下さい                       *}

{$R *.DFM}

var
  bmpStream: TMemoryStream;  {* Bitmap File 読み込み用MemoryStream   *}

{--------------------------------------------------------------------------
  Form OnCreate  --- bmpStream を作成
//------------------------------------------------------------------------}
procedure TForm1.FormCreate(Sender: TObject);
begin
  bmpStream := TMemoryStream.Create;
end;
{--------------------------------------------------------------------------
  Form OnDestroy --- bmpStream を破棄
//------------------------------------------------------------------------}
procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmpStream.Free;
end;
{--------------------------------------------------------------------------
  DrawDibDraw を使用した描画処理
    Canvas          : 対象となる Canvas を指定
    dTop, dLeft     : 描画開始位置
    dHeight, dWidth : 描画領域のサイズ
    BitmapStream    : 描画対象Bitmapが入ったMemoryStream
//------------------------------------------------------------------------}
procedure DDDraw( Canvas: TCanvas; dTop, dLeft, dHeight, dWidth: Integer;
                                             BitmapStream: TMemoryStream );
var
  lpBits  : Pointer;         {* ビットマップビット格納先へのポインタ *}
  pBmpInfo: PBitmapInfo;     {* BitmapInfo構造体へのポインタ         *}
  nColors : Cardinal;        {* パレットカラー格納数                 *}
  hdd     : HDRAWDIB;        {* 描画のための DrawDib DC              *}
 {- 描画領域に収まるように縦横等倍縮小 -------------------------------}
  procedure SetSize;
  var
    RatioH,                  {* 高さの比                             *}
    RatioW  : Extended;      {* 幅の比                               *}
  begin
    with pBmpInfo^.bmiHeader do begin
      if ( biWidth > dWidth ) or ( biHeight > dHeight ) then
        begin
          RatioH := dHeight / biHeight;
          RatioW := dWidth  / biWidth;
          if RatioH > RatioW then RatioH := RatioW;
          dHeight := Trunc( biHeight * RatioH );
          dWidth  := Trunc( biWidth  * RatioH );
          Exit;
        end;{if ( biWidth > dWidth ) or ( biHeight > dHeight ) then}
      dHeight := biHeight;
      dWidth  := biWidth;
    end;{with pBmpInfo^.bmiHeader do}
  end;
 {- End --------------------------------------------------------------}
begin
  {* BitmapInfo構造体のアドレスを計算 *}
  pBmpInfo := PBitmapInfo( PChar( BitmapStream.Memory )
                           + SizeOf(TBitmapFileHeader) );
  with pBmpInfo^, bmiHeader do begin
    {* パレットカラー格納数を取得 *}
    if biClrUsed = 1 then
      nColors := biClrUsed
    else
      nColors := ( 1 shl biBitCount );
    {* 各ビット数に合わせてビットマップビット配列のアドレスを計算 *}
    if biBitCount > 8 then
      begin
         lpBits := PChar( @bmiColors ) + Ord( biClrUsed )
                     + Ord( biCompression = BI_BITFIELDS ) * 3;
      end
    else lpBits := PChar( @bmiColors ) + nColors;
    {* 描画のために DrawDib デバイスコンテキストを作成 *}
    hdd := DrawDibOpen;
    try
      {* DrawDib DC のパレットを実体化 *}
      DrawDibRealize( hdd, Canvas.Handle, True );
      {* 描画サイズ設定 *}
      SetSize;
      {* 画像表示 *}
      DrawDibDraw( hdd,
                   Canvas.Handle,
                   dLeft,  dTop,
                   dWidth, dHeight,
                   PBitmapInfoHeader( @bmiHeader ),
                   lpBits,
                   0, 0,
                   biWidth, biHeight,
                   DDF_BACKGROUNDPAL );
                 //↑背景パレットに DrawDib DC のパレットを選択
    finally
      {* DrawDib DC を閉じ、割り当てたリソースを解放 *}
      DrawDibClose( hdd );
    end;{try..finally..}
  end;{with pBmpInfo^ do}
end;
{--------------------------------------------------------------------------
  Button1 OnClick
//------------------------------------------------------------------------}
procedure TForm1.Button1Click(Sender: TObject);
var
  FileName: String;
begin
 {* 実行ファイルと同じフォルダ内の'Test.bmp'を表示させる場合 *}
  FileName := ExtractFilePath( ParamStr(0) ) + 'Test.bmp';
  if not FileExists( FileName ) then Exit;
 {* BitmapファイルをbmpStreamに読み込む *}
  bmpStream.LoadFromFile( FileName );
 {...略...}
 {* Form1のCanvasに描画 *}
  DDDraw( Canvas, 0, 0, ClientHeight, ClientWidth, bmpStream );
end;
{--------------------------------------------------------------------------
//------------------------------------------------------------------------}
{...略...}
end.
//=========================================================================

                              00/7/19(Wed) 02:07am  Fermion [KHF03264]

 



Original document by Fermion         氏 ID:(KHF03264)

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