VB屏幕保护程序源码:下雪的桌面

本软件利用屏幕截图方法截取整个屏幕,然后调用系统api将鼠标设为不显示,最后随机生成白色点。

1、软件组织结构和UI设计:


2、程序源码:

(1)Form1的源码:

Dim WSnow(1000, 1) As Integer
Dim X As Integer
Dim Y As Integer
Dim pos As Integer
Sub Snow()
For i = 0 To 1000
X = Int(60 * Rnd)
Y = Int(100 * Rnd)
WSnow(i, 0) = WSnow(i, 0) + X - 30
WSnow(i, 1) = WSnow(i, 1) + Y
If WSnow(i, 1) > 0 Then
WSnow(i, 1) = WSnow(i, 1) Mod Screen.Height
Me.DrawWidth = Int(2 * Rnd) + 2
Me.PSet (WSnow(i, 0), WSnow(i, 1)), RGB(255, 255, 255)
End If
Next i
End Sub
Public Function CreateBitmapPicture(ByVal hBmp AsLong, ByVal hPal As Long) As Picture
Dim r AsLong
Dim Pic AsPicBmp
Dim IPic AsIPicture
Dim gu AsGUID
Withgu
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

WithPic
VB屏幕保护程序源码:下雪的桌面
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
.hPal = hPal
EndWith
r =OleCreatePictureIndirect(Pic, gu, 1, IPic)
SetCreateBitmapPicture = IPic
End Function

Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal ClientAs Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByValWidthSrc As Long, ByVal HeightSrc As Long) As Picture
DimhDCMemory As Long
Dim hBmp AsLong
Dim hBmpPrevAs Long
Dim r AsLong
Dim hDCSrcAs Long
Dim hPal AsLong
Dim hPalPrevAs Long
DimRasterCapsScrn As Long
DimHasPaletteScrn As Long
DimPaletteSizeScrn As Long
Dim LogPalAs LOGPALETTE
If ClientThen
hDCSrc = GetDC(hWndSrc)
Else
hDCSrc = GetWindowDC(hWndSrc)
End If
hDCMemory =CreateCompatibleDC(hDCSrc)
hBmp =CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
hBmpPrev =SelectObject(hDCMemory, hBmp)
RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS)
HasPaletteScrn = RasterCapsScrn And RC_PALETTE
PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE)
IfHasPaletteScrn And (PaletteSizeScrn = 256) Then
LogPal.palVersion = &H300
LogPal.palNumEntries = 256
r = GetSystemPaletteEntries(hDCSrc, 0, 256,LogPal.palPalEntry(0))
hPal = CreatePalette(LogPal)
hPalPrev = SelectPalette(hDCMemory, hPal, 0)
r = RealizePalette(hDCMemory)
End If
r =BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc,TopSrc, vbSrcCopy)
hBmp =SelectObject(hDCMemory, hBmpPrev)
IfHasPaletteScrn And (PaletteSizeScrn = 256) Then
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If
r =DeleteDC(hDCMemory)
r =ReleaseDC(hWndSrc, hDCSrc)
SetCaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function

Public Function CaptureScreen() As Picture
DimhWndScreen As Long
'取得窗体句柄
hWndScreen =GetDesktopWindow()
'捕获窗体
SetCaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width Screen.TwipsPerPixelX, Screen.Height Screen.TwipsPerPixelY)
End Function

Private Sub Form_DblClick()
ShowCursor (1)
End
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift AsInteger)
ShowCursor (1)
End
End Sub

Private Sub Form_Load()
SetForm1.Picture = CaptureScreen()
ShowCursor(0)
Me.DrawWidth= 2
pos =0
For i = 0 To1000
WSnow(i, 0) = Int(Screen.Width * Rnd)
WSnow(i, 1) = -Int(Screen.Height * Rnd)
Next i
App.TaskVisible = False
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer,X As Single, Y As Single)
pos = pos + 1
If pos > 10 Then
ShowCursor (1)
End
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
ShowCursor (1)
End Sub

Private Sub Timer1_Timer()
Me.Refresh
Call Snow
End Sub
(2)Module1.bas源码:

Public Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type

Public Type LOGPALETTE
palVersion As Integer
palNumEntries As Integer
palPalEntry(255) AsPALETTEENTRY
End Type

Public Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Public Const RASTERCAPS As Long = 38
Public Const RC_PALETTE As Long = &H100
Public Const SIZEPALETTE As Long = 104
Public Const vbHiMetric As Integer = 8
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Declare Function ShowCursor Lib "user32" (ByVal bShow AsLong) As Long
Public Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDCAs Long) As Long
Public Declare Function CreateCompatibleBitmap Lib "GDI32" (ByValhDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) AsLong
Public Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC AsLong, ByVal iCapabilitiy As Long) As Long
Public Declare Function GetSystemPaletteEntries Lib "GDI32" (ByValhDC As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long,lpPaletteEntries As PALETTEENTRY) As Long
Public Declare Function CreatePalette Lib "GDI32" (lpLogPalette AsLOGPALETTE) As Long
Public Declare Function SelectObject Lib "GDI32" (ByVal hDC AsLong, ByVal hObject As Long) As Long
Public Declare Function BitBlt Lib "GDI32" (ByVal hDCDest As Long,ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long,ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long,ByVal YSrc As Long, ByVal dwRop As Long) As Long
Public Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) AsLong
Public Declare Function GetForegroundWindow Lib "user32" () AsLong
Public Declare Function SelectPalette Lib "GDI32" (ByVal hDC AsLong, ByVal hPalette As Long, ByVal bForceBackground As Long) AsLong
Public Declare Function RealizePalette Lib "GDI32" (ByVal hDC AsLong) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hWnd AsLong) As Long
Public Declare Function GetDC Lib "user32" (ByVal hWnd As Long) AsLong
Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd AsLong, lpRect As RECT) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long,ByVal hDC As Long) As Long
Public Declare Function GetDesktopWindow Lib "user32" () AsLong
Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll"(PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle AsLong, IPic As IPicture) As Long

Public Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type

  

爱华网本文地址 » http://www.413yy.cn/a/25101017/353158.html

更多阅读

股票公式全解析:16 股票软件源码引入

股票公式全解析:[16]股票软件源码引入——简介我们上一篇文章主要说明了大智慧的源码引入的基本方法,大家在使用这个源码的时候一定要注意具体的设置,按照我的要求一步一步实现,源码的编写我会专门有一个介绍,现在我继续说明其他股票软件

Android 4.4 源码下载 android游戏源码

Android 4.4 源码下载——简介最新Android4.4源码于11月1日已经开放,Android迷们可以下载了,小编也在第一时间下载了源码,下面就把Android4.4源码下载的过程写个文档来记录,以帮助有需要的朋友们本经验说明: 小编的这个建议只适合于10.

顶底背驰源码 顶背驰是什么意思

最近很多朋友来短信要这个指标,其实也不是什么独门暗器,可以选股,条件是禅小于-80,可以用在各个周期。可以帮助判断顶底,自己多打开股票分析顶底的判断使用方法,有的顶后再顶,丢掉了不少利润,区分不同位置使用,盘整的时候准确率很高,趋势的时

声明:《VB屏幕保护程序源码:下雪的桌面》为网友大爱教授分享!如侵犯到您的合法权益请联系我们删除