skärmdump??

Hur gör jag en skärmdump och hur gör jag den till en fil av lämpligt format tex tif, jpg eller något annat.

Skicka gärna en kod till
herman@hermansson.net

------------------
Herman

För att ta en skärmdump krävs lite API-anrop.
<font size="1" face="Verdana, Arial, Helvetica, sans-serif">Kod:<font size="1" face="Verdana, Arial, Helvetica, sans-serif" color="#666600">
Option Explicit
Private Declare Function GetDesktopWindow _
Lib "user32" () As Long

Private Declare Function GetDC _
Lib "user32" ( _
ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC _
Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hdc 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 Sub CaptureDesktop()
Dim hWindow As Long
Dim hDContext As Long
Picture1.AutoRedraw = True
Picture1.Width = Screen.Width
Picture1.Height = Screen.Height
Form1.Visible = False
hWindow = GetDesktopWindow()
hDContext = GetDC(hWindow)
BitBlt Picture1.hdc, 0, 0, _
Screen.Width \ Screen.TwipsPerPixelX, _
Screen.Height \ Screen.TwipsPerPixelY, _
hDContext, 0, 0, vbSrcCopy
Picture1.Refresh
Picture1.Picture = Picture1.Image
ReleaseDC hWindow, hDContext
Form1.Visible = True
SavePicture Picture1.Picture, "c:\newpic.bmp"
End Sub

Private Sub Command1_Click()
Call CaptureDesktop
End Sub

Vad du behöver är en "picturebox" men namnet "picture1", samt en knapp men namn "command1".

Formuläret du lägger koden i görs alltså osynligt när koden körs så att du slipper själva fönstret i din dump, detta kan lätt ändras om det behövs.

Denna funktionen sparar filen som "bmp", det är alltid en början iaf.

------------------
Fredrik Klarqvist
f.klarqvist@spray.se
http://server.webwerkstaden.se/fredde/

Hej!

Jag ser att formatet blir 1020*764 på bmp filen när jag kör din kod istället för det normala 1024*768 hur du någon aning varför?

Jag har hittat en annan kod också som funkar hyfsat. Jag får rätt storlek med det blir något skumt fel ibland.

Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, _
ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Public Function fSaveDesktopToFile(ByVal theFile As String) As Boolean

On Error GoTo Trap
'Check if the File Exist
If Dir(theFile) <> "" Then Exit Function

Call keybd_event(vbKeySnapshot, 0, 0, 0)

SavePicture Clipboard.GetData(vbCFBitmap), theFile

fSaveDesktopToFile = True
Exit Function

Trap:
'Error handling
MsgBox "Error"

End Function

------------------
Herman

Nädu...har faktiskt ingen aning varför bredden minskas...

jag har testat den andra koden du har med och tycker att den är ganska buggig, jag får iaf upp fel fönster och ibland bara blanka bilder.

------------------
Fredrik Klarqvist
f.klarqvist@spray.se
http://server.webwerkstaden.se/fredde/