ҡդӶ ʵŧ 纺촨շ٨絴͵ ᷹ФѺ

͵Դҷҧ Inbox Ѻ

˹ѡ
-
VB 6/VB.Net
ASP/ASP.Net
Ѻ¤
¹ҹ Flash Movie
ռͺش  
 RSS Feeds
 ǹŴ RSS Reader ...   Download  RSS Reader

Forum - www.g2gnet.com
Webmaster - www.g2gnet.com
Visitors - Session views
 5 6 1 6 1 5 7

7 ѹҤ ..2549
112 Users On-Line.
Visitors - Page views
 8 9 7 3 9 0 0
1 Ҿѹ ..2551

Google   
g2gnet.com
Ҵѡ:  

鹰ҹ㹡ҹ MS FlexGrid ͹ҧѹẺ One To Many (Ҥ 2)

Category »  VB 6/VB.Net
: Webmaster 4/3/2553   : 12:54
(ҹ : 16983) 
Ѻͧ 觨յա͹ ... ʹ 2 ҹ ҹáѺѧѲ ֡ §ҹ 㨡кǹäԴ ͡Ẻ աҹ ùʹǷҧ Ըաö·ʹ͡ ٻẺ͡ѡɳ੾Тͧͧ ҡк觺͡ѹ "¹ҹǡ ѹҡԹ仵椹Դ" ... դ ͹͡Ẻ 㺢 Ѻ ١ ҡ͹ ... ͺ¤Ѻ óչѹѧѡӤѭ ºѺ ÷㺢 Ѻ ¡Թҡ͹͡Ѻ Т鹵͹ ѧ繵ͧ͡ẺҧŴ« öԹҨҡҧ͡ Ѻ ÷ö䢢㹵ҧԴµçѹ ... ÷Ẻ ¡ Friendly Use ԵáѺҹ ... 觨ᵡҧ仨ҡҷӢ¡ѹ ˹ѧ ... ͵ͧǹŴ Source Code ҷͺٹФѺ
ǹŴ
ǹŴ Source Code Ѻ MS Visual Basic 6.0 - Service Pack 6
 ǹŴ Visual Basic 6.0 SP5: Run-Time Redistribution Pack
 ǹŴ Microsoft Data Access Object (MDAC) Jet 4.0 Update
 ǹŴ Microsoft Visual Basic Service Pack 6

ҧԴ (MS Flex Grid) ... VB 6.0
ҹẺ Text File MS FlexGrid MS Visual Basic 6.0
ҧԴ (MS Flex Grid) ... ͹èѴ§㹡ʴ MS FlexGrid
ҧԴ (MS Flex Grid) ... ͹ Wheel Mouse MS FlexGrid
ҧԴ (MS Flex Grid) ... ͹ѺѴ MS FlexGrid
鹰ҹ㹡ҹ MS FlexGrid ͹ҧѹẺ One To Many (Ҥ 1)
鹡кǹ÷ӧҹ

Projects --> References ...


Projects --> Component ...


͡Ẻ Design Time
modDataBase.bas ҡԹ (ѹա) ... 55555+

Option Explicit

Global ConnDB As New ADODB.Connection
Global RS As New ADODB.Recordset
Global DS As New ADODB.Recordset
Global Statement As String
Global SQLStmt As String
'
' ˹繡  䢢
Global blnNewData As Boolean
' Դ Update 㹿ա¹ŧ
Global FormUpdate As Boolean

' ҹ MS Access
Public Sub OpenDataBase()
On Error GoTo Err_Handler
Dim DB_File As String
    DB_File = App.Path
    If Right$(DB_File, 1) <> "\" Then DB_File = DB_File & "\"
    DB_File = DB_File & "ProductDB.MDB"
    ' Open a connection.
    Set ConnDB = New ADODB.Connection
    ConnDB.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & DB_File & ";" & _
        "Persist Security Info=False"
    ConnDB.Open
    Exit Sub
    
Err_Handler:
    MsgBox "Error : " & Err.Number & " " & Err.Description
    End
End Sub

Public Sub CloseDataBase()
    ' Ǩͺա§ - Connect 
    If ConnDB.State = adStateOpen Then
        ConnDB.Close
        Set ConnDB = Nothing
    End If
End Sub


Query - ѹͧҧԹ (tblProduct) Ѻ ҧ˹¹Ѻ (tblUnit) ... ҹԧ¹ФѺ

ҡͧ͡ SQL ǵѴ Query Statement ŧ Visual Basic 6 ...
SELECT tblProduct.ProductPK, tblProduct.ProductCode, tblProduct.Description, tblUnit.UnitName, tblProduct.PriceUnit
FROM tblProduct INNER JOIN tblUnit ON tblProduct.UnitFK = tblUnit.UnitPK



- ҧ͡ѹҵʹѺ ѡá (0) ͧҤ Primary 仫͹ User
- Primary Key ͧԹ (ProductCode) ¤Ѻ

㹡äԹҨҡҧ tblProduct ... ʴ੾ǹӤѭФѺ

' ======================================================
' õ駤ҤسѵԢͧ MS FlexGrid ѡɳТͧ Run Time
' ======================================================
Sub SetupGrid()
    With fgData
        .FixedRows = 1
        .FixedCols = 0
        ' ˹ 7 ѡ
        .Cols = 7
        ' ˹ 1  (੾ Column Header)
        .Rows = 1
        .ColWidth(0) = 0
        .ColWidth(1) = .Width \ 6 - 100
        .ColWidth(2) = .Width \ 6 + 250
        .ColWidth(3) = .Width \ 6 - 200
        .ColWidth(4) = .Width \ 6 - 100
        .ColWidth(5) = .Width \ 6 - 200
        .ColWidth(6) = .Width \ 6
        
        .TextMatrix(0, 0) = "PK"
        .TextMatrix(0, 1) = "Թ"
        .TextMatrix(0, 2) = "Թ"
        .TextMatrix(0, 3) = "˹¹Ѻ"
        .TextMatrix(0, 4) = "ҤԹ"
        .TextMatrix(0, 5) = "ӹǹ" ' ͹ѡ
        .TextMatrix(0, 6) = "ӹǹԹ"
    End With
    
End Sub

' ======================================================
' Դ˵ءóҢԹ ¡á Enter
' ======================================================
Private Sub txtSearch_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Call CheckDataRow
    End If
End Sub

' ======================================================
' õǨͺ MS FlexGrid ͹ʴ¡
' ======================================================
Private Sub CheckDataRow()
    Dim CurrentRow As Integer

    ' Ǩͺ繤ҧ ҡ͡ҡ (User աä)
    If Trim(txtSearch.Text) = "" Or Len(Trim(txtSearch.Text)) = 0 Then
        txtSearch.SetFocus
        Exit Sub
    End If

    ' ҢԹ㹵ҧԹ (tblProduct)
    ' ҧҨǹ Ѻҹͧ VB6 Ѻ Access
    ' á͹ФѺ йҨҡ˹ѧ Ҩҡʺóǹͧ
Set RS = New Recordset Statement = "SELECT tblProduct.ProductPK, tblProduct.ProductCode, " & _ " tblProduct.Description, tblUnit.UnitName, tblProduct.PriceUnit " & _ " FROM tblProduct INNER JOIN tblUnit ON tblProduct.UnitFK = tblUnit.UnitPK " & _ " WHERE ProductCode = " & "'" & Trim$(txtSearch.Text) & "'" ' txtSearch.Text = "" RS.CursorLocation = adUseClient ' äҢŵͧҹԹ˹ҧ зҶ֧Ǣ ... RS.Open Statement, ConnDB, adOpenForwardOnly, adLockReadOnly, adCmdText ' 辺 ͡ҡ If RS.RecordCount = 0 Then RS.Close: Set RS = Nothing Exit Sub End If ' 鹡äҢ㹵ҧԴ For CurrentRow = 1 To fgData.Rows - 1 ' Թҷѡ 1 If fgData.TextMatrix(CurrentRow, 1) = RS("ProductCode") Then ' ҡ¡ԹӹǹԹա 1 ѹ Ƿ Ѩغѹ fgData.TextMatrix(CurrentRow, 5) = Val(fgData.TextMatrix(CurrentRow, 5)) + 1 ' ٳҤԹ ѺӹǹԹ fgData.TextMatrix(CurrentRow, 6) = Format(Val(fgData.TextMatrix(CurrentRow, 4)) * _ Val(fgData.TextMatrix(CurrentRow, 5)), "0.00") RS.Close: Set RS = Nothing ' ͤӹdzӹǹԹ Call CalTotalAmount ' ҡǹͺ FOR ͡ҡ¤Ѻ Exit Sub End If Next ' ================================================= ' ù´ͧԹҧԴͧ ' ================================================= ' ӹǹ MS FlexGrid ա 1 fgData.Rows = fgData.Rows + 1 ' ǻѨغѹŴŧ 1 (Ѻ Column Header) CurrentRow = fgData.Rows - 1 ' ӡҹŨҡ RecordSet ' ѡá (ѡ 0) ͧҤ Primary Key 仫͹ФѺ ... fgData.TextMatrix(CurrentRow, 0) = RS("ProductPK") ' ʴԹ fgData.TextMatrix(CurrentRow, 1) = "" & RS("ProductCode") ' ʴԹ fgData.TextMatrix(CurrentRow, 2) = "" & RS("Description") ' ʴ˹¹ѺԹ fgData.TextMatrix(CurrentRow, 3) = "" & RS("UnitName") ' ʴҤԹ fgData.TextMatrix(CurrentRow, 4) = Format(RS("PriceUnit"), "0.00") ' ӹǹԹҤ 1 fgData.TextMatrix(CurrentRow, 5) = 1 ' ӹdzҤҢ Ѻ ӹǹ fgData.TextMatrix(CurrentRow, 6) = Format(fgData.TextMatrix(CurrentRow, 4) * _ fgData.TextMatrix(CurrentRow, 5), "0.00") RS.Close: Set RS = Nothing ' ͤӹdzӹǹԹ Call CalTotalAmount End Sub ' ============================================= ' ӹdzҼͧҤԹҷ ' ============================================= Sub CalTotalAmount() ' ҡѡ¡á͡ҡ If fgData.Rows = 1 Then Exit Sub Dim i As Integer Dim TotalAmount As Double ' Ѻ仵ӹǹǷѨغѹͧҧԴ Ҩ ' ѡ 6 㹵¹¹ TotalAmount ... 55555+ For i = 1 To fgData.Rows - 1 TotalAmount = TotalAmount + Val(fgData.TextMatrix(i, 6)) Next lblTotalAmount.Caption = Format(TotalAmount, "#,##0.00") End Sub
ͧ͹Ѻ价Ҥ 1 ¤Ѻ ... ѹѧѡ ԸդԴ ѡ᷹ (º͡ǧ˹) ҧ RecordSet ͷӡäԹҨԧ 㹵ҧ ͹ºº (ͧ = ФѺ) 㹡óչҨ LIKE (ͺ˹ҡպ͡աФѺ ... ͧ) ... ˹˹ Ẻѹѧ ҵͧʡҧԴѹö ͹ŧѡ Ƿҵͧ¨дա ... Ҩҡ¹ǹФѺ ...

㹡ʡҷͧ ҧԴ ö͹ŧ
ҹǷҧͧ͡Ẻ ԹҡҧԴö͹ ...

' =============================================
' ԨóҨҡ˵ءó (Event) 㹡 Focus ç˹ Cell
' =============================================
Sub fgData_EnterCell()
Select Case fgData.Col ' ͡ Column ͧ
    Case 0, 1, 2, 3, 4, 6: ' ͹ѡк
        txtData.Visible = False ' ֧ͧԴͧ txtData

        
    Case 5: '  ١ͧ Cell ѧ Focus ѡ 5 鹡кǹ÷ӧҹ
        txtData.Visible = True ' Դ txtData ͧ
        txtData.Text = fgData.Text '  Cell ж١觵 txtData ͷӡ䢵

        ' 鹵͹͡͹˹觢ͧ txtData 价Ѻ躹˹觢ͧ Cell (ѡ˹) ҵͧ
        ' ͹  fgData.Move ˹觷ҧ, ˹觺, ҧͧ, ٧ͧ
        txtData.Move fgData.CellLeft + 60, fgData.Top + fgData.CellTop, fgData.CellWidth, fgData.CellHeight

        '  txtData ͹价Ѻ˹ Cell ҵͧ  Focus 价 txtData ͷö䢢ŧ TextBox 
        txtData.SetFocus
End Select

End Sub

' ͤ TextBox ¹  Cell  TextBox Ѻ ͧ¹
Private Sub txtData_Change()
    Dim sRow As Integer
    ' Ҥҵ˹觢ͧ
    sRow = fgData.Row
    
    '  txtData Դ¹ŧ 觤Ѻ Cell ҵͧô
    '   йѧͧ͡Ѻ  txtData ѹѺ Cell  -- Фѭеǹ
    '  TextBox еͧ繤ҧ  0 ... ҡ 1 ѹ
    If Trim(txtData.Text) = "" Or Len(Trim(txtData.Text)) = 0 Or txtData.Text = "0" Then txtData.Text = "1"
    
    fgData.TextMatrix(sRow, 5) = txtData.Text
    ' ӹdzҤ  ӹǹԹ
    fgData.TextMatrix(sRow, 6) = Format(fgData.TextMatrix(sRow, 4) * fgData.TextMatrix(sRow, 5), "0.00")

    ' ͤӹdzӹǹԹ
    Call CalTotalAmount

End Sub

Private Sub txtData_GotFocus()
    ' 㹡÷ High Light  TextBox
    Call HLText(txtData)
End Sub

' ôѡ衴ŧ TextBox
Private Sub txtData_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyDown
            SendKeys "{DOWN}"
            Call txtData_KeyPress(vbKeyReturn)
        Case vbKeyUp
            SendKeys "{UP}"
            Call txtData_KeyPress(vbKeyReturn)
        Case vbKeyEscape
            Call txtData_KeyPress(vbKeyReturn)
    End Select
End Sub

Private Sub txtData_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        txtData.Visible = False
        KeyAscii = 0
    Else
        ' ǨͺáŢҹ
        KeyAscii = CheckDigitOnly(KeyAscii)
    End If

End Sub

' ==========================================================
' ǡѧҹҵͧҹ ù Module дաҹФѺ
' ==========================================================
' Ǩͺû͹੾еŢ
Function CheckDigitOnly(Index As Integer) As Integer
    Select Case Index
        Case 48 To 57 ' 0 - 9
        Case 8            ' Back Space
        Case 13         ' Enter
        Case Else
            Index = 0
    End Select
    CheckDigitOnly = Index
End Function

' 㹡÷ High Light  TextBox ... Ѻ GotFocus
Public Sub HLText(ByRef sText)
    On Error Resume Next
    With sText
        .SelStart = 0
        .SelLength = Len(sText.Text)
    End With
End Sub
Conclusion:
ҡͧҹ ¾Ըա͹Ẻ Ѻ 鹵ͧѹһѭ ػä ѺþѲҽ֡ͧ 㹧ҹ¹ҧ ҧ˴ ʹҡ ... ԡ ... 蹹ФѺ ҹѹ»ҡ˹ѧ ѡ 䫵 ... ѧҧ çѹ Ѻͧҹ (Դҡ¹ѹͧҡҫԹ) դ ѹػä ҡ˹ ͹

͵ - g2gNet Dot Com
Ţ¹ҳԪ硷͹ԡ 0407314800231
CopyLeft © 2004 - 2099 g2gNet.Com All rights reserved.
Email: [email protected] . 08-6862-6560