Quantcast
Channel: VBForums
Viewing all articles
Browse latest Browse all 15525

VB6: how can i speed up my draw pixel function DIB's?

$
0
0
heres my actual function for draw between line points:
Code:

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)
        For x = 0 To UBound(DrawPixelPoints) - 1
           
            PosX = x
            PosY = y
           
            'Test the image size for we tiled the image:
            If (PosX > (Width - 1)) Then
                While (PosX > (Width - 1))
                    PosX = PosX - Width
                Wend
            End If
           
            If (PosY > (Height - 1)) Then
                While (PosY > (Height - 1))
                    PosY = PosY - Height
                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(PosX, PosY).B
            ImageData(1, Point.x, Point.y) = Pixels(PosX, PosY).G
            ImageData(2, Point.x, Point.y) = Pixels(PosX, PosY).R
           
        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

i need more speed, but i don't know how :(
heres the functions for get line points and convert the 3D point to 2D point:
Code:

Public Function ConvertPositon3DTo2D(Position As Position3D, World3DSize As Size3D) As POINTAPI
   
    Dim ConvertedPosition As POINTAPI
    Dim PosZZDepth As Long
   
    Dim Width As Double
    Dim Height As Double
   
    'sum Z position with cam world distance:
    PosZZDepth = Position.Z + World3DSize.distance
    If (PosZZDepth = 0) Then PosZZDepth = 1 'avoiding division by zero
   
    'getting center of the screen center:
    If (World3DSize.Width = 0) Then World3DSize.Width = 1 'avoiding division by zero
    Width = World3DSize.Width / 2
    If (World3DSize.Height = 0) Then World3DSize.Height = 1 'avoiding division by zero
    Height = World3DSize.Height / 2
   
   
    'avoid drawing on back of the camera:
    If (PosZZDepth <= World3DSize.distance) Then
        PosZZDepth = 1
        'World3DSize.distance = 1
    End If
   
    'convert 3D(X, Y, Z) to 2D(X,Y):
    'ConvertedX = (ActualX * CamDistance /(CamDistance + ZPosition)) + HalfCenterOfWidth
    'ConvertedY = (ActualY * CamDistance /(CamDistance + ZPosition)) + HalfCenterOfHeight
    ConvertedPosition.x = (Position.x * World3DSize.distance / PosZZDepth) + Width
    ConvertedPosition.y = (Position.y * World3DSize.distance / PosZZDepth) + Height
   
    ConvertPositon3DTo2D = ConvertedPosition
End Function

Public Function GetLinePoints(ByRef Origin As Position3D, ByRef Destiny As Position3D) As Position3D()
    Dim Steps As Double
    Dim Points() As Position3D
   
    'Get the points line count:
    Steps = Math.Sqr(Math.Abs(Destiny.x - Origin.x) ^ 2 + Math.Abs(Destiny.y - Origin.y) ^ 2 + Math.Abs(Destiny.Z - Origin.Z) ^ 2)
    Steps = Ceil(Steps)
    If (Steps = 0) Then Steps = 1 'void division by zero
   
    'Get the line increment step:
    Dim increment As Position3D
    increment.x = (Destiny.x - Origin.x) / Steps
    increment.y = (Destiny.y - Origin.y) / Steps
    increment.Z = (Destiny.Z - Origin.Z) / Steps
   
    Dim nextpoint As Position3D
    nextpoint = Origin
    Dim i As Integer
    Dim inter As Position3D
    Dim size As Size3D
    ReDim Points(Steps)
   
    'Get all step points:
    For i = 1 To Steps
        nextpoint.x = nextpoint.x + increment.x
        nextpoint.y = nextpoint.y + increment.y
        nextpoint.Z = nextpoint.Z + increment.Z
        inter.x = Math.Round(nextpoint.x)
        inter.y = Math.Round(nextpoint.y)
        inter.Z = Math.Round(nextpoint.Z)
        Points(i).x = inter.x
        Points(i).y = inter.y
        Points(i).Z = inter.Z
        'Debug.Print "X: " + CStr(inter.X) + vbTab + "Y: " + CStr(inter.Y) + vbTab + "Z: " + CStr(inter.Z)
    Next i
    GetLinePoints = Points
End Function

maybe it's these 2 functions that are kill my speed work, because i'm using divisions too.
i need advices for speed up my code.. the image is drawed normaly, but slow :(

Viewing all articles
Browse latest Browse all 15525

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>