Hello,
Is there anyone who could make me a firefly compatible version of sidelog.bas. It draws a vertical text on a label.
http://www.powerbasic.com/support/forums/Forum7/HTML/001971.html
Thanks for anyone trying or pointing me in the right direction,
Marc
Create a new project and paste the following into the code editor for the main form. I am handling everything in the CUSTOM event rather than separate the code into pieces.
'= Text Background Gradient Color Constants.
%RGB_RED = 0
%RGB_BLUE = 1
%RGB_GREEN = 2
'==============================================================================
'= UDT (User Defined Types) STRUCTURES.
'==============================================================================
Type AngleTextTYPE
sText As Asciiz * 255 '= Text String To Draw.
dwTextColor As Dword '= Text Color.
lHeight As Long '= hDC Height.
lWidth As Long '= hDC Width.
lGradient As Long '= %TRUE Draw Gradient.
lGradientColor As Long '= Gradient Color.
lFntSize As Long '= LOGFONT - Font Info.
lFntHeight As Long
lFntWidth As Long
lFntEscapement As Long '= This Controls The Angle Of The
lFntOrientation As Long '= Text. NOTE: Both Should Be Set The Same.
lFntWeight As Long
lFntItalic As Long
lFntUnderline As Long
lFntStrikeOut As Long
lFntCharSet As Long
lFntOutPrecision As Long
lFntClipPrecision As Long
lFntQuality As Long
lFntPitchAndFamily As Long
sFntFaceName As Asciiz * 255
End Type
'==============================================================================
'= GLOBAL AND MISC VARIABLES.
'==============================================================================
Global udtAt As AngleTextTYPE '= Global UDT.
'------------------------------------------------------------------------------------------------------------------------
Function FRMMAIN_CUSTOM ( _
hWndForm As Dword, _ ' handle of Form
wMsg As Long, _ ' type of message
wParam As Dword, _ ' first message parameter
lParam As Long _ ' second message parameter
) As Long
Local hDC As Dword, hCtl As Dword, lXpos As Long, lYpos As Long
Local pPaint As PAINTSTRUCT
Local nRect As Rect
Select Case wMsg
Case %WM_CREATE
'= Initialize The Angled Text Structure.
udtAt.sText = "PowerBasic PB/WIN 7.02 Compiler."
udtAt.dwTextColor = %WHITE
udtAt.lHeight = 0
udtAt.lWidth = 0
udtAt.lGradient = %TRUE
udtAt.lGradientColor = %RGB_BLUE
udtAt.lFntSize = 12
'udtAt.lFntHeight = Calculated In The DrawAngleText Sub.
udtAt.lFntWidth = 0
'= The 2 Values Below Should be Set To The Same Values ie: 900
'= For Vertical TEXT. Play With Them And See What Happens.
'= Change Them The 2 900 Values To 700.
udtAt.lFntEscapement = 900
udtAt.lFntOrientation = 900
udtAt.lFntWeight = %FW_BOLD
udtAt.lFntItalic = %TRUE
udtAt.lFntUnderline = %FALSE
udtAt.lFntStrikeOut = %FALSE
udtAt.lFntCharSet = %DEFAULT_CHARSET
udtAt.lFntOutPrecision = %OUT_DEFAULT_PRECIS
udtAt.lFntClipPrecision = %CLIP_DEFAULT_PRECIS
udtAt.lFntQuality = %ANTIALIASED_QUALITY
udtAt.lFntPitchAndFamily = %FF_DONTCARE
udtAt.sFntFaceName = "MS Sans Serif"
Case %WM_PAINT
'= Get Controls Handle And Size.
GetClientRect HWND_FRMMAIN_LABEL1, nRect
udtAt.lWidth = nRect.nRight - nRect.nLeft
udtAt.lHeight = nRect.nBottom - nRect.nTop
'= Draw The Angled Text To Controls DC.
hDC = BeginPaint(HWND_FRMMAIN_LABEL1, pPaint)
DrawAngleText hDC, 4, udtAt.lFntSize
EndPaint HWND_FRMMAIN_LABEL1, pPaint
Function = 0
Exit Function
Case %WM_ERASEBKGND
Function = 0
Exit Function
Case %WM_SIZE
MoveWindow HWND_FRMMAIN_LABEL1, 0, 0, 24, HiWrd(lParam), %TRUE
Case %WM_DESTROY '= Clean-Up All Resources Used.
DeleteDC hDC
End Select
End Function
'==============================================================================
'= DrawAngleText.
'=
'= hDC - Is The Label Controls DC.
'= lHPos - Controls The Horz Positioning Of The Text.
'= lVpos - Controls The Vert Positioning Of The Text.
'=
'= NOTE: This Is Great For Custom AboutBoxes Etc.
'==============================================================================
Sub DrawAngleText(ByVal hDC As Dword, ByVal lHpos As Long, ByVal lVpos As Long)
Register lOnBand As Long
Local lResult As Long, fStep As Single
Local hBrush As Dword, hFont As Dword, hFontOld As Dword
Local rectFill As Rect, rectClient As Rect, tLF As LOGFONT
'============================================================================
'= Draw The Gradient.
'============================================================================
SetGraphicsMode hDC, %GM_ADVANCED '= Set Graphics Mode To Advanced.
SetBkMode hDC, %TRANSPARENT '= Set Background Mode To Transparent.
SetTextColor hDC, udtAt.dwTextColor '= Set The Foreground Text Color.
'= Check For Gradient Color And Draw The Gradient.
If udtAt.lGradient Then
GetClientRect WindowFromDC(hDC), rectClient
fStep = rectClient.nbottom / 200
For lOnBand = 0 To 199
SetRect rectFill, 0, lOnBand * fStep, rectClient.nright + 1, (lOnBand + 1) * fStep
'= Create The Colored Brush Depending On Users Color Celection.
Select Case udtAt.lGradientColor
Case %RGB_RED
hBrush = CreateSolidBrush(RGB((255 - lOnBand), 0, 0))
Case %RGB_GREEN
hBrush = CreateSolidBrush(RGB(0, (255 - lOnBand), 0))
Case %RGB_BLUE
hBrush = CreateSolidBrush(RGB(0, 0, (255 - lOnBand)))
End Select
FillRect hDC, rectFill, hBrush
DeleteObject hBrush
Next lOnBand
End If
'============================================================================
'= Create The Angled Font.
'= You Can Draw The Text Using This Function At Any Angle You Wish.
'============================================================================
'= Initialize The LOGFONT Structure.
tLF.lfHeight = -MulDiv((udtAt.lFntSize), _
(GetDeviceCaps(hDC, %LOGPIXELSY)), 72)
tLF.lfFaceName = udtAt.sFntFaceName
tLF.lfPitchAndFamily = udtAt.lFntPitchAndFamily
If udtAt.lFntWeight = %FW_DONTCARE Then
tLF.lfWeight = %FW_NORMAL
Else
tLF.lfWeight = udtAt.lFntWeight
End If
tLF.lfUnderline = udtAt.lFntUnderline
tLF.lfItalic = udtAt.lFntItalic
tLF.lfStrikeOut = udtAt.lFntStrikeOut
tLF.lfCharSet = udtAt.lFntCharSet
tLF.lfOutPrecision = udtAt.lFntOutPrecision
tLF.lfClipPrecision = udtAt.lFntClipPrecision
tLF.lfQuality = udtAt.lFntQuality
tLF.lfEscapement = udtAt.lFntEscapement
tLF.lfOrientation = udtAt.lFntOrientation
'= Create The Font For Drawing.
hFont = CreateFontIndirect(tLF)
'============================================================================
'= Display New Font With Angled Text And Delete All Resources Used.
'============================================================================
If (hFont <> 0) Then
hFontOld = SelectObject(hDC, hFont)
lResult = TextOut(hDC, lHpos, udtAt.lHeight - lVpos, _
ByCopy udtAt.sText, Len(udtAt.sText))
SelectObject hDC, hFontOld
DeleteObject hFont
End If
End Sub