without use DirectX, how can i get rendering\graphics speed?
i created an Image class that uses DIB's... but something seems wrong for i draw in a pixel way.. too slow, maybe because i'm trying getting the line, 3D, points.
maybe someone can give me more info:

Friend Sub DrawImageRectanglePoints(DestinationHDC As Long, Points() As Position3D, WorldSize As Size3D, Optional ByVal Opacity As Long = 255)
    'Points(1) is the Upper-Right
    'Points(2) is the Low-Right
    'Points(3) is the Low-Left
    Dim x As Long
    Dim y As Long
    Dim PosX As Long
    Dim PosY As Long
    Dim DestinationBitmap As Long
    Dim lpBitsDestination As Long
    Dim DestuHdr          As BITMAPINFOHEADER
    Dim bm As BITMAP
    Dim bi As BITMAPINFO
    Dim desthDib As Long, destlpBits As Long
    Dim desthPrevBmp As Long
    If (hBitmap = 0 Or hMemDC = 0) Then Exit Sub
    'Get actual hBitmap from Destination HDC:
    DestinationBitmap = GetCurrentObject(DestinationHDC, OBJ_BITMAP)
    GetObject DestinationBitmap, Len(bm), bm

    'Get all pixels from that hBitmap:
    Dim ImageData() As Byte
    ReDim ImageData(0 To (bm.bmBitsPixel \ 8) - 1, 0 To bm.bmWidth - 1, 0 To bm.bmHeight - 1)

    GetBitmapBits DestinationBitmap, bm.bmWidthBytes * bm.bmHeight, ImageData(0, 0, 0)

    'Get left and right vertical line points:
    Dim PointsUpperDownLeft() As Position3D
    PointsUpperDownLeft = GetLinePoints(Points(0), Points(3))
    Dim PointsUpperDownRight() As Position3D
    PointsUpperDownRight = GetLinePoints(Points(1), Points(2))

    'Between the left and right vertical line points we get the horizontal line points:
    Dim DrawPixelPoints() As Position3D
    Dim OriginPoint As POINTAPI
    Dim Point As POINTAPI
    Dim color As COLORQUAD
    Dim OriginPosX As Long, OriginPosY As Long
    Dim OriginWidth As Long, OriginHeight As Long
    Point = ConvertPositon3DTo2D(Points(3), WorldSize)
    OriginPosX = Point.x
    Point = ConvertPositon3DTo2D(Points(0), WorldSize)
    OriginPosY = Point.y
    Point = ConvertPositon3DTo2D(Points(2), WorldSize)
    OriginWidth = Point.x
    OriginHeight = Point.y

    'Move from horizontal line dots and draw the pixel:
    For y = 0 To UBound(PointsUpperDownLeft) - 1
        'Get the horizontal line points:
        DrawPixelPoints = GetLinePoints(PointsUpperDownRight(y), PointsUpperDownLeft(y))
        'OriginPoint = ConvertPositon3DTo2D(DrawPixelPoints(0), WorldSize)
        PosY = y
        If (PosY >= (Height)) Then
            While (PosY > (Height - 1))
                PosY = PosY - Height
            Wend
        End If
        For x = 0 To UBound(DrawPixelPoints) - 1

            PosX = x


            'Test the image size for we tiled the image:
            If (PosX > (Width - 1)) Then
                While (PosX > (Width - 1))
                    PosX = PosX - Width
                Wend
            End If



            'Get the pixel color(ARGB):

        On Error Resume Next

            'Convert the 3D point to 2D point:
            Point = ConvertPositon3DTo2D(DrawPixelPoints(x), WorldSize)

            'changing the RGB pixel:

            ImageData(0, Point.x, Point.y) = Pixels(Width - PosX, PosY).B
            ImageData(1, Point.x, Point.y) = Pixels(Width - PosX, PosY).G
            ImageData(2, Point.x, Point.y) = Pixels(Width - PosX, PosY).R
            pvChangeAlphaRGBA ImageData(2, Point.x, Point.y), ImageData(1, Point.x, Point.y), ImageData(0, Point.x, Point.y), ImageData(3, Point.x, Point.y), Opacity
            'AlphaBlend DestinationHDC, Point.x, Point.y, 1, 1, hMemDC, Width - PosX, PosY, 1, 1, AC_SRC_ALPHA * &H1000000 + Opacity * &H10000

        Next x

    Next y

    'Show the new image:
    SetBitmapBits DestinationBitmap, bm.bmWidthBytes * bm.bmHeight, ImageData(0, 0, 0)
    If destHDC <> 0 Then
        Call SelectObject(destHDC, prevbit)
        Call DeleteDC(destHDC)
    End If
End Sub

that's why, on other topic, i speaked on UBound() and LBound()

Recommended Answers

That clears up why/what you are asking along with me reading https://www.vbforums.com/showthread.php?889830-VB6-how-can-i-speed-up-my-draw-pixel-function-DIB-s

As UBound() I only see it called one time at line 49 so it's one call and unless we measure I'll …

Jump to Post

All 2 Replies

That clears up why/what you are asking along with me reading https://www.vbforums.com/showthread.php?889830-VB6-how-can-i-speed-up-my-draw-pixel-function-DIB-s

As UBound() I only see it called one time at line 49 so it's one call and unless we measure I'll write that's to be left as-is.
But in the For loop from line 49 to about 90? we see UBound() inside the loop and IF (I take your word it's big overhead here) that is so, I would use:
xboundvariable = UBound(DrawPixelPoints) - 1 just before line 49 so line 59 could be:
For x = 0 To xboundvariable

Remember I did not read this code multiple times. Some fault me here but it's Christmas Eve, our dog passed a day ago and other things are going on. Some say I shouldn't try under such conditions but try I will.

To wit, a very optimizing compiler might do such optimizing for us but hey, it's VB6 and not GCC.

With that out of the way, I think I see every pixel being handled so that's a lot of time in loops and more. I can't quite reverse engineer what this code is doing so I can't connect it to some possible API call that would (usually) best your own code. Let me elaborate with a bad example.

We need a line drawn through a bitmap. We can either slog through the bitmap and set bits as need be. Or we paint the bitmap onto the screen area then draw a line on top. Back then the second method always won.

Sorry if I misread your code intentions but few comments are there.

finally i speed up my code severy:

Friend Sub DrawImagePlanePoints(DestinationHDC As Long, Points() As Position3D, WorldSize As Size3D, Optional ByVal Opacity As Long = 255)
    'Points(0) is the Upper-Left
    'Points(1) is the Upper-Right
    'Points(2) is the Low-Right
    'Points(3) is the Low-Left

    'Testing if we have image before we use it:
    If (hBitmap = 0 Or hMemDC = 0) Then Exit Sub

    'Get left and right vertical line points:
    Dim PointsUpperDownLeft() As Position3D
    PointsUpperDownLeft = GetLinePoints(Points(0), Points(3))
    Dim PointsUpperDownRight() As Position3D
    PointsUpperDownRight = GetLinePoints(Points(1), Points(2))

    'Between the left and right vertical line points we get the horizontal line points:
    Dim OriginPoint As POINTAPI
    Dim DestinationPoint As POINTAPI

    'Draw Horizontal image line from vertical plane lines:
    Dim y As Long
    Dim PosX As Long
    Dim PosY As Long

    For y = 0 To UBound(PointsUpperDownLeft) - 1

        OriginPoint = ConvertPositon3DTo2D(PointsUpperDownLeft(y), WorldSize)
        DestinationPoint = ConvertPositon3DTo2D(PointsUpperDownRight(y), WorldSize)


        PosY = y
        If (PosY >= (Height)) Then
            While (PosY > (Height - 1))
                PosY = PosY - Height
            Wend
        End If
        AlphaBlend DestinationHDC, OriginPoint.x, OriginPoint.y, DestinationPoint.x - OriginPoint.x, 1, hMemDC, 0, PosY, Width, 1, AC_SRC_ALPHA * &H1000000 + Opacity * &H10000
    Next y
End Sub

now the image can be drawed transparency.... and i can, too, make 1 color transparent, changing the alpha value.
using the image size, i can tile it too ;)
thanks for all

Be a part of the DaniWeb community

We're a friendly, industry-focused community of 1.20 million developers, IT pros, digital marketers, and technology enthusiasts learning and sharing knowledge.