本人想實作 類似win7 任務欄縮略圖功能。
就是把當前的程式視窗以更小的視窗（比如150*150，縮小后，里面的布局也相應比例縮小，而且是實時的，比如視頻）
到我的程式界面里。
望高手給出代碼，后開貼重分感謝。
uj5u.com熱心網友回復：
來學習的，頂起來uj5u.com熱心網友回復：
你這要求是截圖然后縮小顯示出來是不？
Option Explicit
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 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 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function SetStretchBltMode Lib "gdi32" (ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Const STRETCH_HALFTONE = 4
Dim topWnd As Long
Dim w As Long, h As Long, fW As Long, fH As Long, rc As RECT
Dim dskHDC As Long
Dim MemDC As Long
Dim MemBitmap As Long
Private Sub Form_Load()
With Picture1
SetStretchBltMode .hdc, STRETCH_HALFTONE
.ScaleMode = vbPixels
fW = .ScaleWidth
fH = .ScaleHeight
End With
dskHDC = GetDC(0)
MemDC = CreateCompatibleDC(dskHDC)
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject MemBitmap
DeleteDC MemDC
ReleaseDC 0, dskHDC
End Sub
Private Sub Timer1_Timer()
topWnd = GetForegroundWindow()
If IsWindowVisible(topWnd) Then
Call GetWindowRect(topWnd, rc)
w = rc.Right - rc.Left
h = rc.Bottom - rc.Top
Debug.Print w, h
DeleteObject MemBitmap
MemBitmap = CreateCompatibleBitmap(dskHDC, w, h)
If MemBitmap <> 0 Then
Call SelectObject(MemDC, MemBitmap)
Call BitBlt(MemDC, 0, 0, w, h, dskHDC, rc.Left, rc.Top, vbSrcCopy Or &H40000000)
StretchBlt Picture1.hdc, 0, 0, fW, fH, MemDC, 0, 0, w, h, vbSrcCopy
End If
End If
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/91037.html
標籤：VB基礎類
上一篇：大神幫解決3個問題，謝謝了。
下一篇：誰能幫我解密這幾個介面嘛