用VB设计霓虹灯广告牌制作程序
发布网友
发布时间：2022-04-24 09:32
共1个回答
热心网友
时间：2022-05-03 10:56
才10分
你要的是大屏幕字符或者ppt播放程序吧。
给你点代码仅供参考；
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type ROWRECT
oRT As RECT
sa As String
bMove As Boolean
sOld As String
End Type
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As Long) As Long
' To set fram control as the parent of the slide show window
Public Declare Function SetParent Lib "user32" _
(ByVal hWndChild As Long, _
ByVal hWndNewParent As Long) As Long
Public 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
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
Public Const HWND_TOPMOST = -1&
Public Const HWND_NOTOPMOST = -2&
Public Const SWP_NOSIZE = &H1&
Public Const SWP_NOMOVE = &H2&
Public Const SWP_NOACTIVATE = &H10&
Public Const SWP_SHOWWINDOW = &H40&
Public Const DT_BOTTOM = &H8
Public Const DT_CALCRECT = &H400
Public Const DT_CENTER = &H1
Public Const DT_CHARSTREAM = 4 ' Character-stream, PLP
Public Const DT_DISPFILE = 6 ' Display-file
Public Const DT_EXPANDTABS = &H40
Public Const DT_EXTERNALLEADING = &H200
Public Const DT_INTERNAL = &H1000
Public Const DT_LEFT = &H0
Public Const DT_METAFILE = 5 ' Metafile, VDM
Public Const DT_NOCLIP = &H100
Public Const DT_NOPREFIX = &H800
Public Const DT_PLOTTER = 0 ' Vector plotter
Public Const DT_RASCAMERA = 3 ' Raster camera
Public Const DT_RASDISPLAY = 1 ' Raster display
Public Const DT_RASPRINTER = 2 ' Raster printer
Public Const DT_RIGHT = &H2
Public Const DT_SINGLELINE = &H20
Public Const DT_TABSTOP = &H80
Public Const DT_TOP = &H0
Public Const DT_VCENTER = &H4
Public Const DT_WORDBREAK = &H10
下面是timer控件里的代码。定时刷新产生动的效果。
If mBchange And miChange > miShowWorkInfoTime + 1 Then
' moPptApp.Presentations.Count
'If op.SlideShowSettings.Run.View.Slide.SlideNumber = 2 Then
If moPptApp.Presentations.Count = 0 Then
PicA.Visible = False
miChange = 1
'moPptPresentation.Close
moPptApp.Quit
DoEvents
End If
Else
'PicA.Visible = False
'If miChange = miShowWorkInfoTime + miShowWelcomeInfoTime Then miChange = 1 Else miChange = miChange + 1
miChange = miChange + 1
If miChange > 10000000 Then miChange = 0
' If miChange Mod 2 = 0 Then
PicA.Cls ‘屏的左半部清空
picB.Cls ‘屏的右半部清空
If miChange Mod 100 = 0 Then s_loadData
For iA = 0 To miRows - 1
If moRectA(iA).sa <> "" Then
If moRectA(iA).bMove Then moRectA(iA).oRT.Left = moRectA(iA).oRT.Left - 2
If moRectA(iA).oRT.Left < 80 - miColWidth Then
moRectA(iA).oRT.Left = miColWidth - 80
End If
moRectA(iA).oRT.Right = moRectA(iA).oRT.Left + miColWidth
DrawText PicA.hdc, moRectA(iA).sa, -1, moRectA(iA).oRT, DT_CENTER Or DT_WORDBREAK ’这个是关键，在屏幕上重新写出字符。
End If
If moRectB(iA).sa <> "" Then
If moRectB(iA).bMove Then moRectB(iA).oRT.Left = moRectB(iA).oRT.Left - 2
If moRectB(iA).oRT.Left < 80 - miColWidth Then
moRectB(iA).oRT.Left = miColWidth - 80
End If
moRectB(iA).oRT.Right = moRectB(iA).oRT.Left + miColWidth
DrawText picB.hdc, moRectB(iA).sa, -1, moRectB(iA).oRT, DT_CENTER Or DT_WORDBREAK ’这个是关键，在屏幕上重新写出字符。
End If
s_MakeLine
Next
DoEvents
' End If
End If
DoEvents
