This time it comes with colors.
![]()
Place a Timer1 on Form1 and paste this code:
Supports paste on right mouse click (no copy yet). Saves output bitmap to %TEMP%\aaa.png on each frame.
Win10+ only.
cheers,
</wqw>
Place a Timer1 on Form1 and paste this code:
Code:
'--- Form1
Option Explicit
DefObj A-Z
Private Const MODULE_NAME As String = "Form1"
'=========================================================================
' API
'=========================================================================
Private Const SW_HIDE As Long = 0
Private Const GENERIC_READ As Long = &H80000000
Private Const GENERIC_WRITE As Long = &H40000000
Private Const FILE_SHARE_READ As Long = 1
Private Const FILE_SHARE_WRITE As Long = 2
Private Const OPEN_EXISTING As Long = 3
Private Const SRCCOPY As Long = &HCC0020
Private Const OPAQUE As Long = 2
Private Const KEY_EVENT As Integer = 1
Private Const FIXED_PITCH As Long = 1
Private Const FF_MODERN As Long = 48
Private Const DIB_RGB_COLORS As Long = 0
Private Declare Function AllocConsole Lib "kernel32" () As Long
Private Declare Function FreeConsole Lib "kernel32" () As Long
Private Declare Function GetConsoleWindow Lib "kernel32" () As Long
Private Declare Function SetConsoleCtrlHandler Lib "kernel32" (ByVal HandlerRoutine As Long, ByVal Add As Long) As Long
Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileW" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetConsoleScreenBufferInfo Lib "kernel32" (ByVal hConsoleOutput As Long, lpInfo As CONSOLE_SCREEN_BUFFER_INFO) As Long
Private Declare Function SetConsoleScreenBufferSize Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal dwSize As Long) As Long
Private Declare Function SetConsoleWindowInfo Lib "kernel32" (ByVal hConsoleOutput As Long, ByVal bAbsolute As Long, lpConsoleWindow As SMALL_RECT) As Long
Private Declare Function ReadConsoleOutput Lib "kernel32" Alias "ReadConsoleOutputW" (ByVal hConsoleOutput As Long, lpBuffer As Any, ByVal dwBufferSize As Long, ByVal dwBufferCoord As Long, lpReadRegion As SMALL_RECT) As Long
Private Declare Function WriteConsoleInput Lib "kernel32" Alias "WriteConsoleInputW" (ByVal hConsoleInput As Long, lpBuffer As INPUT_RECORD, ByVal nLength As Long, lpNumberOfEventsWritten As Long) As Long
Private Declare Function CreateProcess Lib "kernel32" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, lpStartupInfo As STARTUPINFO, lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode 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 DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (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 nW As Long, ByVal nH As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function TextOutW Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As Long, ByVal nCount As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal h As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal Weight As Long, ByVal Italic As Long, ByVal Underline As Long, ByVal StrikeOut As Long, ByVal CharSet As Long, ByVal OutPrec As Long, ByVal ClipPrec As Long, ByVal Quality As Long, ByVal PitchFamily As Long, ByVal Face As String) As Long
Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" (ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, lpBitsInfo As Any, ByVal wUsage As Long, lpBits As Long, ByVal Handle As Long, ByVal dw As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal uCode As Long, ByVal uMapType As Long) As Long
Private Declare Function GetKeyboardState Lib "user32" (pbKeyState As Byte) As Long
Private Declare Function ToUnicode Lib "user32" (ByVal wVirtKey As Long, ByVal wScanCode As Long, lpKeyState As Byte, ByVal pwszBuff As Long, ByVal cchBuff As Long, ByVal wFlags As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
'--- GDI+
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As Any, ByVal outputbuf As Long) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal fileName As Long, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Long, pclsid As Any) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hBitmap As Long, ByVal hPalette As Long, hGdipBmp As Long) As Long
Private Type COORD
X As Integer
Y As Integer
End Type
Private Type SMALL_RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type CONSOLE_SCREEN_BUFFER_INFO
dwSize As COORD
dwCursorPosition As COORD
wAttributes As Integer
srWindow As SMALL_RECT
dwMaximumWindowSize As COORD
End Type
Private Type CHAR_INFO
UnicodeChar As Integer
Attributes As Integer
End Type
Private Type KEY_EVENT_RECORD
bKeyDown As Long
wRepeatCount As Integer
wVirtualKeyCode As Integer
wVirtualScanCode As Integer
UnicodeChar As Integer
dwControlKeyState As Long
End Type
Private Type INPUT_RECORD
EventType As Integer
Padding As Integer
KeyEvent As KEY_EVENT_RECORD
End Type
Private Type STARTUPINFO
cb As Long
lpReserved As Long
lpDesktop As Long
lpTitle As Long
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
Private Type TEXTMETRIC
tmHeight As Long
tmAscent As Long
tmDescent As Long
tmInternalLeading As Long
tmExternalLeading As Long
tmAveCharWidth As Long
tmMaxCharWidth As Long
tmWeight As Long
tmOverhang As Long
tmDigitizedAspectX As Long
tmDigitizedAspectY As Long
tmFirstChar As Byte
tmLastChar As Byte
tmDefaultChar As Byte
tmBreakChar As Byte
tmItalic As Byte
tmUnderlined As Byte
tmStruckOut As Byte
tmPitchAndFamily As Byte
tmCharSet As Byte
End Type
Private Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
'=========================================================================
' Constants and member vars
'=========================================================================
Private Const LNG_CONSOLE_COLS As Long = 120
Private Const LNG_CONSOLE_ROWS As Long = 30
Private m_uCtx As UcsConsoleContext
Private m_aColors(0 To 15) As Long
Private Type UcsConsoleContext
hConOut As Long
hConIn As Long
hMemDC As Long
hDib As Long
lpBits As Long
hOldDib As Long
hFont As Long
hOldFont As Long
CellWidth As Long
CellHeight As Long
BmpWidth As Long
BmpHeight As Long
ProcessInfo As PROCESS_INFORMATION
CharInfo() As CHAR_INFO
ScreenInfo As CONSOLE_SCREEN_BUFFER_INFO
End Type
Private Sub PrintError(sFunction As String)
#If ImplUseDebugLog Then
DebugLog MODULE_NAME, sFunction & "(" & Erl & ")", Err.Description & " &H" & Hex$(Err.Number), vbLogEventTypeError
#Else
Debug.Print "Critical error: " & Err.Description & " [" & MODULE_NAME & "." & sFunction & "]"
#End If
End Sub
Private Sub Form_Load()
Dim uStartup As STARTUPINFO
On Error GoTo EH
Me.ScaleMode = vbPixels
Me.KeyPreview = True
Me.BackColor = vbBlack
pvConsoleInit m_uCtx
Me.Width = Me.Width - Me.ScaleWidth * Screen.TwipsPerPixelX + m_uCtx.BmpWidth * Screen.TwipsPerPixelX
Me.Height = Me.Height - Me.ScaleHeight * Screen.TwipsPerPixelY + m_uCtx.BmpHeight * Screen.TwipsPerPixelY
uStartup.cb = LenB(uStartup)
Call CreateProcess(vbNullString, "cmd.exe", 0, 0, 0, 0, 0, vbNullString, uStartup, m_uCtx.ProcessInfo)
Timer1.Interval = 30
Timer1.Enabled = True
Exit Sub
EH:
PrintError "Form_Load"
End Sub
Private Sub Timer1_Timer()
On Error GoTo EH
pvConsoleRender m_uCtx
If m_uCtx.ProcessInfo.hProcess <> 0 Then
If WaitForSingleObject(m_uCtx.ProcessInfo.hProcess, 0) = 0 Then
Unload Me
End If
End If
Exit Sub
EH:
PrintError "Timer1_Timer"
End Sub
Private Sub Form_Paint()
On Error GoTo EH
With m_uCtx
Call BitBlt(Me.hDC, 0, 0, .BmpWidth, .BmpHeight, .hMemDC, 0, 0, SRCCOPY)
SaveBitmapAsPng .hDib, Environ$("TEMP") & "\aaa.png"
End With
Exit Sub
EH:
PrintError "Form_Paint"
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo EH
Select Case KeyCode + Shift * &H10000
Case vbKeyV + vbCtrlMask * &H10000, vbKeyInsert + vbShiftMask * &H10000
If Clipboard.GetFormat(vbCFText) Then
pvConsoleSendText m_uCtx.hConIn, Clipboard.GetText()
End If
Case Else
pvConsoleSendKey m_uCtx.hConIn, KeyCode, Shift
End Select
KeyCode = 0
Exit Sub
EH:
PrintError "Form_KeyDown"
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo EH
If Button = vbRightButton Then
Form_KeyDown vbKeyV, vbCtrlMask
End If
Exit Sub
EH:
PrintError "Form_MouseDown"
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo EH
Timer1.Enabled = False
pvConsoleTerminate m_uCtx
Exit Sub
EH:
PrintError "Form_Unload"
End Sub
'= private ===============================================================
Private Sub pvConsoleInit(uCtx As UcsConsoleContext)
Dim vSplit As Variant
Dim lIdx As Long
Dim uMetric As TEXTMETRIC
Dim uRect As SMALL_RECT
Dim uBmpHeader As BITMAPINFOHEADER
If m_aColors(15) = 0 Then
vSplit = Split("&H0 &H800000 &H8000 &H808000 &H80 &H800080 &H8080 &HC0C0C0 &H808080 &HFF0000 &HFF00 &HFFFF00 &HFF &HFF00FF &HFFFF &HFFFFFF")
For lIdx = 0 To 15
m_aColors(lIdx) = vSplit(lIdx)
Next
End If
With uCtx
Call AllocConsole
Call ShowWindow(GetConsoleWindow(), SW_HIDE)
Call SetConsoleCtrlHandler(0, 1)
.hConOut = CreateFile(StrPtr("CONOUT$"), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
.hConIn = CreateFile(StrPtr("CONIN$"), GENERIC_READ Or GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, 0, OPEN_EXISTING, 0, 0)
Call SetConsoleWindowInfo(.hConOut, 1, uRect)
Call SetConsoleScreenBufferSize(.hConOut, MakeCoord(LNG_CONSOLE_COLS, LNG_CONSOLE_ROWS))
uRect.Right = LNG_CONSOLE_COLS - 1
uRect.Bottom = LNG_CONSOLE_ROWS - 1
Call SetConsoleWindowInfo(.hConOut, 1, uRect)
.hMemDC = CreateCompatibleDC(0)
.hFont = CreateFont(-16, 0, 0, 0, 400, 0, 0, 0, 1, 0, 0, 0, FIXED_PITCH Or FF_MODERN, "Consolas")
.hOldFont = SelectObject(.hMemDC, .hFont)
Call GetTextMetrics(.hMemDC, uMetric)
.CellWidth = uMetric.tmAveCharWidth
.CellHeight = uMetric.tmHeight + uMetric.tmExternalLeading
.BmpWidth = LNG_CONSOLE_COLS * .CellWidth
.BmpHeight = LNG_CONSOLE_ROWS * .CellHeight
With uBmpHeader
.biSize = LenB(uBmpHeader)
.biPlanes = 1
.biBitCount = 24
.biWidth = uCtx.BmpWidth
.biHeight = -uCtx.BmpHeight
.biSizeImage = (3 * uCtx.BmpWidth) * uCtx.BmpHeight
End With
.hDib = CreateDIBSection(.hMemDC, uBmpHeader, DIB_RGB_COLORS, .lpBits, 0, 0)
.hOldDib = SelectObject(.hMemDC, .hDib)
Call SetBkMode(.hMemDC, OPAQUE)
ReDim .CharInfo(0 To LNG_CONSOLE_COLS * LNG_CONSOLE_ROWS - 1)
End With
End Sub
Private Sub pvConsoleRender(uCtx As UcsConsoleContext)
Dim uPrevScreen As CONSOLE_SCREEN_BUFFER_INFO
Dim uPrevInfo() As CHAR_INFO
Dim uRegion As SMALL_RECT
Dim lRow As Long
Dim lCol As Long
Dim lIdx As Long
Dim lAttr As Long
Dim lLastFg As Long
Dim lLastBg As Long
Dim lCode As Long
Dim sChar As String
Dim lFg As Long
Dim lBg As Long
Dim uRect As RECT
Dim hBrush As Long
Dim bDirty As Boolean
With uCtx
If .hConOut = 0 Then
Exit Sub
End If
uPrevScreen = .ScreenInfo
If GetConsoleScreenBufferInfo(.hConOut, .ScreenInfo) = 0 Then
Exit Sub
End If
bDirty = uPrevScreen.dwCursorPosition.X <> .ScreenInfo.dwCursorPosition.X Or uPrevScreen.dwCursorPosition.Y <> .ScreenInfo.dwCursorPosition.Y
uPrevInfo = .CharInfo
uRegion.Right = LNG_CONSOLE_COLS - 1
uRegion.Bottom = LNG_CONSOLE_ROWS - 1
Call ReadConsoleOutput(.hConOut, .CharInfo(0), MakeCoord(LNG_CONSOLE_COLS, LNG_CONSOLE_ROWS), 0, uRegion)
lLastFg = -1
lLastBg = -1
For lRow = 0 To LNG_CONSOLE_ROWS - 1
For lCol = 0 To LNG_CONSOLE_COLS - 1
lIdx = lRow * LNG_CONSOLE_COLS + lCol
If uPrevInfo(lIdx).UnicodeChar <> .CharInfo(lIdx).UnicodeChar Or uPrevInfo(lIdx).Attributes <> .CharInfo(lIdx).Attributes _
Or bDirty And uPrevScreen.dwCursorPosition.X = lCol And uPrevScreen.dwCursorPosition.Y = lRow Then
lAttr = .CharInfo(lIdx).Attributes
lFg = m_aColors(lAttr And &HF)
lBg = m_aColors((lAttr \ &H10) And &HF)
If lFg <> lLastFg Then
Call SetTextColor(.hMemDC, lFg)
lLastFg = lFg
End If
If lBg <> lLastBg Then
Call SetBkColor(.hMemDC, lBg)
lLastBg = lBg
End If
lCode = .CharInfo(lIdx).UnicodeChar And &HFFFF&
If lCode = 0 Then
lCode = 32
End If
sChar = ChrW$(lCode)
Call TextOutW(.hMemDC, lCol * .CellWidth, lRow * .CellHeight, StrPtr(sChar), 1)
bDirty = True
End If
Next
Next
If bDirty Then
uRect.Left = .ScreenInfo.dwCursorPosition.X * .CellWidth
uRect.Right = uRect.Left + .CellWidth
uRect.Bottom = (.ScreenInfo.dwCursorPosition.Y + 1) * .CellHeight
uRect.Top = uRect.Bottom - 2
hBrush = CreateSolidBrush(m_aColors(7))
Call FillRect(.hMemDC, uRect, hBrush)
Call DeleteObject(hBrush)
Call BitBlt(Me.hDC, 0, 0, .BmpWidth, .BmpHeight, .hMemDC, 0, 0, SRCCOPY)
SaveBitmapAsPng .hDib, Environ$("TEMP") & "\aaa.png"
End If
End With
End Sub
Private Sub pvConsoleSendKey(ByVal hConIn As Long, ByVal lVk As Integer, ByVal Shift As Integer)
Dim lScanCode As Long
Dim aKeys(0 To 255) As Byte
Dim aBuf(0 To 7) As Integer
Dim lCount As Long
Dim lUnicodeChar As Long
Dim lControlState As Long
Dim uRecord As INPUT_RECORD
Dim lWritten As Long
If hConIn = 0 Then
Exit Sub
End If
lScanCode = MapVirtualKey(lVk, 0)
Call GetKeyboardState(aKeys(0))
lCount = ToUnicode(lVk, lScanCode, aKeys(0), VarPtr(aBuf(0)), 8, 0)
If lCount = 1 Then
lUnicodeChar = aBuf(0)
Else
lUnicodeChar = 0
End If
If (Shift And vbShiftMask) Then
lControlState = lControlState Or &H10 ' SHIFT_PRESSED
End If
If (Shift And vbCtrlMask) Then
lControlState = lControlState Or &H8 ' LEFT_CTRL_PRESSED
End If
If (Shift And vbAltMask) Then
lControlState = lControlState Or &H2 ' LEFT_ALT_PRESSED
End If
uRecord.EventType = KEY_EVENT
uRecord.KeyEvent.wRepeatCount = 1
uRecord.KeyEvent.wVirtualKeyCode = lVk
uRecord.KeyEvent.wVirtualScanCode = CInt(lScanCode And &HFFFF&)
uRecord.KeyEvent.UnicodeChar = lUnicodeChar
uRecord.KeyEvent.dwControlKeyState = lControlState
uRecord.KeyEvent.bKeyDown = 1
Call WriteConsoleInput(hConIn, uRecord, 1, lWritten)
uRecord.KeyEvent.bKeyDown = 0
Call WriteConsoleInput(hConIn, uRecord, 1, lWritten)
End Sub
Private Sub pvConsoleSendText(ByVal hConIn As Long, ByVal sText As String)
Dim lLen As Long
Dim lPos As Long
Dim nChar As Integer
Dim uInput As INPUT_RECORD
Dim lWritten As Long
If hConIn = 0 Then
Exit Sub
End If
sText = Replace(sText, vbCrLf, vbCr)
sText = Replace(sText, vbLf, vbCr)
lLen = Len(sText)
uInput.EventType = KEY_EVENT
uInput.KeyEvent.wRepeatCount = 1
For lPos = 1 To lLen
nChar = AscW(Mid$(sText, lPos, 1))
uInput.KeyEvent.UnicodeChar = nChar
If nChar = 13 Then
uInput.KeyEvent.wVirtualKeyCode = vbKeyReturn
Else
uInput.KeyEvent.wVirtualKeyCode = 0
End If
uInput.KeyEvent.wVirtualScanCode = 0
uInput.KeyEvent.dwControlKeyState = 0
uInput.KeyEvent.bKeyDown = 1
Call WriteConsoleInput(hConIn, uInput, 1, lWritten)
uInput.KeyEvent.bKeyDown = 0
Call WriteConsoleInput(hConIn, uInput, 1, lWritten)
Next
End Sub
Private Sub pvConsoleTerminate(uCtx As UcsConsoleContext)
With uCtx
If .ProcessInfo.hProcess <> 0 Then
Call TerminateProcess(.ProcessInfo.hProcess, 0)
Call CloseHandle(.ProcessInfo.hProcess)
End If
If .ProcessInfo.hThread <> 0 Then
Call CloseHandle(.ProcessInfo.hThread)
End If
If .hConOut <> 0 Then
Call CloseHandle(.hConOut)
End If
If .hConIn <> 0 Then
Call CloseHandle(.hConIn)
End If
If .hMemDC <> 0 Then
Call SelectObject(.hMemDC, .hOldDib)
Call SelectObject(.hMemDC, .hOldFont)
Call DeleteObject(.hDib)
Call DeleteObject(.hFont)
Call DeleteDC(.hMemDC)
End If
' Call FreeConsole
End With
End Sub
Private Function MakeCoord(ByVal lX As Long, ByVal lY As Long) As Long
MakeCoord = (lY And &HFFFF&) * &H10000 Or (lX And &HFFFF&)
End Function
Private Function SaveBitmapAsPng(ByVal hDib As Long, ByVal sFile As String) As Boolean
Dim uStartup(0 To 3) As Long
Dim hToken As Long
Dim hGdipBmp As Long
Dim uEncoder(0 To 3) As Long
Dim lStatus As Long
uStartup(0) = 1
If GdiplusStartup(hToken, uStartup(0), 0) <> 0 Then
Exit Function
End If
If GdipCreateBitmapFromHBITMAP(hDib, 0, hGdipBmp) = 0 Then
Call CLSIDFromString(StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), uEncoder(0))
lStatus = GdipSaveImageToFile(hGdipBmp, StrPtr(sFile), uEncoder(0), ByVal 0)
SaveBitmapAsPng = (lStatus = 0)
Call GdipDisposeImage(hGdipBmp)
End If
Call GdiplusShutdown(hToken)
End FunctionWin10+ only.
cheers,
</wqw>
![Vladimir Aćimović – Draeseke: Piano Works (2026) [FLAC 24bit/96kHz]](http://imghd.xyz/images/2026/06/27/jz9s92jaavhy5_600.jpg)
