[zeitghost]

VERSION 2.00
Begin Form frmWfaxdisp 
   Caption         =   "Weather Fax Display Program"
   ClientHeight    =   5820
   ClientLeft      =   1095
   ClientTop       =   1770
   ClientWidth     =   7365
   Height          =   6510
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   388
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   491
   Top             =   1140
   Width           =   7485
   Begin CommonDialog CMDialog1 
      Left            =   2160
      Top             =   6600
   End
   Begin PictureBox picDisplay 
      Align           =   1  'Align Top
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      DrawMode        =   4  'Not Copy Pen
      Height          =   9000
      Left            =   0
      Picture         =   WFAXDISP.FRX:0000
      ScaleHeight     =   600
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   491
      TabIndex        =   0
      Top             =   0
      Width           =   7365
   End
   Begin Menu mnuFile 
      Caption         =   "File"
      Begin Menu mneSelect 
         Caption         =   "Select File"
      End
      Begin Menu mnuSep2 
         Caption         =   "-"
      End
      Begin Menu mnuSave 
         Caption         =   "Save File"
      End
      Begin Menu mnuSep1 
         Caption         =   "-"
      End
      Begin Menu mnuExit 
         Caption         =   "E&xit"
      End
   End
End
Option Explicit
'File Open/Save Dialog Flags
 Const OFN_READONLY = &H1&
 Const OFN_OVERWRITEPROMPT = &H2&
 Const OFN_HIDEREADONLY = &H4&
 Const OFN_NOCHANGEDIR = &H8&
 Const OFN_SHOWHELP = &H10&
 Const OFN_NOVALIDATE = &H100&
 Const OFN_ALLOWMULTISELECT = &H200&
 Const OFN_EXTENSIONDIFFERENT = &H400&
 Const OFN_PATHMUSTEXIST = &H800&
 Const OFN_FILEMUSTEXIST = &H1000&
 Const OFN_CREATEPROMPT = &H2000&
 Const OFN_SHAREAWARE = &H4000&
 Const OFN_NOREADONLYRETURN = &H8000&

Sub mneSelect_Click ()
'dim nestring( 800,400 ) as string
 Dim filenum As Integer
 Dim input_char As String
 Dim R, G, B As Integer       'point colour
 Dim X, Y           'point location
 Dim loop_count As Long
 Dim file_byte_count As Long
 
 frmGetFile.cboFileType.AddItem "Fax Files (*.DUP)"
 frmGetFile.cboFileType.ListIndex = 0
 frmGetFile.Show 1

 MsgBox frmGetFile.Tag
 If frmGetFile.Tag = "" Then Exit Sub

 filenum = FreeFile

 Open frmGetFile.Tag For Binary As #filenum
 file_byte_count = LOF(filenum)

 Debug.Print file_byte_count

 X = 1
 Y = 1

 For loop_count = 1 To file_byte_count Step 1
 input_char = Input$(1, #filenum)

 'MsgBox "input char " + Hex$(Asc(input_char))
 R = Asc(input_char)
 G = Asc(input_char)
 B = Asc(input_char)

 frmWfaxdisp.picDisplay.PSet (X, Y), RGB(R, G, B) 'firkle pixel

 X = X + 1
 If X > 1599 Then 	'end of line?
    X = 0
    Y = Y + 1		'new line
    DoEvents
 End If

 If Y > frmWfaxdisp.picDisplay.ScaleHeight Then 'bottom of window?
 MsgBox "got to end of picturebox"
 Y = 0
 End If

 Next

 'frmWfaxdisp.picDisplay.AutoRedraw = True 'didn't work...

End Sub

Sub mnuExit_Click ()
 End
End Sub

Sub mnuSave_Click ()

Dim filetosave As String


CMDialog1.DialogTitle = "Save As"
CMDialog1.Flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
CMDialog1.Filter = "All Pictures|*.bmp;*.wmf;*.ico"
CMDialog1.Action = 2

'store name of file to save
filetosave = CMDialog1.Filename
If filetosave = "" Then Exit Sub

MsgBox filetosave
'just in case, set up error handler
On Error GoTo notSaved

'save the picture in picDisp to the file specified in filetosave
SavePicture frmWfaxdisp.picDisplay.Picture, filetosave
Exit Sub

notSaved:
MsgBox "Could not save file " + filetosave, 48, "File Save Error"
Resume Next

End Sub

Sub picDisplay_Change ()
 MsgBox "changed"
End Sub