on VB6 how we create a memory DC?

[Joaquim_5]

on VB6 i have these code for create a memory DC:

Public Sub CreateMemoryBitmap(ByVal Width As Long, ByVal _
    Height As Long)

    If (ImageWidth > 0 Or ImageHeight > 0) Then DeleteMemoryBitmap
    ImageWidth = Width
    ImageHeight = Height
    ' Create the device context.

    hdc = CreateCompatibleDC(ByVal 0&)
    If (hdc = 0) Then Debug.Print "no HDC"

    ' Create the bitmap.
    HBitmap = CreateCompatibleBitmap(hdc, ImageWidth, _
        ImageHeight)
    If (HBitmap = 0) Then Debug.Print "no HBITMAP"
    ' Make the device context use the bitmap.
    OldHDC = SelectObject(hdc, HBitmap)
    DrawLine 0, 0, 100, 100, vbBlack

End Sub

i test if the hdc is created, but no error.. but i get bad results.. i belive the DC\HBitmap are created incorrectly :(

[SCBWV]

I assume you're trying to create a screen compatible DC by passing 0& to CreateCompatibleDC. Perhaps try:

Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

'then

'Create a device context
 mDC = CreateCompatibleDC(GetDC(0))
'Create a bitmap, compatible with the screen
 mBitmap = CreateCompatibleBitmap(GetDC(0), lngWidth / Screen.TwipsPerPixelX, lngHeight / Screen.TwipsPerPixelY)

You really shouldn't use keywords (Width, Height) as arguments to your CreateMemoryBitmap sub. In the above code, I used lngWidth and lngHeight. Also, I assume these were passed as twip values, so the example above converts them to pixels, which the API expects.

[Joaquim_5]

the problem is been used on a class?
i did these code and works fine:

Private Const CCHDEVICENAME As Long = 32
Private Const CCHFORMNAME As Long = 32


Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByRef lpInitData As Any) As Long
Private Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long


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 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 Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function BitBlt Lib "gdi32.dll" (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 Const IMAGEWIDTH = 400
Private Const IMAGEHEIGHT = 400

Private Sub Form_Load()
    'Declarando variáveis
    Dim hdcSource As Long
    Dim hdcDest As Long
    Dim hbm As Long
    Dim hbmOld As Long

    'Tamanho do retângulo
    Dim rectLeft As Long
    Dim rectTop As Long
    Dim rectRight As Long
    Dim rectBottom As Long
    rectLeft = 50
    rectTop = 50
    rectRight = 250
    rectBottom = 250

    'Criar HDC
    hdcSource = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    hdcDest = CreateCompatibleDC(hdcSource)

    'Criar HBitmap
    hbm = CreateCompatibleBitmap(hdcSource, IMAGEWIDTH, IMAGEHEIGHT)
    hbmOld = SelectObject(hdcDest, hbm)

    'Desenhar retângulo em HDC
    Rectangle hdcDest, rectLeft, rectTop, rectRight, rectBottom
    Ellipse hdcDest, rectLeft, rectTop, rectRight, rectBottom
    'Copiar HDC para Form
    BitBlt Form1.hdc, 0, 0, IMAGEWIDTH, IMAGEHEIGHT, hdcDest, 0, 0, SRCCOPY

    'Limpar memória
    SelectObject hdcDest, hbmOld
    DeleteObject hbm
    DeleteDC hdcDest
    DeleteDC hdcSource
End Sub

but the previous don't :(
is for be on a class or something?

[SCBWV]

I was able to place the code in a class and it functioned. Make sure the scope (Public vs Private) of your functions and variables are accessible to the code as appropriate.

[Joaquim_5]

my class1:

Private Const CCHDEVICENAME As Long = 32
Private Const CCHFORMNAME As Long = 32


Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type
Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByRef lpInitData As Any) As Long
Private Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long


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 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 Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function BitBlt Lib "gdi32.dll" (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

'Declarando variáveis
Public hdcSource As Long
Public hdcDest As Long
Public hbm As Long
Public hbmOld As Long

Public Sub NewImage(Width As Long, Height As Long)

    'Criar HDC
    hdcSource = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    hdcDest = CreateCompatibleDC(hdcSource)

    'Criar HBitmap
    hbm = CreateCompatibleBitmap(hdcSource, IMAGEWIDTH, IMAGEHEIGHT)
    hbmOld = SelectObject(hdcDest, hbm)
    Rectangle hdcDest, 0, 0, 100, 100
    Ellipse hdcDest, 0, 0, 100, 100
End Sub

Public Sub DeleteImage()
    'Limpar memória
    SelectObject hdcDest, hbmOld
    DeleteObject hbm
    DeleteDC hdcDest
    DeleteDC hdcSource
End Sub

how i use it:
(autoredraw true and scalemode pixel)
on form1:

Dim s As Class1
Private Sub Form_Load()
     Set s = New Class1
     s.NewImage 100, 100
     Me.Show
     BitBlt Form1.hdc, 0, 0, 100, 100, s.hdcDest, 0, 0, SRCCOPY
End Sub

why isn't showed?

[SCBWV]

This works.
Class Module:

Private Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByRef lpInitData As Any) As Long
Private Declare Function Ellipse Lib "gdi32.dll" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
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 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 Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

'Declarando variáveis
Public hdcSource As Long
Public hdcDest As Long
Public hbm As Long
Public hbmOld As Long

Public Sub NewImage(IMAGEWIDTH As Long, IMAGEHEIGHT As Long)
    'Criar HDC
    hdcSource = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
    hdcDest = CreateCompatibleDC(hdcSource)

    'Criar HBitmap
    hbm = CreateCompatibleBitmap(hdcSource, IMAGEWIDTH, IMAGEHEIGHT)
    hbmOld = SelectObject(hdcDest, hbm)
    Rectangle hdcDest, 0, 0, 100, 100
    Ellipse hdcDest, 0, 0, 100, 100
End Sub

Public Sub DeleteImage()
    'Limpar memória
    SelectObject hdcDest, hbmOld
    DeleteObject hbm
    DeleteDC hdcDest
    DeleteDC hdcSource
End Sub

Form Code:

Dim s As Class1
Private Const SRCCOPY = &HCC0020

Private Declare Function BitBlt Lib "gdi32.dll" (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 Form_Load()
     Set s = New Class1
     s.NewImage 100, 100
     Me.Show
     Me.Refresh
     BitBlt Form1.hdc, 0, 0, 100, 100, s.hdcDest, 0, 0, SRCCOPY
End Sub

[Joaquim_5]

isn't working.. have to do with Windows 10?

[SCBWV]

I'm running Windows 11 22H2 and it works for me. Are you getting an error or is the graphic just not being drawn?

[Joaquim_5]

SCBWV: i copied, now your code, but nothing is showed on form... after several tries... i change the AutoRedraw to false and now works...
i need learn when i must use the AutoRedraw.. seems the problem was here.
on other code, the image is drawed without Paint event too :(
so why, when use a class, the AutoRedraw must be false?

[Joaquim_5]

now i understand better:

• if the AutoRedraw is false, i must use the Refresh, before draw it;
• if the AutoRedraw is true, i don't need use the Refresh.
  thank you so much for all to all

[Joaquim_5]

now i understand better:

if the AutoRedraw is false, i must use the 'Refresh' or 'Cls', before draw it;
if the AutoRedraw is true, we don't need them.
thank you so much for all to all

[SCBWV]

You're welcome. Good luck.