www.pudn.com > 牛顿法解方程之混沌情况1.32源代码.zip > Module4.bas

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 
 
 
'=======================================================