home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Quiz_Softw2029431162006.psc / basMain.bas < prev    next >
BASIC Source File  |  2003-06-04  |  2KB  |  82 lines
  1. Attribute VB_Name = "basMain"
  2. Option Explicit
  3.  
  4. Public ImagePath As String
  5.  
  6. Public MyExam         As New cExamDB
  7. Public MyAnswer       As New Collection
  8. Public AvailCategory  As New Collection
  9. Public DataInfo As New Collection
  10.  
  11. Public Sub Main()
  12.     MyExam.InitExam App.Path & "\primary.mdb"
  13.     ImagePath = App.Path & "\Image\"
  14.     Load frmMain
  15.     frmMain.Show
  16. End Sub
  17.  
  18. Public Sub Shuffle(ByRef Data() As Integer)
  19.     Dim i As Integer, IsInArray As Boolean
  20.     Dim MaxValue As Integer, TempValue, step As Integer
  21.  
  22.     step = 0
  23.     Randomize
  24.     
  25.     MaxValue = UBound(Data())
  26.     Do While step < MaxValue
  27.         IsInArray = False
  28.         TempValue = Int((MaxValue * Rnd) + 1)
  29.         For i = 0 To step
  30.             If Data(i) = TempValue Then
  31.                 IsInArray = True
  32.                 Exit For
  33.             End If
  34.         Next i
  35.         If Not IsInArray Then
  36.             Data(step) = TempValue
  37.             step = step + 1
  38.         End If
  39.     Loop
  40. End Sub
  41.  
  42. Public Function BitmapToPicture(ByVal hBMP As Long) As IPicture
  43.  
  44.    If (hBMP = 0) Then Exit Function
  45.  
  46.    Dim NewPic As Picture, tPicConv As PictDesc, IGuid As Guid
  47.  
  48.    ' Fill PictDesc structure with necessary parts:
  49.    With tPicConv
  50.       .cbSizeofStruct = Len(tPicConv)
  51.       .picType = vbPicTypeBitmap
  52.       .hImage = hBMP
  53.    End With
  54.  
  55.    ' Fill in IDispatch Interface ID
  56.    With IGuid
  57.       .Data1 = &H20400
  58.       .Data4(0) = &HC0
  59.       .Data4(7) = &H46
  60.    End With
  61.  
  62.    ' Create a picture object:
  63.    OleCreatePictureIndirect tPicConv, IGuid, True, NewPic
  64.    
  65.    ' Return it:
  66.    Set BitmapToPicture = NewPic
  67. End Function
  68.  
  69. Public Sub DrawLine(lhDC As Long, X1 As Integer, Y1 As Integer, _
  70.                      X2 As Integer, Y2 As Integer, nWidth As Integer, cColor As Long)
  71.  
  72.     Dim hPen As Long, OldPen As Long, tPT As POINTAPI
  73.     
  74.     hPen = CreatePen(PS_SOLID, nWidth, cColor)
  75.     OldPen = SelectObject(lhDC, hPen)
  76.     MoveToEx lhDC, X1, Y1, tPT
  77.     LineTo lhDC, X2, Y2
  78.     SelectObject lhDC, OldPen
  79.     DeleteObject hPen
  80. End Sub
  81.  
  82.