肛周脓肿封口出黄水:VB创建时间窗体

来源:百度文库 编辑:偶看新闻 时间:2024/03/29 00:03:19
rem 在窗体中加一个picture控件和一个时钟控件
rem .bas文件
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010&
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public 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
'以上为API函数声明
Public Const HWND_TOPMOST = -1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_FRAMECHANGED = &H20
'The frame changed: send WM_NCCALCSIZE
Public Const SWP_DRAWFRAME = SWP_FRAMECHANGED
'以上为程序中用到的常量
Public Const HWND_BOTTOM = 1
Public Const HWND_BROADCAST = &HFFFF&
Public Const HWND_DESKTOP = 0
Public Const HWND_NOTOPMOST = -2
Public Const HWND_TOP = 0
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_NOCOPYBITS = &H100
Public Const SWP_NOOWNERZORDER = &H200
'Don't do owner Z ordering
Public Const SWP_NOREDRAW = &H8
Public Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
Public Const SWP_NOZORDER = &H4
Public Const SWP_SHOWWINDOW = &H40
'以上常量声明在程序中没有使用
'可以试着在调用SetWindowPos函数时使用这些常量或它们的组合
'得到其他效果
Public Const Flags = SWP_DRAWFRAME Or SWP_NOMOVE Or SWP_NOSIZE

rem 窗体代码
Dim y As Integer, R As Single, G As Single, B As Single
Dim i As Integer
Private Sub Form_Activate()
y = 0
Picture1.DrawWidth = 3
Picture1.Line (0, 1500)-(100, 1500)
Picture1.Line (1500, 0)-(1500, 100)
Picture1.Line (3000, 1500)-(2900, 1500)
Picture1.Line (1500, 3000)-(1500, 2900)
End Sub
Private Sub Form_Load()
Me.Left = 15360 - 3480
Me.Top = 0
Picture1.ScaleWidth = 3000
Picture1.ScaleHeight = 3000
Dim sHour%, sMinute%, sSecond%
Const hW = 1500
Const hH = 1500
Const PI = 3.14
SetWindowRgn Me.hwnd, CreateEllipticRgn(1, 1, 206, 206), True
Dim x As Integer
Picture1.ScaleMode = 1
Picture1.DrawMode = 1
Dim res As Long
res = SetWindowPos(Me.hwnd, HWND_TOPMOST, _
                         0, 0, 0, 0, Flags)
Call draw
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
     x = ReleaseCapture()
     Call SendMessage(Me.hwnd, WM_SYSCOMMAND, SC_MOVE + 2, 1)
End If
End Sub
Private Sub Picture1_DblClick()
End
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
     x = ReleaseCapture()
     Call SendMessage(Me.hwnd, WM_SYSCOMMAND, SC_MOVE + 2, 1)
End If
End Sub
Private Sub Timer1_Timer()
Call draw
End Sub

Public Sub draw()
Picture1.Cls
Call Form_Activate
Const CN = 3.14 / 180
sHour = Hour(Time)
sMinute = Minute(Time)
sSecond = Second(Time)
x = 30 * sHour * CN
Picture1.DrawWidth = 3
Picture1.Line (1500, 1500)-(1500 + 600 * Sin(x), 1500 - 600 * Cos(x)), RGB(255, 0, 0)
Picture1.DrawWidth = 2
x = 6 * sMinute * CN
Picture1.Line (1500, 1500)-(1500 + 1000 * Sin(x), 1500 - 1000 * Cos(x))
Picture1.DrawWidth = 1
x = 6 * sSecond * CN
Picture1.Line (1500, 1500)-(1500 + 1300 * Sin(x), 1500 - 1300 * Cos(x))
Picture1.Circle (1500, 1500), 1500
End Sub