如何将窗体的某一区域存为了一个图片文件?

[donotbesilent]

矩形区域,如果可以实现其他圆形或不规则区域更好.

[COOL099]

先取得DC,再按相應格式寫入.

[COOL099]

hDCSrc = GetDC(hWndSrc) '如果要考貝非客戶區則用這行
hDCSrc = GetWindowDC(hWndSrc)


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)

'如果屏幕?象有?色板??得屏幕?色板
If HasPaletteScrn 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)

If HasPaletteScrn And (PaletteSizeScrn = 256) Then
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If

r = DeleteDC(hDCMemory)
r = ReleaseDC(hWndSrc, hDCSrc)


Dim Pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID

'填充IDispatch界面
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

'填充Pic
With Pic
.Size = Len(Pic) ' Pic?构?度
.Type = vbPicTypeBitmap ' ?象?型
.hBmp = hBmp ' 位?句柄
.hPal = hPal ' ?色板句柄
End With

'建立Picture?象
r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)

'返回Picture?象
SavePicture IPic,"C:\temp.bmp"

[jiangsw863]

hDCSrc = GetDC(hWndSrc)
hDCSrc = GetWindowDC(hWndSrc)


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)


If HasPaletteScrn 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)

If HasPaletteScrn And (PaletteSizeScrn = 256) Then
hPal = SelectPalette(hDCMemory, hPalPrev, 0)
End If

r = DeleteDC(hDCMemory)
r = ReleaseDC(hWndSrc, hDCSrc)


Dim Pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID

'填充IDispatch界面
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

'填充Pic
With Pic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
.hPal = hPal
End With
r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
SavePicture IPic,"C:\temp.bmp"

[TechnoFantasy]

下面的代码拷贝窗口内100X100像素的内容到Picture1并保存：

Option Explicit

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 Const SRCCOPY = &HCC0020

Private Sub Command1_Click()
BitBlt Picture1.hDC, 0, 0, 100, 100, Me.hDC, 0, 0, SRCCOPY
SavePicture Picture1.Image, "c:\abcd.bmp"
End Sub