==============================================
Sub FillSysInfo ()
Dim WinFlags As Long, FreeSpace As Currency, FreeBlock As Currency, temp

' Operating System Info.
    WinFlags = GetWinFlags()
    
    lblinfo(2).Caption = "Microsoft Windows Version " & WindowsVersion()
    If WinFlags And WF_ENHANCED Then
	lblinfo(3).Caption = "(Enhanced Mode)"
    Else
	lblinfo(3).Caption = "(Standard Mode)"
    End If
    
    lblinfo(4).Caption = "Disk Operating System " & DosVersion()

' CPU Info.
    If WinFlags And WF_CPU486 Then
	lblinfo(5).Caption = "CPU: 486"
    ElseIf WinFlags And WF_CPU386 Then
	lblinfo(5).Caption = "CPU: 386"
    ElseIf WinFlags And WF_CPU286 Then
	lblinfo(5).Caption = "CPU: 286"
    End If
    If WinFlags And WF_80x87 Then
	lblinfo(5).Caption = lblinfo(5).Caption & " (with Math coprocessor)"
    End If
    
' Video info.
    lblinfo(8).Caption = "Video Driver: " & GetSysIni("boot.description", "display.drv")
    lblinfo(9).Caption = "Resolution: " & Screen.Width \ Screen.TwipsPerPixelX & " x " & Screen.Height \ Screen.TwipsPerPixelY
    lblinfo(10).Caption = "Colors: " & DeviceColors((hDC))

' General info.
    If GetSystemMetrics(SM_MOUSEPRESENT) Then
	lblinfo(11).Caption = "Mouse: " & GetSysIni("boot.description", "mouse.drv")
    Else
	lblinfo(11).Caption = "No mouse"
    End If
    lblinfo(12).Caption = "Network: " & GetSysIni("boot.description", "network.drv")
    lblinfo(13).Caption = "Language: " & GetSysIni("boot.description", "language.dll")
    lblinfo(14).Caption = "Keyboard: " & GetSysIni("boot.description", "keyboard.typ")
End Sub
==============================================
Sub Timer1_Timer ()
     Static PickBmp As Integer
     Main.Move Main.Left + 20, Main.Top - 5
     ' For a variantion, use the following line instead of the preceding one.
     'Main.Move (Main.Left + 20) Mod ScaleWidth, (Main.Top - 5 + ScaleHeight) Mod ScaleHeight
     If PickBmp Then
	Main.Picture = OpenWings.Picture  'Displays open butterfly picture.
     Else
	Main.Picture = CloseWings.Picture 'Displays closed butterfly picture.
     End If
     PickBmp = Not PickBmp
End Sub

==============================================
These 3 form the basis for a drag/drop from a filelist
control to an image

Sub File1_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    file1.DragIcon = Drive1.DragIcon
    file1.Drag
End Sub

Sub Image1_DragDrop (Source As Control, X As Single, Y As Single)
    ' Get last three letters of the dragged filename
    temp = Right$(file1.FileName, 3)
    ' If dragged file is in the root, append filename.
    If Mid(file1.Path, Len(file1.Path)) = "\" Then
      dropfile = file1.Path & file1.FileName
    ' If dragged file is not in root, append "\" and filename.
    Else
      dropfile = file1.Path & "\" & file1.FileName
    End If
      
    image1.Picture = LoadPicture("")
    Select Case temp
    Case "txt"
	X = Shell("Notepad " + dropfile, 1)
    Case "bmp", "wmf", "rle", "ico"
	image1.Picture = LoadPicture(dropfile)
    Case "exe"
	X = Shell(dropfile, 1)
    Case "hlp"
	X = Shell("WinHelp " + dropfile, 1)
    Case Else
	nl = Chr$(10) + Chr$(13)
	msg = "Try one of these file types:"
	msg = nl + msg + nl + nl + "     .txt, .bmp, .exe, .hlp"
	MsgBox msg
    End Select
End Sub

Sub Image1_DragOver (Source As Control, X As Single, Y As Single, State As Integer)
    Select Case State
    Case 0
	' Display a new icon when the source
	' enters the drop area.
	file1.DragIcon = Dir1.DragIcon
    Case 1
	' Display the original DragIcon when the source
	' leaves the drop area.
	file1.DragIcon = Drive1.DragIcon
    End Select

' Note that Dir1.DragIcon and Drive1.DragIcon have been
' set at design time. This allows you to load the "Enter
' and "Leave" icons for File1 at runtime without requiring
' that the user has those icons are on disc.

End Sub

==============================================
These 3 form the basis for drawing on a form with a mouse

Sub Form_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawNow = 0
End Sub
Sub Form_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
    If DrawNow Then
	Line -(X, Y)
	Circle (X, Y), 50
    End If
End Sub
Sub Form_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
    DrawNow = -1
    CurrentX = X
    CurrentY = Y
End Sub

==============================================
Shows how to do icon animation

Sub runtop ()
    ' Advance animation one frame
    
    y = y + 1: If y = 18 Then y = 0
    
    picture1.Picture = picClip1.GraphicCell(y)
    
    ' Icon animation:  This will only be evident when the
    ' form is minimized.  .ICO files have been loaded into
    ' the Picture3 array, rather than .BMP's.  This allows
    ' the mask feature of the .ICO to be utilized, letting
    ' the background behind the icon show through.
    
    form1.Icon = picture3(y).Picture

End Sub
==============================================
Drawing a form's command buttons on the printer object

Sub DrawCmd (cmdCtrl As Control)
    ' Declare local variables.
    Dim capTxt
    ' Save width/height of command button
    dX = cmdCtrl.Width
    dY = cmdCtrl.Height
    ' Save X and Y-coordinates of upper left corner of command button
    cmdX = cmdCtrl.Left
    cmdY = cmdCtrl.Top
    ' Save text inside command button
    capTxt = cmdCtrl.Caption
    ' Set width of lines to draw the button.
    DrawWidth = 2
    ' Move current X and Y-coordinates of Printer object to
    ' upper left corner of command button.
    Printer.CurrentX = cmdX
    Printer.CurrentY = cmdY
    ' Draw a box on Printer object to represent command button.
    ' Use Step method to give height and
    ' width of button as relative coordinates for lower
    ' right corner of button.
    Printer.Line -Step(dX, dY), , B
    ' Move current X and Y-coordinates of the Printer object to
    ' start of caption text. Because caption is centered in the button,
    ' calculate starting coordinates by subtracting width/height of
    ' caption text from width/height of button. Add half
    ' difference in both height and with to upper left corner
    ' coordinates to get starting point of text.
    Printer.CurrentX = cmdX + ((dX - Printer.TextWidth(capTxt)) / 2)
    Printer.CurrentY = cmdY + ((dY - Printer.TextHeight(capTxt)) / 2)
    ' Print caption text from command button on Printer object.
    Printer.Print cmdCtrl.Caption
End Sub

==============================================
Drawing a form's label controls on the printer object

Sub DrawLbl (lblCtrl As Control)
    ' Copy font attributes of label to Printer object.
    Printer.FontBold = lblCtrl.FontBold
    Printer.FontItalic = lblCtrl.FontItalic
    Printer.FontSize = lblCtrl.FontSize
    ' Declare variables for the height/width of label caption.
    Dim TxtHgt
    Dim TxtWid
    ' Save the text height/width of caption font
    TxtHgt = Printer.TextHeight(lblCtrl.Caption)
    TxtWid = Printer.TextWidth(lblCtrl.Caption)
    ' Draw the border, if label has one
    If lblCtrl.BorderStyle = 1 Then
	DrawWidth = 2
	Printer.CurrentX = lblCtrl.Left
	Printer.CurrentY = lblCtrl.Top
	Printer.Line -Step(lblCtrl.Width, lblCtrl.Height), , B
    End If
    ' Set the Y-coordinate of the Printer object.
    Printer.CurrentY = lblCtrl.Top
    ' Set the X-coordinate of the Printer object according to the Alignment
    ' property of the label.
    Select Case lblCtrl.Alignment
	' If alignment is left
	Case 0
	    Printer.CurrentX = lblCtrl.Left
	' If alignment is right
	Case 1
	    Printer.CurrentX = lblCtrl.Left + (lblCtrl.Width - TxtWid)
	' If alignment is center
	Case 2
	    Printer.CurrentX = lblCtrl.Left + ((lblCtrl.Width - TxtWid) / 2)
    End Select
    ' Print caption text.
    Printer.Print lblCtrl.Caption
End Sub
==============================================
Drawing a form's picturebox controls on the printer object

Sub DrawPic (picCtrl As Control)
    ' Declare local variables.
    Dim XRd
    Dim YRd
    Dim PelX
    Dim PelY
    Dim PelC
    ' Declare and initialize screen resolution variables.
    Dim ScrX
    ScrX = Screen.TwipsPerPixelX
    Dim ScrY
    ScrY = Screen.TwipsPerPixelY
    ' Set scale mode in image control to read pixels.
    picCtrl.ScaleMode = 3
    ' For each row of pixels in the source bitmap...
    For YRd = 0 To (picCtrl.ScaleHeight - 1)
	' Calculate the Y position of the pixel.
	PelY = picCtrl.Top + (YRd * ScrY)
	' For each pixel in the current row of the source bitmap...
	For XRd = 0 To (picCtrl.ScaleWidth - 1)
	    ' Calculate the X position of the pixel.
	    PelX = picCtrl.Left + (XRd * ScrX)
	    ' Store the pixel color in a local variable.
	    PelC = picCtrl.Point(XRd, YRd)
	    ' If the current pixel in the source bitmap is white, skip it
	    ' to improve the speed of the application.
	    If PelC <> QBColor(7) And PelC > 0 Then
		' Read pixel color in source bitmap and paint
		' corresponding pixel in target object
		Printer.Line (PelX, PelY)-Step(ScrX, ScrY), PelC, BF
	    End If
	' Get next pixel.
	Next XRd
	' Yield processing after each row so app doesn't tie up
	' system while transferring the bitmap.
	DoEvents
    ' Get next row.
    Next YRd
    ' Return (0, 0) coordinates of the Printer object to where they
    ' were before changing the scale mode.
    SetClientPrintOrigin Card
End Sub
==============================================
Drawing a form (and its controls) on the printer object

Sub PrintFrm (PFrm As Form)
    ' Declare local variables.
    Dim CtlCnt
    ' Change the mouse pointer to the hourglass.
    PFrm.MousePointer = 11
    ' Set the font size for the Printer object.
    Printer.FontSize = 8.25
    ' Move the (0, 0) coordinates of the Printer object to center the
    ' form in the page.
    Printer.ScaleLeft = -((Printer.Width - PFrm.Width) / 2)
    Printer.ScaleTop = -((Printer.Height - PFrm.Height) / 2)
    ' Draw a box that represents the outline of the form.
    DrawWidth = 2
    Printer.Line (0, 0)-Step(PFrm.Width, PFrm.Height), , B
    ' Print Title bar on Printer object.
    Printer.Line (0, BarHgt)-Step(PFrm.Width, 0)
    Printer.CurrentX = (PFrm.Width - Printer.TextWidth("TimeCard")) / 2
    Printer.CurrentY = (BarHgt - Printer.TextHeight("TimeCard")) / 2
    Printer.Print "TimeCard"
    ' Move the (0, 0) coordinates of the Printer object so that it
    ' coincides with the (0, 0) coordinates of the form's client area
    ' by moving down a distance equal to the height of the Title bar
    ' and the Menu bar.
    SetClientPrintOrigin Card
    ' Use the Line method to redraw the lines and boxes displayed on the
    ' form on the Printer object.
    LinesOnPrinter
    ' Find and print the following controls if they are on the form...
    For CtlCnt = 0 To PFrm.Controls.Count - 1
	' If command button...
	If TypeOf PFrm.Controls(CtlCnt) Is CommandButton Then
	    DrawCmd PFrm.Controls(CtlCnt)
	' If image control...
	ElseIf TypeOf PFrm.Controls(CtlCnt) Is PictureBox Then
	    DrawPic PFrm.Controls(CtlCnt)
	' If label...
	ElseIf TypeOf PFrm.Controls(CtlCnt) Is Label Then
	    DrawLbl PFrm.Controls(CtlCnt)
	End If
    Next CtlCnt
    ' Send contents of Printer object to printer.
    Printer.EndDoc
    ' Change the mouse pointer back to default.
    PFrm.MousePointer = 0
End Sub
==============================================
Sub Dial (Number$)
    Dim DialString$, FromModem$, dummy

    '--- AT is the Hayes compatible ATTENTION command an is required to send commands to the modem.
    '--- DT means "Dial Tone" - The Dial command, using touch tones as opposed to pulse (DP = Dial Pulse)
    '--- PhoneNumbers$(Index) is the phone number of the person you're dialing
    '--- A semicolon tells the modem to return to command mode after dialing (important)
    '--- A Carriage return, Chr$(13), is required when sending commands to the modem.
    DialString$ = "ATDT" + Number$ + ";" + Chr$(13)

    '-- Comm port settings
    Comm1.Settings = "300,N,8,1"
    
    '-- Open the comm port
    On Error Resume Next
    Comm1.PortOpen = True
    If Err Then
       MsgBox "COM1: not available. Change the CommPort property to another port."
       Exit Sub
    End If
    
    '-- Flush the input buffer
    Comm1.InBufferCount = 0
    
    '-- Dial the number
    Comm1.Output = DialString$
    
    '-- Wait for "OK" to come back from the modem
    Do
       dummy = DoEvents()
       '-- If there is data in the buffer, then read it.
       If Comm1.InBufferCount Then
	  FromModem$ = FromModem$ + Comm1.Input
	  '-- Check for "OK"
	  If InStr(FromModem$, "OK") Then
	     '-- Notify the user to pick up the phone
	     Beep
	     MsgBox "Please pick up the phone and either press Enter, or click OK"
	     Exit Do
	  End If
       End If
	
       '-- Was Cancel pressed?
       If CancelFlag Then
	  CancelFlag = False
	  Exit Do
       End If
    Loop
    
    '-- Disconnect the modem
    Comm1.Output = "ATH" + Chr$(13)
    
    '-- Close the port
    Comm1.PortOpen = False
    
End Sub
==============================================

Sub FOpenProc ()
    Dim RetVal
    On Error Resume Next
    Dim OpenFileName As String
    frmMDI.CMDialog1.Filename = ""
    frmMDI.CMDialog1.Action = 1
    If Err <> 32755 Then 'user pressed cancel
	OpenFileName = frmMDI.CMDialog1.Filename
	OpenFile (OpenFileName)
	UpdateFileMenu (OpenFileName)
    End If
End Sub

==============================================

Function GetFileName ()
    'Displays a Save As dialog and returns a file name
    'or an empty string if the user cancels
    On Error Resume Next
    frmMDI.CMDialog1.Filename = ""
    frmMDI.CMDialog1.Action = 2
    If Err <> 32755 Then      'User cancelled dialog
	GetFileName = frmMDI.CMDialog1.Filename
    Else
	GetFileName = ""
    End If
End Function

==============================================

Function OnRecentFilesList (FileName) As Integer
  Dim i

  For i = 1 To 4
    If frmMDI.mnuRecentFile(i).Caption = FileName Then
      OnRecentFilesList = True
      Exit Function
    End If
  Next i
    OnRecentFilesList = False
End Function

==============================================

Sub OpenFile (FileName)
    Dim NL, TextIn, GetLine
    Dim fIndex As Integer

    NL = Chr$(13) + Chr$(10)
    
    On Error Resume Next
    ' open the selected file
    Open FileName For Input As #1
    If Err Then
	MsgBox "Can't open file: " + FileName
	Exit Sub
    End If
    ' change mousepointer to an hourglass
    screen.MousePointer = 11
    
    ' change form's caption and display new text
    fIndex = FindFreeIndex()
    document(fIndex).Tag = fIndex
    document(fIndex).Caption = UCase$(FileName)
    document(fIndex).Text1.Text = Input$(LOF(1), 1)
    FState(fIndex).Dirty = False
    document(fIndex).Show
    Close #1
    ' reset mouse pointer
    screen.MousePointer = 0
End Sub

==============================================

Sub SaveFileAs (FileName)
On Error Resume Next
    Dim Contents As String

    ' open the file
    Open FileName For Output As #1
    ' put contents of the notepad into a variable
    Contents = frmMDI.ActiveForm.Text1.Text
    ' display hourglass
    screen.MousePointer = 11
    ' write variable contents to saved file
    Print #1, Contents
    Close #1
    ' reset the mousepointer
    screen.MousePointer = 0
    ' set the Notepad's caption

    If Err Then
	MsgBox Error, 48, App.Title
    Else
	frmMDI.ActiveForm.Caption = UCase$(FileName)
	' reset the dirty flag
	FState(frmMDI.ActiveForm.Tag).Dirty = False
    End If
End Sub

==============================================

Sub UpdateFileMenu (FileName)
	Dim RetVal
	' Check if OpenFileName is already on MRU list.
	RetVal = OnRecentFilesList(FileName)
	If Not RetVal Then
	  ' Write OpenFileName to MDINOTEPAD.INI
	  WriteRecentFiles (FileName)
	End If
	' Update menus for most recent file list.
	GetRecentFiles
End Sub