home *** CD-ROM | disk | FTP | other *** search
- Option Explicit
-
- '*************************************************************************
- '* *
- '* GLOBAL CONSTANTS *
- '* *
- '*************************************************************************
-
-
- '
- ' GetSystemMetrics() codes
- '
-
- Global Const SM_CXSCREEN = 0
- Global Const SM_CYSCREEN = 1
- Global Const SM_CXVSCROLL = 2
- Global Const SM_CYHSCROLL = 3
- Global Const SM_CYCAPTION = 4
- Global Const SM_CXBORDER = 5
- Global Const SM_CYBORDER = 6
- Global Const SM_CXDLGFRAME = 7
- Global Const SM_CYDLGFRAME = 8
- Global Const SM_CYVTHUMB = 9
- Global Const SM_CXHTHUMB = 10
- Global Const SM_CXICON = 11
- Global Const SM_CYICON = 12
- Global Const SM_CXCURSOR = 13
- Global Const SM_CYCURSOR = 14
- Global Const SM_CYMENU = 15
- Global Const SM_CXFULLSCREEN = 16
- Global Const SM_CYFULLSCREEN = 17
- Global Const SM_CYKANJIWINDOW = 18
- Global Const SM_MOUSEPRESENT = 19
- Global Const SM_CYVSCROLL = 20
- Global Const SM_CXHSCROLL = 21
- Global Const SM_DEBUG = 22
- Global Const SM_SWAPBUTTON = 23
- Global Const SM_RESERVED1 = 24
- Global Const SM_RESERVED2 = 25
- Global Const SM_RESERVED3 = 26
- Global Const SM_RESERVED4 = 27
- Global Const SM_CXMIN = 28
- Global Const SM_CYMIN = 29
- Global Const SM_CXSIZE = 30
- Global Const SM_CYSIZE = 31
- Global Const SM_CXFRAME = 32
- Global Const SM_CYFRAME = 33
- Global Const SM_CXMINTRACK = 34
- Global Const SM_CYMINTRACK = 35
- Global Const SM_CMETRICS = 36
-
-
- '
- ' API message constants.
- '
-
- Global Const WM_MOVE = &H3
- Global Const WM_MOUSEFIRST = &H200
- Global Const WM_MOUSEMOVE = &H200
- Global Const WM_LBUTTONDOWN = &H201
- Global Const WM_LBUTTONUP = &H202
- Global Const WM_LBUTTONDBLCLK = &H203
- Global Const WM_RBUTTONDOWN = &H204
- Global Const WM_RBUTTONUP = &H205
- Global Const WM_RBUTTONDBLCLK = &H206
- Global Const WM_MBUTTONDOWN = &H207
- Global Const WM_MBUTTONUP = &H208
- Global Const WM_MBUTTONDBLCLK = &H209
- Global Const WM_MOUSELAST = &H209
-
- ' Key State Masks for Mouse Messages
- Global Const MK_LBUTTON = &H1
- Global Const MK_RBUTTON = &H2
- Global Const MK_SHIFT = &H4
- Global Const MK_CONTROL = &H8
- Global Const MK_MBUTTON = &H10
-
-
- '
- ' My constants
- '
-
- Global Const MODELESS = 0 ' Show forms as modeless.
- Global Const MODAL = 1 ' Show forms as modal.
-
- Global Const LEFT_BUTTON = 1 ' VB's code for left mouse button in MouseDown event.
- Global Const RIGHT_BUTTON = 2 ' VB's code for right mouse button in MouseDown event.
-
- Global Const MAX_TOOLBOX_ITEMS = 16 ' Maximum number of items allowed in a toolbox.
- Global Const MAX_FLYOUT_ITEMS = 16 ' Maximum number of items allowed in a flyout.
-
- Global Const WM_USER = &H400 ' Used in PostMessage() call from flyout to toolbox.
-
- Global Const ICON_ARC = 0 ' Indexes into PictureClip control bitmap for all
- Global Const ICON_BOLD = 5 ' icons. Bitmap is 5 columns by 20 rows. The
- Global Const ICON_BUTTON = 10 ' first column contains the normal version of
- Global Const ICON_CAMERA = 15 ' each icon. The second column contains the
- Global Const ICON_CENTERJUST = 20 ' depressed version of the icon. Columns 3-5
- Global Const ICON_DOUBLEUNDERLINE = 25 ' are not used.
- Global Const ICON_HELP = 30
- Global Const ICON_ITALIC = 35
- Global Const ICON_FULLJUST = 40
- Global Const ICON_LEFTJUST = 45
- Global Const ICON_LINE = 50
- Global Const ICON_MACRO = 55
- Global Const ICON_OVAL = 60
- Global Const ICON_PRINTER = 65
- Global Const ICON_RECTANGLE = 70
- Global Const ICON_SMALLCAPS = 75
- Global Const ICON_SUMMATION = 80
- Global Const ICON_CENTERTAB = 85
- Global Const ICON_DECIMALTAB = 90
- Global Const ICON_LEFTTAB = 95
-
- Global Const ICON_DEPRESSED = 1 ' Add this to the base index of an icon to get the
- ' PictureClip control index for the depressed icon.
-
- '*************************************************************************
- '* *
- '* DATA STRUCTURE DEFINITIONS *
- '* *
- '*************************************************************************
-
- Type POINTAPI
- X As Integer
- Y As Integer
- End Type
-
-
- Type tagIcons
- icon_index As Integer ' Index of icon im PictureClip control
- help_str As String ' Help string for this icon
- End Type
-
-
- Type tagFlyoutData
- num_icons As Integer
- num_columns As Integer
- num_rows As Integer
- End Type
-
-
- Type tagToolBox
- title As String ' Caption for toolbox window
- num_items As Integer ' Number of icons in this toolbox (must be 1..16)
- num_columns As Integer ' Number of column in this toolbox (must defined)
- num_rows As Integer ' Number of rows in toolbox (is calculated)
- tool_selected As Integer ' Index in icons() of selected tool.
- icons(0 To 15, 0 To 16) As tagIcons ' Contains description for all icons in a toolbox
- ' as well as the flyout associated with each tool.
- ' icons(x,0) is description for toolbox tool icon X
- ' icons(x,y) is decsription for icon Y on the
- ' flyout menu displayed when tool X is selected.
- flyout_data(0 To 15) As tagFlyoutData
- ' Contains data for every flyout. The number_icons
- ' and num_columns fields must be set. The num_rows
- ' field is calulated. Each element corresponds to
- ' the flyout for the toolbox icon with the same
- ' index. the field number_icons must be in the
- ' range 1..16. The field num_columns must be
- ' defined; num_rows is calculated.
- flyout_item_selected As Integer ' Index in icons() for the flyout menu icon selected
- ' (e.g., icons(tool_selected,flyout_item_selected))
- End Type
-
-
-
- '*************************************************************************
- '* *
- '* GLOBAL VARIABLES *
- '* *
- '*************************************************************************
-
- Global gToolbox As tagToolBox ' The definition for our toolbox.
-
-
- '*************************************************************************
- '* *
- '* API AND DLL ROUTINE DECLARATIONS *
- '* *
- '*************************************************************************
-
- Declare Function GetSystemMetrics% Lib "User" (ByVal nIndex%)
- Declare Sub dwDWORDto2Integers Lib "dwspydll.dll" (ByVal l&, X%, Y%)
- Declare Sub MoveWindow Lib "User" (ByVal hWnd%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal bRepaint%)
- Declare Function SetCapture% Lib "User" (ByVal hWnd%)
- Declare Sub ReleaseCapture Lib "User" ()
- Declare Function PostMessage% Lib "User" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&)
-
- Sub ArrangeFlyout ()
-
- Dim border_width% ' Width of the flyout window border
- Dim border_height% ' Height of the flyout window border
- Dim caption_height% ' Height of the toolbox window caption
- Dim x_pos% ' Left position of the flyout window
- Dim y_pos% ' Top position of the flyout window
- Dim client_width% ' Width of the client area of the flyout window
- Dim client_height% ' Height of the client area of the flyout window
- Dim image_height% ' Height of the Image control used to a flyout icon
- Dim image_width% ' Width of the Image control used to a flyout icon
- Dim row% ' Temp var
- Dim column% ' Temp var
- Dim temp% ' Temp var
-
-
- '
- ' Set the flyout_item_selected field in the Toolbox structure to -1 to indicate
- ' no flyout menu item has been selected.
- '
-
- gToolbox.flyout_item_selected = -1
-
-
- '
- ' Calculate the number of rows in the flyout.
- '
-
- gToolbox.flyout_data(gToolbox.tool_selected).num_rows = (gToolbox.flyout_data(gToolbox.tool_selected).num_icons \ gToolbox.flyout_data(gToolbox.tool_selected).num_columns) - ((gToolbox.flyout_data(gToolbox.tool_selected).num_icons Mod gToolbox.flyout_data(gToolbox.tool_selected).num_columns) > 0)
-
-
- '
- ' Get the size of the flyout window's borders.
- '
-
- caption_height% = GetSystemMetrics%(SM_CYCAPTION)
- border_height% = GetSystemMetrics%(SM_CYBORDER)
- border_width% = GetSystemMetrics%(SM_CXBORDER)
-
-
- '
- ' Get and store the height and width of the Images in the flyout window.
- '
-
- image_height% = frmFlyout!Image1(0).Height
- image_width% = frmFlyout!Image1(0).Width
-
-
- '
- ' Calculate the width and height of the client area of the
- ' flyout window.
- '
-
- client_width% = gToolbox.flyout_data(gToolbox.tool_selected).num_columns * image_width%
- client_height% = gToolbox.flyout_data(gToolbox.tool_selected).num_rows * image_height%
-
-
- '
- ' Calculate the left and top position for the flyout window.
- ' The top of the flyout menu is aligned with the bottom edge of
- ' its tool icon in the toolbox.
- ' The left side of the flyout menu is aligned with the midpoint of
- ' its tool icon in the toolbox.
- '
-
- x_pos% = ((MDIForm1.Left + frmToolbox.Left) \ Screen.TwipsPerPixelX) + border_width% + frmToolbox!Image1(gToolbox.tool_selected).Left + (frmToolbox!Image1(gToolbox.tool_selected).Width \ 2)
- y_pos% = ((MDIForm1.Top + frmToolbox.Top) \ Screen.TwipsPerPixelY) + caption_height% + frmToolbox!Image1(gToolbox.tool_selected).Top + (frmToolbox!Image1(gToolbox.tool_selected).Height * 2)
-
-
- '
- ' Move the flyout window to its initial location and size
- ' it appropriately.
- '
-
- Call MoveWindow(frmFlyout.hWnd, x_pos%, y_pos%, (client_width% + (2 * border_width%)), client_height%, False)
-
-
- '
- ' For every icon in the flyout...
- ' Place its Image in the correct location.
- ' Load the correct icon from the PictureClip control.
- '
-
- temp% = 0
-
- For row% = 0 To (gToolbox.flyout_data(gToolbox.tool_selected).num_rows - 1)
-
- For column% = 0 To (gToolbox.flyout_data(gToolbox.tool_selected).num_columns - 1)
-
- If (temp% < gToolbox.flyout_data(gToolbox.tool_selected).num_icons) Then
- frmFlyout!Image1(temp%).Top = row% * image_height%
- frmFlyout!Image1(temp%).Left = column% * image_width%
- frmFlyout!Image1(temp%).Picture = frmToolbox!PicClip1.GraphicCell(gToolbox.icons(gToolbox.tool_selected, (temp% + 1)).icon_index)
- frmFlyout.Image1(temp%).Visible = True
- End If
- temp% = temp% + 1
-
- Next column%
-
- Next row%
-
-
- '
- ' Make all the unused Images invisible.
- '
-
- If (gToolbox.flyout_data(gToolbox.tool_selected).num_icons < MAX_FLYOUT_ITEMS) Then
- For temp% = gToolbox.flyout_data(gToolbox.tool_selected).num_icons To (MAX_FLYOUT_ITEMS - 1)
- frmFlyout.Image1(temp%).Visible = False
- Next temp%
- End If
-
- End Sub
-
- Sub ArrangeToolbox ()
-
- Dim border_width% ' Width of the flyout window border
- Dim border_height% ' Height of the flyout window border
- Dim caption_height% ' Height of the toolbox window caption
- Dim client_width% ' Width of the client area of the flyout window
- Dim client_height% ' Height of the client area of the flyout window
- Dim image_height% ' Height of the Image control used to a flyout icon
- Dim image_width% ' Width of the Image control used to a flyout icon
- Dim row% ' Temp var
- Dim column% ' Temp var
- Dim temp% ' Temp var
-
-
- '
- ' Set the tool_selected field in the Toolbox structure to -1 to indicate
- ' no tool has been selected.
- '
-
- gToolbox.tool_selected = -1
-
-
- '
- ' Calculate the number of rows in the toolbox.
- '
-
- gToolbox.num_rows = (gToolbox.num_items \ gToolbox.num_columns) - ((gToolbox.num_items Mod gToolbox.num_columns) > 0)
-
-
- '
- ' Get the size of the toolbox window's borders and caption.
- '
-
- caption_height% = GetSystemMetrics%(SM_CYCAPTION)
- border_height% = GetSystemMetrics%(SM_CYBORDER)
- border_width% = GetSystemMetrics%(SM_CXBORDER)
-
-
- '
- ' Calculate the width and height of the client area of the
- ' toolbox window.
- '
-
- client_width% = gToolbox.num_columns * frmToolbox!Image1(0).Width
- client_height% = gToolbox.num_rows * frmToolbox!Image1(0).Height
-
-
- '
- ' For every icon in the toolbox...
- ' Place its Image in the correct location.
- ' Load the correct icon from the PictureClip control.
- ' Make the Image visible.
- '
-
- temp% = 0
- image_height% = frmToolbox!Image1(0).Height
- image_width% = frmToolbox!Image1(0).Width
-
- For row% = 0 To (gToolbox.num_rows - 1)
-
- For column% = 0 To (gToolbox.num_columns - 1)
-
- If (temp% < gToolbox.num_items) Then
- frmToolbox!Image1(temp%).Top = row% * image_height%
- frmToolbox!Image1(temp%).Left = column% * image_width%
- frmToolbox!Image1(temp%).Picture = frmToolbox!PicClip1.GraphicCell(gToolbox.icons(temp%, 0).icon_index)
- frmToolbox.Image1(temp%).Visible = True
- End If
- temp% = temp% + 1
-
- Next column%
-
- Next row%
-
-
- '
- ' Make all the unused Images invisible.
- '
-
- If (gToolbox.num_items < MAX_TOOLBOX_ITEMS) Then
- For temp% = gToolbox.num_items To (MAX_TOOLBOX_ITEMS - 1)
- frmToolbox.Image1(temp%).Visible = False
- Next temp%
- End If
-
-
- '
- ' Move the toolbox window to its initial location and size
- ' it appropriately.
- '
-
- Call MoveWindow(frmToolbox.hWnd, 10, 10, (client_width% + (2 * border_width%)), (client_height% + caption_height%), True)
-
- End Sub
-
- Sub InitializeToolbox ()
-
- '
- ' Set the title for the toolbox, the number of columns in the
- ' toolbox, and the number of tools in the Toolbox.
- '
-
- gToolbox.title = "Tools"
- gToolbox.num_items = 6
- gToolbox.num_columns = 2
-
-
- '
- ' For each tool in the toolbox, define its icon and help string.
- '
-
- gToolbox.icons(0, 0).icon_index = ICON_CENTERJUST
- gToolbox.icons(0, 0).help_str = "Center justification tool."
- gToolbox.icons(1, 0).icon_index = ICON_DOUBLEUNDERLINE
- gToolbox.icons(1, 0).help_str = "Double underline tool."
- gToolbox.icons(2, 0).icon_index = ICON_ITALIC
- gToolbox.icons(2, 0).help_str = "Italic tool."
- gToolbox.icons(3, 0).icon_index = ICON_FULLJUST
- gToolbox.icons(3, 0).help_str = "Full justification tool."
- gToolbox.icons(4, 0).icon_index = ICON_LEFTJUST
- gToolbox.icons(4, 0).help_str = "Left justification tool."
- gToolbox.icons(5, 0).icon_index = ICON_SMALLCAPS
- gToolbox.icons(5, 0).help_str = "Small caps tool."
-
-
- '
- ' For each tool in the toolbox, define its flyout menu.
- '
- ' Define the number of icons in the flyout and the number
- ' of columns in the flyout.
- '
- ' Define the icons in the flyout and the help string for
- ' each icon.
- '
-
- gToolbox.flyout_data(0).num_icons = 4 ' Flyout for Tool #0
- gToolbox.flyout_data(0).num_columns = 4
-
- gToolbox.icons(0, 1).icon_index = ICON_ARC
- gToolbox.icons(0, 1).help_str = "Arc command."
- gToolbox.icons(0, 2).icon_index = ICON_BOLD
- gToolbox.icons(0, 2).help_str = "Bold command."
- gToolbox.icons(0, 3).icon_index = ICON_BUTTON
- gToolbox.icons(0, 3).help_str = "Button command."
- gToolbox.icons(0, 4).icon_index = ICON_CAMERA
- gToolbox.icons(0, 4).help_str = "Camera command."
-
-
-
- gToolbox.flyout_data(1).num_icons = 6 ' Flyout for Tool #1
- gToolbox.flyout_data(1).num_columns = 3
-
- gToolbox.icons(1, 1).icon_index = ICON_LINE
- gToolbox.icons(1, 1).help_str = "Line command."
- gToolbox.icons(1, 2).icon_index = ICON_MACRO
- gToolbox.icons(1, 2).help_str = "Macro command."
- gToolbox.icons(1, 3).icon_index = ICON_OVAL
- gToolbox.icons(1, 3).help_str = "Oval command."
- gToolbox.icons(1, 4).icon_index = ICON_PRINTER
- gToolbox.icons(1, 4).help_str = "Printer command."
- gToolbox.icons(1, 5).icon_index = ICON_RECTANGLE
- gToolbox.icons(1, 5).help_str = "Rectangle command."
- gToolbox.icons(1, 6).icon_index = ICON_SUMMATION
- gToolbox.icons(1, 6).help_str = "Summation command."
-
-
-
- gToolbox.flyout_data(2).num_icons = 3 ' Flyout for Tool #2
- gToolbox.flyout_data(2).num_columns = 3
-
- gToolbox.icons(2, 1).icon_index = ICON_CENTERTAB
- gToolbox.icons(2, 1).help_str = "Center tab command."
- gToolbox.icons(2, 2).icon_index = ICON_DECIMALTAB
- gToolbox.icons(2, 2).help_str = "Decimal tab command."
- gToolbox.icons(2, 3).icon_index = ICON_LEFTTAB
- gToolbox.icons(2, 3).help_str = "Left tab command."
-
-
-
- gToolbox.flyout_data(3).num_icons = 5 ' Flyout for Tool #3
- gToolbox.flyout_data(3).num_columns = 5
-
- gToolbox.icons(3, 1).icon_index = ICON_DOUBLEUNDERLINE
- gToolbox.icons(3, 1).help_str = "Double underline command."
- gToolbox.icons(3, 2).icon_index = ICON_HELP
- gToolbox.icons(3, 2).help_str = "Help command."
- gToolbox.icons(3, 3).icon_index = ICON_ITALIC
- gToolbox.icons(3, 3).help_str = "Italic command."
- gToolbox.icons(3, 4).icon_index = ICON_FULLJUST
- gToolbox.icons(3, 4).help_str = "Full justification command."
- gToolbox.icons(3, 5).icon_index = ICON_LEFTJUST
- gToolbox.icons(3, 5).help_str = "Left justification command."
-
-
-
- gToolbox.flyout_data(4).num_icons = 10 ' Flyout for Tool #4
- gToolbox.flyout_data(4).num_columns = 5
-
- gToolbox.icons(4, 1).icon_index = ICON_ARC
- gToolbox.icons(4, 1).help_str = "Arc command."
- gToolbox.icons(4, 2).icon_index = ICON_BOLD
- gToolbox.icons(4, 2).help_str = "Bold command."
- gToolbox.icons(4, 3).icon_index = ICON_BUTTON
- gToolbox.icons(4, 3).help_str = "Button command."
- gToolbox.icons(4, 4).icon_index = ICON_CAMERA
- gToolbox.icons(4, 4).help_str = "Camera command."
- gToolbox.icons(4, 5).icon_index = ICON_CENTERJUST
- gToolbox.icons(4, 5).help_str = "Center justification command."
- gToolbox.icons(4, 6).icon_index = ICON_DOUBLEUNDERLINE
- gToolbox.icons(4, 6).help_str = "Double underline command."
- gToolbox.icons(4, 7).icon_index = ICON_HELP
- gToolbox.icons(4, 7).help_str = "Help command."
- gToolbox.icons(4, 8).icon_index = ICON_ITALIC
- gToolbox.icons(4, 8).help_str = "Italic command."
- gToolbox.icons(4, 9).icon_index = ICON_FULLJUST
- gToolbox.icons(4, 9).help_str = "Full justification command."
- gToolbox.icons(4, 10).icon_index = ICON_LEFTJUST
- gToolbox.icons(4, 10).help_str = "Left justification command."
-
-
-
- gToolbox.flyout_data(5).num_icons = 10 ' Flyout for Tool #5
- gToolbox.flyout_data(5).num_columns = 5
-
- gToolbox.icons(5, 1).icon_index = ICON_LINE
- gToolbox.icons(5, 1).help_str = "Line command."
- gToolbox.icons(5, 2).icon_index = ICON_MACRO
- gToolbox.icons(5, 2).help_str = "Macro command."
- gToolbox.icons(5, 3).icon_index = ICON_OVAL
- gToolbox.icons(5, 3).help_str = "Oval command."
- gToolbox.icons(5, 4).icon_index = ICON_PRINTER
- gToolbox.icons(5, 4).help_str = "Printer command."
- gToolbox.icons(5, 5).icon_index = ICON_RECTANGLE
- gToolbox.icons(5, 5).help_str = "Rectangle command."
- gToolbox.icons(5, 6).icon_index = ICON_SMALLCAPS
- gToolbox.icons(5, 6).help_str = "Small caps command."
- gToolbox.icons(5, 7).icon_index = ICON_SUMMATION
- gToolbox.icons(5, 7).help_str = "Summation command."
- gToolbox.icons(5, 8).icon_index = ICON_CENTERTAB
- gToolbox.icons(5, 8).help_str = "Center tab command."
- gToolbox.icons(5, 9).icon_index = ICON_DECIMALTAB
- gToolbox.icons(5, 9).help_str = "Decimal tab command."
- gToolbox.icons(5, 10).icon_index = ICON_LEFTTAB
- gToolbox.icons(5, 10).help_str = "Left tab command."
-
- End Sub
-
- Sub ProcessFlyoutSelection ()
-
- If (gToolbox.flyout_item_selected > -1) Then
- MsgBox "Selected flyout item: " + gToolbox.icons(gToolbox.tool_selected, (gToolbox.flyout_item_selected + 1)).help_str, 64, "Flyout"
- Else
- MsgBox "No flyout item selected", 64, "Flyout"
- End If
-
- End Sub
-
-