印刷時に左余白を作るには（フォームの印刷） (ID：7673)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

> 『StretchDrawBitmapメソッドをコピーしておいて』が分かりません。

この部分だけ回答するといいのですね？ コード自体は知りません。
こんな感じになります。中村さんも許してくれるでしょう。

// ビットマップ用印刷ルーチン
procedure StretchDrawBitmap(Canvas:TCanvas;  // 描画先キャンバス
                            r : TRect;       // 描画先範囲
                            Bitmap:TBitmap); // ビットマップ
const
  InfoSize = SizeOf(TBitmapInfoHeader) + 4 * 256;
var
  OldMode   : integer;      // StretchModeの保存用
  pInfo     : PBitmapInfo;  // DIBヘッダ＋カラーテーブルへのポインタ

InfoData  : array[0..InfoSize-1] of Byte; // DIBヘッダ＋カラーテーブル
  Image     : array of Byte;// DIBのピクセルデータ
  DC        : HDC;          // GetDIBits 用 Device Context
  OldPal    : HPALETTE;     // パレット保存用
begin
  pInfo :=@InfoData;

// 24 Bit DIB の領域を確保
  SetLength(Image, ((Bitmap.Width * 24 + 31) div 32) * 4 * Bitmap.Height);

// DIB のBitmapInfoHeader を初期化
  with pInfo^.bmiHeader do begin
    biSize := SizeOf(TBitmapInfoHeader);
    biWidth := Bitmap.Width;     biHeight := Bitmap.Height;
    biPlanes := 1;               biBitCount := 24;
    biCompression := BI_RGB;
  end;

// 24bpp DIB イメージを取得
  DC := GetDC(0);
  try
    OldPal := 0;
    if Bitmap.Palette <> 0 then
      OldPal := SelectPalette(DC, Bitmap.Palette, True);

GetDIBits(DC, Bitmap.Handle, 0, Bitmap.Height,
              Image, pInfo^, DIB_RGB_COLORS);
    if OldPal <> 0 then SelectPalette(DC, OldPal, True);
  finally
    ReleaseDC(0, DC);
  end;

procedure TForm1.Button1Click(Sender: TObject);
var
  r: TRect;
  i: Integer;
  FormImage: TBitmap;
begin
  FormImage := GetFormImage;
  with Printer do
    begin
      BeginDoc;
        // (200,200)の位置にフォームを描画

StretchDrawBitmap(Canvas, rect(200, 200, FormImage.Width + 200, FormImage.Height + 200), FormImage);
      EndDoc;
    end;
  FormImage.Free;
end;

＃関数、手続き、メソッド、ユニットファイルの構造、などを研究してください。

←解決時は質問者本人がここをチェックしてください。

戻る