Printing on an angle

[jerryclement]

I've searched for printing letters on an angle with no luck.
Does anyone know of such a routine printing in a regular window?
Thanks,  JerryC

[LarryMc]

This is one way:

Code Select Expand

'This code snippet shows how to draw a rotated text on a form.
'
'Written by Nir Sofer
'
'http://nirsoft.mirrorz.com
$include "windowssdk.inc"

DEF hdc as INT
DEF lf As LOGFONT
uint GFont   
DIALOG d1

CREATEDIALOG d1,0,0,600,350,@CAPTION|@SYSMENU|@BORDER,0,"Drawtext Test",&dialoghandler

DOMODAL d1

END
   
WAITUNTIL d1 = 0

SUB dialoghandler
SELECT @MESSAGE
CASE @IDINITDIALOG
CENTERWINDOW d1
SETFONT d1, "Arial", 12, 700, @SFITALIC | 0x00FF0000
case WM_SETFONT
GFont = @wParam
case @IDPAINT
Form_Paint()
releasehdc d1,hdc
CASE @IDCLOSEWINDOW
CLOSEDIALOG d1,@IDOK
ENDSELECT

ENDSUB

SUB GetFont(hdc As INT, Angle As uint)
    'Get the current HFONT handle
hFont = GetCurrentObject(hdc, OBJ_FONT)
    'Retrieve the LOGFONT structure from the font handle.
    GetObject (hFont, Len(lf), lf)
    'Change the font angle
    lf.lfEscapement =Int(Angle * 10)
    lf.lfOrientation = lf.lfEscapement
    'Create a new font
    GFont = CreateFontIndirect(lf)
EndSUB

SUB Form_Paint
STOP
DEF TextToDraw As String
    DEF X As INT
    DEF Y As INT
    DEF Angle As Double

'We must use a TrueType font, otherwise the text won't be rotated.

hdc = GETHDC(d1)
GetFont(hdc,30)
TextToDraw = "http://nirsoft.cjb.net"
   
    X = 100: Y = 100
    'Select the font into the DC
    hPrevFont = SelectObject(hdc, GFont)
    'Draw the text in 3 colors in order to create 3D effect.
    DrawTextSUB (hdc, TextToDraw, X-1, Y-1, Angle, RGB(0, 0, 255))
    DrawTextSUB (hdc, TextToDraw, X+1, Y+1, Angle, RGB(0, 0, 0))
    DrawTextSUB (hdc, TextToDraw, X, Y, Angle, RGB(0, 0, 192))
    'destroy the font object.
    DeleteObject (GFont)
ENDSUB

Sub DrawTextSUB(hdc As INT, Text As String, X As INT, Y As INT, Angle As Double, _COLOR As double)
    Dim hFont As uint
    Dim hPrevFont As uint
   
    SetTextColor (hdc, _COLOR)

    'Draw the text
move d1,x,y
    TextOut (hdc, X, Y, Text, Len(Text))
    'Select back the previous font
    SelectObject (hdc, hPrevFont)

End Sub

LarryMc

[jerryclement]

 

Thanks Larry!!  It took me awhile to figure out that I had NOT installed Sapero's IWB header.  It works like a charm.  Thanks soo much for the help.
JerryC

[LarryMc]

I don't do anything without Sapero's headers.

LarryMc