Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpclassname As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
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
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private timerStr(0 To 5) As Integer
Private Sub exit_Click()
Unload Me
End
End Sub
Private Sub about_Click()
eds
End Sub
Function eds()
If Label3.Caption = "By WiNmAnYg0o1" Then
Label3.Alignment = 0
Label3.Caption = "联系我：LLJTSJ@Gmail.com 再选“关于”返回"
GoTo q
End If
If Label3.Caption = "联系我：LLJTSJ@Gmail.com 再选“关于”返回" Then
Label3.Caption = "By WiNmAnYg0o1"
Label3.Alignment = 1
GoTo Skip
End If
Skip:
q:
End Function
Private Sub Form_Load()
Dim i As Integer
'窗体最前显示
With Form1
SetWindowPos .hWnd, HWND_TOPMOST, 0, 0, 0, 0, Flag
End With
'DoTheStuff hWnd '透明窗体,把黑色的部分透明
Timer1.Interval = 1000
Timer1.Enabled = True
Call Timer1_Timer '调用数字图片变换的过程，要不初始会显示默认时钟图片
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Me.MousePointer = 15
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
ElseIf Button = 2 Then
Me.PopupMenu Menucomm
End If
Me.MousePointer = 0
End Sub
Private Sub Label3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Me.MousePointer = 15
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
ElseIf Button = 2 Then
Me.PopupMenu Menucomm
End If
Me.MousePointer = 0
End Sub
Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Me.MousePointer = 15
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
ElseIf Button = 2 Then
Me.PopupMenu Menucomm
End If
Me.MousePointer = 0
End Sub
Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Me.MousePointer = 15
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
ElseIf Button = 2 Then
Me.PopupMenu Menucomm
End If
Me.MousePointer = 0
End Sub
Private Sub Picture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'拖动窗体
If Button = 1 Then
Me.MousePointer = 15
ReleaseCapture
SendMessage Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
ElseIf Button = 2 Then
Me.PopupMenu Menucomm
End If
Me.MousePointer = 0
End Sub
Private Sub Picture2_Click(Index As Integer)
End Sub
Private Sub Timer1_Timer()
Dim i As Integer
Dim hourStr As String, minuteStr As String, secondStr As String
hourStr = Hour(Time)
minuteStr = Minute(Time)
secondStr = Second(Time)
timerStr(0) = IIf(Len(hourStr) = 2, Left(hourStr, 1), 0)
timerStr(1) = IIf(Len(hourStr) = 2, Right(hourStr, 1), hourStr)
timerStr(2) = IIf(Len(minuteStr) = 2, Left(minuteStr, 1), 0)
timerStr(3) = IIf(Len(minuteStr) = 2, Right(minuteStr, 1), minuteStr)
timerStr(4) = IIf(Len(secondStr) = 2, Left(secondStr, 1), 0)
timerStr(5) = IIf(Len(secondStr) = 2, Right(secondStr, 1), secondStr)
For i = 0 To 5
Picture1(i).Picture = ImageList1.ListImages(timerStr(i) + 1).Picture
Next i
End Sub
只能公布下代码了……所有代码……其他请自己备
Option Explicit
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
'常量
Public Const MF_BYPOSITION = &H400&
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_HIDEWINDOW = &H80
Public Const SWP_SHOWWINDOW = &H40
Public Const Flag = SWP_NOMOVE Or SWP_NOSIZE '不移动和改变窗口大小
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)
Public Const LWA_ALPHA = &H2
'拖动窗体的API
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 HTCAPTION = 2
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Const WM_NCLBUTTONDOWN = &HA1
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Sub DoTheStuff(ByVal hWnd As Long)
SetWindowLong hWnd, -20, &H80000 '设置透明,那些颜色为&H00000000&的变为透明
SetLayeredWindowAttributes hWnd, 0, 0, 1
End Sub
有些没有用的
上面是模块
开头是FRM
