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
This is one way:
'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
;D :D :) ;D
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
;D ;D ;D
I don't do anything without Sapero's headers.
LarryMc