Here is some code for VB6 (wordwrapping)
Private Sub Command1_Click()
'To use this function with a text box, make sure the
'text box's Multiline property to True, and use the
'following code:
'-- VB functions that take strings as parameters
'will not accept a Text property.
T$ = Text1.Text
'-- Get the formatted text (45 characters wide)
Wrapped$ = WordWrap$(T$, 45)
'-- Save the text to a file.
Open "yourfile.text" For append As 1
Print #1, Wrapped$
Close #1
End Sub
Private Function WordWrap$(St$, Length)
'-- This function converts raw text into CRLF delimited lines.
Length = Length + 1
St$ = Trim$(St$)
Cr$ = Chr$(13)
Crlf$ = Chr$(13) & Chr$(10)
Do
L = Len(NextLine$)
S = InStr(St$, " ")
C = InStr(St$, Cr$)
If C Then
If L + C <= Length Then
Text$ = Text$ & NextLine$ & Left$(St$, C)
NextLine$ = ""
St$ = Mid$(St$, C + 1)
GoTo LoopHere
End If
End If
If S Then
If L + S <= Length Then
DoneOnce = True
NextLine$ = NextLine$ & Left$(St$, S)
St$ = Mid$(St$, S + 1)
ElseIf S > Length Then
Text$ = Text$ & Crlf$ & Left$(St$, Length)
St$ = Mid$(St$, Length + 1)
Else
Text$ = Text$ & NextLine$ & Crlf$
NextLine$ = ""
End If
Else
If L Then
If L + Len(St$) > Length Then
Text$ = Text$ & NextLine$ & Crlf$ & St$ & Crlf$
Else
Text$ = Text$ & NextLine$ & St$ & Crlf$
End If
Else
Text$ = Text$ & St$ & Crlf$
End If
Exit Do
End If
LoopHere:
Loop
WordWrap$ = Text$
End Function
Here is some text editor code. Very simple and will append to text files. Great if you don't want to store a large database!
Private Sub cmd1_Click()
'when user clicks Close command
rtftextnote.Text = ""
mnuFileClose.Enabled = False 'dim Close command
mnuopenfile.Enabled = True 'enable Open command
rtftextnote.Enabled = True
Close #1
End Sub
Private Sub Command1_Click()
Frmhelp2.Show
End Sub
Private Sub Command6_Click()
Unload Me
End Sub
Private Sub Command7_Click()
formcheck.Show
End Sub
Private Sub Form_Load()
End Sub
Private Sub Label1_Click()
End Sub
Private Sub mnuEditBar0_Click()
End Sub
Private Sub mnuFile_Click()
End Sub
Private Sub mnuFileClose_Click()
'when user clicks Close command
rtftextnote.Text = "" 'clear text box
mnuFileClose.Enabled = False 'dim Close command
mnuopenfile.Enabled = True 'enable Open command
rtftextnote.Enabled = True 'disable text box
End Sub
Private Sub mnuopenfile_Click()
'when user clicks Open command
CommonDialog1.Filter = "Text files (*.TXT)|*.TXT"
CommonDialog1.ShowOpen 'display Open dialog box
If CommonDialog1.FileName <> "" Then
frmdocument1.MousePointer = 11 'display hour glass
Open CommonDialog1.FileName For Input As #1
Do Until EOF(1) 'then read lines from file
Line Input #1, LineOfText$
AllText$ = AllText$ & LineOfText$
Loop
rtftextnote.Text = AllText$ 'display file
rtftextnote.Enabled = True
mnuFileClose.Enabled = True
mnuopenfile.Enabled = True 'enable scroll
frmdocument1.MousePointer = 0 'reset mouse
Close #1 'close file
End If
Exit Sub
End Sub
Private Sub mnusavefile_click()
CommonDialog1.Filter = "text files(*.txt)|*.txt"
CommonDialog1.ShowSave
If CommonDialog1.FileName <> "" Then
Open CommonDialog1.FileName For append As #1
Print #1, rtftextnote.Text; " "
Close #1
End If
End Sub
Private Sub mnuFileExit_Click()
'unload the form
Unload Me
End Sub
Private Sub mnuFileSend_Click()
MsgBox "Add 'mnuFileSend_Click' code."
End Sub
Private Sub mnuFilePrintPreview_Click()
'ToDo: Add 'mnuFilePrintPreview_Click' code.
MsgBox "Add 'mnuFilePrintPreview_Click' code."
End Sub
Private Sub mnuFilePageSetup_Click()
On Error Resume Next
With CommonDialog1
.DialogTitle = "Page Setup"
.CancelError = True
.ShowPrinter
End With
End Sub
Private Sub rtf_Change()
End Sub
Private Sub rtftextnote_Change()
End Sub
here is some code for a calculator without control array of command buttons. You use two text boxes. One label (enabled)option buttons, and your imagination!
Private Sub Command1_Click()
On Error GoTo mathhandler
Dim first, second
first = Val(Text1.Text)
second = Val(Text2.Text)
If Option1.Value = True Then
Label1.Caption = first + second
End If
If Option2.Value = True Then
Label1.Caption = first - second
End If
If Option3.Value = True Then
Label1.Caption = first * second
End If
If Option4.Value = True Then
Label1.Caption = first / second
End If
If Option4.Value = True Then
End If
mathhandler:
If Err.Number = 11 Or _
Err.Number = 6 _
Or Err.Number = 5 Then
Text2.Text = "0"
Label1.Caption = "0"
Else
msg = "Is this the correct answer?"
msg = msg & ":"
MsgBox msg, vbexlamation
End If
Exit Sub
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
frmhelpalbert.Show
End Sub
Private Sub Label1_Click()
Label1.Caption = ""
Label1.Enabled = False
Label1.Enabled = True
Close #1
End Sub
Private Sub Label6_Click()
End Sub
Private Sub Label9_Click()
End Sub
Private Sub Text2_Change()
If Text2.Text = "0" Then
Text2.Text = "STOP!you can't divide by zero: or no value was entered!"
Text2.Enabled = False
Close #1
Command1.Enabled = False
End If
Exit Sub
End Sub