Roteret tekst

prøv den her :

type
    TConvertColor = record
      case boolean of
      true : (C : TColor);
      false : (R : byte; B : byte; G : byte; dummy : byte);
    end;

procedure DC_TextOut(c:TCanvas;x,y,winkel,groesse:integer;txt:PChar;color :  TColor);
// works only with TrueType !!!!!!!!!!!!!!!!!!!!!!!
var hfont, fontold : integer;
    dc            : hdc;
    fontname      : string;
begin
  dc := c.handle;
  SetBkMode(dc,transparent);
  fontname := c.font.name + #0;
  hfont  := CreateFont(-groesse,0,winkel*10,0,fw_normal,0,0,0,1,out_tt_precis,$10,2,4,@fontname[1]);

  If SetTextColor(dc,RGB(TConvertColor(Color).R,TConvertColor(Color).G,TConvertColor(Color).B))=CLR_INVALID then
    ShowMessage(\'Fehler\');

  fontold := SelectObject(dc,hfont);
  c.TextOut(x,y,txt);
  SelectObject(dc, fontold);
  DeleteObject(hfont);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  DC_TextOut(Canvas,100,100,37,50,\'Es war ein mal ein Pferde\', clred);
end;



Så skal du bare smide den ud på printerens Canvas i stedet på Formens Canvas ...

Jens B

ellers prøv den her. hvor FD er en Font Dialog

procedure TForm1.Button1Click(Sender: TObject);
var
  OldFont: TFont;
  NewFont: THandle;
  LogFont: TLogFont;
begin
  OldFont := TFont.Create;
  with Canvas do begin
    {Save the current form font}
    OldFont.Assign(Font);
    {Pick the new font}
    if FD.Execute then Canvas.Font.Assign(FD.Font);
    {Fill in the TLogFont fields}
    with LogFont do begin
      lfHeight := Font.Height;                {Srt to Canvas.Font.Height}
      lfWidth := 0;                          {Let font mapper choose
                                              width}
      lfEscapement := 450;                    {Angle of print, in 10ths of
                                              degree, in this case 45
                                              degrees}
      lfOrientation := 0 ;                    {Ignored by Windows}
      lfWeight := FW_BOLD;                    {Default}
      lfItalic := 0;                          {No Italics}
      lfUnderline := 0;                      {No underline}
      lfStrikeout := 0;                      {No strikeout}
      lfCharSet := ANSI_CHARSET;              {Default}
      lfOutPrecision := OUT_TT_ONLY_PRECIS;  {Force True Type fonts}
      lfClipPrecision := CLIP_DEFAULT_PRECIS; {Default}
      lfQuality := PROOF_QUALITY;            {Windows gets a better one
                                              if available}
      lfPitchAndFamily := Variable_Pitch;    {Default}
      StrPCopy(lfFaceName, Font.Name);        {Canvas\'s font name}
    end;
    Brush.Color := clSilver;
    {Create and get handle of temporary font}
    NewFont := CreateFontIndirect(LogFont);
    {Assign temporary font to form\'s Canvas}
    Font.Handle := NewFont;
    {Write text to form\'s Canvas}
    TextOut(10, 260, \'Jens Borrisholt\');
    TextOut(35, 260, \'i G dur til min Hest \');
    TextOut(60, 260, \'*** TEST PRINTING ***\');
    {Restore form\'s original font}
    Font.Assign(OldFont);
  end;
  {Destroy temporary font}
  DeleteObject(NewFont);
end;

Jens B

Nu går det lidt stærkt. Jeg har lige afprøvet første mulighed, og gik ind igen for at give dig point - for det virker.

Dit fortsatte svar vil jeg afprøve ved lejlighed.

Tak for hjælpen.