Definir o Tamanho do Papel em TPrinter

Descrição:

Esta procedure configura o tamanho do papel em Run-Time para ser utilizado com o objeto TPrinter; Esta procedure deve ser chamada antes de aplicar o método Printer.BeginDoc.

procedure TForm1.SetPrinterPage(Width, Height : LongInt);
var
   Device : array[0..255] of char;
   Driver : array[0..255] of char;
   Port   : array[0..255] of char;
   hDMode : THandle;
   PDMode : PDEVMODE;

begin

     Printer.GetPrinter(Device, Driver, Port, hDMode);

     If hDMode <> 0 then
     begin

          pDMode := GlobalLock( hDMode );

          If pDMode <> nil then
          begin

               pDMode^.dmPaperSize   := DMPAPER_USER;
               pDMode^.dmPaperWidth  := Width;
               pDMode^.dmPaperLength := Height;
               pDMode^.dmFields := pDMode^.dmFields or DM_PAPERSIZE;

               GlobalUnlock( hDMode );

          end;

     end;

end;

Imprimir BitMap utilizando TPrinter

Descrição:

As vezes, quando utilizados os médoto Draw e StretchDraw da propriedade Canvas do objeto TPrinter, a imagem não é impressa, para corrigir isto, utilize esta procedure, que passando como parâmetros a instância Printer.Canvas, Margem Esquerda, Margem Superior, Largura, Altura e o BitMap a ser impresso.

procedure TForm1.DrawImage( Canvas : TCanvas; 


                 X, Y, Width, Height : Integer; ABitmap : TBitmap);
var
   Header, Bits : Pointer;
   HeaderSize   : Integer;
   BitsSize     : Longint;

begin

     GetDibSizes( ABitmap.Handle, HeaderSize, BitsSize );
     Header := AllocMem( HeaderSize );
     Bits   := AllocMem( BitsSize);

     try

        GetDib( ABitmap.Handle, ABitmap.Palette, Header^, Bits^);

        StretchDIBits( Canvas.Handle, X, Y,
                       Width, Height, 0, 0,
                       ABitmap.Width, ABitmap.Height,
                       Bits, TBitmapInfo(Header^),
                       DIB_RGB_COLORS,SRCCOPY);

     finally

        FreeMem( Header, HeaderSize);
        FreeMem( Bits,   BitsSize  );

     end;

end;

Escreva texto no "Ângulo" de sua Preferência utilizando TCanvas

Descrição:

Use e abuse dos textos utilizando o ângulo de sua preferência e o objeto TCanvas; Crie um novo projeto e veja este exemplo!

procedure TForm1.Button1Click(Sender: TObject);
var
   lf : TLogFont;
   tf : TFont;

begin

     with Form1.Canvas do
     begin

          Brush.Style := bsClear;

          Font.Name := 'Courier New';
          Font.Size := 20;
          Font.Color := clRed;
          Font.Style := [fsItalic, fsBold, fsUnderLine];
          tf := TFont.Create;
          tf.Assign(Font);

          GetObject(tf.Handle, sizeof(lf), @lf);
          lf.lfEscapement := 0;
          lf.lfOrientation := 0;
          lf.lfQuality := 1;
          tf.Handle := CreateFontIndirect(lf);
          Font.Assign(tf);
          TextOut(Width div 2, (Height div 2), '45º Graus');

          Font.Color := clBlue;
          tf := TFont.Create;
          tf.Assign(Font);
          GetObject(tf.Handle, sizeof(lf), @lf);
          lf.lfEscapement := 900;
          lf.lfOrientation := 900;
          tf.Handle := CreateFontIndirect(lf);
          Font.Assign(tf);
          TextOut(Width div 2, (Height div 2) - (Tf.Height) , '90º Graus');

          Font.Color := clYellow;
          tf := TFont.Create;
          tf.Assign(Font);
          GetObject(tf.Handle, sizeof(lf), @lf);
          lf.lfEscapement := 1350;
          lf.lfOrientation := 1350;
          tf.Handle := CreateFontIndirect(lf);
          Font.Assign(tf);
          TextOut(Width div 2, (Height div 2) - (Tf.Height) , '135º Graus');

          Font.Color := clGreen;
          tf := TFont.Create;
          tf.Assign(Font);
          GetObject(tf.Handle, sizeof(lf), @lf);
          lf.lfEscapement := 1800;
          lf.lfOrientation := 1800;
          tf.Handle := CreateFontIndirect(lf);
          Font.Assign(tf);
          TextOut(Width div 2, (Height div 2) - (Tf.Height), '180º Graus');

          Font.Color := clBlack;
          tf := TFont.Create;
          tf.Assign(Font);
          GetObject(tf.Handle, sizeof(lf), @lf);
          lf.lfEscapement := 2250;
          lf.lfOrientation := 2250;
          tf.Handle := CreateFontIndirect(lf);
          Font.Assign(tf);
          TextOut(Width div 2, (Height div 2) - (Tf.Height), '180º Graus');

          tf.Free;

     end;

end;