Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/CODIGO_2/SIMP_FAX/SIMPLFAX.FRM

Visual Basic Form | 1993-04-29 | 14.3 KB | 407 lines

VERSION 2.00
Begin Form FaxRes
   Caption         =   "Extremely Simple VB/Winfax
 Sample Program"
   Height          =   6435
   Icon            =   SIMPLFAX.FRX:0000
   Left            =   1095
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6030
   ScaleWidth      =   5985
   Top             =   1155
   Width           =   6105
   Begin ComboBox FaxRes
      Height          =   300
      Left            =   1920
      Style           =   2  'Dropdown List
      TabIndex        =   11
      Top             =   4860
      Width           =   1695
   End
   Begin TextBox MessageText
      Height          =   1275
      Left            =   1920
      MultiLine       =   -1  'True
      TabIndex        =   10
      Top             =   3420
      Width           =   3915
   End
   Begin TextBox SenderCompanyName
      Height          =   285
      Left            =   1920
      TabIndex        =   9
      Top             =   3000
      Width           =   3915
   End
   Begin TextBox SenderName
      Height          =   285
      Left            =   1920
      TabIndex        =   8
      Top             =   2580
      Width           =   3915
   End
   Begin TextBox FaxSubject
      Height          =   285
      Left            =   1920
      TabIndex        =   7
      Top             =   2160
      Width           =   3915
   End
   Begin TextBox RecCompanyName
      Height          =   285
      Left            =   1920
      TabIndex        =   6
      Top             =   1740
      Width           =   3915
   End
   Begin TextBox RecName
      Height          =   285
      Left            =   1920
      TabIndex        =   5
      Top             =   1320
      Width           =   3915
   End
   Begin TextBox SendFaxTime
      Enabled         =   0   'False
      Height          =   285
      Left            =   4140
      TabIndex        =   4
      Top             =   900
      Width           =   915
   End
   Begin OptionButton SendFaxLater
      Caption         =   "On"
      Height          =   255
      Left            =   1920
      TabIndex        =   2
      Top             =   900
      Width           =   615
   End
   Begin OptionButton SendFaxNow
      Caption         =   "Now"
      Height          =   255
      Left            =   1920
      TabIndex        =   1
      Top             =   600
      Value           =   -1  'True
      Width           =   795
   End
   Begin TextBox SendFaxDate
      Enabled         =   0   'False
      Height          =   285
      Left            =   2580
      TabIndex        =   3
      Top             =   900
      Width           =   1155
   End
   Begin TextBox FaxNumber
      Height          =   285
      Left            =   1920
      TabIndex        =   0
      Top             =   180
      Width           =   3915
   End
   Begin CommandButton CancelFax
      Caption         =   "Exit"
      Height          =   435
      Left            =   4380
      TabIndex        =   14
      Top             =   5520
      Width           =   1455
   End
   Begin CommandButton SendFax
      Caption         =   "Send fax"
      Enabled         =   0   'False
      Height          =   435
      Left            =   2820
      TabIndex        =   13
      Top             =   5520
      Width           =   1455
   End
   Begin Label Label9
      Caption         =   "Fax resolution"
      Height          =   195
      Left            =   180
      TabIndex        =   24
      Top             =   4920
      Width           =   1455
   End
   Begin Label Label8
      Caption         =   "Message text"
      Height          =   195
      Left            =   180
      TabIndex        =   23
      Top             =   3480
      Width           =   1395
   End
   Begin Label Label7
      Caption         =   "Company name"
      Height          =   195
      Left            =   180
      TabIndex        =   22
      Top             =   3060
      Width           =   1515
   End
   Begin Label Label6
      Caption         =   "Sender's name"
      Height          =   195
      Left            =   180
      TabIndex        =   21
      Top             =   2640
      Width           =   1515
   End
   Begin Label Label5
      Caption         =   "Fax subject"
      Height          =   195
      Left            =   180
      TabIndex        =   20
      Top             =   2220
      Width           =   1455
   End
   Begin Label Label4
      Caption         =   "Company name"
      Height          =   195
      Left            =   180
      TabIndex        =   19
      Top             =   1800
      Width           =   1515
   End
   Begin Label Label3
      Caption         =   "Recipient's name"
      Height          =   195
      Left            =   180
      TabIndex        =   18
      Top             =   1380
      Width           =   1515
   End
   Begin Label SendFaxAtLabel
      Caption         =   "at"
      Height          =   195
      Left            =   3840
      TabIndex        =   17
      Top             =   960
      Width           =   255
   End
   Begin Label Label2
      Caption         =   "Send fax"
      Height          =   195
      Left            =   180
      TabIndex        =   16
      Top             =   660
      Width           =   1215
   End
   Begin Label Label1
      Caption         =   "Fax number"
      Height          =   255
      Left            =   180
      TabIndex        =   15
      Top             =   240
      Width           =   1095
   End
   Begin Label DDElabel
      Caption         =   "The invisible DDElabel ..."
      Height          =   255
      Left            =   120
      TabIndex        =   12
      Top             =   5640
      Visible         =   0   'False
      Width           =   2295
   End
Sub CancelFax_Click ()
If MsgBox("Exit the fax program?", 36, "User-friendly question #17") Then
    End
End If
End Sub
Sub FaxNumber_Change ()
If Len(FaxNumber.Text) > 47 Then
    MsgBox "Maximum fax number length is 47." + Chr$(13) + Chr$(10) + "Additional digits will be ignored.", 48, "Sorry!"
    FaxNumber.Text = Left$(FaxNumber.Text, 47)
End If
If Len(LTrim$(RTrim$(FaxNumber.Text))) <> 0 Then
    SendFax.Enabled = True
    SendFax.Enabled = False
End If
End Sub
Sub Form_Activate ()
FaxNumber.SetFocus
End Sub
Sub Form_Load ()
ad$ = "SIMPLFAX 1.0 - VB/WinFax Sample Program" + Chr$(13) + Chr$(10) + "Copyright
1993 michiel de bruijn"
ad$ = ad$ + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "You may freely use and distribute this program and its source code in accordance to the licence agreement as included in SIMPLFAX.WRI"
MsgBox ad$, 64, "About SIMPLFAX"
tmp$ = Date$
For a% = 1 To Len(tmp$)
    If Mid$(tmp$, a%, 1) = "-" Then Mid$(tmp$, a%, 1) = "/"
Next a%
SendFaxDate.Text = tmp$
SendFaxTime.Text = Time$
FaxRes.AddItem "Normal"
FaxRes.AddItem "High"
FaxRes.ListIndex = 1
End Sub
Static Sub nop ()
End Sub
Sub RecCompanyName_Change ()
If Len(RecCompanyName.Text) > 42 Then
    MsgBox "Maximum name length is 42." + Chr$(13) + Chr$(10) + "Additional characters will be ignored.", 48, "Sorry!"
    RecCompanyName.Text = Left$(RecCompanyName.Text, 42)
End If
End Sub
Sub RecName_Change ()
If Len(RecName.Text) > 31 Then
    MsgBox "Maximum name length is 31." + Chr$(13) + Chr$(10) + "Additional characters will be ignored.", 48, "Sorry!"
    RecName.Text = Left$(RecName.Text, 31)
End If
End Sub
Sub SendFax_Click ()
'====================================================================================================
' STEP 1: Set WinFax as the default printer so we can print to it using the VB printer object
'====================================================================================================
' First, retrieve the current default printer, if any
buf$ = Space$(256)
dummy% = GetProfileString("windows" + Chr$(0), "device" + Chr$(0), Chr$(0), buf$, Len(buf$))
PrevDefaultPrinter$ = buf$
' Then find out the WinFax setup (driver name & port)
buf$ = Space$(256)
dummy% = GetProfileString("printerports" + Chr$(0), "winfax" + Chr$(0), Chr$(0), buf$, Len(buf$))
If Left$(buf$, 1) = Chr$(0) Then
    MsgBox "WinFax is not properly installed as a printer on this machine", 16, "Cannot send fax"
    Exit Sub
End If
x% = InStr(buf$, ":")
wfparms$ = Left$(buf$, x%)
' And set WinFax as the default printer
res% = WriteProfileString("windows" + Chr$(0), "device" + Chr$(0), "WINFAX," + wfparms$ + Chr$(0))
If res% <> 1 Then
    MsgBox "Could not select WinFax as the default printer.", 16, "Cannot send fax"
    Exit Sub
End If
'====================================================================================================
' STEP 2: Contact WinFax via DDE and send the phone number etc. in advance
'====================================================================================================
' Set the application name and topic (see pg. 12-12 of the WinFax PRO 3.0 manual)
DDElabel.LinkTopic = "FAXMNG|Transmit"
' Try to create the link. The error handler is used to start WinFax if it's not already running
On Local Error GoTo NoWinFax
DDElabel.LinkMode = 2
On Local Error GoTo 0
' WinFax should be running and listening at this point. Send the required data
DDElabel.LinkItem = "Sendfax"
tmp$ = "recipient(" + Chr$(34) + FaxNumber.Text + Chr$(34) + ","
If SendFaxNow.Value = True Then
    tmp$ = tmp$ + ",,"
    tmp$ = tmp$ + Chr$(34) + SendFaxDate.Text + Chr$(34) + "," + Chr$(34) + SendFaxTime.Text + Chr$(34) + ","
End If
tmp$ = tmp$ + Chr$(34) + RecName.Text + Chr$(34) + ","
tmp$ = tmp$ + Chr$(34) + RecCompanyName.Text + Chr$(34) + ","
tmp$ = tmp$ + Chr$(34) + FaxSubject.Text + Chr$(34) + ")"
DDElabel.Caption = tmp$
DDElabel.LinkPoke
If FaxRes.ListIndex = 0 Then tmp$ = "low" Else tmp$ = "high"
DDElabel.Caption = "resolution(" + Chr$(34) + tmp$ + Chr$(34) + ")"
DDElabel.LinkPoke
'====================================================================================================
' STEP 3: Do the actual printing
'====================================================================================================
printer.FontName = "Arial": printer.FontSize = 62
printer.FontBold = True: printer.FontItalic = True
tmp$ = "FAX MESSAGE"
printer.CurrentY = 100
printer.CurrentX = (printer.ScaleWidth \ 2) - (printer.TextWidth(tmp$) \ 2)
printer.Print tmp$
printer.FontSize = 14: printer.FontBold = False: printer.FontItalic = False
printer.Print
printer.CurrentX = 1000: printer.Print "Date/Time";
printer.CurrentX = 3000: printer.Print Date$; " "; Time$
printer.Print
printer.CurrentX = 1000: printer.Print "To";
printer.CurrentX = 3000: printer.Print RecName.Text
printer.Print
printer.CurrentX = 1000: printer.Print "Company";
printer.CurrentX = 3000: printer.Print RecCompanyName.Text
printer.Print
printer.CurrentX = 1000: printer.Print "Subject";
printer.CurrentX = 3000: printer.Print FaxSubject.Text
printer.Print
printer.CurrentX = 1000: printer.Print "From";
printer.CurrentX = 3000: printer.Print SenderName.Text
printer.Print
printer.CurrentX = 1000: printer.Print "Company";
printer.CurrentX = 3000: printer.Print SenderCompanyName.Text
printer.Print
printer.Print
printer.FontName = "Times New Roman"
' PROGRAMMER'S HEALTH WARNING! Extremely slow, simplistic & braindead
' formatting code ahead. Read at your own risk!!
margin% = printer.ScaleWidth - 2000
printer.CurrentX = 1000
For a% = 1 To Len(MessageText.Text)
    char$ = Mid$(MessageText.Text, a%, 1)
    If (char$ = " ") And printer.CurrentX > margin% Then
        printer.Print
        printer.CurrentX = 1000
    ElseIf char$ = Chr$(13) Then
        printer.Print
        printer.CurrentX = 1000
    ElseIf char$ = Chr$(10) Then
        nop
    Else
        printer.Print char$;
    End If
Next a%
' (if you read it anyway: it's OK to go and scream now. I'm sorry)
printer.EndDoc
MsgBox "Your fax was sent OK to the WinFax program.", 64, "Printing complete"
'====================================================================================================
' STEP 3: Cleanup: Terminate our DDE conversation with WinFax and restore the default printer
'====================================================================================================
DDElabel.LinkMode = 0
DDElabel.LinkTopic = ""
RecName.Text = "": RecCompanyName.Text = ""
SenderName.Text = "": SenderCompanyName.Text = ""
FaxSubject.Text = "": MessageText.Text = ""
FaxNumber.Text = ""
RestoreDefaultPrinter:
res% = WriteProfileString("windows" + Chr$(0), "device" + Chr$(0), PrevDefaultPrinter$ + Chr$(0))
If res% <> 1 Then
    MsgBox "Could not restore your default printer." + Chr$(13) + Chr$(10) + "Please do so manually via the Control Panel", 48, "Problem detected"
    Exit Sub
End If
Exit Sub
'====================================================================================================
' Error handling (limited)
'====================================================================================================
NoWinFax:
    If Err = 282 Then
        buf$ = Space$(256)
        dummy% = GetProfileString("winfax" + Chr$(0), "exepath" + Chr$(0), Chr$(0), buf$, Len(buf$))
        x% = InStr(buf$, Chr$(0))
        If x% <> 1 Then
            exepath$ = Left$(buf$, x% - 1)
            dummy% = Shell(exepath$ + "faxmng.exe")
            Resume
        Else
            MsgBox "Winfax is not properly installed on this machine." + Chr$(13) + Chr$(10) + "Please ensure that you have version 3.x and your setup is correct.", 16, "Fatal error: "
            Resume RestoreDefaultPrinter
        End If
    Else
        MsgBox "Error talking to WinFax!" + Chr$(13) + Chr$(10) + "Please ensure that you have version 3.x and your setup is correct.", 16, "Fatal error: "
        Exit Sub
    End If
End Sub
Sub SendFaxAtLabel_Click ()
SendFaxLater.Value = True
SendFaxLater_Click
End Sub
Sub SendFaxLater_Click ()
SendFaxDate.Enabled = True
SendFaxTime.Enabled = True
SendFaxTime.Text = Time$
End Sub
Sub SendFaxNow_Click ()
SendFaxDate.Enabled = False
SendFaxTime.Enabled = False
End Sub