Find all our projects in development below.
All source code is GNU General Public License (GPL)
Browsing OtherAddinForm.frm (6.55 KB)
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form OtherAddinForm
Caption = "Other Add-in (HTML Source)"
ClientHeight = 3135
ClientLeft = 165
ClientTop = 735
ClientWidth = 6015
Icon = "OtherAddinForm.frx":0000
MinButton = 0 'False
ScaleHeight = 3135
ScaleWidth = 6015
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog CommonDialog1
Left = 0
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
Filter = "Text Files (*.txt)|*.txt|All Files (*.*)|*.*"
End
Begin VB.TextBox Text1
BeginProperty Font
Name = "Courier New"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3135
Left = 0
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 0
Top = 0
Width = 6015
End
Begin VB.Menu FileMenu
Caption = "&File"
Begin VB.Menu NewMenu
Caption = "&New"
End
Begin VB.Menu OpenMenu
Caption = "&Open..."
End
Begin VB.Menu SaveAsMenu
Caption = "&Save As..."
End
Begin VB.Menu Blank1
Caption = "-"
End
Begin VB.Menu ExitMenu
Caption = "E&xit"
End
End
Begin VB.Menu EditMenu
Caption = "&Edit"
Begin VB.Menu UndoMenu
Caption = "&Undo"
Shortcut = ^Z
End
Begin VB.Menu Blank2
Caption = "-"
End
Begin VB.Menu CutMenu
Caption = "Cu&t"
Shortcut = ^X
End
Begin VB.Menu CopyMenu
Caption = "&Copy"
Shortcut = ^C
End
Begin VB.Menu PasteMenu
Caption = "&Paste"
Shortcut = ^V
End
Begin VB.Menu DeleteMenu
Caption = "De&lete"
Shortcut = {DEL}
End
Begin VB.Menu Blank3
Caption = "-"
End
Begin VB.Menu SelectAllMenu
Caption = "Select &All"
Shortcut = ^A
End
End
Begin VB.Menu HelpMenu
Caption = "&Help"
Begin VB.Menu HTMLHelpMenu
Caption = "&HTML Help..."
End
End
End
Attribute VB_Name = "OtherAddinForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_CANUNDO = &HC6
Private Const EM_UNDO = &HC7
Function CanUndo(TextBoxObj As TextBox) As Boolean
CanUndo = (SendMessage(TextBoxObj.hWnd, EM_CANUNDO, 0&, 0&) <> 0)
End Function
Sub ExecUndo(TextBoxObj As TextBox)
SendMessage TextBoxObj.hWnd, EM_UNDO, 0&, 0&
End Sub
Private Sub CopyMenu_Click()
On Error Resume Next
Clipboard.SetText Text1.SelText
End Sub
Private Sub CutMenu_Click()
On Error Resume Next
Clipboard.SetText Text1.SelText
Text1.SelText = ""
CutMenu.Enabled = False
End Sub
Private Sub DeleteMenu_Click()
Text1.SelText = ""
DeleteMenu.Enabled = False
End Sub
Private Sub ExitMenu_Click()
Unload Me
End Sub
Private Sub Form_Load()
CommonDialog1.Flags = cdlOFNFileMustExist + cdlOFNOverwritePrompt + cdlOFNLongNames + cdlOFNHideReadOnly
UndoMenu.Enabled = False
CutMenu.Enabled = False
CopyMenu.Enabled = False
DeleteMenu.Enabled = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode < 2 Then Cancel = True: Hide
End Sub
Private Sub Form_Resize()
On Error Resume Next
Text1.Width = Width - 120
Text1.Height = Height - 690
End Sub
Private Sub HTMLHelpMenu_Click()
LaunchURL "http://www.htmlgoodies.com/"
End Sub
Private Sub NewMenu_Click()
Text1.Text = ""
End Sub
Private Sub OpenMenu_Click()
On Error Resume Next
Dim FNum As Integer
FNum = FreeFile
With CommonDialog1
.DialogTitle = "Open"
.ShowOpen
End With
If Err Then Exit Sub
On Error GoTo OpenErr
Open CommonDialog1.FileName For Input As #FNum
Text1.Text = Input(LOF(FNum), FNum)
Text1.SelStart = 0
Close #FNum
Exit Sub
OpenErr:
If Err.Number = 7 Then
Text1.Text = ""
MsgBox "Error: Cannot load text file, file is too big.", vbCritical
ElseIf Err.Number = 55 Then
MsgBox "Error: Unable to open the file, try restarting eBay Auction Builder and opening the file again.", vbCritical
Else
MsgBox "Error: " + Err.Description, vbCritical
End If
End Sub
Private Sub PasteMenu_Click()
On Error Resume Next
Text1.SelText = Clipboard.GetText(1)
End Sub
Private Sub SaveAsMenu_Click()
On Error GoTo CancelErr
Dim FNum As Integer
FNum = FreeFile
With CommonDialog1
.DialogTitle = "Save As"
.ShowSave
End With
Open CommonDialog1.FileName For Output As #FNum
Print #FNum, Text1.Text;
Close #FNum
CancelErr:
End Sub
Private Sub SelectAllMenu_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If CanUndo(Text1) Then
UndoMenu.Enabled = True
Else
UndoMenu.Enabled = False
End If
End Sub
Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
If Text1.SelLength > 0 Then
CutMenu.Enabled = True
CopyMenu.Enabled = True
DeleteMenu.Enabled = True
Else
CutMenu.Enabled = False
CopyMenu.Enabled = False
DeleteMenu.Enabled = False
End If
End If
End Sub
Private Sub UndoMenu_Click()
ExecUndo Text1
End Sub