home *** CD-ROM | disk | FTP | other *** search
VERSION 2.00 Begin Form MsgEdit BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "MsgBox Editor" ClientHeight = 4152 ClientLeft = 1608 ClientTop = 1992 ClientWidth = 5544 ForeColor = &H00000000& Height = 4800 Left = 1560 LinkMode = 1 'Source LinkTopic = "Form2" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 4152 ScaleWidth = 5544 Top = 1392 Width = 5640 Begin CommandButton Finished Caption = "&Finished!" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 12 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 495 Left = 1920 TabIndex = 8 Top = 3480 Width = 1815 End Begin CommandButton MessageClear Caption = "C&lear" Height = 495 Left = 4680 TabIndex = 6 TabStop = 0 'False Top = 2040 Width = 615 End Begin TextBox MessageEdit Height = 855 Left = 240 MultiLine = -1 'True TabIndex = 5 Top = 2040 Width = 4215 End Begin CommandButton TitleClear Caption = "&Clear" Height = 495 Left = 4680 TabIndex = 2 TabStop = 0 'False Top = 600 Width = 615 End Begin TextBox TitleEdit Height = 375 Left = 240 TabIndex = 1 Top = 600 Width = 4215 End Begin Label Label3 BackStyle = 0 'Transparent Caption = "Use Return to start new line, and Control-Return (or click on OK) to accept text." FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 7.8 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 375 Index = 1 Left = 240 TabIndex = 7 Top = 3000 Width = 4215 End Begin Label Label1 BackStyle = 0 'Transparent Caption = "Enter MsgBox &Message Here:" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 12 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 375 Left = 360 TabIndex = 4 Top = 1560 Width = 3855 End Begin Label Label3 BackStyle = 0 'Transparent Caption = "Use Control-Return (or click on OK) to accept text." FontBold = 0 'False FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 7.8 FontStrikethru = 0 'False FontUnderline = 0 'False Height = 255 Index = 0 Left = 240 TabIndex = 3 Top = 1080 Width = 4215 End Begin Label Label2 BackStyle = 0 'Transparent Caption = "Enter MsgBox &Title Here:" FontBold = -1 'True FontItalic = 0 'False FontName = "MS Sans Serif" FontSize = 12 FontStrikethru = 0 'False FontUnderline = 0 'False ForeColor = &H00000000& Height = 375 Left = 360 TabIndex = 0 Top = 120 Width = 4095 End Begin Menu Hints Caption = "&Hints" Begin Menu TitleMsg Caption = "&Title..." End Begin Menu MsgMsg Caption = "&Message..." End Begin Menu EditMsg Caption = "&Editing..." End Begin Menu sep Caption = "-" End Begin Menu AboutMsg Caption = "&About..." End End Option Explicit Sub AboutMsg_Click () MBAbout.Show 1 End Sub Function CheckString (TheText As String, TheType As Integer) As Integer Dim StrMsg$ Dim LenMsg$ Dim WordText$ CheckString = True StrMsg$ = "VB will will truncate this long word at the 255th character. Try again!" LenMsg$ = "VB will only allow 1,024 characters in a message box. Try again!" WordText$ = TheText While InStr(WordText$, Chr$(32)) > 0 If InStr(WordText$, Chr$(32)) > 255 Then Call Turn3dOnOff MsgBox StrMsg$, 16, "String Error" Call Turn3dOnOff CheckString = False End If WordText$ = Mid$(WordText$, InStr(WordText$, Chr$(32)) & 1) Wend If Len(TheText) > 1024 And TheType = MSG Then Call Turn3dOnOff MsgBox LenMsg$, 16, "String Error" Call Turn3dOnOff CheckString = False End If End Function Sub EditMsg_Click () Dim pstrTheMessage As String Dim pstrTheTitle As String pstrTheMessage = "Instructions for editing are placed below the edit boxes. You may embed carriage returns" pstrTheMessage = gstrTheMessage & " in the Message section by pressing Return. You can accept the text by pressing Control-Return in either the Title or" pstrTheMessage = gstrTheMessage & " the Message Box. You may also use a mouse to click on the Finished button." pstrTheTitle = "Editing" Call Turn3dOnOff MsgBox pstrTheMessage, 0, pstrTheTitle Call Turn3dOnOff End Sub Sub Finished_Click () Dim pintTheAnswer As Integer ' Check the title to see if it is valid pintTheAnswer = CheckString((TitleEdit.Text), TTL) If pintTheAnswer Then ' If titel is ok gstrTheTitle = TitleEdit.Text Else ' If not valid TitleEdit.SetFocus Exit Sub End If ' Check the Message to see if it is valid pintTheAnswer = CheckString((MessageEdit.Text), MSG) If pintTheAnswer Then ' If Message is ok gstrRawMessage = MessageEdit.Text Else ' If not valid MessageEdit.SetFocus Exit Sub End If ' Make shure there is a Message If Len(gstrRawMessage) > 0 Then MsgEdit.Hide Else ' if not Call Turn3dOnOff pintTheAnswer = MsgBox("What good's a message box without a message?", 37, "String Error") Call Turn3dOnOff If pintTheAnswer = 4 Then ' Retry MessageEdit.SetFocus Exit Sub Else ' Cancel MsgEdit.Hide End If End If End Sub Sub Form_Load () Call CenterOnForm(MsgBxGen, MsgEdit) TitleEdit.Text = gstrTheTitle MessageEdit.Text = gstrRawMessage End Sub Sub MessageClear_Click () MessageEdit.Text = "" End Sub Sub MessageEdit_KeyUp (KeyCode As Integer, Shift As Integer) Dim eCtrlDown% Dim CtrlDown% Dim StringState Dim AnAnswer eCtrlDown% = (Shift And CTRL_MASK) > 0 If KeyCode = KEY_RETURN Then ' Display key combinations. If CtrlDown% Then StringState = CheckString((MessageEdit.Text), MSG) If StringState <> False Then gstrRawMessage = Left$(MessageEdit.Text, Len(MessageEdit.Text) - 2) End If If Len(gstrRawMessage) > 0 Then Finished.SetFocus Else Call Turn3dOnOff AnAnswer = MsgBox("What good's a message box without a message?", 37, "String Error") Call Turn3dOnOff If AnAnswer = RETRY Then Exit Sub Else End End If End If End If End If End Sub Sub MsgMsg_Click () Dim pstrTheMessage As String Dim pstrTheTitle As String pstrTheMessage = "The message box function/procedure will only accept messages 1,024 characters" pstrTheMessage = gstrTheMessage & " long. Longer messages will be truncated at the 1,024th character. Words (any series of characters without intervening spaces) will be truncated at the 255th character." pstrTheTitle = "The Message" Call Turn3dOnOff MsgBox pstrTheMessage, 0, pstrTheTitle Call Turn3dOnOff End Sub Sub TitleClear_Click () TitleEdit.Text = "" End Sub Sub TitleEdit_KeyUp (KeyCode As Integer, Shift As Integer) Dim CtrlDown% CtrlDown% = (Shift And CTRL_MASK) > 0 If KeyCode = KEY_RETURN Then ' Display key combinations. If CtrlDown% Then gstrTheTitle = TitleEdit.Text MessageEdit.SetFocus End If End If End Sub Sub TitleMsg_Click () Dim pstrTheMessage As String Dim pstrTheTitle As String pstrTheMessage = "Any word (series of characters with no intervening spaces) is truncated at the 255th character. Titles longer than the width of the monitor are not very helpful as messages." pstrTheTitle = "The Title" Call Turn3dOnOff MsgBox pstrTheMessage, 0, pstrTheTitle Call Turn3dOnOff End Sub 
(.txt)