home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / VISUAL_B / CODIGO_2 / TOOL20 / TOOLDEMO.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1993-01-30  |  17.1 KB  |  569 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.     ' Catch undeclared variables
  288.     Option Explicit
  289. Sub ContextHelp1_ControlClick (HelpID As Long, Position As Long)
  290.     ' Erase the help message
  291.     Label1.Caption = ""
  292.     If (Position >= 0) Then
  293.     If (HelpID = 0) Then
  294.         MsgBox "No context-sensitive help available for this control", 48
  295.     Else
  296.         ' For demo purposes, just display the HelpContextID
  297.         MsgBox "HelpContextID =" + Str$(HelpID)
  298.         Exit Sub
  299.         ' A real application would do this:
  300.         ' Display help for clicked item
  301.         Call WinHelp(hWnd, HelpPath, HELP_CONTEXT, HelpID)
  302.     End If
  303.     End If
  304. End Sub
  305. Sub Form_Load ()
  306.     Dim i%, hModule%, FirstCustom%, CustomButton%
  307.     Dim ButtonWidth!, NewLeft!, NewTop!
  308.     Const BUFSIZ = 255
  309.     Dim Buf As String * BUFSIZ
  310.     ' Minimum size set at design time
  311.     MINHEIGHT = Height
  312.     MINWIDTH = Width
  313.     ' The Microsoft Visual Design Guide
  314.     ' gives its measurements in pixels
  315.     ScaleMode = 3
  316.     ' Reposition ToolButtons for device
  317.     ' independence and initialize custom buttons
  318.     FirstCustom = -1
  319.     ButtonWidth = ToolButton(0).Width
  320.     NewTop = (BARHEIGHT - ToolButton(0).Height) / 2
  321.     For i = 0 To TB_MAX
  322.     If (ToolButton(i).ButtonSource = 1) Then
  323.         CustomButton = CustomButton + 1
  324.         If (FirstCustom = -1) Then
  325.         ' Only the first custom button is
  326.         ' initialized at design-time
  327.         FirstCustom = i
  328.         Else
  329.         ' Initialize from first custom button
  330.         ToolButton(i).Picture = ToolButton(FirstCustom).Picture
  331.         ToolButton(i).CustomCount = ToolButton(FirstCustom).CustomCount
  332.         ' Buttons appear in the same order in
  333.         ' the bitmap as on the toolbar
  334.         ToolButton(i).CustomButton = CustomButton
  335.         End If
  336.     End If
  337.     If (i = 0) Then
  338.         ' First button
  339.         NewLeft = BUTTONGAP
  340.     Else
  341.         ' Subsequent buttons
  342.         NewLeft = NewLeft + ButtonWidth - 1
  343.         Select Case i
  344.         Case TB_EDITCUT, TB_FONTBOLD, TB_HELPCONTEXT
  345.             ' Start a new button group
  346.             NewLeft = NewLeft + BUTTONGAP + 1
  347.         End Select
  348.     End If
  349.     ' Reposition this button
  350.     ToolButton(i).Move NewLeft, NewTop
  351.     Next i
  352.     ' Reposition other controls for device
  353.     ' independence
  354.     Line1(1).Y1 = BARHEIGHT - 1
  355.     Line1(1).Y2 = BARHEIGHT - 1
  356.     Text1.Top = BARHEIGHT
  357.     ' Toggling AutoSize sets height to minimum
  358.     Label1.AutoSize = True
  359.     Label1.AutoSize = False
  360.     Label1.Caption = ""
  361.     ' Figure out where the help file is
  362.     hModule = GetModuleHandle("TOOLBUTN")
  363.     If (hModule <> 0) Then
  364.     i = GetModuleFileName(hModule, Buf, BUFSIZ)
  365.     If (i <> 0) Then
  366.         HelpPath = Left$(Buf, i - 3) + "HLP"
  367.     End If
  368.     End If
  369.     If (HelpPath = "") Then
  370.     ' Custom control DLL not loaded???
  371.     HelpPath = "TOOLBUTN.HLP"
  372.     End If
  373. End Sub
  374. Sub Form_Resize ()
  375.     If (WindowState = 1) Then
  376.     ' Minimized
  377.     Exit Sub
  378.     End If
  379.     If (Width < MINWIDTH) Then
  380.     ' Minimum width set at design time
  381.     Width = MINWIDTH
  382.     Exit Sub
  383.     End If
  384.     If (Height < MINHEIGHT) Then
  385.     ' Minimum height set at design time
  386.     Height = MINHEIGHT
  387.     Exit Sub
  388.     End If
  389.     ' Resize controls to fit window
  390.     Line1(0).X2 = ScaleWidth
  391.     Line1(1).X2 = ScaleWidth
  392.     Text1.Width = ScaleWidth + 2
  393.     Text1.Height = ScaleHeight - Text1.Top - BARHEIGHT
  394.     Label1.Move 6, Text1.Top + Text1.Height + ((BARHEIGHT - Label1.Height) / 2), ScaleWidth - 12
  395. End Sub
  396. Sub Form_Unload (Cancel As Integer)
  397.     ' Terminate windows help
  398.     Call WinHelp(Form1.hWnd, "toolbutn.hlp", HELP_QUIT, 0)
  399. End Sub
  400. Sub MIEditCopy_Click ()
  401.     ' Copy the selection to the clipboard
  402.     Clipboard.SetText Text1.SelText
  403. End Sub
  404. Sub MIEditCut_Click ()
  405.     ' Cut the selection to the clipboard
  406.     Clipboard.SetText Text1.SelText
  407.     Text1.SelText = ""
  408. End Sub
  409. Sub MIEditPaste_Click ()
  410.     ' Replace the selection with the clipboard contents
  411.     Text1.SelText = Clipboard.GetText()
  412. End Sub
  413. Sub MIFileExit_Click ()
  414.     ' Clean up
  415.     Unload Form1
  416. End Sub
  417. Sub MIFileNew_Click ()
  418.     ' Reset filename
  419.     FileName = ""
  420.     ' Clear Text control
  421.     Text1.Text = ""
  422. End Sub
  423. Sub MIFileOpen_Click ()
  424.     Dim AskName$
  425.     AskName = InputBox$("Filename:", "Open File", FileName)
  426.     If (AskName = "") Then
  427.     Exit Sub
  428.     End If
  429.     FileName = AskName
  430.     ' Display hourglass cursor
  431.     Screen.MousePointer = 11
  432.     ' Attempt to open the file
  433.     On Error GoTo OpenError
  434.     Open FileName For Input As 1
  435.     On Error GoTo 0
  436.     ' Make sure file isn't too big
  437.     If (LOF(1) > 32767) Then
  438.     MsgBox "Selected file is too large", 48, "Open File"
  439.     Close 1
  440.     GoTo OpenExit
  441.     End If
  442.     ' Read file into textbox
  443.     Text1.Text = Input$(LOF(1), 1)
  444.     Close 1
  445. OpenExit:
  446.     ' Restore cursor
  447.     Screen.MousePointer = 0
  448.     Exit Sub
  449. OpenError:
  450.     On Error GoTo 0
  451.     MsgBox "Cannot open file '" + FileName + "'", 48, "File Open"
  452.     Resume OpenExit
  453. End Sub
  454. Sub MIFilePrint_Click ()
  455.     MsgBox "File Print not implemented!", 48, "ToolButton"
  456. End Sub
  457. Sub MIFileSaveAs_Click ()
  458.     Dim AskName$
  459.     AskName = InputBox$("Filename:", "Save File", FileName)
  460.     If (AskName = "") Then
  461.     Exit Sub
  462.     End If
  463.     FileName = AskName
  464.     ' Display hourglass cursor
  465.     Screen.MousePointer = 11
  466.     ' Attempt to open the file
  467.     On Error GoTo SaveError
  468.     Open FileName For Output As 1
  469.     ' Write the file
  470.     Print #1, Text1.Text;
  471.     Close 1
  472.     On Error GoTo 0
  473. SaveExit:
  474.     ' Restore cursor
  475.     Screen.MousePointer = 0
  476.     Exit Sub
  477. SaveError:
  478.     On Error GoTo 0
  479.     MsgBox "Cannot write file '" + FileName + "'", 48, "Save File"
  480.     Resume SaveExit
  481. End Sub
  482. Sub MIFontBold_Click ()
  483.     ' Set/reset bold attribute
  484.     Text1.FontBold = Not Text1.FontBold
  485.     ToolButton(TB_FONTBOLD).Value = Abs(Text1.FontBold)
  486. End Sub
  487. Sub MIFontItalic_Click ()
  488.     ' Set/reset italic attribute
  489.     Text1.FontItalic = Not Text1.FontItalic
  490.     ToolButton(TB_FONTITALIC).Value = Abs(Text1.FontItalic)
  491. End Sub
  492. Sub MIFontUnderline_Click ()
  493.     ' Set/reset underline attribute
  494.     Text1.FontUnderline = Not Text1.FontUnderline
  495.     ToolButton(TB_FONTUNDERLINE).Value = Abs(Text1.FontUnderline)
  496. End Sub
  497. Sub MIHelpAbout_Click ()
  498.     ' Display an About box
  499.     MsgBox "
  500.  Brett Foster 1992", 64, "ToolButton Demo"
  501. End Sub
  502. Sub MIHelpContents_Click ()
  503.     ' Invoke windows help
  504.     Call WinHelp(Form1.hWnd, "toolbutn.hlp", HELP_CONTENTS, 0)
  505. End Sub
  506. Sub MIHelpContext_Click ()
  507.     ' Display a help message
  508.     Label1.Caption = ContextHelp1.Tag
  509.     ' Enable context-sensitive help
  510.     ContextHelp1.Enabled = -1
  511. End Sub
  512. Sub MIHelpSearch_Click ()
  513.     ' Display WinHelp search dialog
  514.     Call WinHelpString(hWnd, HelpPath, HELP_PARTIALKEY, "")
  515. End Sub
  516. Sub MIHelpUse_Click ()
  517.     ' Display help on help
  518.     Call WinHelp(hWnd, "", HELP_HELPONHELP, 0)
  519. End Sub
  520. Sub Text1_Change ()
  521.     Dim SomeText%
  522.     ' Any text in the window?
  523.     SomeText = (Len(Text1.Text) <> 0)
  524.     If (ToolButton(TB_FILENEW).Enabled <> SomeText) Then
  525.     ' Enable/disable FileNew and FileSave
  526.     ToolButton(TB_FILENEW).Enabled = SomeText
  527.     ToolButton(TB_FILESAVE).Enabled = SomeText
  528.     MIFileNew.Enabled = SomeText
  529.     MIFileSaveAs.Enabled = SomeText
  530.     End If
  531. End Sub
  532. Sub ToolButton_Click (Index As Integer)
  533.     ' Each ToolButton is equivalent to a menu command
  534.     Select Case Index
  535.     Case TB_FILENEW
  536.         Call MIFileNew_Click
  537.     Case TB_FILEOPEN
  538.         Call MIFileOpen_Click
  539.     Case TB_FILESAVE
  540.         Call MIFileSaveAs_Click
  541.     Case TB_FILEPRINT
  542.         Call MIFilePrint_Click
  543.     Case TB_EDITCUT
  544.         Call MIEditCut_Click
  545.     Case TB_EDITCOPY
  546.         Call MIEditCopy_Click
  547.     Case TB_EDITPASTE
  548.         Call MIEditPaste_Click
  549.     Case TB_FONTBOLD
  550.         Call MIFontBold_Click
  551.     Case TB_FONTITALIC
  552.         Call MIFontItalic_Click
  553.     Case TB_FONTUNDERLINE
  554.         Call MIFontUnderline_Click
  555.     Case TB_HELPCONTEXT
  556.         Call MIHelpContext_Click
  557.     Case TB_HELPCONTENTS
  558.         Call MIHelpContents_Click
  559.     End Select
  560. End Sub
  561. Sub ToolButton_MouseDown (Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  562.     ' Display help message associated with this button
  563.     Label1.Caption = ToolButton(Index).HintMessage
  564. End Sub
  565. Sub ToolButton_MouseUp (Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)
  566.     ' Clear the help message
  567.     Label1.Caption = ""
  568. End Sub
  569.