印刷時に左余白を作るには（フォームの印刷）

解決

oishiman 2004-03-13 19:34:20 No: 7670

用紙の左側に余白をもうけて印刷したいのですがという質問に対し，下記のように解答していただいたのですが，
『StretchDrawBitmapメソッドをコピーしておいて』
が分かりません。
---------------------------------------------------------------------
http://www.asahi-net.or.jp/~HA3T-NKMR/tips004.htm

ここにある例でうまくいきませんか？
StretchDrawBitmapメソッドをコピーしておいて、

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;

ただし、これだけでは紙をはみ出すかもしれません。

jok 2004-03-13 22:35:42 No: 7671

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

メソッドではなくたんなる手続きですね。中村さんのサイトから

procedure TForm1.Button1Click(Sender: TObject);

の直前のところのコードエディタにコピペするだけでいいのでは？

oishiman 2004-03-14 06:01:38 No: 7672

すみません。おっしゃってる意味が理解できません。

すみません。

jok 2004-03-14 08:40:18 No: 7673

> 『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;

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

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

jok 2004-03-14 08:43:28 No: 7674

すみません、コピペ部分が切れてました。以下のようになります。

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

  // 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;

// 拡大モードをカラー用に変更
OldMode:=SetStretchBltMode(Canvas.Handle,COLORONCOLOR);

  // 描画！！
  StretchDIBits(Canvas.Handle,
                r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top,
                0,0,pInfo^.bmiHeader.biWidth,pInfo^.bmiHeader.biHeight,
                Image,pInfo^,DIB_RGB_COLORS,SRCCOPY);
  // 拡大モードを元に戻す
  SetStretchBltMode(Canvas.Handle,OldMode);
end;

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

jok 2004-03-14 08:57:04 No: 7675

蛇足ですが、ある関数や手続きを使う場合、コンパイラが先に認識できる
ように使う行より上に実装するか、あるいは宣言部に宣言しておく必要が
あります。例えば、自分独自の関数 SumTwo() をつくったとします。これを
使う直前に実装するには

function SumTwo(const Int1,Int2:integer):integer;
begin
result := Int1 + Int2;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := IntToStr(SumTwo(2,3));
end;

こんなふうにします。今回の StretchDrawBitmap() 手続きもこれと同じです。

宣言部に宣言しておくと、実装部では呼ばれるのと実装との順序は任意です。
こんな感じです。

    { Private 宣言 }
  public
    { Public 宣言 }
  end;

function SumTwo(const Int1,Int2:integer):integer;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption := IntToStr(SumTwo(2,3));
end;

function SumTwo(const Int1,Int2:integer):integer;
begin
result := Int1 + Int2;
end;

oishiman 2004-03-14 10:34:14 No: 7676

jokさま，ありがとうございました。

約半年間，積極的ではありませんでしたが，ずーとなやんでおりました。

本当に助かりました！