module4.bas

一个用C语言编写的求混沌序列的源程序,挺好的!

Attribute VB_Name = "Module4"
Option Explicit

'======================================================================
'一些 API 调用 和 封装的调用函数
'======================================================================

'API

'用指定颜色绘制一个点
Public Declare Function SetPixelV Lib "gdi32" _
        (ByVal hdc As Long, ByVal x As Long, _
        ByVal y As Long, ByVal crColor As Long) As Long
'用指定颜色绘制一个点，并返回实际设置的值
Public Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

'获得指定点的颜色值
Public Declare Function GetPixel Lib "gdi32" _
        (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

'程序暂停指定时间
Public Declare Sub Sleep Lib "kernel32" _
        (ByVal dwMilliseconds As Long)
        
'获取图片像素编码性质
Public Declare Function GetPixelFormat Lib "gdi32" (ByVal hdc As Long) As Long
Public Type PIXELFORMATDESCRIPTOR  '像素性质设置时使用
    nSize As Integer
    nVersion As Integer
    dwFlags As Long
    iPixelType As Byte
    cColorBits As Byte
    cRedBits As Byte
    cRedShift As Byte
    cGreenBits As Byte
    cGreenShift As Byte
    cBlueBits As Byte
    cBlueShift As Byte
    cAlphaBits As Byte
    cAlphaShift As Byte
    cAccumBits As Byte
    cAccumRedBits As Byte
    cAccumGreenBits As Byte
    cAccumBlueBits As Byte
    cAccumAlphaBits As Byte
    cDepthBits As Byte
    cStencilBits As Byte
    cAuxBuffers As Byte
    iLayerType As Byte
    bReserved As Byte
    dwLayerMask As Long
    dwVisibleMask As Long
    dwDamageMask As Long
End Type
'设置图片像素编码方式
Public Declare Function SetPixelFormat Lib "gdi32" (ByVal hdc As Long, ByVal n As Long, pcPixelFormatDescriptor As PIXELFORMATDESCRIPTOR) As Long

Public Const SWP_NOMOVE = &H2
Public Const HWND_TOPMOST = -1
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOACTIVATE = &H10
Public Const HWND_NOTOPMOST = -2
'API 用来实现设置顶层窗口
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 SW_NORMAL = 1
'外部调用
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


Public Const SPIF_SENDWININICHANGE = &H2
Public Const SPIF_UPDATEINIFILE = &H1
Public Const SPI_SETDESKWALLPAPER = 20
'设置桌面用
Public Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
        (ByVal uAction As Long, _
        ByVal uParam As Long, _
        ByRef lpvParam As Any, _
        ByVal fuWinIni As Long) As Long
       
'获得Windows所在目录名称
Public Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" _
        (ByVal lpBuffer As String, _
        ByVal nSize As Long) As Long
'获得图像数据
Public Declare Function GetBitmapBits Lib "gdi32" _
        (ByVal hBitmap As Long, _
         ByVal dwCount As Long, _
         lpBits As Any) As Long
'设置图像数据
Public Declare Function SetBitmapBits Lib "gdi32" _
        (ByVal hBitmap As Long, _
         ByVal dwCount As Long, _
         lpBits As Any) As Long
         
         
Public Sub SetWallPaper(PicBox As PictureBox)
   '设置桌面图片
    Dim fileName As String, temp As String
    Dim i As Long, k As Long
    temp = String(255, 0)
    GetWindowsDirectory temp, 256
    temp = Left(temp, InStr(1, temp, Chr(0)) - 1)
    If Right(temp, 1) = "\" Then temp = Left(temp, Len(temp) - 1)
    fileName = temp + "\HssNiuDunWallPaper.bmp"
    SavePicture PicBox.Image, fileName
    DoEvents
    'Call ClearWallPaper
    Call SetWallPaperA(fileName)
End Sub

Public Sub ClearWallPaper()
    '清除桌面图片
    Dim temp As Long
    temp = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, ByVal "(None)", _
                SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
    'MsgBox temp
End Sub
Public Sub SetWallPaperA(BitmapFile As String)
    '设置桌面图片API调用
    Dim temp As Long
    temp = SystemParametersInfo(SPI_SETDESKWALLPAPER, 0&, ByVal BitmapFile, _
                SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE)
    'MsgBox temp
    'SystemParametersInfo SPI_SETDESKWALLPAPER, 0, ByVal BMPFile, SPIF_UPDATEINIFILE
End Sub


'=======================================================