Impressao - criando e usando com a impressora as fontes Draft 10cpi, Draft 12cpi e Draft 17cpi

// criando e usando com a impressora as fontes Draft 10cpi, Draft 12cpi e Draft 17cpi

// FIQUEI QUASE 2 ANOS TENTANDO PARA FAZER ISSO!!! - AGORA NAO É SÓ O WORD QUE FAZ

// Ass. Flávio Junior

// Dê preferencia para o método usando METAFILE, mas mantive o método bitmap

// para ver como funciona caso realmente seja necessario usa-lo

unit DraftFontUnit;

interface

uses Forms, Classes, Controls, StdCtrls, Windows, Graphics, ARotinasUnit, Printers;

type

  TDraftFontForm = class(TForm)

    ImprimirComBitMapBtn: TButton;

    B66Btn: TButton;

    B88Btn: TButton;

    ImprimirComMetaFileBtn: TButton;

    Button2: TButton;

    Button4: TButton;

    procedure FormCreate(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure ImprimirComBitMapBtnClick(Sender: TObject);

    procedure ImprimirComMetaFileBtnClick(Sender: TObject);

  end;

var

  DraftFontForm: TDraftFontForm;

  // usados para criação das fontes:

  LogFont  : tagLOGFONTA;

  FontHSize: Integer;

  // variaveis do tipo TFont

  F10CPP , F17CPP , F12CPP , F20CPP       : TFont;

  F10CPPB, F17CPPB, F12CPPB, F20CPPB, FExp: TFont;

const

  Texto10 = '10cpp/6lpp  Teste para com 10 cpp e 6  LINHAS POR POLEGADAS, ESTE E MODO NORM=80';

  Texto12 = '12cpp/6lpp  Teste para com 12 cpp  e  6 linhas POR POLEGADAS, ESTE E MODO UM POUCO MENOR QUE =96';

  Texto17 = '17cpp/6lpp  Teste para com 17 cpp e 6 linhas por polegadas, este E MODO COMPRIMIDO DE IMPRESSÃO ESTA LINHA SERA IMPRESSA APENAS 1 VEZ=137';

  Texto20 = '20cpp/6lpp  Teste para com 20 cpp e 6 linhas por polegadas, este e modo super COMPRIMIDO DE IMPRESSÃO, ESTA LINHA SERA IMPRESSA APENAS UMA VEZ+COMPLEMENTO = 160';

implementation

{$R *.dfm}

procedure TDraftFontForm.FormCreate(Sender: TObject);

begin

  // carrega alguns parametros necessários que serão comuns as fontes

  FontHSize := 98;

  LogFont.lfHeight         := FontHSize;           LogFont.lfEscapement     := 0;

  LogFont.lfOrientation    := 0;                   LogFont.lfItalic         := 0;

  LogFont.lfUnderline      := 0;                   LogFont.lfStrikeOut      := 0;

  LogFont.lfWeight         := FW_NORMAL;           LogFont.lfCharSet        := DEFAULT_CHARSET;

  LogFont.lfOutPrecision   := OUT_DEFAULT_PRECIS;  LogFont.lfClipPrecision  := CLIP_DEFAULT_PRECIS;

  LogFont.lfQuality        := DRAFT_QUALITY;       LogFont.lfPitchAndFamily := FIXED_PITCH;

  LogFont.lfFaceName       := 'InternalFont';

  // cria as fontes internas

  F10CPP := TFont.Create;  F12CPP := TFont.Create;  F17CPP := TFont.Create;  F20CPP := TFont.Create;

  F10CPPB:= TFont.Create;  F12CPPB:= TFont.Create;  F17CPPB:= TFont.Create;  F20CPPB:= TFont.Create;

  FExp   := TFont.Create;

  // fontes normais

  LogFont.lfWidth  := 57;    F10CPP.Handle    := CreateFontIndirect(LogFont);

  LogFont.lfWidth  := 47;    F12CPP.Handle    := CreateFontIndirect(LogFont);

  LogFont.lfWidth  := 33;    F17CPP.Handle    := CreateFontIndirect(LogFont);

  LogFont.lfWidth  := 28;    F20cpp.Handle    := CreateFontIndirect(LogFont);

  LogFont.lfWidth  := 68;    FExp.Handle      := CreateFontIndirect(LogFont);

  // fontes bold.

  LogFont.lfWeight := FW_BOLD;

  LogFont.lfWidth  := 59;   F10cppB.Handle   := CreateFontIndirect(LogFont);

  LogFont.lfWidth  := 49;   F12CPPB.Handle   := CreateFontIndirect(LogFont);

  LogFont.lfWidth  := 34;   F17CPPB.Handle   := CreateFontIndirect(LogFont);

  LogFont.lfWidth  := 29;   F20cppB.Handle   := CreateFontIndirect(LogFont);

end;

procedure TDraftFontForm.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  // libera fontes da memoria

  F10CPP.Free;  F12CPP.Free;  F17CPP.Free;  F20CPP.Free;  F10CPPB.Free;  FExp.Free;

end;

// criando impressão via bitmap (muito mais lento)

procedure TDraftFontForm.ImprimirComBitMapBtnClick(Sender: TObject);

var

  OldBkMode, I, Y, H, PY, Max: Integer;

  Bit: TBitmap;

begin

  Bit                    := TBitmap.Create;

  Bit.Monochrome         := True;                                     // monocromatico senão fica zolhentos megabaites

  Bit.Canvas.Font        := F10CPP;                                   // fonte padrão

  Bit.Width              := Bit.Canvas.TextWidth(RepeteStr('W',81));  // largura que precisaremos do bitmap

  Bit.Height             := Printer.PageHeight;

  Bit.Canvas.Brush.Color := clWhite;

  OldBkMode              := SetBkMode(Handle, TRANSPARENT);           // modo transparente no canvas

  PY                     := 1;

  // tem 3 botões na tela, (tag = 1,66,88) tag = 1 é só para imprimir as fontes diferentes (tag = 1)

  if TComponent(Sender).Tag = 1 then

  begin

    Y := 100;

    Bit.Canvas.Font := F10CPP;   Bit.Canvas.TextOut(1, PY, Texto10);          Inc(PY, Y);

    Bit.Canvas.Font := F10CPPB;  Bit.Canvas.TextOut(1, PY, Texto10);          Inc(PY, Y);

    Bit.Canvas.Font := F12CPP;   Bit.Canvas.TextOut(1, PY, Texto12);          Inc(PY, Y);

    Bit.Canvas.Font := F12CPPB;  Bit.Canvas.TextOut(1, PY, Texto12);          Inc(PY, Y);

    Bit.Canvas.Font := F17CPP;   Bit.Canvas.TextOut(1, PY, Texto17);          Inc(PY, Y);

    Bit.Canvas.Font := F17CPPB;  Bit.Canvas.TextOut(1, PY, Texto17);          Inc(PY, Y);

    Bit.Canvas.Font := F20CPP;   Bit.Canvas.TextOut(1, PY, Texto20);          Inc(PY, Y);

    Bit.Canvas.Font := F20CPPB;  Bit.Canvas.TextOut(1, PY, Texto20);          Inc(PY, Y);

    Bit.Canvas.Font := FExp;     Bit.Canvas.TextOut(1, PY, 'EXPANDIDO NORMAL');

  end

  else // outros 2 botões

  begin

    if TComponent(Sender).Tag = 66 then  // tag = 66 é um teste de 6LPP

    begin

      H   := Bit.Canvas.TextHeight('ÇÁ') + 4;

      Max := 63;

    end

    else                                 // tag = 88 é um teste de 6LPP

    begin

      H   := Bit.Canvas.TextHeight('ÇÁ') - 22;

      Max := 83;

    end;

    // preenche a folha com bobissas

    for I := 1 to Max do

    begin

      Bit.Canvas.TextOut(1, PY, StrZero(I, 2) + '_ÇÁ_1,2_' + RepeteStr(' 234567890', 7));

      Inc(PY, H);

    end;

  end;

  // imprime

  Printer.BeginDoc;

  Printer.Canvas.Draw(1,1,Bit);

  Printer.EndDoc;

  SetBkMode(Handle, OldBkMode);

  Bit.Free;

end;

// criando impressão via metafile (infinitamente + rapido e menor)

procedure TDraftFontForm.ImprimirComMetaFileBtnClick(Sender: TObject);

var

  Meta    : TMetafile;

  MFCanvas: TMetaFileCanvas;

  I, Y, H, PY, Max: Integer;

begin

  Meta          := TMetafile.Create;       // cria o MetaFile

  Meta.Width    := Printer.PageWidth;      // seta os tamanhos

  Meta.Height   := Printer.PageHeight;

  MFCanvas      := TMetafileCanvas.Create(Meta, 0);  // cria um "canvas" que será usado para "desenhar" cada folha

  MFCanvas.Font := F10CPP;

  PY            := 1;

  // tem 3 botões na tela, (tag = 1,66,88) tag = 1 é só para imprimir as fontes diferentes (tag = 1)

  if TComponent(Sender).Tag = 1 then

  begin

    Y := 100;

    MFCanvas.Font := F10CPP;   MFCanvas.TextOut(1, PY, Texto10);          Inc(PY, Y);

    MFCanvas.Font := F10CPPB;  MFCanvas.TextOut(1, PY, Texto10);          Inc(PY, Y);

    MFCanvas.Font := F12CPP;   MFCanvas.TextOut(1, PY, Texto12);          Inc(PY, Y);

    MFCanvas.Font := F12CPPB;  MFCanvas.TextOut(1, PY, Texto12);          Inc(PY, Y);

    MFCanvas.Font := F17CPP;   MFCanvas.TextOut(1, PY, Texto17);          Inc(PY, Y);

    MFCanvas.Font := F17CPPB;  MFCanvas.TextOut(1, PY, Texto17);          Inc(PY, Y);

    MFCanvas.Font := F20CPP;   MFCanvas.TextOut(1, PY, Texto20);          Inc(PY, Y);

    MFCanvas.Font := F20CPPB;  MFCanvas.TextOut(1, PY, Texto20);          Inc(PY, Y);

    MFCanvas.Font := FExp;     MFCanvas.TextOut(1, PY, 'EXPANDIDO NORMAL');

  end

  else  // outros 2 botões

  begin

    if TComponent(Sender).Tag = 66 then

    begin

      H   := MFCanvas.TextHeight('ÇÁ')  +4;    // tag = 66 é um teste de 6LPP        A = +4,  Cartao =  -2

      Max := 66;

    end

    else

    begin

      H   := MFCanvas.TextHeight('ÇÁ') - 22;  // tag = 88 é um teste de 6LPP        A4 = 22,  Carta  =  26

      Max := 88;

    end;

    // preenche a folha com bobissas

    for I := 1 to Max do

    begin

      MFCanvas.TextOut(1, PY, StrZero(I, 2) + '_ÇÁ_1,2_' + RepeteStr(' 234567890', 7));

      Inc(PY, H);

    end;

  end;

  MFCanvas.Free;

  // sava em arquivo para poder ser "consultado' (nao necessário)

  Meta.SaveToFile('c:\teste.wmf');

  // imprime

  Printer.BeginDoc;

  Printer.Canvas.Draw(1,1,Meta);

  Printer.EndDoc;

  Meta.Free;

end;

end.