home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
code
/
network
/
ogmess
/
ogrtn.bas
< prev
next >
Wrap
BASIC Source File
|
1995-02-27
|
3KB
|
142 lines
Sub centerwnd (source As Form)
'Center form on Screen
scrx% = screen.width
scry% = screen.height
source.top = scry% / 2 - source.height / 2
source.left = scrx% / 2 - source.width / 2
End Sub
Sub disp_sample (font As String, size As String)
On Error GoTo errorhand
Dim sampletxt As String
If size = "" Then
size = "4"
End If
If font = "" Then
font = printer.fonts(1)
End If
sampletxt = "_____Sample Text_____"
prnmsg.samplepic.Cls
prnmsg.samplepic.fontname = font
prnmsg.samplepic.fontsize = Val(size)
'vertical center
prnmsg.samplepic.currenty = Int(prnmsg.samplepic.scaleheight / 2) - Int(prnmsg.samplepic.TextHeight(sampletxt) / 2)
'Horizontal center
prnmsg.samplepic.currentx = Int(prnmsg.samplepic.scalewidth / 2) - Int(prnmsg.samplepic.TextWidth(sampletxt) / 2)
prnmsg.samplepic.Print sampletxt
errorhand:
Resume theend
theend:
End Sub
Function getfield$ (thisfield As Integer, delimchar As String, delimstr As String)
Dim strrtn As String
Dim inc, fldcnt, curloc As Integer
Dim start, fin As Integer
curloc = 1
If delimstr = "" Then
getfield$ = ""
Exit Function
End If
If thisfield = 1 Then
strrtn = Left$(delimstr, InStr(delimstr, delimchar) - 1)
Else
For fldcnt = 1 To thisfield
curloc = InStr(curloc + 1, delimstr, delimchar)
If fldcnt = thisfield - 1 Then
start = curloc + 1
End If
If fldcnt = thisfield Then
fin = curloc
If curloc = 0 And start > 0 Then
fin = Len(delimstr)
End If
End If
Next fldcnt
If start > fin Then
strrtn = ""
Else
strrtn = Mid$(delimstr, start, (fin - start))
End If
End If
getfield$ = strrtn
End Function
Sub printmsg_rtn (source As String)
Dim fontnum As Integer
If source = "" Then
MsgBox "Error Nothing to Print", 48, "Print Message"
Exit Sub
End If
printstring = source
fontnum = printer.fontcount
fontnum = fontnum - 1
For i% = 0 To fontnum
prnmsg.fntnames.AddItem printer.fonts(i%)
Next i%
prnmsg.fntnames.text = printer.fonts(0)
For i% = 4 To 127
prnmsg.fntsize.AddItem Str$(i%)
Next i%
prnmsg.fntsize.text = "12"
sam$ = printer.fonts(1)
size$ = "4"
Call disp_sample(sam$, "4")
prnmsg.windowstate = 0
prnmsg.Show
End Sub
Sub resetup ()
setup.pbox.text = maildir
setup.usename.text = username
setup.Show
End Sub
Sub setup_rtn ()
winpath = Environ$("windir")
namefile = winpath + "\" + "OGMESS.ini"
On Error GoTo nofile
Open namefile For Input As #1
Input #1, username
Input #1, maildir
Close #1
setupflag = True
Exit Sub
nofile:
If Err = 53 Then
setup.Show
End If
Exit Sub
End Sub