home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / basic / toll20.zip / TOOLDEMO.FRM < prev    next >
Text File  |  1993-01-30  |  18KB  |  686 lines

  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "ToolButton Demo"
  5.    ForeColor       =   &H00C0C0C0&
  6.    Height          =   2676
  7.    HelpContextID   =   101
  8.    Icon            =   TOOLDEMO.FRX:0000
  9.    Left            =   1068
  10.    LinkMode        =   1  'Source
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   1932
  13.    ScaleWidth      =   4800
  14.    Top             =   1272
  15.    Width           =   4896
  16.    Begin ContextHelp ContextHelp1 
  17.       Enabled         =   0   'False
  18.       Left            =   4110
  19.       Tag             =   "Left click for help, Esc to cancel"
  20.       Top             =   1290
  21.    End
  22.    Begin TextBox Text1 
  23.       Height          =   825
  24.       HelpContextID   =   103
  25.       Left            =   -15
  26.       MultiLine       =   -1  'True
  27.       ScrollBars      =   2  'Vertical
  28.       TabIndex        =   0
  29.       TabStop         =   0   'False
  30.       Text            =   "Text1"
  31.       Top             =   420
  32.       Width           =   4800
  33.    End
  34.    Begin Line Line1 
  35.       BorderColor     =   &H00808080&
  36.       Index           =   1
  37.       X1              =   0
  38.       X2              =   4755
  39.       Y1              =   405
  40.       Y2              =   405
  41.    End
  42.    Begin Line Line1 
  43.       BorderColor     =   &H00FFFFFF&
  44.       Index           =   0
  45.       X1              =   0
  46.       X2              =   4755
  47.       Y1              =   0
  48.       Y2              =   0
  49.    End
  50.    Begin ToolButton ToolButton 
  51.       BackColor       =   &H8000000F&
  52.       Height          =   264
  53.       HelpContextID   =   200
  54.       HintMessage     =   "Clears the TextBox"
  55.       Index           =   0
  56.       Left            =   96
  57.       StandardButton  =   4  'File New
  58.       Top             =   48
  59.       Width           =   288
  60.    End
  61.    Begin ToolButton ToolButton 
  62.       BackColor       =   &H8000000F&
  63.       Height          =   264
  64.       HelpContextID   =   201
  65.       HintMessage     =   "Reads a file into the TextBox"
  66.       Index           =   1
  67.       Left            =   432
  68.       StandardButton  =   5  'File Open
  69.       Top             =   48
  70.       Width           =   288
  71.    End
  72.    Begin ToolButton ToolButton 
  73.       BackColor       =   &H8000000F&
  74.       Height          =   264
  75.       HelpContextID   =   202
  76.       HintMessage     =   "Saves the TextBox to a file"
  77.       Index           =   2
  78.       Left            =   780
  79.       StandardButton  =   6  'File Save
  80.       Top             =   48
  81.       Width           =   288
  82.    End
  83.    Begin ToolButton ToolButton 
  84.       BackColor       =   &H8000000F&
  85.       Enabled         =   0   'False
  86.       Height          =   264
  87.       HelpContextID   =   203
  88.       HintMessage     =   "Prints the textbox (NOT IMPLEMENTED)"
  89.       Index           =   3
  90.       Left            =   1128
  91.       StandardButton  =   7  'File Print
  92.       Top             =   48
  93.       Width           =   288
  94.    End
  95.    Begin ToolButton ToolButton 
  96.       BackColor       =   &H8000000F&
  97.       Height          =   264
  98.       HelpContextID   =   204
  99.       HintMessage     =   "Cuts the selection to the clipboard"
  100.       Index           =   4
  101.       Left            =   1572
  102.       StandardButton  =   1  'Edit Cut
  103.       Top             =   48
  104.       Width           =   288
  105.    End
  106.    Begin ToolButton ToolButton 
  107.       BackColor       =   &H8000000F&
  108.       Height          =   264
  109.       HelpContextID   =   205
  110.       HintMessage     =   "Copies the selection to the clipboard"
  111.       Index           =   5
  112.       Left            =   1920
  113.       StandardButton  =   2  'Edit Copy
  114.       Top             =   48
  115.       Width           =   288
  116.    End
  117.    Begin ToolButton ToolButton 
  118.       BackColor       =   &H8000000F&
  119.       Height          =   264
  120.       HelpContextID   =   206
  121.       HintMessage     =   "Replaces the selection with the clipboard contents"
  122.       Index           =   6
  123.       Left            =   2268
  124.       StandardButton  =   3  'Edit Paste
  125.       Top             =   48
  126.       Width           =   288
  127.    End
  128.    Begin ToolButton ToolButton 
  129.       BackColor       =   &H8000000F&
  130.       ButtonSource    =   1  'Custom
  131.       ButtonType      =   1  'Attribute
  132.       CustomButton    =   1
  133.       CustomCount     =   3
  134.       Height          =   264
  135.       HelpContextID   =   207
  136.       HintMessage     =   "Sets the TextBox FontBold attribute"
  137.       Index           =   7
  138.       Left            =   2712
  139.       Picture         =   TOOLDEMO.FRX:0302
  140.       StandardButton  =   5  'File Open
  141.       Top             =   48
  142.       Value           =   1  'Down
  143.       Width           =   288
  144.    End
  145.    Begin ToolButton ToolButton 
  146.       BackColor       =   &H8000000F&
  147.       ButtonSource    =   1  'Custom
  148.       ButtonType      =   1  'Attribute
  149.       Height          =   264
  150.       HelpContextID   =   208
  151.       HintMessage     =   "Sets the TextBox FontItalic attribute"
  152.       Index           =   8
  153.       Left            =   3060
  154.       StandardButton  =   3  'Edit Paste
  155.       Top             =   48
  156.       Width           =   288
  157.    End
  158.    Begin ToolButton ToolButton 
  159.       BackColor       =   &H8000000F&
  160.       ButtonSource    =   1  'Custom
  161.       ButtonType      =   1  'Attribute
  162.       Height          =   264
  163.       HelpContextID   =   209
  164.       HintMessage     =   "Sets the TextBox FontUnderline attribute"
  165.       Index           =   9
  166.       Left            =   3408
  167.       StandardButton  =   3  'Edit Paste
  168.       Top             =   48
  169.       Width           =   288
  170.    End
  171.    Begin ToolButton ToolButton 
  172.       BackColor       =   &H8000000F&
  173.       Height          =   264
  174.       HelpContextID   =   210
  175.       HintMessage     =   "Enables context-sensitive help"
  176.       Index           =   10
  177.       Left            =   3852
  178.       StandardButton  =   9  'Context-Sensitive Help
  179.       Top             =   48
  180.       Width           =   288
  181.    End
  182.    Begin ToolButton ToolButton 
  183.       BackColor       =   &H8000000F&
  184.       Height          =   264
  185.       HelpContextID   =   211
  186.       HintMessage     =   "Displays the ToolButton help contents"
  187.       Index           =   11
  188.       Left            =   4200
  189.       StandardButton  =   8  'Help
  190.       Top             =   48
  191.       Width           =   288
  192.    End
  193.    Begin Label Label1 
  194.       BackColor       =   &H00C0C0C0&
  195.       Caption         =   "Label1"
  196.       FontBold        =   0   'False
  197.       FontItalic      =   0   'False
  198.       FontName        =   "MS Sans Serif"
  199.       FontSize        =   7.8
  200.       FontStrikethru  =   0   'False
  201.       FontUnderline   =   0   'False
  202.       Height          =   240
  203.       Left            =   45
  204.       TabIndex        =   1
  205.       Top             =   1335
  206.       Width           =   690
  207.    End
  208.    Begin Menu ABFile 
  209.       Caption         =   "&File"
  210.       Begin Menu MIFileNew 
  211.          Caption         =   "&New"
  212.       End
  213.       Begin Menu MIFileOpen 
  214.          Caption         =   "&Open..."
  215.          Shortcut        =   +{F12}
  216.       End
  217.       Begin Menu MIFileSaveAs 
  218.          Caption         =   "&Save As..."
  219.          Shortcut        =   {F12}
  220.       End
  221.       Begin Menu MIFileSep1 
  222.          Caption         =   "-"
  223.       End
  224.       Begin Menu MIFilePrint 
  225.          Caption         =   "&Print"
  226.          Enabled         =   0   'False
  227.       End
  228.       Begin Menu MIFileSep2 
  229.          Caption         =   "-"
  230.       End
  231.       Begin Menu MIFileExit 
  232.          Caption         =   "E&xit"
  233.       End
  234.    End
  235.    Begin Menu ABEdit 
  236.       Caption         =   "&Edit"
  237.       Begin Menu MIEditCut 
  238.          Caption         =   "Cu&t"
  239.          Shortcut        =   ^X
  240.       End
  241.       Begin Menu MIEditCopy 
  242.          Caption         =   "&Copy"
  243.          Shortcut        =   ^C
  244.       End
  245.       Begin Menu MIEditPaste 
  246.          Caption         =   "&Paste"
  247.          Shortcut        =   ^V
  248.       End
  249.    End
  250.    Begin Menu ABFont 
  251.       Caption         =   "F&ont"
  252.       Begin Menu MIFontBold 
  253.          Caption         =   "&Bold"
  254.          Shortcut        =   ^B
  255.       End
  256.       Begin Menu MIFontItalic 
  257.          Caption         =   "&Italic"
  258.          Shortcut        =   ^I
  259.       End
  260.       Begin Menu MIFontUnderline 
  261.          Caption         =   "&Underline"
  262.          Shortcut        =   ^U
  263.       End
  264.    End
  265.    Begin Menu ABHelp 
  266.       Caption         =   "&Help"
  267.       Begin Menu MIHelpContents 
  268.          Caption         =   "&Contents"
  269.       End
  270.       Begin Menu MIHelpSearch 
  271.          Caption         =   "&Search for Help On..."
  272.       End
  273.       Begin Menu MIHelpContext 
  274.          Caption         =   "Conte&xt-Sensitive"
  275.          Shortcut        =   +{F1}
  276.       End
  277.       Begin Menu MIHelpUse 
  278.          Caption         =   "&How to Use Help"
  279.       End
  280.       Begin Menu MIHelpSep1 
  281.          Caption         =   "-"
  282.       End
  283.       Begin Menu MIHelpAbout 
  284.          Caption         =   "&About..."
  285.       End
  286.    End
  287. End
  288.     ' Catch undeclared variables
  289.     Option Explicit
  290.  
  291. Sub ContextHelp1_ControlClick (HelpID As Long, Position As Long)
  292.  
  293.     ' Erase the help message
  294.     Label1.Caption = ""
  295.  
  296.     If (Position >= 0) Then
  297.     If (HelpID = 0) Then
  298.         MsgBox "No context-sensitive help available for this control", 48
  299.     Else
  300.         ' For demo purposes, just display the HelpContextID
  301.         MsgBox "HelpContextID =" + Str$(HelpID)
  302.         Exit Sub
  303.  
  304.         ' A real application would do this:
  305.         ' Display help for clicked item
  306.         Call WinHelp(hWnd, HelpPath, HELP_CONTEXT, HelpID)
  307.     End If
  308.     End If
  309.  
  310. End Sub
  311.  
  312. Sub Form_Load ()
  313.  
  314.     Dim i%, hModule%, FirstCustom%, CustomButton%
  315.     Dim ButtonWidth!, NewLeft!, NewTop!
  316.     Const BUFSIZ = 255
  317.     Dim Buf As String * BUFSIZ
  318.  
  319.     ' Minimum size set at design time
  320.     MINHEIGHT = Height
  321.     MINWIDTH = Width
  322.  
  323.     ' The Microsoft Visual Design Guide
  324.     ' gives its measurements in pixels
  325.     ScaleMode = 3
  326.  
  327.     ' Reposition ToolButtons for device
  328.     ' independence and initialize custom buttons
  329.     FirstCustom = -1
  330.     ButtonWidth = ToolButton(0).Width
  331.     NewTop = (BARHEIGHT - ToolButton(0).Height) / 2
  332.     For i = 0 To TB_MAX
  333.     If (ToolButton(i).ButtonSource = 1) Then
  334.         CustomButton = CustomButton + 1
  335.         If (FirstCustom = -1) Then
  336.         ' Only the first custom button is
  337.         ' initialized at design-time
  338.         FirstCustom = i
  339.         Else
  340.         ' Initialize from first custom button
  341.         ToolButton(i).Picture = ToolButton(FirstCustom).Picture
  342.         ToolButton(i).CustomCount = ToolButton(FirstCustom).CustomCount
  343.  
  344.         ' Buttons appear in the same order in
  345.         ' the bitmap as on the toolbar
  346.         ToolButton(i).CustomButton = CustomButton
  347.         End If
  348.     End If
  349.  
  350.     If (i = 0) Then
  351.         ' First button
  352.         NewLeft = BUTTONGAP
  353.     Else
  354.         ' Subsequent buttons
  355.         NewLeft = NewLeft + ButtonWidth - 1
  356.  
  357.         Select Case i
  358.         Case TB_EDITCUT, TB_FONTBOLD, TB_HELPCONTEXT
  359.             ' Start a new button group
  360.             NewLeft = NewLeft + BUTTONGAP + 1
  361.         End Select
  362.     End If
  363.  
  364.     ' Reposition this button
  365.     ToolButton(i).Move NewLeft, NewTop
  366.     Next i
  367.  
  368.     ' Reposition other controls for device
  369.     ' independence
  370.     Line1(1).Y1 = BARHEIGHT - 1
  371.     Line1(1).Y2 = BARHEIGHT - 1
  372.     Text1.Top = BARHEIGHT
  373.  
  374.     ' Toggling AutoSize sets height to minimum
  375.     Label1.AutoSize = True
  376.     Label1.AutoSize = False
  377.     Label1.Caption = ""
  378.  
  379.     ' Figure out where the help file is
  380.     hModule = GetModuleHandle("TOOLBUTN")
  381.     If (hModule <> 0) Then
  382.     i = GetModuleFileName(hModule, Buf, BUFSIZ)
  383.     If (i <> 0) Then
  384.         HelpPath = Left$(Buf, i - 3) + "HLP"
  385.     End If
  386.     End If
  387.     
  388.     If (HelpPath = "") Then
  389.     ' Custom control DLL not loaded???
  390.     HelpPath = "TOOLBUTN.HLP"
  391.     End If
  392.  
  393. End Sub
  394.  
  395. Sub Form_Resize ()
  396.  
  397.     If (WindowState = 1) Then
  398.     ' Minimized
  399.     Exit Sub
  400.     End If
  401.  
  402.     If (Width < MINWIDTH) Then
  403.     ' Minimum width set at design time
  404.     Width = MINWIDTH
  405.     Exit Sub
  406.     End If
  407.  
  408.     If (Height < MINHEIGHT) Then
  409.     ' Minimum height set at design time
  410.     Height = MINHEIGHT
  411.     Exit Sub
  412.     End If
  413.  
  414.     ' Resize controls to fit window
  415.     Line1(0).X2 = ScaleWidth
  416.     Line1(1).X2 = ScaleWidth
  417.     Text1.Width = ScaleWidth + 2
  418.     Text1.Height = ScaleHeight - Text1.Top - BARHEIGHT
  419.     Label1.Move 6, Text1.Top + Text1.Height + ((BARHEIGHT - Label1.Height) / 2), ScaleWidth - 12
  420.  
  421. End Sub
  422.  
  423. Sub Form_Unload (Cancel As Integer)
  424.     
  425.     ' Terminate windows help
  426.     Call WinHelp(Form1.hWnd, "toolbutn.hlp", HELP_QUIT, 0)
  427.  
  428. End Sub
  429.  
  430. Sub MIEditCopy_Click ()
  431.  
  432.     ' Copy the selection to the clipboard
  433.     Clipboard.SetText Text1.SelText
  434.  
  435. End Sub
  436.  
  437. Sub MIEditCut_Click ()
  438.  
  439.     ' Cut the selection to the clipboard
  440.     Clipboard.SetText Text1.SelText
  441.     Text1.SelText = ""
  442.  
  443. End Sub
  444.  
  445. Sub MIEditPaste_Click ()
  446.  
  447.     ' Replace the selection with the clipboard contents
  448.     Text1.SelText = Clipboard.GetText()
  449.  
  450. End Sub
  451.  
  452. Sub MIFileExit_Click ()
  453.  
  454.     ' Clean up
  455.     Unload Form1
  456.  
  457. End Sub
  458.  
  459. Sub MIFileNew_Click ()
  460.  
  461.     ' Reset filename
  462.     FileName = ""
  463.  
  464.     ' Clear Text control
  465.     Text1.Text = ""
  466.  
  467. End Sub
  468.  
  469. Sub MIFileOpen_Click ()
  470.  
  471.     Dim AskName$
  472.  
  473.     AskName = InputBox$("Filename:", "Open File", FileName)
  474.     If (AskName = "") Then
  475.     Exit Sub
  476.     End If
  477.     FileName = AskName
  478.  
  479.     ' Display hourglass cursor
  480.     Screen.MousePointer = 11
  481.  
  482.     ' Attempt to open the file
  483.     On Error GoTo OpenError
  484.     Open FileName For Input As 1
  485.     On Error GoTo 0
  486.  
  487.     ' Make sure file isn't too big
  488.     If (LOF(1) > 32767) Then
  489.     MsgBox "Selected file is too large", 48, "Open File"
  490.     Close 1
  491.     GoTo OpenExit
  492.     End If
  493.  
  494.     ' Read file into textbox
  495.     Text1.Text = Input$(LOF(1), 1)
  496.     Close 1
  497.  
  498. OpenExit:
  499.     ' Restore cursor
  500.     Screen.MousePointer = 0
  501.     Exit Sub
  502.  
  503. OpenError:
  504.     On Error GoTo 0
  505.     MsgBox "Cannot open file '" + FileName + "'", 48, "File Open"
  506.     Resume OpenExit
  507.  
  508. End Sub
  509.  
  510. Sub MIFilePrint_Click ()
  511.  
  512.     MsgBox "File Print not implemented!", 48, "ToolButton"
  513.  
  514. End Sub
  515.  
  516. Sub MIFileSaveAs_Click ()
  517.  
  518.     Dim AskName$
  519.  
  520.     AskName = InputBox$("Filename:", "Save File", FileName)
  521.     If (AskName = "") Then
  522.     Exit Sub
  523.     End If
  524.     FileName = AskName
  525.  
  526.     ' Display hourglass cursor
  527.     Screen.MousePointer = 11
  528.  
  529.     ' Attempt to open the file
  530.     On Error GoTo SaveError
  531.     Open FileName For Output As 1
  532.  
  533.     ' Write the file
  534.     Print #1, Text1.Text;
  535.     Close 1
  536.     On Error GoTo 0
  537.  
  538. SaveExit:
  539.     ' Restore cursor
  540.     Screen.MousePointer = 0
  541.     Exit Sub
  542.  
  543. SaveError:
  544.     On Error GoTo 0
  545.     MsgBox "Cannot write file '" + FileName + "'", 48, "Save File"
  546.     Resume SaveExit
  547.  
  548. End Sub
  549.  
  550. Sub MIFontBold_Click ()
  551.  
  552.     ' Set/reset bold attribute
  553.     Text1.FontBold = Not Text1.FontBold
  554.     ToolButton(TB_FONTBOLD).Value = Abs(Text1.FontBold)
  555.  
  556. End Sub
  557.  
  558. Sub MIFontItalic_Click ()
  559.  
  560.     ' Set/reset italic attribute
  561.     Text1.FontItalic = Not Text1.FontItalic
  562.     ToolButton(TB_FONTITALIC).Value = Abs(Text1.FontItalic)
  563.  
  564. End Sub
  565.  
  566. Sub MIFontUnderline_Click ()
  567.  
  568.     ' Set/reset underline attribute
  569.     Text1.FontUnderline = Not Text1.FontUnderline
  570.     ToolButton(TB_FONTUNDERLINE).Value = Abs(Text1.FontUnderline)
  571.  
  572. End Sub
  573.  
  574. Sub MIHelpAbout_Click ()
  575.  
  576.     ' Display an About box
  577.     MsgBox "⌐ Brett Foster 1992", 64, "ToolButton Demo"
  578.  
  579. End Sub
  580.  
  581. Sub MIHelpContents_Click ()
  582.  
  583.     ' Invoke windows help
  584.     Call WinHelp(Form1.hWnd, "toolbutn.hlp", HELP_CONTENTS, 0)
  585.  
  586. End Sub
  587.  
  588. Sub MIHelpContext_Click ()
  589.  
  590.     ' Display a help message
  591.     Label1.Caption = ContextHelp1.Tag
  592.  
  593.     ' Enable context-sensitive help
  594.     ContextHelp1.Enabled = -1
  595.  
  596. End Sub
  597.  
  598. Sub MIHelpSearch_Click ()
  599.     
  600.     ' Display WinHelp search dialog
  601.     Call WinHelpString(hWnd, HelpPath, HELP_PARTIALKEY, "")
  602.  
  603. End Sub
  604.  
  605. Sub MIHelpUse_Click ()
  606.  
  607.     ' Display help on help
  608.     Call WinHelp(hWnd, "", HELP_HELPONHELP, 0)
  609.  
  610. End Sub
  611.  
  612. Sub Text1_Change ()
  613.  
  614.     Dim SomeText%
  615.  
  616.     ' Any text in the window?
  617.     SomeText = (Len(Text1.Text) <> 0)
  618.  
  619.     If (ToolButton(TB_FILENEW).Enabled <> SomeText) Then
  620.     ' Enable/disable FileNew and FileSave
  621.     ToolButton(TB_FILENEW).Enabled = SomeText
  622.     ToolButton(TB_FILESAVE).Enabled = SomeText
  623.     MIFileNew.Enabled = SomeText
  624.     MIFileSaveAs.Enabled = SomeText
  625.     End If
  626.  
  627. End Sub
  628.  
  629. Sub ToolButton_Click (Index As Integer)
  630.  
  631.     ' Each ToolButton is equivalent to a menu command
  632.     Select Case Index
  633.     Case TB_FILENEW
  634.         Call MIFileNew_Click
  635.     
  636.     Case TB_FILEOPEN
  637.         Call MIFileOpen_Click
  638.     
  639.     Case TB_FILESAVE
  640.         Call MIFileSaveAs_Click
  641.     
  642.     Case TB_FILEPRINT
  643.         Call MIFilePrint_Click
  644.     
  645.     Case TB_EDITCUT
  646.         Call MIEditCut_Click
  647.     
  648.     Case TB_EDITCOPY
  649.         Call MIEditCopy_Click
  650.     
  651.     Case TB_EDITPASTE
  652.         Call MIEditPaste_Click
  653.     
  654.     Case TB_FONTBOLD
  655.         Call MIFontBold_Click
  656.     
  657.     Case TB_FONTITALIC
  658.         Call MIFontItalic_Click
  659.     
  660.     Case TB_FONTUNDERLINE
  661.         Call MIFontUnderline_Click
  662.     
  663.     Case TB_HELPCONTEXT
  664.         Call MIHelpContext_Click
  665.     
  666.     Case TB_HELPCONTENTS
  667.         Call MIHelpContents_Click
  668.     End Select
  669.  
  670. End Sub
  671.  
  672. Sub ToolButton_MouseDown (Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  673.  
  674.     ' Display help message associated with this button
  675.     Label1.Caption = ToolButton(Index).HintMessage
  676.  
  677. End Sub
  678.  
  679. Sub ToolButton_MouseUp (Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  680.  
  681.     ' Clear the help message
  682.     Label1.Caption = ""
  683.  
  684. End Sub
  685.  
  686.