Ertzel Posted October 29, 2012 Author Share Posted October 29, 2012 This tutorial is for any system using the newest version of rendering in Eclipse. Currently the screenshot button does duck all and is completely useless. This removes the screenshot button completely and adds a new code for taking screenshots that any player can do and shows the whole game screen.It is a very simple tutorial also.First remove anything to do with the current screenshot system except the picSSMap picturebox on frmMain.Add the following anywhere (I created a new mod called modScreenShot):```Option ExplicitPrivate Declare Function BitBlt Lib "GDI32" (ByVal hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc As Long, ByVal XSrc As Long, ByVal YSrc As Long, ByVal dwRop As Long) As LongPrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private 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 CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) As LongPrivate Declare Function DeleteDC Lib "GDI32" (ByVal hDC As Long) As LongPrivate Declare Function GetDesktopWindow Lib "user32" () As LongPrivate Declare Function GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal iCapability As Long) As LongPrivate Declare Function GetForegroundWindow Lib "user32" () As LongPrivate Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As LongPrivate Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function GetDC Lib "user32" Alias "GetDc" (ByVal hwnd As Long) As LongPrivate Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As LongPrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fpictureOwnsHandle As Long, IPIC As IPicture) As LongPrivate Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As LongPrivate Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As LongPrivate Declare Function SelectObject Lib "GDI32" (ByVal hDC As Long, ByVal hObject As Long) As LongPrivate Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As LongGlobal Const INVERSE = 6Const SOLID = 0Const DOT = 2Global HoldX As SingleGlobal HoldY As SingleGlobal StartX As SingleGlobal StartY As SingleGlobal SavedDrawStyleGlobal SavedModeOption Base 0Private Type PALETTEENTRYpeRed As BytepeGreen As BytepeBlue As BytepeFlags As ByteEnd TypePrivate Type LOGPALETTEpalversion As IntegerpalNumEntries As IntegerpalpalEntry(255) As PALETTEENTRYEnd TypePrivate Type GUIDdata1 As LongData2 As IntegerData3 As IntegerData4(7) As ByteEnd TypePrivate Const RASTERCAPS As Long = 38Private Const RC_PALETTE As Long = &H100Private Const SIZEPALETTE As Long = 104Private Type RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypePrivate Type PicBmpSize As LongType As LonghBmp As Longhpal As Longreserved As LongEnd TypePublic Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hpal As Long) As PictureOn Error GoTo errorDim r As LongDim pic As PicBmpDim IPIC As IPictureDim IID_DisPatch As GUID With IID_DisPatch .data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With With pic .Size = Len(pic) .Type = vbPicTypeBitmap .hBmp = hBmp .hpal = hpal End With r = OleCreatePictureIndirect(pic, IID_DisPatch, 1, IPIC) Set CreateBitmapPicture = IPICExit Functionerror:Resume NextEnd FunctionPublic Function CaptureWindow(ByVal hWndSrc As Long, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal Heightsrc As Long) As PictureDim hDCMemory As LongDim hBmp As LongDim hBmpPrev As LongDim rc As LongDim hDCSrc As LongDim hpal As LongDim hpalPrev As LongDim RasterCapsScrn As LongDim HasPaletteScrn As LongDim PaletteSizeScrn As LongDim LogPal As LOGPALETTE 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 rc = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palpalEntry(0)) hpal = CreatePalette(LogPal) hpal = SelectPalette(hDCMemory, hpal, 0) rc = RealizePalette(hDCMemory) End If rc = 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 rc = DeleteDC(hDCMemory) rc = ReleaseDC(hWndSrc, hDCSrc) Set CaptureWindow = CreateBitmapPicture(hBmp, hpal)Exit FunctionErrorRoutineErr:MsgBox "Create window " & Err & errorResume NextEnd FunctionPublic Function CaptureForm(frmsrc As Form) As PictureOn Error GoTo errorroutineerror Set CaptureForm = CaptureWindow(frmsrc.hwnd, 0, 0, frmsrc.ScaleX(frmsrc.Width, vbTwips, vbPixels), frmsrc.ScaleY(frmsrc.Height, vbTwips, vbPixels)) Exit Functionerrorroutineerror:MsgBox "form : " & Err & errorEnd Function```Next, go into```Public Sub CheckInputKeys()```and anywhere in there add:```' Screenshot MapIf GetKeyState(vbKeySnapshot) < 0 Then ' vbKeySnapshot = Print Screen buttonSleep 200 ' Sleep for 200 miliseconds to avoid double picturesDim sFilePath As String, num As Long, wasFound As Boolean wasFound = False For num = 1 To 255 sFilePath = App.Path & "\ScreenShots\map" & GetPlayerMap(MyIndex) & "[" & num & "].jpg" If Not FileExist(sFilePath, True) Then frmMain.picSSMap.Picture = captureform(frmMain) SavePicture frmMain.picSSMap.Picture, App.Path & "\ScreenShots\map" & GetPlayerMap(MyIndex) & "[" & num & "].jpg" Exit Sub End If Next If wasFound Then MsgBox "The maximum screenshots for this map have been reached! Delete some if you wish to take more...", vbOKOnly End IfEnd If```In your client folder create a new folder named ScreenShots.This will make it so now when you press the PrintScreen button on your keyboard, it renders everything sown on frmMain to picSSMap and then saves picSSMap.Picture into a image called map (YourMapNumber) [MapImagesCount].jpg and can save up to 255 images per map. You can change that number or saving format to fit your own needs.Example of Screenshots folder:![](http://www.freemmorpgmaker.com/files/imagehost/pics/12c651778069f8f1585d8aa4befbf3e6.png) Link to comment Share on other sites More sharing options...
clark Posted October 29, 2012 Share Posted October 29, 2012 Looking Good i'm going to try this later , i have a question is that possible to make a screenshot of the entire map (even if not completly visible on the game screen) with this code? and if yes how? Link to comment Share on other sites More sharing options...
Ertzel Posted October 29, 2012 Author Share Posted October 29, 2012 No, this only renders what is on a form or your whole computer screen. Since the rest of the map is never drawn anywhere, this has no way of saving/rendering the rest of your map. Link to comment Share on other sites More sharing options...
Growlith1223 Posted October 29, 2012 Share Posted October 29, 2012 -snip-forgot that it's using the computer's screenshot function Link to comment Share on other sites More sharing options...
Ertzel Posted October 29, 2012 Author Share Posted October 29, 2012 > by making this system render to a picturebox, resize the picturebox to the max values then take the screenshotThat wont work. It is already rendering to a picturebox and saving the image but it can only rendering either your whole computer screen with CaptureScreen() or a form with captureform(). It has no way of knowing the rest of the map.I guess in theory you could make a script to render the rest of map to a picturebox instead of rendering the frmMain to the picturebox. Then taking your image from there. But that's a completely different system really. Link to comment Share on other sites More sharing options...
clark Posted October 29, 2012 Share Posted October 29, 2012 > No, this only renders what is on a form or your whole computer screen. Since the rest of the map is never drawn anywhere, this has no way of saving/rendering the rest of your map.Ok , Thanks. Link to comment Share on other sites More sharing options...
Growlith1223 Posted October 29, 2012 Share Posted October 29, 2012 i already fixed my post.. Link to comment Share on other sites More sharing options...
DarkDino Posted January 25, 2013 Share Posted January 25, 2013 Oh nice ![:)](http://www.touchofdeathforums.com/community/public/style_emoticons/<#EMO_DIR#>/smile.png)! Link to comment Share on other sites More sharing options...
barreytor Posted January 31, 2013 Share Posted January 31, 2013 Nice, only thing I'd change is the screenchot naming, and use "Date-Time-ScreenshotNum" instead.That would allow for up to 255 screens saved for every second instead of map. Link to comment Share on other sites More sharing options...
Ertzel Posted January 31, 2013 Author Share Posted January 31, 2013 This is untested but for that you should be able to Replace:```' Screenshot MapIf GetKeyState(vbKeySnapshot) < 0 Then ' vbKeySnapshot = Print Screen buttonSleep 200 ' Sleep for 200 miliseconds to avoid double picturesDim sFilePath As String, num As Long, wasFound As Boolean wasFound = False For num = 1 To 255 sFilePath = App.Path & "\ScreenShots\map" & GetPlayerMap(MyIndex) & "[" & num & "].jpg" If Not FileExist(sFilePath, True) Then frmMain.picSSMap.Picture = captureform(frmMain) SavePicture frmMain.picSSMap.Picture, App.Path & "\ScreenShots\map" & GetPlayerMap(MyIndex) & "[" & num & "].jpg" Exit Sub End If Next If wasFound Then MsgBox "The maximum screenshots for this map have been reached! Delete some if you wish to take more...", vbOKOnly End IfEnd If```With:```If GetKeyState(vbKeySnapshot) < 0 Then ' vbKeySnapshot = Print Screen buttonSleep 200 ' Sleep for 200 miliseconds to avoid double picturesDim sFilePath As String, num As Long, wasFound As Boolean, dtmTest As DatedtmTest = DateValue(Now) wasFound = False For num = 1 To 255 sFilePath = App.Path & "\ScreenShots\map" & GetPlayerMap(MyIndex) & "[" & dtmTest & "].jpg" If Not FileExist(sFilePath, True) Then frmMain.picSSMap.Picture = captureform(frmMain) SavePicture frmMain.picSSMap.Picture, sFilePath Exit Sub End If Next If wasFound Then MsgBox "The maximum screenshots for this map have been reached! Delete some if you wish to take more...", vbOKOnly End IfEnd If```and then it will save the dat/time in []'s instead of a number from 1-255. Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now