Distort Image

I made a 3D cube in VB (without DirectX, using a tutorial by Jacob Roman), but I'm having trouble drawing the faces on the cube. Currently i have taken the image and drawn vertical strips, slowly increasing or decreasing to make it work.
Attachment 56212

Currently my problem is cause I'm using paintpicture and drawing each strip on the screen at a time, its slowing down a lot. Even if i remove the paintpicture part, it still takes time as it cycles through the image. So my question is, is there another way to draw the image, or possibly improve my code to make it faster?

Simplified code I'm using.

Code:

---

Private Type Point_3D
    X As Single
    Y As Single
    Z As Single
End Type


Private Sub DrawImage(ImgCtrl As StdPicture, P1 As Point_3D, P2 As Point_3D, P3 As Point_3D, P4 As Point_3D)
On Error Resume Next
Dim X As Single
Dim Y As Single
Dim DirX As Double
Dim M1 As Double
Dim M2 As Double
Dim Xpos As Double
Dim PicHeight As Double

DirX = (P1.X - P2.X)
M1 = (P2.Y - P1.Y) / (P2.X - P1.X)
M2 = (P4.Y - P3.Y) / (P4.X - P3.X)
Xpos = 1

        For X = P2.X To P1.X Step Int(DirX) / Abs(Int(DirX))
            'Line (X, M1 * (X - P1.X) + P1.Y)-(X, M2 * (X - P3.X) + P3.Y)
            PicHeight = (M2 * (X - P3.X) + P3.Y) - (M1 * (X - P1.X) + P1.Y)
            Me.PaintPicture ImgCtrl, X, M1 * (X - P1.X) + P1.Y, 1, PicHeight, Xpos, 0, 1
            Xpos = Xpos + Abs((Me.ScaleX(ImgCtrl.Width, vbHimetric, vbPixels) / (P2.X - P1.X)))
        Next

End Sub

Private Sub Command1_Click()
Me.Cls
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
Dim Points(1 To 4) As Point_3D
   
    Points(1).X = 10
    Points(1).Y = 50
    Points(2).X = 200
    Points(2).Y = 20
    Points(3).X = 10
    Points(3).Y = 150
    Points(4).X = 200
    Points(4).Y = 180
   
    DrawImage Image1.Picture, Points(1), Points(2), Points(3), Points(4)
End Sub

---

Thanks :)