想你的帮助文件也能这样秀一把吗？那就看看下面的：
窗体一：frmMain
复制内容到剪贴板
代码:
Option Explicit
Private Sub mnuHelpAbout_Click()
frmAbout.Show vbModal, Me
End Sub窗体二：frmAbout
复制内容到剪贴板
代码:
Option Explicit
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Const DT_BOTTOM As Long = &H8
Const DT_CALCRECT As Long = &H400
Const DT_CENTER As Long = &H1
Const DT_EXPANDTABS As Long = &H40
Const DT_EXTERNALLEADING As Long = &H200
Const DT_LEFT As Long = &H0
Const DT_NOCLIP As Long = &H100
Const DT_NOPREFIX As Long = &H800
Const DT_RIGHT As Long = &H2
Const DT_SINGLELINE As Long = &H20
Const DT_TABSTOP As Long = &H80
Const DT_TOP As Long = &H0
Const DT_VCENTER As Long = &H4
Const DT_WORDBREAK As Long = &H10
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'the actual text to scroll. This could also be loaded in from a text file
Const ScrollText As String = "想学习就在HTTP://WWW.HACKERXFILES.NET" & vbCrLf & _
""
Dim EndingFlag As Boolean
Private Sub Form_Activate()
RunMain
End Sub
Private Sub Form_Load()
picScroll.ForeColor = vbYellow
picScroll.FontSize = 14
End Sub
Private Sub RunMain()
Dim LastFrameTime As Long
Const IntervalTime As Long = 40
Dim rt As Long
Dim DrawingRect As RECT
Dim UpperX As Long, UpperY As Long 'Upper left point of drawing rect
Dim RectHeight As Long
'show the form
frmAbout.Refresh
'Get the size of the drawing rectangle by suppying the DT_CALCRECT constant
rt = DrawText(picScroll.hdc, ScrollText, -1, DrawingRect, DT_CALCRECT)
If rt = 0 Then 'err
MsgBox "Error scrolling text", vbExclamation
EndingFlag = True
Else
DrawingRect.Top = picScroll.ScaleHeight
DrawingRect.Left = 0
DrawingRect.Right = picScroll.ScaleWidth
'Store the height of The rect
RectHeight = DrawingRect.Bottom
DrawingRect.Bottom = DrawingRect.Bottom + picScroll.ScaleHeight
End If
Do While Not EndingFlag
If GetTickCount() - LastFrameTime > IntervalTime Then
picScroll.Cls
DrawText picScroll.hdc, ScrollText, -1, DrawingRect, DT_CENTER Or DT_WORDBREAK
'update the coordinates of the rectangle
DrawingRect.Top = DrawingRect.Top - 1
DrawingRect.Bottom = DrawingRect.Bottom - 1
'control the scolling and reset if it goes out of bounds
If DrawingRect.Top < -(RectHeight) Then 'time to reset
DrawingRect.Top = picScroll.ScaleHeight
DrawingRect.Bottom = RectHeight + picScroll.ScaleHeight
End If
picScroll.Refresh
LastFrameTime = GetTickCount()
End If
DoEvents
Loop
Unload Me
Set frmAbout = Nothing
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblExit.ForeColor = vbYellow
End Sub
Private Sub Form_Unload(Cancel As Integer)
EndingFlag = True
End Sub
Private Sub lblExit_Click()
Beep
EndingFlag = True
End Sub
Private Sub lblExit_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblExit.ForeColor = vbRed
End Sub[
本帖最后由 破风 于 2007-2-1 12:38 编辑 ]
