Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/tool_wnd/mainwnd.frm

Visual Basic Form | 1994-05-25 | 6.2 KB | 204 lines

VERSION 2.00
Begin Form MainWnd
   BackColor       =   &H00C0C0C0&
   Caption         =   "Toolbar Demonstration"
   ClientHeight    =   765
   ClientLeft      =   1125
   ClientTop       =   2010
   ClientWidth     =   7245
   Height          =   1455
   Icon            =   MAINWND.FRX:0000
   Left            =   1065
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   765
   ScaleWidth      =   7245
   Top             =   1380
   Width           =   7365
   Begin PictureBox ToolBar
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   405
      Left            =   0
      ScaleHeight     =   27
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   483
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   0
      Width           =   7245
      Begin Label Status
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Ready"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   195
         Left            =   3060
         TabIndex        =   1
         Top             =   105
         Width           =   465
      End
   End
   Begin Menu Menu_Fil
      Caption         =   "&Files"
      Begin Menu MenuF_New
         Caption         =   "&New"
         Shortcut        =   ^N
      End
      Begin Menu MenuF_Ope
         Caption         =   "&Open..."
         Shortcut        =   ^O
      End
      Begin Menu MenuF_Pri
         Caption         =   "&Print..."
         Shortcut        =   ^P
      End
      Begin Menu zd1
         Caption         =   "-"
      End
      Begin Menu MenuF_End
         Caption         =   "&End"
         HelpContextID   =   1003
      End
   End
   Begin Menu Menu_Opt
      Caption         =   "&Options"
      Begin Menu MenuO_Qui
         Caption         =   "&QuickHelp"
         Checked         =   -1  'True
      End
   End
   Begin Menu MenuA_Abo
      Caption         =   "&About..."
   End
Option Explicit
Sub Form_Load ()
Dim HSysMenu As Integer, rc As Integer
Dim temp$
    stppx = 15
    stppy = 15
    QuickInfo = True
    For rc = 0 To 6
        vbCopyTool ToolWnd.Tool(rc), ToolBar, vbQHTrue
    Next rc
    temp$ = "Toolbartext 1|QuickInfo 1"
    vbQHPutString 0, temp$
    temp$ = "Toolbartext 2|QuickInfo 2"
    vbQHPutString 1, temp$
    temp$ = "Toolbartext 3|QuickInfo 3"
    vbQHPutString 2, temp$
    temp$ = "Toolbartext 4|QuickInfo 4"
    vbQHPutString 3, temp$
    temp$ = "Toolbartext 5|QuickInfo 5"
    vbQHPutString 4, temp$
    temp$ = "Toolbartext 6|QuickInfo 6"
    vbQHPutString 5, temp$
    temp$ = "Toolbartext 7|QuickInfo 7"
    vbQHPutString 6, temp$
    Unload ToolWnd
    HSysMenu = GetSystemMenu(Me.hWnd, 0)
    rc = RemoveMenu(HSysMenu, 2, MF_BYPOSITION)
    Me.Height = 1080
    ToolBar.AutoRedraw = True
    ToolBar.Line (201, 5)-(477, 5), RGB(128, 128, 128)
    ToolBar.Line (201, 5)-(201, 21), RGB(128, 128, 128)
    ToolBar.Line (477, 5)-(477, 21), RGB(255, 255, 255)
    ToolBar.Line (201, 21)-(478, 21), RGB(255, 255, 255)
    ToolBar.AutoRedraw = False
    MenuRight MenuA_Abo
End Sub
Sub Form_Resize ()
Static tw As Integer
    If Me.WindowState = 1 Then
        If ToolhWnd Then
            tw = True
            Unload ToolWnd
        End If
    Else
        If tw Then
            ToolWnd.Show
        End If
        'FloatingWindow Me.hWnd, False
    End If
End Sub
Sub Form_Unload (Cancel As Integer)
    If Me.WindowState = 1 Then WindowState = 0
    If ToolhWnd Then Unload ToolWnd
End Sub
Sub MenuA_Abo_Click ()
    MsgBox "(c) 1994, TSAF", 64
End Sub
Sub MenuF_End_Click ()
    Unload Me
End Sub
Sub MenuO_Qui_Click ()
    MenuO_Qui.Checked = Not MenuO_Qui.Checked
    QuickInfo = MenuO_Qui.Checked
End Sub
Sub ToolBar_DblClick ()
Dim h As Integer
    h = 15 * (GetSystemMetrics(15) + GetSystemMetrics(4) + 2 * GetSystemMetrics(33) - GetSystemMetrics(6))
    Me.Height = h
    ToolWnd.Show
End Sub
Sub ToolBar_MouseDown (button As Integer, Shift As Integer, x As Single, Y As Single)
Dim sUsed As Integer
Dim temp$
    temp$ = "Ready"
    sUsed = True
    Select Case vbPaintedToolExt(ToolBar, MouseDown, Status)
        Case 0
        Case 1
            If MsgBox("Quit?", 36) = 6 Then sUsed = False: Unload Me
        Case 2
        Case 3
        Case 4
        Case 5
        Case 6
    End Select
    If sUsed Then Me.Show : Status.Caption = temp$
End Sub
Sub ToolBar_MouseMove (button As Integer, Shift As Integer, x As Single, Y As Single)
Dim rc As Integer
Dim mPoint As apiPoint
Dim tRect As apiRect
Static mm As Integer
    If QuickInfo Then
        If Not mm Then rc = vbPaintedToolExt(ToolBar, MouseMove, Status)
        If button And Not mm And rc Then
            mm = True
            GetWindowRect ToolBar.hWnd, tRect
            Do
                DoEvents
                GetCursorPos mPoint
                If mPoint.x < tRect.Left Or mPoint.Y < tRect.Top Or mPoint.x > tRect.Right Or mPoint.Y > tRect.Bottom Then
                    If Not ToolhWnd Then
                        Load ToolWnd
                        GetCursorPos mPoint
                        ToolWnd.Move mPoint.x * stppx, mPoint.Y * stppy
                    End If
                    FakeMove ToolWnd
                Else
                    If ToolhWnd Then Unload ToolWnd
                End If
            Loop Until GetKeyState(1) >= 0
            GetCursorPos mPoint
            If mPoint.x < tRect.Left Or mPoint.Y < tRect.Top Or mPoint.x > tRect.Right Or mPoint.Y > tRect.Bottom Then
                ToolBar_DblClick
            Else
                Unload ToolWnd
            End If
            mm = False
        End If
    End If
End Sub
Sub ToolBar_Resize ()
    MakeUpperStatusBar ToolBar
End Sub