2012年4月11日 星期三

VB中使MsFlexGrid和MSHFlexGrid控件支持鼠标滚动操作


將這一段程式放到 公共的模組中

Public Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long

Public Declare Function WaitMessage Lib "user32" () As Long
Public bCancel As Boolean
Public Const WM_MOUSEWHEEL = 522

Public Sub ProcessMessages(sGrid1 As MSFlexGrid)
Dim Message As Msg
       Do While Not bCancel
          'WaitMessage ‘等待消息
          If PeekMessage(Message, sGrid1.hWnd, WM_MOUSEWHEEL, WM_MOUSEWHEEL, PM_REMOVE) Then
              If Message.wParam < 0 Then  ' 向上
                 'Me.Top = Me.Top + 240
                If sGrid1.TopRow < sGrid1.Rows Then
                   sGrid1.TopRow = sGrid1.TopRow + 1
                End If
             Else     '向下??
                If sGrid1.TopRow > 1 Then
                    sGrid1.TopRow = sGrid1.TopRow - 1
                End If
             End If
          End If
          DoEvents
       Loop
End Sub


然後 在每一支程式 的From_load() 加入 此段


'加入此段 即可使用滑鼠滾輪的功能了
    Me.AutoRedraw = True
      Call ProcessMessages(Grid1)




ADO 填入 MSFlexGrid


Title Use ADO to load data into a FlexGrid control
Keywords ADO, database, FlexGrid
Categories Database
 
Open the database and execute the query. Loop through the recordset's Fields array to get the field names and use them as column headers. For each record in the Recordset, loop through the fields saving their values in the FlexGrid.
Keep track of the largest text width in each column and make each column big enough to display the text.
 
Private Sub Form_Load()
Dim db_file As String
Dim statement As String
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim c As Integer
Dim r As Integer
Dim col_wid() As Single
Dim field_wid As Single

    ' Get the data.
    db_file = App.Path
    If Right$(db_file, 1) <> "\" Then db_file = db_file & _
        "\"
    db_file = db_file & "books.mdb"

    ' Open a connection.
    Set conn = New ADODB.Connection
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & db_file & ";" & _
        "Persist Security Info=False"
    conn.Open

    ' Select the data.
    statement = "SELECT * FROM Books ORDER BY Title"

    ' Get the records.
    Set rs = conn.Execute(statement, , adCmdText)

    ' Use one fixed row and no fixed columns.
    MSFlexGrid1.Rows = 2
    MSFlexGrid1.FixedRows = 1
    MSFlexGrid1.FixedCols = 0

    ' Display column headers.
    MSFlexGrid1.Rows = 1
    MSFlexGrid1.Cols = rs.Fields.Count
    ReDim col_wid(0 To rs.Fields.Count - 1)
    For c = 0 To rs.Fields.Count - 1
        MSFlexGrid1.TextMatrix(0, c) = rs.Fields(c).Name
        col_wid(c) = TextWidth(rs.Fields(c).Name)
    Next c

    ' Display the values for each row.
    r = 1
    Do While Not rs.EOF
        MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
        '將資料RS 中的資料取出來 填入 MSFlexGrid 
        For c = 0 To rs.Fields.Count - 1
            MSFlexGrid1.TextMatrix(r, c) = rs.Fields(c).Value

            ' See how big the value is.
            ' 判斷行中 最長的字串 當成最大欄寬
            field_wid = TextWidth(rs.Fields(c).Value)
            If col_wid(c) < field_wid Then col_wid(c) = _
                field_wid
        Next c

        rs.MoveNext
        r = r + 1
    Loop

    ' Close the recordset and connection.
    rs.Close
    conn.Close

    ' Set the column widths.
    For c = 0 To MSFlexGrid1.Cols - 1
        MSFlexGrid1.ColWidth(c) = col_wid(c) + 240
    Next c
End Sub

2012年4月8日 星期日

VB6 MSFlexGrid 元件資料匯至 excel問題


VB6 中 有 MSFlexGrid 元件 內資料在匯出至Excel 是
一般模式都是用迴圈方式(程式碼如下)
    For i = 0 To MSFlexGrid1.Rows - 1
        For jNo = 0 To MSFlexGrid1.Cols - 1
          wshExcel.Cells(i + 1, j + 1) =  MSFlexGrid1.TextMatrix(i, j)
        Next cNo
     Next rNo

請問各位大大,要如何讓 MSFlexGrid可以像listbox元件一樣可以直接貼上
Listbox程式碼如下
    Set MyXlsApp = CreateObject("Excel.Application")
    MyXlsApp.Visible = True
    Set xlbook = MyXlsApp.Workbooks.Add
    Set xlsheet1 = xlbook.Worksheets(1)

    xlsheet1.Cells(1, 1).Value = "產品序號"
    xlsheet1.Cells(1, 2).Value = "功率"
    xlsheet1.Cells(1, 3).Value = "全距"
    xlsheet1.Cells(1, 4).Value = "檢驗時間"
   
    xlsheet1.Range(xlsheet1.Cells(1, 1), xlsheet1.Cells(UserForm1.ListBox1.ListCount, UserForm1.ListBox1.ColumnCount)).Offset(1, 0) = UserForm1.ListBox1.List

例如

xlsheet1.Range(x,y),offset)1,0)=MSFlexGrid1.XXXXXXX

DTPicker 顯示民國日期格式(VB6)

Option Explicit
Private Sub DTPicker1_Format(ByVal CallbackField As String, FormattedString As String)
    If CallbackField = "XXXXXXXXX" Then
       FormattedString = Format(DTPicker1.Year - 1911, "###") + "/" + Format(DTPicker1.Month, "00") + "/" + Format(DTPicker1.Day, "00")
       Text1.Text = FormattedString
    End If
End Sub
Private Sub DTPicker1_FormatSize(ByVal CallbackField As String, Size As Integer)
    If CallbackField = "XXXXXXXXX" Then
       Size = Len(CallbackField)
    End If
End Sub
Private Sub Form_Load()
    DTPicker1.Value = Date
    DTPicker1.CustomFormat = "XXXXXXXXX"
    DTPicker1.Format = dtpCustom
End Sub


要加入  mscomctl.ocx和comctl32.ocx了,