heres my actual function for draw between line points:
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:
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 :(
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
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
i need advices for speed up my code.. the image is drawed normaly, but slow :(