To:tztz520(午夜逛街)及各位高手 窗体样子保存为图片的问题

[riverlj]

以下代码是将运行的窗体样子保存为图片：
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 Sub Command1_Click()
Picture3.Width = Me.Width
Picture3.Height = Me.Height
BitBlt Picture3.hDC, 0, 0, Picture3.Width, Picture3.Height, Me.hDC, 0, 0, vbSrcCopy
SavePicture Picture3.Image, "f:\acdacd.bmp"'保存到F盘
End Sub

Private Sub Form_Load()
Picture3.AutoRedraw = True
Picture3.Visible = False
'Picture3运行时不可见,用来保存窗体界面
End Sub

**************************
问题是：如果窗体隐藏了：Me.Hide 则运行上述方法就不能保存窗体的样子了！
所以，请各位帮帮忙，窗体隐藏了，如何保存窗体的样子（窗体一定是隐藏的）

[viena]

没办法~

[zhengoodman]

gz

[yunyu97]

你把窗体移动到屏幕外面，然后保存是一样的效果呀。

[naolin2008]

可以将窗体的透明度设为０　时，试试，也相当于隐藏啊

[tztz520]

不用隐藏,设成透明,用户也看不到的.

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

Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000

Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "User32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegSetValue Lib "advapi32.dll" Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Const HKEY_CURRENT_USER = &H80000001
Private Const REG_DWORD = 4 ' 32-bit number

Dim reg As Long




Private Sub SetFromtransparence(Obform As Object, TransparenceTolerance As Integer) '透明度是从1-255
Dim Ret As Long

Ret = GetWindowLong(Obform.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Obform.hwnd, GWL_EXSTYLE, Ret

SetLayeredWindowAttributes Obform.hwnd, 0, TransparenceTolerance, LWA_ALPHA
End Sub



Private Sub Form_Load()
SetFromtransparence Me, 0 '设置透明
Picture3.AutoRedraw = True
Picture3.Visible = False
End Sub

Private Sub Timer1_Timer()
Timer1.Interval = 2000
Picture3.Width = Me.Width
Picture3.Height = Me.Height
BitBlt Picture3.hDC, 0, 0, Picture3.Width, Picture3.Height, Me.hDC, 0, 0, vbSrcCopy
SavePicture Picture3.Image, "f:\acdacd.bmp" '保存到F盘
Timer1.Enabled = False
End Sub

[韧恒]

个人认为， 简单的办法就象 yunyu97() 说的，把窗口移动到屏幕外还是比较实用的，因为在win98中无法使用楼上的办法设置窗口透明。

[shadowsky]

好搞笑！ 如果隐藏了你怎么点按钮 放到屏幕以外也看不到按钮阿！ 不要告诉我让那个窗口一直处于激活状态然后设置那个按钮为默认然后就一直按回车来保存了，还有不要告诉我你用快捷键 呵呵！ 那个设置为0 的 她取到得 hdc 也是透明的阿 也就是说那个图片不是窗体的。 没一个正解。

[xinliangyu]

'窗体中有一commonbutton，一picturebox:
Option Explicit
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc 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 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 SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub Command1_Click()
Dim hMemDc As Long
Dim hMemBmp As Long

hMemDc = CreateCompatibleDC(Me.hdc)
hMemBmp = CreateCompatibleBitmap(Me.hdc, ScaleWidth, ScaleHeight)
DeleteObject SelectObject(hMemDc, hMemBmp)
'将窗体图像拷贝到内存DC中：
StretchBlt hMemDc, 0, 0, ScaleWidth, ScaleHeight, Me.hdc, 0, 0, ScaleWidth, ScaleHeight, vbSrcCopy

Picture1.Visible = True

Refresh

StretchBlt Picture1.hdc, 0, 0, Picture1.Width, Picture1.Height, hMemDc, 0, 0, ScaleWidth, ScaleHeight, vbSrcCopy

DeleteObject hMemBmp
DeleteDC hMemDc

SavePicture Picture1.Image, "文件名"
End Sub

Private Sub Form_Load()
Picture1.Move 0, 0, ScaleWidth, ScaleHeight
Picture1.Visible = False
End Sub

[xinliangyu]

关键是在将窗体图像暂存于内存DC中

[CCL]

to shadowsky(小狗快跑(狗狗一到问题全解)):
没做过不要乱说好不好！你根本不知道窗口透明的原理就觉得hdc透明了。事实上即使是透明的窗体hdc也完全不透明，所看到的透明效果完全是先使管理器在外部对窗口的渲染，可以说这个印象对窗体内部来说是完全不存在的。所以，如果环境是NT5以上，那么用上面说的完全透明窗口法是可行的。

[dongle2001]

xinliangyu(yxl) ,佩服