mdlglobal.bas

Simple Word Document...

Attribute VB_Name = "MdlGlobal"
Public DocuNumber As Integer
Public DocuNew() As frmPage

Public DocuZoomVal As Double
Public PageMarginleft As Integer
Public PageMarginTop As Integer
Public PageMarginRight As Integer
Public PageMarginBottom As Integer

Public HeaderMargin As Integer
Public FooterMargin As Integer

Public flagcut As Boolean
Public flagcopy As Boolean

Public FOpen As Scripting.FileSystemObject
Public FRead As Scripting.TextStream
Public FWrite As Scripting.TextStream

Dim SpellCheck As Object


Sub Main()
    
    Set FOpen = New Scripting.FileSystemObject
    
    DocumentOpened = False
    MDIfrm.Show
    DocuNumber = 0
    
    DocuZoomVal = 1
    
    HeaderMargin = 720
    FooterMargin = 720
    PageMarginleft = (1440 * 1) * DocuZoomVal
    PageMarginTop = (1440 * 1) * DocuZoomVal
    PageMarginRight = (1440 * 1) * DocuZoomVal
    PageMarginBottom = (1440 * 1) * DocuZoomVal
    
    NewDocument
    MDIfrm.mnuAlign(0).Checked = True
    MDIfrm.ComFont.Text = MDIfrm.ActiveForm.Document_.SelFontName
    MDIfrm.comSize.Text = MDIfrm.ActiveForm.Document_.SelFontSize
End Sub

Public Function NewDocument()
    EnableControlforNewDocu
    DocuNumber = DocuNumber + 1
    ReDim Preserve DocuNew(DocuNumber)
    Set DocuNew(DocuNumber) = New frmPage
    DocuNew(DocuNumber).Caption = "Document" & DocuNumber
    DocuNew(DocuNumber).Show
End Function

Public Function MakeStatusBarFormated(Bar As StatusBar)
    Bar.Panels.Clear
    Set my_panel = Bar.Panels.Add(1)
    Bar.Panels(1).AutoSize = 2
    Bar.Panels(1).Bevel = sbrInset
    Bar.Panels(1).Style = sbrCaps
    Bar.Panels(1).Width = 600
    
    Set my_panel = Bar.Panels.Add(2)
    Bar.Panels(2).AutoSize = 2
    Bar.Panels(2).Bevel = sbrInset
    Bar.Panels(2).Style = sbrNum
    Bar.Panels(2).Width = 600
    
    Set my_panel = Bar.Panels.Add(3)
    Bar.Panels(3).AutoSize = 2
    Bar.Panels(3).Bevel = sbrInset
    Bar.Panels(3).Style = sbrIns
    Bar.Panels(3).Width = 600
    
    Set my_panel = Bar.Panels.Add(4)
    Bar.Panels(4).AutoSize = sbrSpring
    Bar.Panels(4).Bevel = sbrInset
    Bar.Panels(4).Style = sbrText
    
End Function

Public Sub EnableControlforNewDocu()
    With MDIfrm
        .mnuClose.Enabled = True
        .mnuSave.Enabled = True
        .mnuSaveAs.Enabled = True
        .mnuPageSetup.Enabled = True
        .mnuPreview.Enabled = True
        .mnuPrint.Enabled = True
        
        .mnuUndo.Enabled = True
        .mnuRedo.Enabled = True
        .mnuCut.Enabled = True
        .mnuCopy.Enabled = True
        .mnuPaste.Enabled = True
        .mnuSelectAll.Enabled = True
        .mnuClear.Enabled = True
        .mnuFind.Enabled = True
        .mnuReplace.Enabled = True
        
        .mnuHeaderFooter.Enabled = True
        
        .mnuBreak.Enabled = True
        .mnuDateTime.Enabled = True
        .mnuAutoText.Enabled = True
        .mnuSymbol.Enabled = True
        .mnuFromFile.Enabled = True
        .mnuFromScanner.Enabled = True
        .mnuInsertFile.Enabled = True
        
        .mnuFonts.Enabled = True
        .mnuParagraph.Enabled = True
        .mnuBulletNumber.Enabled = True
        .mnuAlign(0).Enabled = True
        .mnuAlign(1).Enabled = True
        .mnuAlign(2).Enabled = True
        .mnuChangeCase.Enabled = True
        
        .mnuSpellGrammer.Enabled = True
        
        .mnuNewwindow.Enabled = True
        .mnuHorizon.Enabled = True
        .mnuVertical.Enabled = True
        
        .FileTools.Buttons(3).Enabled = True
        .FileTools.Buttons(4).Enabled = True
        .FileTools.Buttons(5).Enabled = True
        
        .EditTools.Buttons(1).Enabled = True
        .EditTools.Buttons(2).Enabled = True
        .EditTools.Buttons(3).Enabled = True
        .EditTools.Buttons(4).Enabled = True
        .EditTools.Buttons(5).Enabled = True
        
        .ComFont.Enabled = True
        .comSize.Enabled = True
        .FormatTools.Buttons(1).Enabled = True
        .FormatTools.Buttons(2).Enabled = True
        .FormatTools.Buttons(3).Enabled = True
        .FormatTools.Buttons(4).Enabled = True
        .FormatTools.Buttons(5).Enabled = True
        .FormatTools.Buttons(6).Enabled = True
        .FormatTools.Buttons(7).Enabled = True
    End With
End Sub


Public Sub DisableControlNoDocu()
    With MDIfrm
        .mnuClose.Enabled = False
        .mnuSave.Enabled = False
        .mnuSaveAs.Enabled = False
        .mnuPageSetup.Enabled = False
        .mnuPreview.Enabled = False
        .mnuPrint.Enabled = False
        
        .mnuUndo.Enabled = False
        .mnuRedo.Enabled = False
        .mnuCut.Enabled = False
        .mnuCopy.Enabled = False
        .mnuPaste.Enabled = False
        .mnuSelectAll.Enabled = False
        .mnuClear.Enabled = False
        .mnuFind.Enabled = False
        .mnuReplace.Enabled = False
        
        .mnuHeaderFooter.Enabled = False
        
        .mnuBreak.Enabled = False
        .mnuDateTime.Enabled = False
        .mnuAutoText.Enabled = False
        .mnuSymbol.Enabled = False
        .mnuFromFile.Enabled = False
        .mnuFromScanner.Enabled = False
        .mnuInsertFile.Enabled = False
        
        .mnuFonts.Enabled = False
        .mnuParagraph.Enabled = False
        .mnuBulletNumber.Enabled = False
        .mnuAlign(0).Enabled = False
        .mnuAlign(1).Enabled = False
        .mnuAlign(2).Enabled = False
        .mnuChangeCase.Enabled = False
        
        .mnuSpellGrammer.Enabled = False
        
        .mnuNewwindow.Enabled = False
        .mnuHorizon.Enabled = False
        .mnuVertical.Enabled = False
        
        
        .FileTools.Buttons(3).Enabled = False
        .FileTools.Buttons(4).Enabled = False
        .FileTools.Buttons(5).Enabled = False
        
        .EditTools.Buttons(1).Enabled = False
        .EditTools.Buttons(2).Enabled = False
        .EditTools.Buttons(3).Enabled = False
        .EditTools.Buttons(4).Enabled = False
        .EditTools.Buttons(5).Enabled = False
        
        .ComFont.Enabled = False
        .comSize.Enabled = False
        .FormatTools.Buttons(1).Enabled = False
        .FormatTools.Buttons(2).Enabled = False
        .FormatTools.Buttons(3).Enabled = False
        .FormatTools.Buttons(4).Enabled = False
        .FormatTools.Buttons(5).Enabled = False
        .FormatTools.Buttons(6).Enabled = False
        .FormatTools.Buttons(7).Enabled = False
    End With
End Sub

Public Function FastReplace(SSrch$, SFind$, SRepl$) As String

    Dim Src() As Byte, Dst() As Byte, R() As Byte, F() As Byte
    Dim LenF&, LenR&, LenDst&, i&, j&, OutPos&

    Const ChunkSize& = 4096

    If SSrch = "" Or SFind = "" Then Exit Function

    Src = SSrch: F = SFind: R = SRepl
    LenF = UBound(F): LenR = UBound(R)
    LenDst = ChunkSize: ReDim Dst(0 To LenDst - 1)
  
    For i = 0 To UBound(Src) Step 2

        For j = 0 To LenF Step 2
            If Src(i + j) <> F(j) Then Exit For
        Next j

        If j > LenF Then 'Found

            For j = 0 To LenR Step 2
                If OutPos >= LenDst Then
                    LenDst = LenDst + ChunkSize
                    ReDim Preserve Dst(0 To LenDst)
                End If
                Dst(OutPos) = R(j): OutPos = OutPos + 2
            Next j

            i = i + LenF - 1

        Else

            If OutPos >= LenDst Then
                LenDst = LenDst + ChunkSize
                ReDim Preserve Dst(0 To LenDst)
            End If

            Dst(OutPos) = Src(i): OutPos = OutPos + 2

        End If
    Next i
  
    ReDim Preserve Dst(0 To OutPos - 2): SSrch = Dst
    
    FastReplace = SSrch$
    
End Function

Public Function SpellChecker(Textbox As String) As String
On Error GoTo Errorhandler

    Set SpellCheck = CreateObject("Word.Application")
    SpellCheck.Visible = False
    SpellCheck.Documents.Add
    Clipboard.Clear
    Clipboard.SetText Textbox
    SpellCheck.Selection.Paste
    SpellCheck.ActiveDocument.CheckSpelling
    SpellCheck.Visible = False
    SpellCheck.ActiveDocument.Select
    SpellCheck.Selection.Cut
    SpellChecker = Clipboard.GetText
    SpellCheck.ActiveDocument.Close SaveChanges:= _
    wdDoNotSaveChanges
    SpellCheck.Quit

    Set SpellCheck = Nothing
    Exit Function

Errorhandler:
    SpellCheck.ActiveDocument.Close SaveChanges:= _
    wdDoNotSaveChanges
    SpellCheck.Quit
    Set SpellCheck = Nothing

    MsgBox "Error: " & Err.Number & "  " & Err.Description, vbExclamation, "School Report Card Spell Check Error"
End Function



'Create the Ruler
Public Sub DrawRuler(MSize As Integer, HRuler As PictureBox)
    Dim Sincr As Single, RScale As Integer
    'Scalemode is in TWIPS 1440 per inch
    RScale = 1440
    'Number of segment across form
    Sincr = RScale / MSize
    Do While Sincr < HRuler.ScaleWidth
        'Number of sections
        For i = 1 To MSize
            'Size of Tics
            If i = MSize Then
                'HRuler.Line (Sincr, 0)-(Sincr, HRuler.ScaleHeight)
                'HRuler.CurrentY = 0
                'HRuler.Print Int(Sincr / RScale)
                HRuler.CurrentX = Sincr - 40
                HRuler.CurrentY = 20
                HRuler.Print Int(Sincr / RScale)
            Else
                If i = Int(MSize * 0.5) Then
                    HRuler.Line (Sincr, (HRuler.ScaleHeight / 2) - 40)-(Sincr, (HRuler.ScaleHeight / 2) + 40)
                Else
                    HRuler.Line (Sincr, (HRuler.ScaleHeight / 2) - 20)-(Sincr, (HRuler.ScaleHeight / 2) + 20)
                End If
                
'                If i = Int(MSize * 0.75) Then
'                    HRuler.Line (Sincr, HRuler.ScaleHeight - (HRuler.ScaleHeight * 0.25))-(Sincr, HRuler.ScaleHeight)
'                Else
'                    If i = Int(MSize * 0.5) Then
'                        HRuler.Line (Sincr, HRuler.ScaleHeight - (HRuler.ScaleHeight * 0.5))-(Sincr, HRuler.ScaleHeight)
'                    Else
'                        If i = MSize * 0.25 Then
'                            HRuler.Line (Sincr, HRuler.ScaleHeight - (HRuler.ScaleHeight * 0.25))-(Sincr, HRuler.ScaleHeight)
'                        Else
'                            HRuler.Line (Sincr, HRuler.ScaleHeight - (HRuler.ScaleHeight * 0.125))-(Sincr, HRuler.ScaleHeight)
'                        End If
'                    End If
'                End If
            End If
            Sincr = Sincr + (RScale / MSize)
        Next
    Loop
End Sub