VERSION 5.00
Begin VB.Form Form1 
   AutoRedraw      =   -1  'True
   Caption         =   "Form1"
   ClientHeight    =   7965
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   14055
   LinkTopic       =   "Form1"
   ScaleHeight     =   7965
   ScaleWidth      =   14055
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox Check1 
      Caption         =   "Use API"
      Height          =   495
      Left            =   2280
      TabIndex        =   2
      Top             =   6360
      Width           =   1215
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   4800
      TabIndex        =   1
      Top             =   6480
      Width           =   1215
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      Height          =   6135
      Left            =   120
      ScaleHeight     =   6075
      ScaleWidth      =   13755
      TabIndex        =   0
      Top             =   120
      Width           =   13815
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
'draws line from current position to point passsed API
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
'moves to new drawing position API
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
'determines performance of execution for testing purposes only
Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
'allows us to create a pen of certain thickness and color
Private Declare Function CreatePen Lib "gdi32.dll" (ByVal fnPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
'necessary to delete pen created with above API function so we don't have memory leaks
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
'selects our newly created pen or our old pen
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWnd As Long) As Long

Private Type mapLineType
    XPosStart As Single
    YPosStart As Single
    XPosEnd As Single
    YPosEnd As Single
    Colour As Long
    Thickness As Single
End Type
Private mapLine(500000) As mapLineType
'below type is needed for LineTo and MoveEx API functions
Private Type POINTAPI
        x As Long
        y As Long
End Type
 




Private Sub Command1_Click()
Dim mypointapi As POINTAPI
Dim hPen As Long  ' handle to the pen created API
Dim hOldPen As Long  ' handle to Picture1's previously selected pen API
Dim retval As Long  ' dummy api function return value API
Dim i As Long
'needed for conversion from twips to pixels with API functions
Dim picture1width As Long
Dim picture1height As Long

'performance measuring variable
Dim start As Long

picture1width = (Picture1.Width / Screen.TwipsPerPixelX)
picture1height = (Picture1.Height / Screen.TwipsPerPixelY)
For i = 1 To 500000
mapLine(i).XPosStart = Int(picture1width * Rnd)
mapLine(i).YPosStart = Int(picture1height * Rnd)
mapLine(i).XPosEnd = Int(picture1width * Rnd)
mapLine(i).YPosEnd = Int(picture1height * Rnd)
mapLine(i).Colour = Int(31000 * Rnd + 1)
mapLine(i).Thickness = Int(1 * Rnd + 1)
Next
Open ("C:\testfile.tst") For Binary As #1
Put #1, 1, mapLine
Close #1

start = GetTickCount
Open ("C:\testfile.tst") For Binary As #1
Get #1, 1, mapLine
Close #1
Debug.Print "loaded in : " & (GetTickCount - start) / 1000 & " seconds"

start = GetTickCount
  


' Draw the rectangle filled using the solid yellow brush
If Check1.Value = 1 Then
    LockWindowUpdate (Picture1.hWnd)
    For i = 1 To 500000
    
    'create a pen based on passed thickness and color
    hPen = CreatePen(0, mapLine(i).Thickness, mapLine(i).Colour)
    ' Stores pciture1's default brush so we can restore it after our new pen is deleted
    hOldPen = SelectObject(Picture1.hdc, hPen)
    'move to starting point
    retval = MoveToEx(ByVal Picture1.hdc, mapLine(i).XPosStart, mapLine(i).YPosStart, mypointapi)
    'draw line to ending point
    retval = LineTo(ByVal Picture1.hdc, ByVal mapLine(i).XPosEnd, ByVal mapLine(i).YPosEnd)
    ' Delete the pen we created to free up resources.
    retval = DeleteObject(hPen)
    ' Select the old pen for use by picture1
    retval = SelectObject(Picture1.hdc, hPen)
    DoEvents
    Next
    LockWindowUpdate (0)
    Picture1.Refresh
Else
    For i = 1 To 500000
    Picture1.DrawWidth = mapLine(i).Thickness
    Picture1.Line (mapLine(i).XPosStart, mapLine(i).YPosStart)-(mapLine(i).XPosEnd, mapLine(i).YPosEnd), mapLine(i).Colour
    DoEvents
    Next
End If

Debug.Print "Drawn in :" & (GetTickCount - start) / 1000 & " seconds"
End Sub