电平柱状动态图

1：声明变量

Dim mdc As LongDim ddc As LongDim ldc As LongDim bmpResult As LongDim bmpLite As LongDim bmpDark As LongDim pos As Long

2：应用系统相关方法

Const LR_DEFAULTCOLOR = 0Const LR_MONOCHROME = 1Const LR_COLOR = 2Const LR_COPYRETURNORG = 4Const LR_COPYDELETEORG = 8Const LR_LOADFROMFILE = 16Const LR_LOADTRANSPARENT = 32Const LR_DEFAULTSIZE = 64Const LR_VGACOLOR = 128Const SRCCOPY = &HCC0020 ' (DWORD) dest = sourcePrivate Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As LongPrivate Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As LongPrivate Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongPrivate 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 LongPrivate Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As LongPrivate Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongPrivate Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPrivate Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

'Option ExplicitPrivate Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

3：创建图片缓存；如果不创建会出现不断闪烁

Private Sub creatImge()    Dim dc As Long    Dim old As Long    pos = 0    bmpDark = LoadImage(0, App.path & "\GUI\dark.bmp", 0, 0, 0, LR_LOADFROMFILE)    bmpLite = LoadImage(0, App.path & "\GUI\lite.bmp", 0, 0, 0, LR_LOADFROMFILE)    dc = GetDC(Me.hWnd)    mdc = CreateCompatibleDC(dc)    ldc = CreateCompatibleDC(dc)    ddc = CreateCompatibleDC(dc)    'box.Width = 640    bmpResult = CreateCompatibleBitmap(dc, 4, 214)    ReleaseDC Me.hWnd, dc    old = SelectObject(mdc, bmpResult)    If old <> 0 Then        DeleteObject old    End If    old = SelectObject(ldc, bmpLite)    If old <> 0 Then        DeleteObject old    End If    old = SelectObject(ddc, bmpDark)    If old <> 0 Then        DeleteObject old    End If    End Sub

last:使用；具体参数慢慢分析

Public Function setBitBlt(x As Integer, pos As Integer) If pos = 214 Then        pos = 0    End If     Dim dc As Long    'pos = pos + 10    If pos > 214 Then        pos = 214    End If    If mdc <> 0 Then        BitBlt mdc, 0, 0, 4, 214, ddc, 0, 0, vbSrcCopy       ' If pos < 320 Then            BitBlt mdc, 0, 214 - pos, 4, pos, ldc, 0, 214 - pos, vbSrcCopy             ' End If       ' Else           ' BitBlt mdc, 0, 0, 49, pos, ldc, 49, 0, vbSrcCopy       ' End If        dc = GetDC(Me.hWnd)        If mdc <> 0 Then            BitBlt dc, x, 190, 4, 214, mdc, 0, 0, vbSrcCopy  '173            'BitBlt dc, box.Left, box.Top, 320, 240, mdc, 0, 0, vbSrcCopy            'BitBlt dc, 0, 0, 320, 20, ddc, 0, 0, vbSrcCopy            'BitBlt dc, 0, 0, pos, 20, ldc, 0, 0, vbSrcCopy            'BitBlt dc, 100, 100, 320, 20, ddc, 0, 0, vbSrcCopy            'BitBlt dc, 100, 100, pos, 20, ldc, 0, 0, vbSrcCopy        End If        ReleaseDC Me.hWnd, dc    End If    If pos = 214 Then        pos = 0    End IfEnd Function