home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 4609 / tx4vb / mdidemo.ba_ / mdidemo.ba
Text File  |  1994-03-31  |  11KB  |  308 lines
  1. Option Explicit
  2.  
  3. Global Const A4WidthInTwips = 11905 '21cm in twips
  4. Global Const A4LengthInTwips = 15307 '27cm in twips
  5. Global Const TWIPS_IN_MM = 56.7
  6. Global Const TWIPS_IN_CM = 567
  7.  
  8. Type FormState
  9.     Deleted As Integer
  10.     Dirty As Integer
  11.     Ignore As Integer
  12. End Type
  13. Global FState()  As FormState
  14. Global Document() As New frmMDIChild
  15. Global gFindString, gFindCase As Integer, gFindDirection As Integer
  16. Global gCurPos As Integer, gFirstTime As Integer
  17. Global ArrayNum As Integer
  18.  
  19. '-------------------------------------------------------------------------
  20. ' AnyPadsLeft
  21. '
  22. ' looks for an free entry in the document array
  23. '-------------------------------------------------------------------------
  24. Function AnyPadsLeft () As Integer
  25.     Dim i As Integer
  26.  
  27.     ' Cycle throught the document array.
  28.     ' Return True if there is at least one
  29.     ' open document remaining.
  30.     For i = 1 To UBound(Document)
  31.         If Not FState(i).Deleted Then
  32.             AnyPadsLeft = True
  33.             Exit Function
  34.         End If
  35.     Next
  36.  
  37. End Function
  38.  
  39. '-------------------------------------------------------------------------
  40. ' EditCopyProc
  41. '
  42. ' copies selected contents to clipboard
  43. '-------------------------------------------------------------------------
  44. Sub EditCopyProc ()
  45.     frmMDIParent.ActiveForm.TextControl1.Clip = CLIP_COPY
  46. End Sub
  47.  
  48. '-------------------------------------------------------------------------
  49. ' EditCutProc
  50. '
  51. ' cuts selected contents to clipboard
  52. '-------------------------------------------------------------------------
  53. Sub EditCutProc ()
  54.     frmMDIParent.ActiveForm.TextControl1.Clip = CLIP_CUT
  55. End Sub
  56.  
  57. '-------------------------------------------------------------------------
  58. ' EditDeleteProc
  59. '
  60. ' deletes selected contents (or next character)
  61. '-------------------------------------------------------------------------
  62. Sub EditDeleteProc ()
  63.     frmMDIParent.ActiveForm.TextControl1.Clip = CLIP_CLEAR
  64. End Sub
  65.  
  66. '-------------------------------------------------------------------------
  67. ' EditFindReplaceProc
  68. '
  69. ' calls find or replace dialog
  70. '
  71. ' Parameters: 1 find dialog
  72. '             2 replace dialog
  73. '-------------------------------------------------------------------------
  74. Sub EditFindReplaceProc (Flag As Integer)
  75.     frmMDIParent.ActiveForm.TextControl1.FindReplace = Flag
  76. End Sub
  77.  
  78. '-------------------------------------------------------------------------
  79. ' EditPasteProc
  80. '
  81. ' pastes clipboard data
  82. '-------------------------------------------------------------------------
  83. Sub EditPasteProc ()
  84.     ' Place text from Clipboard into active control.
  85.     frmMDIParent.ActiveForm.TextControl1.Clip = CLIP_PASTE
  86. End Sub
  87.  
  88. '-------------------------------------------------------------------------
  89. ' EditSelectAll
  90. '
  91. ' selects whole contents
  92. '-------------------------------------------------------------------------
  93. Sub EditSelectAll ()
  94.     Dim nPointer As Integer     'MousePointer proterty value
  95.  
  96.     nPointer = frmMDIParent.ActiveForm.TextControl1.MousePointer
  97.     frmMDIParent.ActiveForm.TextControl1.MousePointer = 11
  98.     frmMDIParent.ActiveForm.TextControl1.SelStart = 0
  99.     frmMDIParent.ActiveForm.TextControl1.SelLength = -1
  100.     frmMDIParent.ActiveForm.TextControl1.MousePointer = nPointer
  101. End Sub
  102.  
  103. '-------------------------------------------------------------------------
  104. ' EnableToolbarButtons
  105. '
  106. '-------------------------------------------------------------------------
  107. Sub EnableToolbarButtons ()
  108.     If AnyPadsLeft() Then
  109.         frmMDIParent!imgFileSaveButton.Picture = frmMDIParent!imgFileSaveButtonUp.Picture
  110.         frmMDIParent!imgFileSaveButton.Enabled = True
  111.         frmMDIParent!imgCutButton.Picture = frmMDIParent!imgCutButtonUp.Picture
  112.         frmMDIParent!imgCutButton.Enabled = True
  113.         frmMDIParent!imgCopyButton.Picture = frmMDIParent!imgCopyButtonUp.Picture
  114.         frmMDIParent!imgCopyButton.Enabled = True
  115.         frmMDIParent!imgPasteButton.Picture = frmMDIParent!imgPasteButtonUp.Picture
  116.         frmMDIParent!imgPasteButton.Enabled = True
  117.     Else
  118.         frmMDIParent!imgFileSaveButton.Picture = frmMDIParent!imgFileSaveButtonDis.Picture
  119.         frmMDIParent!imgFileSaveButton.Enabled = False
  120.         frmMDIParent!imgCutButton.Picture = frmMDIParent!imgCutButtonDis.Picture
  121.         frmMDIParent!imgCutButton.Enabled = False
  122.         frmMDIParent!imgCopyButton.Picture = frmMDIParent!imgCopyButtonDis.Picture
  123.         frmMDIParent!imgCopyButton.Enabled = False
  124.         frmMDIParent!imgPasteButton.Picture = frmMDIParent!imgPasteButtonDis.Picture
  125.         frmMDIParent!imgPasteButton.Enabled = False
  126.     End If
  127. End Sub
  128.  
  129. '-------------------------------------------------------------------------
  130. ' FileNewProc
  131. '
  132. ' inits new window
  133. '-------------------------------------------------------------------------
  134. Sub FileNewProc ()
  135.     Dim fIndex As Integer
  136.  
  137.     fIndex = FindFreeIndex()
  138.     If fIndex <> 0 Then
  139.         Document(fIndex).Tag = fIndex
  140.         Document(fIndex).Caption = "Untitled:" & fIndex
  141.         Document(fIndex).TXRuler1.ScaleUnits = SCALE_MM
  142.         Document(fIndex).Show
  143.  
  144.         ' Make sure toolbar edit buttons are visible
  145.         frmMDIParent!imgCutButton.Visible = True
  146.         frmMDIParent!imgCopyButton.Visible = True
  147.         frmMDIParent!imgPasteButton.Visible = True
  148.     End If
  149.     
  150. End Sub
  151.  
  152. '-------------------------------------------------------------------------
  153. ' FindFreeIndex
  154. '
  155. '-------------------------------------------------------------------------
  156. Function FindFreeIndex () As Integer
  157.     Dim i As Integer
  158.     Dim ArrayCount As Integer
  159.  
  160.     ArrayCount = UBound(Document)
  161.  
  162.     ' Cycle throught the document array. If one of the
  163.     ' documents has been deleted, then return that
  164.     ' index.
  165.     For i = 1 To ArrayCount
  166.         If FState(i).Deleted Then
  167.             FindFreeIndex = i
  168.             FState(i).Deleted = False
  169.             FState(i).Ignore = False
  170.             Exit Function
  171.         End If
  172.     Next
  173.  
  174.     ' If none of the elements in the document array have
  175.     ' been deleted, then increment the document and the
  176.     ' state arrays by one and return the index to the
  177.     ' new element.
  178.  
  179.     ReDim Preserve Document(ArrayCount + 1)
  180.     ReDim Preserve FState(ArrayCount + 1)
  181.     FindFreeIndex = UBound(Document)
  182. End Function
  183.  
  184. '-------------------------------------------------------------------------
  185. ' FormatColorProc
  186. '
  187. ' sets text or background color
  188. '-------------------------------------------------------------------------
  189. Sub FormatColorProc (Index As Integer)
  190.     Dim lOldColor As Long
  191.  
  192.     On Error Resume Next
  193.  
  194.     If Index = COLOR_TEXT Then
  195.         lOldColor = frmMDIParent.ActiveForm.TextControl1.TextColor
  196.     Else
  197.         lOldColor = frmMDIParent.ActiveForm.TextControl1.BackColor
  198.     End If
  199.  
  200.     If lOldColor = -1 Then
  201.         frmMDIParent.CMDialog1.Color = 0  'use black if different colors
  202.     Else
  203.         frmMDIParent.CMDialog1.Color = lOldColor
  204.     End If
  205.  
  206.     frmMDIParent.CMDialog1.Flags = CC_RGBINIT Or CC_PREVENTFULLOPEN
  207.     frmMDIParent.CMDialog1.CancelError = True
  208.     frmMDIParent.CMDialog1.Action = DLG_COLOR
  209.     If Err Then Exit Sub
  210.  
  211.     'set new color
  212.  
  213.     If lOldColor = -1 Or frmMDIParent.CMDialog1.Color <> lOldColor Then
  214.         If Index = COLOR_TEXT Then
  215.             frmMDIParent.ActiveForm.TextControl1.TextColor = frmMDIParent.CMDialog1.Color
  216.         Else
  217.             frmMDIParent.ActiveForm.TextControl1.BackColor = frmMDIParent.CMDialog1.Color
  218.         End If
  219.     End If
  220. End Sub
  221.  
  222. '-------------------------------------------------------------------------
  223. ' FormatDocProc
  224. '
  225. ' calls the document format dialog
  226. '-------------------------------------------------------------------------
  227. Sub FormatDocProc ()
  228.     frmDocDlg.Show 1
  229. End Sub
  230.  
  231. '-------------------------------------------------------------------------
  232. ' FormatFramesProc
  233. '
  234. ' calls the paragraph frames dialog
  235. '-------------------------------------------------------------------------
  236. Sub FormatFramesProc ()
  237.     frmFramesDlg.Show 1
  238. End Sub
  239.  
  240. '-------------------------------------------------------------------------
  241. ' ResizeChild
  242. '
  243. ' resizes the current text window
  244. '-------------------------------------------------------------------------
  245. Sub ResizeChild (frmCurrent As Form)
  246.     
  247.     'Switch background color to gray if child window gets
  248.     'bigger than maximum TX width (30% zoom on large screens)
  249.     If frmCurrent.Width > frmCurrent!TextControl1.Width Then
  250.         frmCurrent.BackColor = &HC0C0C0
  251.     Else
  252.         frmCurrent.BackColor = &HFFFFFF
  253.     End If
  254.     
  255.     'Resize TX window when MDI child is resized. Do not resize
  256.     'if window is too small.
  257.     If frmCurrent.WindowState <> 1 And frmCurrent.ScaleHeight - frmCurrent!TXRuler1.Height > 0 Then
  258.         frmCurrent!TextControl1.Height = frmCurrent.ScaleHeight
  259.         If (frmCurrent!TXRuler1.Visible) Then
  260.             frmCurrent!TextControl1.Height = frmCurrent!TextControl1.Height - frmCurrent!TXRuler1.Height
  261.         End If
  262.     End If
  263. End Sub
  264.  
  265. '-------------------------------------------------------------------------
  266. ' ViewParagraphBarProc
  267. '
  268. ' switches button bar visible state
  269. '-------------------------------------------------------------------------
  270. Sub ViewParagraphBarProc (frmCurrent As Form)
  271.     frmMDIParent!TXButtonBar1.Visible = Not frmMDIParent!TXButtonBar1.Visible
  272.     frmCurrent!mnuView_ParagraphBar.Checked = frmMDIParent!TXButtonBar1.Visible
  273.     frmMDIParent!picToolbar.Top = 0
  274. End Sub
  275.  
  276. '-------------------------------------------------------------------------
  277. ' ViewRulerProc
  278. '
  279. ' switches the ruler visible state
  280. '-------------------------------------------------------------------------
  281. Sub ViewRulerProc (frmCurrent As Form)
  282.     frmCurrent!TXRuler1.Visible = Not frmCurrent!TXRuler1.Visible
  283.     frmCurrent!mnuView_Ruler.Checked = frmCurrent!TXRuler1.Visible
  284.     ResizeChild frmCurrent
  285. End Sub
  286.  
  287. '-------------------------------------------------------------------------
  288. ' ViewStatusBarProc
  289. '
  290. ' switches the status bar visible state
  291. '-------------------------------------------------------------------------
  292. Sub ViewStatusBarProc (frmCurrent As Form)
  293.     frmMDIParent!TXStatusBar1.Visible = Not frmMDIParent!TXStatusBar1.Visible
  294.     frmCurrent!mnuView_StatusBar.Checked = frmMDIParent!TXStatusBar1.Visible
  295. End Sub
  296.  
  297. '-------------------------------------------------------------------------
  298. ' ViewToolBarProc
  299. '
  300. ' switches the toolbar visible state
  301. '-------------------------------------------------------------------------
  302. Sub ViewToolBarProc (frmCurrent As Form)
  303.     frmMDIParent!picToolbar.Visible = Not frmMDIParent!picToolbar.Visible
  304.     frmCurrent!mnuView_Toolbar.Checked = frmMDIParent!picToolbar.Visible
  305.     frmMDIParent!picToolbar.Top = 0
  306. End Sub
  307.  
  308.