?? 結算價格.frm
字號:
Else
lblSettleType(2).Caption = "單價"
lblSettleType(3).Caption = "備注"
lblSettleType(4).Visible = False
txtSettleType(1).Visible = False
txtSettleType(2).left = txtSettleType(1).left
txtSettleType(2).top = txtSettleType(1).top
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
On Error GoTo ErrHandler
Dim ShiftDown, AltDown, CtrlDown
ShiftDown = (Shift And vbShiftMask) > 0
AltDown = (Shift And vbAltMask) > 0
CtrlDown = (Shift And vbCtrlMask) > 0
Select Case KeyCode
Case vbKeyF1
SendKeys "{F1 3}"
Case vbKeyF5
If Me.tlbAction.Buttons("AddNew").Enabled Then
'AddNew
End If
Case vbKeyF8
If Me.tlbAction.Buttons("Edit").Enabled Then
Edit
End If
Case vbKeyDelete
If Me.tlbAction.Buttons("Delete").Enabled Then
'Delete
End If
Case vbKeyF6
If Me.tlbAction.Buttons("Save").Enabled Then
Save
End If
Case vbKeyZ
If CtrlDown And Me.tlbAction.Buttons("Cancel").Enabled Then
CancelDo
End If
Case vbKeyI
If CtrlDown And Me.tlbAction.Buttons("AddCol").Enabled Then
m_EditCol = 1
AddCol
End If
Case vbKeyD
If CtrlDown And Me.tlbAction.Buttons("DelCol").Enabled Then
m_EditCol = 2
DeleteCol
End If
Case vbKeyP
If CtrlDown And Me.tlbAction.Buttons("Print").Enabled Then
If Not InitPrnGrid Then Exit Sub
Print_Doc Me, "Print", TAB_CADSET
End If
Case vbKeyF4
If CtrlDown Then
Unload Me
End If
End Select
ErrHandler:
Exit Sub
End Sub
Public Sub Gen_Key(TLB_Key As String)
On Error Resume Next
Select Case TLB_Key
Case "Print", "Preview", "Dataout"
If Not InitPrnGrid Then Exit Sub
Print_Doc Me, TLB_Key, TAB_CADSET
End Select
End Sub
Private Sub Form_Load()
Dim objSettlePriceBI As New U8FDBso.clsSettlePriceBI
Dim objDataMgr As New U8FDMgr.DataManager
Dim con As New adodb.Connection
Dim rec As New adodb.Recordset
Dim SQL As String
Dim arrCurr As Variant
Dim i As Integer
MSImageList_Initialize ilsTlb
MSToolBar_Initialize tlbAction, "Print", TB_PRINT
MSToolBar_Initialize tlbAction, "Preview", TB_PREVIEW
MSToolBar_Initialize tlbAction, "Export", TB_Export
MSToolBar_Initialize tlbAction, "AddNew", TB_AddNew
MSToolBar_Initialize tlbAction, "Edit", TB_Edit
MSToolBar_Initialize tlbAction, "Delete", TB_Delete
MSToolBar_Initialize tlbAction, "Save", TB_Save
MSToolBar_Initialize tlbAction, "Cancel", TB_Cancel
MSToolBar_Initialize tlbAction, "Refresh", TB_Refresh
MSToolBar_Initialize tlbAction, "AddCol", TB_AddCol
MSToolBar_Initialize tlbAction, "DelCol", TB_DelCol
MSToolBar_Initialize tlbAction, "Help", TB_HELP
MSToolBar_Initialize tlbAction, "Exit", TB_EXIT
SetPrintDataStyleXML_flag = False
Me.jkrTree.width = 100
m_EditCol = 3
Me.treStyle.LineStyle = tvwRootLines
Me.treStyle.Style = tvwTreelinesPlusMinusPictureText
Me.treStyle.LabelEdit = tvwManual
Me.treStyle.Indentation = 300
txt2Top = Me.txtSettleType(2).top
txt2Left = Me.txtSettleType(2).left
Me.Charge(1).Value = True
Charge_Click 1
Me.cboMoneyName.clear
arrCurr = GetAllCurrencyNames
For i = 0 To UBound(arrCurr) - 1
Me.cboMoneyName.AddItem arrCurr(i)
Next
If cboMoneyName.ListCount > 0 Then cboMoneyName.ListIndex = 0
con.Open g_sDataSourceName
SQL = "select * from SettleStyle order by cSSCode"
rec.Open SQL, con, adOpenStatic, adLockOptimistic
If Not rec.EOF Then
Do Until rec.EOF
If Len(Trim(rec("cSSCode"))) = 1 Then
Me.treStyle.Nodes.Add , , "K" & Trim(rec("cSSCode")), "【" & Trim(rec("cSSCode")) & "】" & Trim(rec("cSSName"))
NodeKey = "K" & Trim(rec("cSSCode"))
Set EO = objSettlePriceBI.FindByCode(g_sDataSourceName, mID(NodeKey, 2))
For i = 1 To EO.EOS.count
Me.treStyle.Nodes.Add NodeKey, tvwChild, "K" & EO.EOS(i)("settle_b_id"), EO.EOS(i)("money_name")
Next
Else
Me.treStyle.Nodes.Add "K" & mID(Trim(rec("cSSCode")), 1, 1), tvwChild, "K" & Trim(rec("cSSCode")), "【" & Trim(rec("cSSCode")) & "】" & Trim(rec("cSSName"))
NodeKey = "K" & Trim(rec("cSSCode"))
Set EO = objSettlePriceBI.FindByCode(g_sDataSourceName, mID(NodeKey, 2))
For i = 1 To EO.EOS.count
Me.treStyle.Nodes.Add NodeKey, tvwChild, "K" & EO.EOS(i)("settle_b_id"), EO.EOS(i)("money_name")
Next
End If
rec.MoveNext
Loop
Else
MsgBox "請先在系統控制臺設置結算方式!", vbInformation, App.ProductName
NodeKey = "K"
End If
For i = 1 To treStyle.Nodes.count
If treStyle.Nodes(i).children > 0 Then
treStyle.Nodes(i).Image = 1
Else
treStyle.Nodes(i).Image = 3
End If
Next
If Me.treStyle.Nodes.count > 0 Then
Me.treStyle.Nodes(1).Selected = True
Me.treStyle.Nodes(1).Expanded = True
NodeKey = Me.treStyle.SelectedItem.key
Set EO = objSettlePriceBI.FindByCode(g_sDataSourceName, mID(NodeKey, 2))
If Me.treStyle.Nodes(1).children > 0 Then
Me.treStyle.Nodes(1).Image = 2
Me.treStyle.Nodes(1).child.Selected = True
NodeKey = Me.treStyle.Nodes(1).child.key
End If
Else
Set EO = objDataMgr.LoadEOMetaData(g_sDataSourceName, m_conBIStyle)
End If
SetUI
Set objSettlePriceBI = Nothing
Set objDataMgr = Nothing
Set rec = Nothing
Set con = Nothing
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error GoTo lblHandle
Dim iAnswer As VbMsgBoxResult
If EO.State = U8FDEso.esoEdit Or EO.State = U8FDEso.esoAddNew Then
iAnswer = MsgBox("還有尚未保存的數據,保存嗎?", vbQuestion + vbYesNoCancel)
If iAnswer = vbNo Then
m_EditStatus = False
If m_EO.State = U8FDEso.esoEdit Then CancelDo
m_EditStatus = True
Unload Me
ElseIf iAnswer = vbYes Then
Save
Unload Me
Else
Cancel = 1
End If
Else
Unload Me
End If
Exit Sub
lblHandle:
MsgBox Err.Description, vbInformation, g_conSysName
Cancel = True
End Sub
Private Sub Form_Resize()
On Error Resume Next
Me.jkrTree.maxLeft = Me.ScaleWidth - conMoveLimit
Me.jkrTree.minLeft = conMoveLimit
Me.treStyle.Move 0, Me.tlbAction.Height, Me.jkrTree.left, Me.ScaleHeight - Me.tlbAction.Height
Me.jkrTree.Move Me.jkrTree.left, Me.tlbAction.Height, 50, Me.ScaleHeight
Me.picView.Move Me.jkrTree.left + 50, Me.tlbAction.Height, Me.ScaleWidth - Me.jkrTree.left - 50, Me.ScaleHeight - Me.tlbAction.Height
ResizeCtbTool Me, picView, treStyle, jkrTree
On Error GoTo 0
End Sub
Private Sub jkrTree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Me.jkrTree.ZOrder 0
End Sub
Private Sub jkrTree_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Me.jkrTree.left < conMoveLimit Then
Me.jkrTree.left = conMoveLimit
ElseIf Me.jkrTree.left > Me.ScaleWidth - conMoveLimit Then
Me.jkrTree.left = Me.ScaleWidth - conMoveLimit
End If
Me.treStyle.width = Me.jkrTree.left
Me.picView.left = Me.jkrTree.left + 50
Me.picView.width = Me.ScaleWidth - Me.treStyle.width - 50
End Sub
Private Sub ocxCtbTool_OnCommand(ByVal enumType As prjTBCtrl.ENUM_MENU_OR_BUTTON, ByVal cButtonId As String, ByVal cMenuId As String)
tlbAction_ButtonClick tlbAction.Buttons(cButtonId)
End Sub
Private Sub tlbAction_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.key
Case "Print"
PrintData
Case "Preview"
PrintView
Case "Export"
Export
' Case "Print", "Preview", "Export"
' If Not InitPrnGrid Then Exit Sub
' Print_Doc Me, Button.key, TAB_CADSET
Case "AddNew"
AddNew
Case "Edit"
m_EditCol = 0
Edit
Case "Delete"
Delete
Case "Save"
Save
Case "Cancel"
CancelDo
Case "Refresh"
RefreshUI
Case "AddCol"
m_EditCol = 1
AddCol
Case "DelCol"
m_EditCol = 2
DeleteCol
Case "Help"
SendKeys "{F1 3}"
Case "Exit"
Unload Me
End Select
End Sub
Private Function InitPrnGrid() As Boolean
InitPrnGrid = False
With frmRightMenu.GrdPrn
frmRightMenu.TabFlg = TAB_ACCDEF
.Redraw = False
.Cols = 7
.FixedCols = 0
.ColWidth(0) = 1000
.ColWidth(1) = 1600
.ColWidth(2) = 1600
.ColWidth(3) = 600
.ColWidth(4) = 1000
.ColWidth(5) = 1000
.ColWidth(6) = 1900
Dim vt As Variant
Dim rsl As New UfRecordset
Dim SQL As String
'SQL = "select " & EO("settle_code").SourceField & "," & "SettleStyle.cSSName" & ",'" & Charge(1).Caption & "'," & EO("unitprice_mny").SourceField & "," & EO("money_name").SourceField & "," & EO("limit_mny").SourceField & "," & EO("digest").SourceField & " from " & EO.SourceTable & "," & "SettleStyle" & " where " & EO.SourceTable & "." & EO("settle_code").SourceField & "=" & "SettleStyle" & ".cSSCode" & " and fd_settle.charge_flag=1"
'SQL = SQL & " union " & "select " & EO("settle_code").SourceField & "," & "SettleStyle.cSSName" & ",'" & Charge(0).Caption & "'," & EO("unitprice_mny").SourceField & "," & EO("money_name").SourceField & "," & EO("limit_mny").SourceField & "," & EO("digest").SourceField & " from " & EO.SourceTable & "," & "SettleStyle" & " where " & EO.SourceTable & "." & EO("settle_code").SourceField & "=" & "SettleStyle" & ".cSSCode" & " and fd_settle.charge_flag=0" & " order by " & EO("settle_code").SourceField
SQL = "select fd_settle.settle_code,SettleStyle.cSSName,case fd_settle.charge_flag when 0 then '結算筆數' when 1 then '計提比例' end as charge_flag,fd_settle_b.money_name,fd_settle_b.unitprice_mny,fd_settle_b.limit_mny,fd_settle_b.digest from fd_settle_b left join fd_settle on fd_settle_b.settle_id=fd_settle.settle_id left join settlestyle on fd_settle.settle_code=settlestyle.csscode"
Set rsl = dbsZJ.OpenRecordset(SQL, dbOpenSnapshot)
If rsl.EOF Then
MsgBox "沒有打印數據!", vbCritical, zjGl_Name
Exit Function
Else
rsl.MoveLast
rsl.MoveFirst
End If
Set vt = rsl.Recordset
.Rows = 2
.FixedRows = 2
.BindRecordSet vt, False, True, True
CloseRS rsl
'初始化表頭及對齊方式
.TextMatrix(0, 0) = "結算方式代碼"
.ColAlignment(0) = UG_ALIGNLEFT
.JoinCells 0, 0, 1, 0, True
.TextMatrix(0, 1) = "結算方式名稱"
.ColAlignment(1) = UG_ALIGNLEFT
.JoinCells 0, 1, 1, 1, True
.TextMatrix(0, 2) = "計費標準"
.ColAlignment(2) = UG_ALIGNLEFT
.JoinCells 0, 2, 1, 2, True
.TextMatrix(0, 3) = "幣別"
.ColAlignment(3) = UG_ALIGNRIGHT
.JoinCells 0, 3, 1, 3, True
.TextMatrix(0, 4) = "單價"
.ColAlignment(4) = UG_ALIGNRIGHT
.JoinCells 0, 4, 1, 4, True
.TextMatrix(0, 5) = "計提基線"
.ColAlignment(5) = UG_ALIGNRIGHT
.JoinCells 0, 5, 1, 5, True
.TextMatrix(0, 6) = "備注"
.ColAlignment(6) = UG_ALIGNLEFT
.JoinCells 0, 6, 1, 6, True
.HeadForeColor = &H404040
.HeadFont.Name = "宋體"
.HeadFont.Size = 9
.HeadFont.Bold = True
End With
InitPrnGrid = True
End Function
Private Sub treStyle_Collapse(ByVal Node As MSComctlLib.Node)
Node.Image = 1
End Sub
Private Sub treStyle_Expand(ByVal Node As MSComctlLib.Node)
Node.Image = 2
End Sub
Private Sub treStyle_NodeClick(ByVal Node As MSComctlLib.Node)
Dim iAnswer As Long
Dim objSettlePriceBI As New U8FDBso.clsSettlePriceBI
Dim objOID As New U8FDEso.OIDObject
If IsNumeric(mID(Node.key, 2)) Then
If NodeKey <> Node.key Then
If Me.picView.Enabled = True Then
iAnswer = MsgBox("放棄當前工作嗎?", vbQuestion + vbYesNo)
If iAnswer = vbNo Then
Me.treStyle.Nodes(NodeKey).Selected = True
Me.picView.SetFocus
Exit Sub
Else
m_EditStatus = False
CancelDo
Me.picView.Enabled = False
End If
End If
NodeKey = Node.key
If Len(NodeKey) < 15 Then
Set m_EO = objSettlePriceBI.FindByCode(g_sDataSourceName, mID(NodeKey, 2))
Else
Set m_EO = objSettlePriceBI.FindByCode(g_sDataSourceName, mID(Node.Parent.key, 2))
End If
Set objSettlePriceBI = Nothing
Set objOID = Nothing
SetUI
End If
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -