仿360安全卫士-Windows电脑助手软件-小蔡电脑助手3.0源码
Visual studio 2008/2010+
该软件源码体现了功能如下：电脑体检，系统优化清理，加速，工具助手以及网购导航等便捷功能。
具体软件功能可以查看
https://blog.csdn.net/JczmDeveloper/article/details/124861207
2022-05-19 17:01:14
33.85MB
原tab控件，仿360开关控件版权归原作者!
VB控件背景透明代码来自：新浪 “玄雨清风”的博客
感谢以上两位源代码作者
链接:http://pan.baidu.com/s/1hrAEXqG 密码:nfhc
'-----------------------以下是转自博客的控件透明源代码(可透明至父窗体或桌面)-------------
'添加一个用户控件UserControl,代如下：
Option Explicit
'实现用户控件UserControl的"伪透明"
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject 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 Const WM_ERASEBKGND = &H14
Private Const WM_PAINT = &HF
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Private m_BK As Boolean
'复制控件在父窗口的背景
Private Sub CopyParentBackground(ByVal phWnd As Long, ByVal chWnd As Long, ByVal hDestDC As Long)
Dim lpRect As RECT, lpPoint As POINTAPI, nWidth As Long, nHeight As Long
Dim BitMap As Long, oldBitMap As Long, hDC As Long, memDC As Long
Call GetWindowRect(phWnd, lpRect) 'Call GetClientRect(phWnd, lpRect)
nWidth = lpRect.Right - lpRect.Left '获取控件的宽度
nHeight = lpRect.Bottom - lpRect.Top '获取控件的高度
hDC = GetDC(0)
BitMap = CreateCompatibleBitmap(hDC, nWidth, nHeight)
Call ReleaseDC(0, hDC)
memDC = CreateCompatibleDC(0)
oldBitMap = SelectObject(memDC, BitMap)
Call SendMessage(phWnd, WM_ERASEBKGND, memDC, 0)
Call SendMessage(phWnd, WM_PAINT, memDC, 0)
'至此memDC上已经保存了父窗口的背景内容
'用户可以调用BitBlt(...)等函数拷贝memDC的内容到子窗口的某个区域，
'这样就达到了透明效果;
Call GetWindowRect(chWnd, lpRect)
lpPoint.X = lpRect.Left
lpPoint.Y = lpRect.Top
Call ScreenToClient(phWnd, lpPoint) '获取控件在父窗口的左上角位置
Call BitBlt(hDestDC, 0, 0, nWidth, nHeight, memDC, lpPoint.X, lpPoint.Y, SRCCOPY)
''''''''''''''''''''''复制背景之后,在这里可以其他事情''''''''''''''''''''''''''''
UserControl.CurrentY = 10
UserControl.Print "透明用户控件"
UserControl.Refresh
'
Call SelectObject(memDC, oldBitMap)
Call DeleteDC(memDC)
Call DeleteObject(BitMap)
End Sub
'复制控件在屏幕的背景
Private Sub CopyScreenBackground(ByVal phWnd As Long, ByVal chWnd As Long, ByVal hDestDC As Long)
Dim lpRect As RECT, nWidth As Long, nHeight As Long, hDC As Long
Call GetWindowRect(chWnd, lpRect)
nWidth = lpRect.Right - lpRect.Left '获取控件的宽度
nHeight = lpRect.Bottom - lpRect.Top '获取控件的高度
ShowWindow chWnd, 0 '隐藏
DoEvents
hDC = GetDC(0)
Call BitBlt(hDestDC, 0, 0, nWidth, nHeight, hDC, lpRect.Left, lpRect.Top, SRCCOPY)
Call ReleaseDC(0, hDC)
ShowWindow chWnd, 5 '显示
''''''''''''''''''''''复制背景之后,在这里可以其他事情''''''''''''''''''''''''''''
UserControl.CurrentY = 10
UserControl.Print "透明用户控件"
UserControl.Refresh
End Sub
Private Sub UserControl_Initialize()
UserControl.ScaleMode = vbPixels
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
CopyBKImage m_BK
End Sub
Private Sub UserControl_Resize()
On Error Resume Next
CopyBKImage m_BK
End Sub
Private Sub UserControl_Show()
CopyBKImage m_BK
End Sub
Public Property Let CopyBKMode(ByVal bkm As Boolean)
m_BK = bkm
End Property
Public Property Let BorderStyle(BStyle As Boolean)
If BStyle = True Then
UserControl.BorderStyle = 1
Else
UserControl.BorderStyle = 0
End If
End Property
Public Sub Refresh()
CopyBKImage m_BK
UserControl.Refresh
End Sub
Private Sub CopyBKImage(Optional ByVal flag As Boolean = False)
If flag = True Then
CopyScreenBackground UserControl.Parent.hwnd, UserControl.hwnd, UserControl.hDC
Else
CopyParentBackground UserControl.Parent.hwnd, UserControl.hwnd, UserControl.hDC
End If
End Sub
'''''''''''''''''''''''''''''''调用实例'''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''Form1代码''''''''''''''''''''''''''''''
Option Explicit
Dim LabX As Single, LabY As Single, IsMouseDownLab As Boolean
Private Sub ctl1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
IsMouseDownLab = True
LabX = X: LabY = Y
End Sub
Private Sub ctl1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If IsMouseDownLab = True Then '移动ctl1的位置
If Button = 1 Then ctl1.Move ctl1.Left + Me.ScaleX(X - LabX, 3, 3), ctl1.Top + ScaleX(Y - LabY, 3, 3)
End If
End Sub
Private Sub ctl1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
IsMouseDownLab = False
End Sub
Private Sub Form_Load()
Me.ScaleMode = vbPixels
ctl1.CopyBKMode = True '复制控件在屏幕的背景
ctl2.CopyBKMode = False '默认值,复制控件在父窗口的背景
ctl2.BorderStyle = True '有边框
ctl1.BorderStyle = False '无边框
End Sub
2022-03-20 14:42:35
74KB
1
仿360桌面悬浮窗效果。
基本代码来自http://download.csdn.net/detail/sinyu890807/5158470 感谢原作者sinyu890807。本人对此进行了改进，如下：
1.丰富了功能，使悬浮框既可以在桌面显示（类似于360），又可以本应用程序页面显示（类似于淘宝的旺旺）。当然，在其它应用程序页面是不显示的。
2.添加了移动到指定区域移除悬浮框的功能（类似于淘宝的旺旺）
3.在悬浮窗上增加了打开应用程序的功能。
2022-03-18 14:17:58
1.04MB
1