Media Share 9/MEDIASHARE_09.ISO/basic/toll20.zip/TOOLDEMO.FRM

Text File | 1993-01-30 | 18KB | 686 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "ToolButton Demo"
   ForeColor       =   &H00C0C0C0&
   Height          =   2676
   HelpContextID   =   101
   Icon            =   TOOLDEMO.FRX:0000
   Left            =   1068
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   1932
   ScaleWidth      =   4800
   Top             =   1272
   Width           =   4896
   Begin ContextHelp ContextHelp1
      Enabled         =   0   'False
      Left            =   4110
      Tag             =   "Left click for help, Esc to cancel"
      Top             =   1290
   End
   Begin TextBox Text1
      Height          =   825
      HelpContextID   =   103
      Left            =   -15
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      TabStop         =   0   'False
      Text            =   "Text1"
      Top             =   420
      Width           =   4800
   End
   Begin Line Line1
      BorderColor     =   &H00808080&
      Index           =   1
      X1              =   0
      X2              =   4755
      Y1              =   405
      Y2              =   405
   End
   Begin Line Line1
      BorderColor     =   &H00FFFFFF&
      Index           =   0
      X1              =   0
      X2              =   4755
      Y1              =   0
      Y2              =   0
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Height          =   264
      HelpContextID   =   200
      HintMessage     =   "Clears the TextBox"
      Index           =   0
      Left            =   96
      StandardButton  =   4  'File New
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Height          =   264
      HelpContextID   =   201
      HintMessage     =   "Reads a file into the TextBox"
      Index           =   1
      Left            =   432
      StandardButton  =   5  'File Open
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Height          =   264
      HelpContextID   =   202
      HintMessage     =   "Saves the TextBox to a file"
      Index           =   2
      Left            =   780
      StandardButton  =   6  'File Save
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Enabled         =   0   'False
      Height          =   264
      HelpContextID   =   203
      HintMessage     =   "Prints the textbox (NOT IMPLEMENTED)"
      Index           =   3
      Left            =   1128
      StandardButton  =   7  'File Print
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Height          =   264
      HelpContextID   =   204
      HintMessage     =   "Cuts the selection to the clipboard"
      Index           =   4
      Left            =   1572
      StandardButton  =   1  'Edit Cut
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Height          =   264
      HelpContextID   =   205
      HintMessage     =   "Copies the selection to the clipboard"
      Index           =   5
      Left            =   1920
      StandardButton  =   2  'Edit Copy
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Height          =   264
      HelpContextID   =   206
      HintMessage     =   "Replaces the selection with the clipboard contents"
      Index           =   6
      Left            =   2268
      StandardButton  =   3  'Edit Paste
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      ButtonSource    =   1  'Custom
      ButtonType      =   1  'Attribute
      CustomButton    =   1
      CustomCount     =   3
      Height          =   264
      HelpContextID   =   207
      HintMessage     =   "Sets the TextBox FontBold attribute"
      Index           =   7
      Left            =   2712
      Picture         =   TOOLDEMO.FRX:0302
      StandardButton  =   5  'File Open
      Top             =   48
      Value           =   1  'Down
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      ButtonSource    =   1  'Custom
      ButtonType      =   1  'Attribute
      Height          =   264
      HelpContextID   =   208
      HintMessage     =   "Sets the TextBox FontItalic attribute"
      Index           =   8
      Left            =   3060
      StandardButton  =   3  'Edit Paste
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      ButtonSource    =   1  'Custom
      ButtonType      =   1  'Attribute
      Height          =   264
      HelpContextID   =   209
      HintMessage     =   "Sets the TextBox FontUnderline attribute"
      Index           =   9
      Left            =   3408
      StandardButton  =   3  'Edit Paste
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Height          =   264
      HelpContextID   =   210
      HintMessage     =   "Enables context-sensitive help"
      Index           =   10
      Left            =   3852
      StandardButton  =   9  'Context-Sensitive Help
      Top             =   48
      Width           =   288
   End
   Begin ToolButton ToolButton
      BackColor       =   &H8000000F&
      Height          =   264
      HelpContextID   =   211
      HintMessage     =   "Displays the ToolButton help contents"
      Index           =   11
      Left            =   4200
      StandardButton  =   8  'Help
      Top             =   48
      Width           =   288
   End
   Begin Label Label1
      BackColor       =   &H00C0C0C0&
      Caption         =   "Label1"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   7.8
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   240
      Left            =   45
      TabIndex        =   1
      Top             =   1335
      Width           =   690
   End
   Begin Menu ABFile
      Caption         =   "&File"
      Begin Menu MIFileNew
         Caption         =   "&New"
      End
      Begin Menu MIFileOpen
         Caption         =   "&Open..."
         Shortcut        =   +{F12}
      End
      Begin Menu MIFileSaveAs
         Caption         =   "&Save As..."
         Shortcut        =   {F12}
      End
      Begin Menu MIFileSep1
         Caption         =   "-"
      End
      Begin Menu MIFilePrint
         Caption         =   "&Print"
         Enabled         =   0   'False
      End
      Begin Menu MIFileSep2
         Caption         =   "-"
      End
      Begin Menu MIFileExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu ABEdit
      Caption         =   "&Edit"
      Begin Menu MIEditCut
         Caption         =   "Cu&t"
         Shortcut        =   ^X
      End
      Begin Menu MIEditCopy
         Caption         =   "&Copy"
         Shortcut        =   ^C
      End
      Begin Menu MIEditPaste
         Caption         =   "&Paste"
         Shortcut        =   ^V
      End
   End
   Begin Menu ABFont
      Caption         =   "F&ont"
      Begin Menu MIFontBold
         Caption         =   "&Bold"
         Shortcut        =   ^B
      End
      Begin Menu MIFontItalic
         Caption         =   "&Italic"
         Shortcut        =   ^I
      End
      Begin Menu MIFontUnderline
         Caption         =   "&Underline"
         Shortcut        =   ^U
      End
   End
   Begin Menu ABHelp
      Caption         =   "&Help"
      Begin Menu MIHelpContents
         Caption         =   "&Contents"
      End
      Begin Menu MIHelpSearch
         Caption         =   "&Search for Help On..."
      End
      Begin Menu MIHelpContext
         Caption         =   "Conte&xt-Sensitive"
         Shortcut        =   +{F1}
      End
      Begin Menu MIHelpUse
         Caption         =   "&How to Use Help"
      End
      Begin Menu MIHelpSep1
         Caption         =   "-"
      End
      Begin Menu MIHelpAbout
         Caption         =   "&About..."
      End
   End
End
    ' Catch undeclared variables
    Option Explicit

Sub ContextHelp1_ControlClick (HelpID As Long, Position As Long)

    ' Erase the help message
    Label1.Caption = ""

    If (Position >= 0) Then
    If (HelpID = 0) Then
        MsgBox "No context-sensitive help available for this control", 48
    Else
        ' For demo purposes, just display the HelpContextID
        MsgBox "HelpContextID =" + Str$(HelpID)
        Exit Sub

        ' A real application would do this:
        ' Display help for clicked item
        Call WinHelp(hWnd, HelpPath, HELP_CONTEXT, HelpID)
    End If
    End If

End Sub

Sub Form_Load ()

    Dim i%, hModule%, FirstCustom%, CustomButton%
    Dim ButtonWidth!, NewLeft!, NewTop!
    Const BUFSIZ = 255
    Dim Buf As String * BUFSIZ

    ' Minimum size set at design time
    MINHEIGHT = Height
    MINWIDTH = Width

    ' The Microsoft Visual Design Guide
    ' gives its measurements in pixels
    ScaleMode = 3

    ' Reposition ToolButtons for device
    ' independence and initialize custom buttons
    FirstCustom = -1
    ButtonWidth = ToolButton(0).Width
    NewTop = (BARHEIGHT - ToolButton(0).Height) / 2
    For i = 0 To TB_MAX
    If (ToolButton(i).ButtonSource = 1) Then
        CustomButton = CustomButton + 1
        If (FirstCustom = -1) Then
        ' Only the first custom button is
        ' initialized at design-time
        FirstCustom = i
        Else
        ' Initialize from first custom button
        ToolButton(i).Picture = ToolButton(FirstCustom).Picture
        ToolButton(i).CustomCount = ToolButton(FirstCustom).CustomCount

        ' Buttons appear in the same order in
        ' the bitmap as on the toolbar
        ToolButton(i).CustomButton = CustomButton
        End If
    End If

    If (i = 0) Then
        ' First button
        NewLeft = BUTTONGAP
    Else
        ' Subsequent buttons
        NewLeft = NewLeft + ButtonWidth - 1

        Select Case i
        Case TB_EDITCUT, TB_FONTBOLD, TB_HELPCONTEXT
            ' Start a new button group
            NewLeft = NewLeft + BUTTONGAP + 1
        End Select
    End If

    ' Reposition this button
    ToolButton(i).Move NewLeft, NewTop
    Next i

    ' Reposition other controls for device
    ' independence
    Line1(1).Y1 = BARHEIGHT - 1
    Line1(1).Y2 = BARHEIGHT - 1
    Text1.Top = BARHEIGHT

    ' Toggling AutoSize sets height to minimum
    Label1.AutoSize = True
    Label1.AutoSize = False
    Label1.Caption = ""

    ' Figure out where the help file is
    hModule = GetModuleHandle("TOOLBUTN")
    If (hModule <> 0) Then
    i = GetModuleFileName(hModule, Buf, BUFSIZ)
    If (i <> 0) Then
        HelpPath = Left$(Buf, i - 3) + "HLP"
    End If
    End If

    If (HelpPath = "") Then
    ' Custom control DLL not loaded???
    HelpPath = "TOOLBUTN.HLP"
    End If

End Sub

Sub Form_Resize ()

    If (WindowState = 1) Then
    ' Minimized
    Exit Sub
    End If

    If (Width < MINWIDTH) Then
    ' Minimum width set at design time
    Width = MINWIDTH
    Exit Sub
    End If

    If (Height < MINHEIGHT) Then
    ' Minimum height set at design time
    Height = MINHEIGHT
    Exit Sub
    End If

    ' Resize controls to fit window
    Line1(0).X2 = ScaleWidth
    Line1(1).X2 = ScaleWidth
    Text1.Width = ScaleWidth + 2
    Text1.Height = ScaleHeight - Text1.Top - BARHEIGHT
    Label1.Move 6, Text1.Top + Text1.Height + ((BARHEIGHT - Label1.Height) / 2), ScaleWidth - 12

End Sub

Sub Form_Unload (Cancel As Integer)

    ' Terminate windows help
    Call WinHelp(Form1.hWnd, "toolbutn.hlp", HELP_QUIT, 0)

End Sub

Sub MIEditCopy_Click ()

    ' Copy the selection to the clipboard
    Clipboard.SetText Text1.SelText

End Sub

Sub MIEditCut_Click ()

    ' Cut the selection to the clipboard
    Clipboard.SetText Text1.SelText
    Text1.SelText = ""

End Sub

Sub MIEditPaste_Click ()

    ' Replace the selection with the clipboard contents
    Text1.SelText = Clipboard.GetText()

End Sub

Sub MIFileExit_Click ()

    ' Clean up
    Unload Form1

End Sub

Sub MIFileNew_Click ()

    ' Reset filename
    FileName = ""

    ' Clear Text control
    Text1.Text = ""

End Sub

Sub MIFileOpen_Click ()

    Dim AskName$

    AskName = InputBox$("Filename:", "Open File", FileName)
    If (AskName = "") Then
    Exit Sub
    End If
    FileName = AskName

    ' Display hourglass cursor
    Screen.MousePointer = 11

    ' Attempt to open the file
    On Error GoTo OpenError
    Open FileName For Input As 1
    On Error GoTo 0

    ' Make sure file isn't too big
    If (LOF(1) > 32767) Then
    MsgBox "Selected file is too large", 48, "Open File"
    Close 1
    GoTo OpenExit
    End If

    ' Read file into textbox
    Text1.Text = Input$(LOF(1), 1)
    Close 1

OpenExit:
    ' Restore cursor
    Screen.MousePointer = 0
    Exit Sub

OpenError:
    On Error GoTo 0
    MsgBox "Cannot open file '" + FileName + "'", 48, "File Open"
    Resume OpenExit

End Sub

Sub MIFilePrint_Click ()

    MsgBox "File Print not implemented!", 48, "ToolButton"

End Sub

Sub MIFileSaveAs_Click ()

    Dim AskName$

    AskName = InputBox$("Filename:", "Save File", FileName)
    If (AskName = "") Then
    Exit Sub
    End If
    FileName = AskName

    ' Display hourglass cursor
    Screen.MousePointer = 11

    ' Attempt to open the file
    On Error GoTo SaveError
    Open FileName For Output As 1

    ' Write the file
    Print #1, Text1.Text;
    Close 1
    On Error GoTo 0

SaveExit:
    ' Restore cursor
    Screen.MousePointer = 0
    Exit Sub

SaveError:
    On Error GoTo 0
    MsgBox "Cannot write file '" + FileName + "'", 48, "Save File"
    Resume SaveExit

End Sub

Sub MIFontBold_Click ()

    ' Set/reset bold attribute
    Text1.FontBold = Not Text1.FontBold
    ToolButton(TB_FONTBOLD).Value = Abs(Text1.FontBold)

End Sub

Sub MIFontItalic_Click ()

    ' Set/reset italic attribute
    Text1.FontItalic = Not Text1.FontItalic
    ToolButton(TB_FONTITALIC).Value = Abs(Text1.FontItalic)

End Sub

Sub MIFontUnderline_Click ()

    ' Set/reset underline attribute
    Text1.FontUnderline = Not Text1.FontUnderline
    ToolButton(TB_FONTUNDERLINE).Value = Abs(Text1.FontUnderline)

End Sub

Sub MIHelpAbout_Click ()

    ' Display an About box
    MsgBox "⌐ Brett Foster 1992", 64, "ToolButton Demo"

End Sub

Sub MIHelpContents_Click ()

    ' Invoke windows help
    Call WinHelp(Form1.hWnd, "toolbutn.hlp", HELP_CONTENTS, 0)

End Sub

Sub MIHelpContext_Click ()

    ' Display a help message
    Label1.Caption = ContextHelp1.Tag

    ' Enable context-sensitive help
    ContextHelp1.Enabled = -1

End Sub

Sub MIHelpSearch_Click ()

    ' Display WinHelp search dialog
    Call WinHelpString(hWnd, HelpPath, HELP_PARTIALKEY, "")

End Sub

Sub MIHelpUse_Click ()

    ' Display help on help
    Call WinHelp(hWnd, "", HELP_HELPONHELP, 0)

End Sub

Sub Text1_Change ()

    Dim SomeText%

    ' Any text in the window?
    SomeText = (Len(Text1.Text) <> 0)

    If (ToolButton(TB_FILENEW).Enabled <> SomeText) Then
    ' Enable/disable FileNew and FileSave
    ToolButton(TB_FILENEW).Enabled = SomeText
    ToolButton(TB_FILESAVE).Enabled = SomeText
    MIFileNew.Enabled = SomeText
    MIFileSaveAs.Enabled = SomeText
    End If

End Sub

Sub ToolButton_Click (Index As Integer)

    ' Each ToolButton is equivalent to a menu command
    Select Case Index
    Case TB_FILENEW
        Call MIFileNew_Click

    Case TB_FILEOPEN
        Call MIFileOpen_Click

    Case TB_FILESAVE
        Call MIFileSaveAs_Click

    Case TB_FILEPRINT
        Call MIFilePrint_Click

    Case TB_EDITCUT
        Call MIEditCut_Click

    Case TB_EDITCOPY
        Call MIEditCopy_Click

    Case TB_EDITPASTE
        Call MIEditPaste_Click

    Case TB_FONTBOLD
        Call MIFontBold_Click

    Case TB_FONTITALIC
        Call MIFontItalic_Click

    Case TB_FONTUNDERLINE
        Call MIFontUnderline_Click

    Case TB_HELPCONTEXT
        Call MIHelpContext_Click

    Case TB_HELPCONTENTS
        Call MIHelpContents_Click
    End Select

End Sub

Sub ToolButton_MouseDown (Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)

    ' Display help message associated with this button
    Label1.Caption = ToolButton(Index).HintMessage

End Sub

Sub ToolButton_MouseUp (Index As Integer, Button As Integer, Shift As Integer, x As Single, Y As Single)

    ' Clear the help message
    Label1.Caption = ""

End Sub