Function MyIntFormatVb(c, s) c = Replace(c, ",", "") If IsNumeric(c) = False Then c = "0" End If MyIntFormatVb = FormatNumber(c,0,,,True) End Function Function MyIntVb(c) c = Replace(c, ",", "") If IsNumeric(c) = False Then c = "0" End If MyIntVb = CDbl(c) End Function Function MyReplaceVb(e, f, r) MyReplaceVb = Replace(e, f, r) End Function 'Function PassDataFmtAuth (c,NeedAuth,MinLen,MaxLen,MinValue,MaxValue,DataFmt,DotNum,FuncName) ' Dim v ' Dim iLenStr ' Dim lbl ' If c.ReadOnly=true Then Exit Function ' If NeedAuth=0 Then ' PassDataFmtAuth="" ' Else ' v=c.Value ' If Len(Trim(c.IsCombo))>0 Then ' set lbl = document.getElementById(c.IsCombo) ' If Not lbl is Nothing Then ' If lbl.value="" Then ' PassDataFmtAuth="此欄位之值未經認証，請重新輸入後按下Enter鍵!" ' Exit Function ' End If ' End If ' End If ' If MinLen=0 And Trim(v)="" Then ' If FuncName<>"" And PassDataFmtAuth="" Then PassDataFmtAuth=window.execScript(FuncName) ' Exit Function ' End If ' 'If MinLen>0 And Trim(v)="" Then ' ' PassDataFmtAuth="E1002" ' ' Exit Function ' 'End If ' If lcase(DataFmt)="i" And Not IsNumeric(v) Then ' PassDataFmtAuth="E1003" ' Exit Function ' End If ' If lcase(Trim(DataFmt))="a" Then 'DataFmt = a ' Dim areano ' Dim i ' Dim CheckSum ' Dim areacode ' Dim id ' id = UCase(v) ' areacode = Left(id, 1) ' If Len(Trim(id)) <> 10 Then ' PassDataFmtAuth="E1004" ' Exit Function ' End If ' If (areacode < "A" Or areacode > "Z") Then ' PassDataFmtAuth="E1004" ' Exit Function ' End If ' If Not IsNumeric(Mid(id, 2)) Then ' PassDataFmtAuth="E1004" ' Exit Function ' End If ' areano = InStr("ABCDEFGHJKLMNPQRSTUVXYWZIO", areacode) + 9 ' id= CStr(areano) + Mid(id, 2) ' CheckSum = CLng(Mid(id, 1, 1)) + CLng(Mid(id, 11, 1)) ' For i = 2 To 10 ' CheckSum = CheckSum + CLng(Mid(id, i, 1)) * (11 - i) ' Next ' If CheckSum Mod 10 <> 0 Then ' PassDataFmtAuth="E1004" ' Exit Function ' End If ' End If 'DataFmt = a End ' If lcase(Trim(DataFmt))="b" Then 'DataFmt = b ' Dim intX1,intX2,intX3,intX4,intX5,intX6,intX7,intX8 ' Dim intY1,intY2,intY3,intY4,intY5,intY6,intY7,intY8 ' Dim intMod,intSum ' If Len(Trim(v)) = 0 Then ' Exit Function ' End If ' If IsNumeric(Trim(v)) = False Then ' If Len(Trim(strBAN)) = 0 Then ' PassDataFmtAuth="E1005" ' Exit Function ' End If ' End If ' If Len(Trim(v)) <> 8 Then ' PassDataFmtAuth="E1005" ' Exit Function ' End If ' intX1 = Cdbl(Mid(Trim(v), 1, 1)) * 1 ' intX2 = Cdbl(Mid(Trim(v), 2, 1)) * 2 ' intX3 = Cdbl(Mid(Trim(v), 3, 1)) * 1 ' intX4 = Cdbl(Mid(Trim(v), 4, 1)) * 2 ' intX5 = Cdbl(Mid(Trim(v), 5, 1)) * 1 ' intX6 = Cdbl(Mid(Trim(v), 6, 1)) * 2 ' intX7 = Cdbl(Mid(Trim(v), 7, 1)) * 4 ' intX8 = Cdbl(Mid(Trim(v), 8, 1)) * 1 ' intY1 = Int(intX2 / 10) ' intY2 = intX2 Mod 10 ' intY3 = Int(intX4 / 10) ' intY4 = intX4 Mod 10 ' intY5 = Int(intX6 / 10) ' intY6 = intX6 Mod 10 ' intY7 = Int(intX7 / 10) ' intY8 = intX7 Mod 10 ' intSum = intX1 + intX3 + intX5 + intX8 + intY1 + intY2 + intY3 + intY4 + intY5 + intY6 + intY7 + intY8 ' intMod = intSum Mod 10 ' If Cdbl(Mid(v, 7, 1)) = 7 Then ' If intMod = 0 Then ' Exit Function ' Else ' intSum = intSum + 1 ' intMod = intSum Mod 10 ' If intMod = 0 Then ' Exit Function ' Else ' PassDataFmtAuth="E1005" ' Exit Function ' End If ' End If ' Else ' If intMod = 0 Then ' Exit Function ' Else ' PassDataFmtAuth="E1005" ' Exit Function ' End If ' End If ' End If 'DataFmt = b End ' If lcase(Trim(DataFmt))="c" Then 'DataFmt = c ' Dim iX1,iX2,iX3,iX4,iX5,iX6,iX7,iX8,iX9,iX10,iX11,iX12,iX13 ' Dim iMen,iSum ' If Len(Trim(v)) <> 13 Then ' PassDataFmtAuth="E1007" ' Exit Function ' End If ' iX1 = Cdbl(Mid(Trim(v), 1, 1)) ' iX2 = Cdbl(Mid(Trim(v), 2, 1)) ' iX3 = Cdbl(Mid(Trim(v), 3, 1)) ' iX4 = Cdbl(Mid(Trim(v), 4, 1)) ' iX5 = Cdbl(Mid(Trim(v), 5, 1)) ' iX6 = Cdbl(Mid(Trim(v), 6, 1)) ' iX7 = Cdbl(Mid(Trim(v), 7, 1)) ' iX8 = Cdbl(Mid(Trim(v), 8, 1)) ' iX9 = Cdbl(Mid(Trim(v), 9, 1)) ' iX10 = Cdbl(Mid(Trim(v), 10, 1)) ' iX11 = Cdbl(Mid(Trim(v), 11, 1)) ' iX12 = Cdbl(Mid(Trim(v), 12, 1)) ' iX13 = Cdbl(Mid(Trim(v), 13, 1)) ' iSum = 10000-(((iX2+iX4+iX6+iX8+iX10+iX12)*3)+iX1+iX3+iX5+iX7+iX9+iX11) ' iMen = Right(iSum,1) ' If Cdbl(iMen) <> iX13 Then PassDataFmtAuth="E1007" ' End If 'DataFmt = c End ' If LCase(Trim(DataFmt))="d" Then 'DataFmt = d 2003/11/13 rhino update ' FmtChkDate(c,v) ' End If 'DataFmt = d End ' 'for debug ' If FuncName<>"" And PassDataFmtAuth="" Then ' r = window.execScript(FuncName) ' PassDataFmtAuth = CustCheck ' End If ' End If 'Ending 'End Function 'Function FmtChkDate(c,v) ' Dim xyz1 ' Dim xyz2 ' Dim xyz ' Dim xDateStr ' xyz = v ' xyz1 = "" ' xyz2 = "" ' If Len(xyz) = 0 Then ' Exit Function ' End If ' If InStr(1, xyz, "/") > 0 Then ' xDateStr = Split(xyz, "/") ' If IsNumeric(Left(Trim(xyz), 4)) = True Then ' Y = Right("000" & (Year(xyz) - 1911), 3) ' ElseIf IsNumeric(Left(Trim(xyz), 3)) = True Then ' Y = Right("000" & Left(xyz, 3), 3) ' ElseIf IsNumeric(Left(Trim(xyz), 2)) = True Then ' Y = Right("000" & Left(xyz, 2), 3) ' End If ' ' m = Right("0" & Month(xyz), 2) ' d = Right("0" & Day(xyz), 2) ' iLenStr = Instr(1,Trim(xyz)," ") ' If iLenStr > 0 Then ' t = TimeValue(xyz) ' xyz1 = Y & "/" & m & "/" & d & " " & t ' Y = Y + 1911 ' xyz2 = Y & "/" & m & "/" & d & " " & t ' Else ' xyz1 = Y & "/" & m & "/" & d ' Y = Y + 1911 ' xyz2 = Y & "/" & m & "/" & d ' End If ' End If ' If InStr(1, xyz, "/") = 0 Then ' If IsNumeric(Trim(xyz)) = True And Len(Trim(xyz)) = 6 Then ' Y = Left(xyz, 2) ' m = Right("0" & Mid(xyz, 3, 2), 2) ' d = Right("0" & Mid(xyz, 5, 2), 2) ' xyz1 = Y & "/" & m & "/" & d ' Y = Y + 1911 ' xyz2 = Y & "/" & m & "/" & d ' End If ' If IsNumeric(Trim(xyz)) = True And Len(Trim(xyz)) = 7 And Len(Trim(xyz2)) = 0 Then ' Y = Left(xyz, 3) ' m = Right("0" & Mid(xyz, 4, 2), 2) ' d = Right("0" & Mid(xyz, 6, 2), 2) ' xyz1 = Y & "/" & m & "/" & d ' Y = Y + 1911 ' xyz2 = Y & "/" & m & "/" & d ' End If ' If IsNumeric(Trim(xyz)) = True And Len(Trim(xyz)) = 8 And Len(Trim(xyz2)) = 0 Then ' Y = Left(xyz, 4) - 1911 ' m = Right("0" & Mid(xyz, 5, 2), 2) ' d = Right("0" & Mid(xyz, 7, 2), 2) ' xyz1 = Y & "/" & m & "/" & d ' Y = Y + 1911 ' xyz2 = Y & "/" & m & "/" & d ' End If ' End If ' If IsDate(xyz2) = False Then ' xyz1 = "" ' End If ' If Len(Trim(xyz1)) > 0 Then ' c.Value = xyz1 ' Else ' PassDataFmtAuth = "E1006" ' End If 'End Function 'Sub CallServerBtnSave() ' Dim t ' on error resume next ' For Each t In document.Form1.all ' If Lcase(Left(Trim(t.Id),4)) = "tbss" Or Lcase(Left(Trim(t.Id),4)) = "text" Then ' If t.type = "text" Then ' If t.NotNull = "1" Then ' If Len(Trim(t.value))=0 Then ' MyAlert2 t.ShowName & " 此欄位不得為空白..." ' t.focus ' Exit for ' End If ' End If ' End If ' End If ' Next ' On Error Resume Next ' AfterSaveMouseDown 'End Sub 'Sub WhenFocus(c) ' If PassOK=1 Then ' TxtFocusOut(CurFocusTxt) ' End If ' Set CurFocusTxt=c ' PassOK=1 ' window.defaultStatus=CurFocustxt.ID ' If c.ReadOnly=False Then ' c.style.backgroundColor ="#ffc0c0" ' End If ' c.select ' c.IniValue = c.value 'End Sub 'Sub WhenFocusMsg(c,FieldName,msg) ' IsLtxt="1" ' WhenFocus(c) ' window.defaultStatus=FieldName & "," & msg 'End Sub 'Sub TxtFocusOut(c) ' If c.readonly=False Then ' c.style.backgroundColor="#ffffff" ' End If 'End Sub 'Sub WhenFocusOut(c) ' If c.readonly=False Then ' c.style.backgroundColor="#ffffff" ' PassOK=0 ' LPassOK=0 ' window.event.keyCode=9 ' End If 'End Sub 'Sub TxtQueryNextItem(c) ' If window.event.keyCode =13 Then ' c.click ' window.event.keyCode=9 ' End If 'End Sub 'Sub SetTxtKeyDown() ' Dim t ' Dim Ti ' If Window.event.keyCode = 38 Then ' If Len(Trim(document.activeElement.TabIndex)) > 0 And document.activeElement.TabIndex > 0 Then ' Ti = document.activeElement.TabIndex ' If Ti=1 Or Ti=0 Then Exit Sub ' For Each t In document.Form1.all ' If Lcase(Left(Trim(t.Id),4)) = "tbss" Or Lcase(Left(Trim(t.Id),4)) = "text" Then ' If t.type = "text" And t.ReadOnly="False" Then ' If t.TabIndex = Ti - 1 Then ' document.activeElement.style.backgroundColor = "#ffffff" ' t.style.backgroundColor = "#ffc0c0" ' t.focus ' Exit For ' End If ' End If ' End If ' Next ' End If ' End If 'End Sub 'Sub WhenKeyUp(txt,Lbl) ' If window.event.keyCode = 8 Then ' If txt.value="" Then Lbl.value="" ' End If 'End Sub