frmmultiplication_table.frm

基于MSFlexgrid控件的气泡提示,对mis编程很有用

      BackStyle       =   0  'Transparent
      Caption         =   "按 ""F11"" 键或者单击鼠标右键进行运算"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9.75
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   375
      Left            =   240
      TabIndex        =   3
      Top             =   3480
      Width           =   7935
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackStyle       =   0  'Transparent
      Caption         =   "MSFlexgrid控件的气泡提示示例"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   14.25
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   495
      Left            =   240
      TabIndex        =   1
      Top             =   120
      Width           =   7695
   End
End
Attribute VB_Name = "frmMultiplication_Table"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/05/07
'描  述：MSFlexgrid控件的气泡提示示例
'网  站：http://www.mndsoft.com/
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************
    '**************************************************
    '
    '   Test application for Sorrentino Massimiliano [[e-mail]]
    '   to test individual tool tips in a grid control
    '   using Mark Mokoski's ToolTip class
    '
    '   12-JAN-2005
    '   Mark Mokoski
    '
    '   2-FEB-2005
    '   Modified application for cell highlighting under mouse
    '   cursor. By request of another PSC member Arnold Donovan [[e-mail]]
    '   Most of the highlight code is in the MSFlexGrid1_MouseMove() event
    '
    '***************************************************

    Option Explicit
    
    'Shell out API for HTML files, Mail and Web Browser
    Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal HWND As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    
    'API call to get Balloon Tips working
    Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
    
    'Declare of a new Tool Tip Object
    'you need to have the clsToolTips in your project
    'or click the links at the bottom of the application window
    
    Dim MSFlexGrid1_Tip                   As New clsTooltips
    
    Dim c                                 As Integer  'Column
    Dim r                                 As Integer  'Row
    Dim Operator1                         As String
    Dim Operator2                         As String
    Dim Result                            As String
    Dim Current_Row                       As Integer  'Current Row Mouse is over
    Dim Current_Col                       As Integer  'Current Column Mouse is over
    Dim Last_Row                          As Integer  'Last Row Mouse was over
    Dim Last_Col                          As Integer  'Last Column Mouse was over
    Dim LastSelected_Row                  As Integer
    Dim LastSelected_Col                  As Integer
    Dim TipText                           As String
    Dim New_Row                           As Integer
    Dim New_Col                           As Integer
    Dim MouseIn_grid                      As Boolean
    '"Mouse Over" Highlight Colors
    Dim SelectedCell_Forecolor            As Long
    Dim SelectedCell_Backcolor            As Long
    Dim Cell_Forecolor                    As Long
    Dim Cell_Backcolor                    As Long
    Dim Fixed_Forecolor                   As Long
    Dim Fixed_Backcolor                   As Long
    

Private Sub cmdClose_Click()

    Unload Me

End Sub

Private Sub Form_Load()

    'Call to API to get controls to work with Balloon Tips
    InitCommonControls
    
    'Turn control redraw OFF
    MSFlexGrid1.Redraw = False
    
    'Set at first fixed row
    MSFlexGrid1.Row = 0
    
    'Set column width and populate columns with numbers 1 thru 10

        For c = 0 To 10
            MSFlexGrid1.ColWidth(c) = 700
            MSFlexGrid1.Col = c
            MSFlexGrid1.CellAlignment = flexAlignCenterCenter
            
                
                If c = 0 Then   'Special case for Row(0), Col(0)
                    MSFlexGrid1.Text = "X"
                Else
                    MSFlexGrid1.Text = Str(c)
                End If

        Next c

    'Set first fixed column
    
    MSFlexGrid1.Col = 0
    
    'Polulate fixed rows with numbers 1 thru 10

        For r = 1 To 10
            MSFlexGrid1.Row = r
            MSFlexGrid1.CellAlignment = flexAlignCenterCenter
            MSFlexGrid1.Text = Str(r)
        Next r
        
        For r = 1 To 10
        
            'Polulate Grid with numbers ( c * r = celldata )

                For c = 1 To 10
                    MSFlexGrid1.Row = r
                    MSFlexGrid1.Col = c
                    MSFlexGrid1.CellAlignment = flexAlignCenterCenter
                    MSFlexGrid1.Text = Str(r * c)
                Next c

        Next r

    'Set the default Hightlight colors
    Fixed_Forecolor = vbYellow
    Fixed_Backcolor = vbBlue
    SelectedCell_Forecolor = vbYellow
    SelectedCell_Backcolor = vbBlue
    Cell_Forecolor = vbWhite
    Cell_Backcolor = vbRed
    
    'Do some other form setup before main application starts
    
    'Set start posistion at row 1, column 1
    MSFlexGrid1.Row = 1
    MSFlexGrid1.Col = 1
    
    MSFlexGrid1.Redraw = True
    
    'Set start values
    Current_Row = MSFlexGrid1.Row
    Last_Row = MSFlexGrid1.Row
    LastSelected_Row = MSFlexGrid1.Row
    Current_Col = MSFlexGrid1.Col
    Last_Col = MSFlexGrid1.Col
    LastSelected_Col = MSFlexGrid1.Col
    
    MSFlexGrid1_Click
    
End Sub

Private Sub html1_Click()

    'Sample call:
    'ShellExecute hWnd, vbNullString, "mailto:[e-mail]?body=hello%0a%0world", vbNullString, vbNullString, vbNormalFocus
    ShellExecute HWND, vbNullString, "http://www.mndsoft.com", vbNullString, vbNullString, vbNormalFocus
  
    'In order to be able to put carriage returns or tabs in your text,
    'replace vbCrLf and vbTab with the following HEX codes:
    '%0a%0d = vbCrLf
    '%09 = vbTab
    'These codes also work when sending URLs to a browser (GET, POST, etc.)

End Sub

Private Sub html2_Click()

    'Sample call:
    'ShellExecute hWnd, vbNullString, "mailto:[e-mail]?body=hello%0a%0world", vbNullString, vbNullString, vbNormalFocus
    ShellExecute HWND, vbNullString, "http://www.mndsoft.com", vbNullString, vbNullString, vbNormalFocus
  
    'In order to be able to put carriage returns or tabs in your text,
    'replace vbCrLf and vbTab with the following HEX codes:
    '%0a%0d = vbCrLf
    '%09 = vbTab
    'These codes also work when sending URLs to a browser (GET, POST, etc.)

End Sub

Private Sub MSFlexGrid1_Click()

    'Set highlight color on fixed row/col of selected cell
    
    'Instead of keeping track of the last selected cell, you could
    'just brute force all the fixed rows / columns back to the
    'stock colors. But that might take too much time with a large grid.
    'So keeping track of the last selected cell is a minor inconvenience
    'in the hope of speeding up the grid redraw.
    
    'Turn off the redraw to stop flicker of grid control
    MSFlexGrid1.Redraw = False
    'Save the current selected cell
    New_Row = MSFlexGrid1.Row
    New_Col = MSFlexGrid1.Col
    
    'Reset color of last selected row fixed cell(s) and set color on new row

        For c = 0 To MSFlexGrid1.FixedCols - 1
            'Select and reset colors on old row
            MSFlexGrid1.Col = c
            MSFlexGrid1.Row = LastSelected_Row
            MSFlexGrid1.CellForeColor = MSFlexGrid1.ForeColorFixed
            MSFlexGrid1.CellBackColor = MSFlexGrid1.BackColorFixed
            'select and set colors on new row
            MSFlexGrid1.Row = New_Row
            MSFlexGrid1.CellForeColor = Fixed_Forecolor
            MSFlexGrid1.CellBackColor = Fixed_Backcolor
        Next c
    
    'Reset color of last selected column fixed cell(s) and set color on new column

        For r = 0 To MSFlexGrid1.FixedRows - 1
            'Select and reset colors on old column
            MSFlexGrid1.Row = r
            MSFlexGrid1.Col = LastSelected_Col
            MSFlexGrid1.CellForeColor = MSFlexGrid1.ForeColorFixed
            MSFlexGrid1.CellBackColor = MSFlexGrid1.BackColorFixed
            'select and set colors on new row
            MSFlexGrid1.Col = New_Col
            MSFlexGrid1.CellForeColor = Fixed_Forecolor
            MSFlexGrid1.CellBackColor = Fixed_Backcolor
        Next r
    
    'Restore currently selected cell
    MSFlexGrid1.Row = New_Row
    MSFlexGrid1.Col = New_Col
    
    'Redraw the control
    MSFlexGrid1.Redraw = True

    'Set cell current selection laso as last cell selected
    LastSelected_Row = MSFlexGrid1.Row
    LastSelected_Col = MSFlexGrid1.Col

    'On Mouse Click, set Row / Column text
    txtSelRowCol.Text = "第 " & Str(MSFlexGrid1.Row) & "行  / 第 " & Str(MSFlexGrid1.Col) & "列"
    DoEvents
  
    
End Sub

Private Sub MSFlexGrid1_GotFocus()

    'Turn off the redraw to stop flicker of grid control
    MSFlexGrid1.Redraw = False
    'Save the current selected cell
    New_Row = MSFlexGrid1.Row
    New_Col = MSFlexGrid1.Col
    
    'Set color of last selected row fixed cell(s) on control Got Focus

        For c = 0 To MSFlexGrid1.FixedCols - 1
            'Select and reset colors on old row
            MSFlexGrid1.Col = c
            MSFlexGrid1.Row = LastSelected_Row
            MSFlexGrid1.CellForeColor = Fixed_Forecolor
            MSFlexGrid1.CellBackColor = Fixed_Backcolor
        Next c
    
    'Set color of last selected column fixed cell(s) on control Got Focus

        For r = 0 To MSFlexGrid1.FixedRows - 1
            'Select and reset colors on old column
            MSFlexGrid1.Row = r
            MSFlexGrid1.Col = LastSelected_Col
            MSFlexGrid1.CellForeColor = Fixed_Forecolor
            MSFlexGrid1.CellBackColor = Fixed_Backcolor
        Next r