vbAccelerator - Contents of code file: frmTest.frm

VERSION 5.00
Begin VB.Form frmTest 
   BackColor       =   &H80000010&
   Caption         =   "New Document"
   ClientHeight    =   3405
   ClientLeft      =   3870
   ClientTop       =   2775
   ClientWidth     =   4890
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   3405
   ScaleWidth      =   4890
   WindowState     =   2  'Maximized
   Begin VB.PictureBox picLines 
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      Height          =   2775
      Left            =   0
      ScaleHeight     =   2775
      ScaleWidth      =   555
      TabIndex        =   1
      Top             =   360
      Width           =   555
   End
   Begin VB.TextBox txtDocument 
      BorderStyle     =   0  'None
      BeginProperty Font 
         Name            =   "Lucida Console"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2715
      Left            =   600
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Top             =   360
      Width           =   4035
   End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_bIsDirty As Boolean
Private m_sFileName As String

Private Const WM_VSCROLL = &H115

Implements ISubclass


Public Function SaveDocument(Optional ByVal bSaveAs As Boolean = False) As
 Boolean
Dim sFile As String
   If Len(m_sFileName) = 0 Then
      bSaveAs = True
   End If
   If (bSaveAs) Then
      Dim c As New cCommonDialog
      If Not (c.VBGetSaveFileName( _
         Filename:=sFile, _
         Filter:="Text Files (*.TXT)|*.TXT|HTML Files (*.HTML)|*.HTML|XML Files
          (*.XML)|*.XML|All Files (*.*)|*.*", _
         DefaultExt:="TXT", _
         Owner:=mfrmMain.hWnd)) Then
         Exit Function
      End If
   Else
      sFile = m_sFileName
   End If
   
   On Error Resume Next
   Kill sFile
   
   On Error GoTo saveError
   Dim iFile As Integer
   iFile = FreeFile
   Open sFile For Binary Access Write Lock Read As #iFile
   Put #iFile, , sFile
   Close #iFile
   
   sFile = Dir(sFile)
   m_sFileName = sFile
   m_bIsDirty = False
   SaveDocument = True
   Exit Function

saveError:
   If (iFile) Then
      On Error Resume Next
      Close #iFile
   End If
   MsgBox "An error occurred trying to save this file: " & vbCrLf &
    Err.Description, vbExclamation
   Exit Function
End Function


Public Sub OpenDocument(ByVal sFileName As String)
   
   Dim sFile As String
   sFile = Dir(sFileName)
   Me.Caption = sFile
   
   On Error Resume Next
   Dim iFile As Integer
   iFile = FreeFile
   Open sFileName For Binary Access Read Lock Write As #iFile
   Dim sText As String
   sText = Space$(LOF(iFile))
   Get #iFile, , sText
   Close #iFile
   
   txtDocument.Text = sText
   
   m_sFileName = sFileName
   m_bIsDirty = False
   
End Sub

Public Sub NewDocument(ByVal sTitle As String)
   
   Me.Caption = sTitle & "/home/VB/Code/Controls/Tab_Controls/MDI_Tabs/.txt"
   txtDocument.Text = ""
   
   m_sFileName = ""
   m_bIsDirty = False
   
End Sub

Private Sub Form_Load()
   picLines.Font = txtDocument.Font
   SetMargins txtDocument.hWnd, 4, 4
   AttachMessage Me, txtDocument.hWnd, WM_VSCROLL
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   If (m_bIsDirty) Then
      'Set mfrmMain.ActiveForm = Me
      Dim iRes As VbMsgBoxResult
      Me.Show
      iRes = MsgBox("Do you want to save changes to " & Me.Caption & "?",
       vbExclamation Or vbYesNoCancel)
      If (iRes = vbCancel) Then
         Cancel = True
      ElseIf (iRes = vbYes) Then
         If Not (SaveDocument(True)) Then
            Cancel = True
         End If
      End If
   End If
End Sub

Private Sub Form_Resize()
On Error Resume Next
   
   If (TextBoxRTL(txtDocument)) Then
      txtDocument.Move _
         Screen.TwipsPerPixelX, _
         Screen.TwipsPerPixelY, _
         Me.ScaleWidth - 2 * Screen.TwipsPerPixelX - picLines.Width, _
         Me.ScaleHeight - 2 * Screen.TwipsPerPixelY
      picLines.Move txtDocument.Width + txtDocument.Left, _
         Screen.TwipsPerPixelX, _
         picLines.Width, _
         Me.ScaleHeight - 2 * Screen.TwipsPerPixelY
   Else
      picLines.Move Screen.TwipsPerPixelX, _
         Screen.TwipsPerPixelX, _
         picLines.Width, _
         Me.ScaleHeight - 2 * Screen.TwipsPerPixelY
      txtDocument.Move _
         picLines.Left + picLines.Width, _
         Screen.TwipsPerPixelY, _
         Me.ScaleWidth - 2 * Screen.TwipsPerPixelX - picLines.Width, _
         Me.ScaleHeight - 2 * Screen.TwipsPerPixelY
   End If
End Sub

Private Property Let ISubclass_MsgResponse(ByVal RHS As EMsgResponse)
   '
End Property

Private Property Get ISubclass_MsgResponse() As EMsgResponse
   '
   ISubclass_MsgResponse = emrPreprocess
   '
End Property

Private Function ISubclass_WindowProc(ByVal hWnd As Long, ByVal iMsg As Long,
 ByVal wParam As Long, ByVal lParam As Long) As Long
   '
   DrawLines picLines, txtDocument
   '
End Function

Private Sub picLines_Resize()
   DrawLines picLines, txtDocument
End Sub

Private Sub txtDocument_Change()
   m_bIsDirty = True
   DrawLines picLines, txtDocument
End Sub

Private Sub txtDocument_KeyDown(KeyCode As Integer, Shift As Integer)
   DrawLines picLines, txtDocument
End Sub

Private Sub txtDocument_KeyUp(KeyCode As Integer, Shift As Integer)
   DrawLines picLines, txtDocument
End Sub

Private Sub txtDocument_MouseDown(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   DrawLines picLines, txtDocument
End Sub

Private Sub txtDocument_MouseUp(Button As Integer, Shift As Integer, x As
 Single, y As Single)
   DrawLines picLines, txtDocument
End Sub