home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 3_2004-2005.ISO / Data / Zips / VB_API_cod1852392132005.psc / clsScreenText.cls < prev    next >
Encoding:
Visual Basic class definition  |  2004-05-31  |  4.6 KB  |  140 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsScreenText"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16.  
  17.  
  18. Private Const WM_SYSCOMMAND As Long = &H112
  19.  
  20. Private Declare Function BeginPath Lib "gdi32" (ByVal hdc As Long) As Long
  21. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  22. Private Declare Function EndPath Lib "gdi32" (ByVal hdc As Long) As Long
  23. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  24. Private Declare Function PathToRegion Lib "gdi32" (ByVal hdc As Long) As Long
  25. Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
  26. Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  27. Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  28. Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
  29.  
  30. Private WithEvents Frm      As Form
  31. Attribute Frm.VB_VarHelpID = -1
  32.  
  33.  
  34.  
  35. '----------------------------------------------------------------------
  36. '   INPUTS: |          F: formname
  37. '                   sMsg: text to show on screen                    |string
  38. '              iFontSize: size of the font                          |integer
  39. '              sFontType: style of font to use  i.e "Comic Sans"    |string
  40. '             lFontColor: color of font to use                      |long
  41. '             bFontBold: if the font is bold or not                 |boolean
  42. '            bTextFloat: places form(text) on top                   |boolean
  43. '        bAllowTextMove: user can drag and move the text            |boolean
  44. '             iTextLeft: Left starting point of the text            |integer
  45. '              iTextTop: Top starting point of the text             |integer
  46. '  RETURNS: |
  47. ' COMMENTS: | text is printed on a form (F) and where the text is
  48. '             painted is recorded as the path
  49. '             tben the forms visible region is defined by
  50. '             that path
  51. '----------------------------------------------------------------------
  52. Sub ScreenMsg(sMsg$, iFontSize%, _
  53.                             lFontColor&, bFontBold As Boolean, _
  54.                             iTextLeft%, iTextTop%, _
  55.                             Optional sFontType$ = "Arial Black")
  56. 'VARIABLES:
  57.     Dim hRgn&
  58.     Dim i%, iTop%
  59.     Dim sParts() As String
  60. 'CODE:
  61.     Unload frmMsg
  62.     
  63.     With frmMsg
  64.     'the font to use for the screen message
  65.      .FontName = sFontType
  66.     
  67.     'font size
  68.      .FontSize = iFontSize%
  69.     
  70.     'fontbold?
  71.       .FontBold = bFontBold
  72.     
  73.     'set the backcolor lFontColor
  74.      .BackColor = lFontColor&
  75.  
  76.     'open a path bracket
  77.      BeginPath .hdc
  78.     
  79.     'split the message by CR
  80.      sParts = Split(sMsg, vbCrLf)
  81.     
  82.     'icrement the Y part of text drawing
  83.     'to = the fontsize + 1
  84.      For i = 0 To UBound(sParts)
  85.        'draw the text
  86.        TextOut .hdc, 2, iTop, sParts(i), Len(sParts(i))
  87.        iTop = (iTop + (iFontSize + 2))
  88.      Next i
  89.     
  90.     'close the path bracket
  91.      EndPath .hdc
  92.     
  93.     'convert the path to a region
  94.      hRgn = PathToRegion(.hdc)
  95.     
  96.     'set the Window-region
  97.      SetWindowRgn .hwnd, hRgn, True
  98.     
  99.     'destroy our region
  100.     DeleteObject hRgn
  101.     
  102.     Set Frm = frmMsg
  103.     
  104.     'show the form
  105.     Load frmMsg
  106.     
  107.     'form(text) position
  108.      .Move iTextLeft, iTextTop
  109.     
  110.    'show, dont activate
  111.      ShowWindow .hwnd, 4
  112.      
  113.   End With
  114. 'END CODE:
  115.  
  116. End Sub
  117.  
  118.  
  119. '----------------------------------------------------------------------
  120. '   INPUTS: |
  121. '  RETURNS: |
  122. ' COMMENTS: |kill form reference
  123. '----------------------------------------------------------------------
  124. Private Sub Class_Terminate()
  125.    On Error Resume Next
  126.    
  127.        Set Frm = Nothing
  128. End Sub
  129. '----------------------------------------------------------------------
  130. '   INPUTS: |
  131. '  RETURNS: |
  132. ' COMMENTS: |keep the msg on top
  133. '----------------------------------------------------------------------
  134. Private Sub Frm_Load()
  135. '
  136.        SetWindowPos Frm.hwnd, -1, 0, 0, 0, 0, &H1 Or &H2
  137. End Sub
  138.  
  139.  
  140.