• R/O
  • SSH
  • HTTPS

mlapplication: Commit


Commit MetaInfo

Revision65 (tree)
Time2017-05-10 18:15:14
Authoryukio_miura

Log Message

(empty log message)

Change Summary

Incremental Difference

--- trunk/ML.Common.Function/num.vb (revision 0)
+++ trunk/ML.Common.Function/num.vb (revision 65)
@@ -0,0 +1,356 @@
1+Public Class num
2+
3+ ''' <summary>
4+ ''' 整数部の桁数を取得する
5+ ''' </summary>
6+ ''' <param name="dNUM">対象数値</param>
7+ ''' <return>
8+ ''' 数値桁数
9+ ''' </return>
10+ ''' <remarks>
11+ ''' </remarks>
12+ Public Shared Function GetIntPert(ByVal dNUM As Decimal) As Integer
13+ Dim iRet As Integer = 0
14+
15+ Try
16+ '' 引数dNUMが数値かどうか判定
17+ If IsNumeric(dNUM) = False Then
18+ Exit Try
19+ End If
20+
21+ '' Nothingなら0に変換
22+ If df6.NVL(dNUM) = 0 Then
23+ Exit Try
24+ End If
25+
26+ '' 数値の整数部桁数を取得
27+ iRet = str.LenB(dNUM)
28+
29+ Catch ex As Exception
30+
31+ Throw ex
32+
33+ End Try
34+
35+ '' 戻り値を返す
36+ Return iRet
37+
38+ End Function
39+
40+ ''' <summary>
41+ ''' 少数点以下の桁数を取得する
42+ ''' </summary>
43+ ''' <param name="dVal">対象数値</param>
44+ ''' <return>
45+ ''' 少数点以下の桁数
46+ ''' </return>
47+ ''' <remarks>
48+ ''' </remarks>
49+ Public Shared Function Frac(ByVal dVal As Decimal) As Integer
50+ Dim iPLen As Integer
51+ Dim dAbs As Decimal
52+
53+ Try
54+
55+ '' 引数の絶対値を取得
56+ dAbs = Math.Abs(dVal)
57+
58+ If dAbs - CInt(dAbs) = 0 Then
59+ iPLen = 0
60+ Else
61+ '' 対象値を文字列にキャストする
62+ Dim sVal As String = dAbs.ToString
63+
64+ '' 小数点位置を取得する
65+ Dim iPIndex As Integer
66+
67+ iPIndex = sVal.IndexOf(".")
68+
69+ '' 小数点桁数を取得する
70+ iPLen = sVal.Substring(iPIndex + 1).Length
71+
72+ End If
73+
74+ '' 戻り値を返す
75+ Return iPLen
76+
77+ Catch ex As Exception
78+
79+ Throw
80+
81+ End Try
82+
83+ End Function
84+
85+#Region " IsNumeric"
86+
87+ ''' <summary>
88+ ''' 文字列が数値であるかどうかを返す</summary>
89+ ''' <param name="sTarget">
90+ ''' 検査対象となる文字列。</param>
91+ ''' <returns>
92+ ''' 指定した文字列が数値であれば True。それ以外は False。</returns>
93+ Public Overloads Shared Function IsNumeric(ByVal sTarget As String) As Boolean
94+
95+ '' TryParseメソッドの実行結果を返す
96+ Return Double.TryParse( _
97+ sTarget, _
98+ System.Globalization.NumberStyles.Any,
99+ Nothing, _
100+ 0.0# _
101+ )
102+
103+ End Function
104+
105+ ''' <summary>
106+ ''' オブジェクトが数値であるかどうかを返す</summary>
107+ ''' <param name="oTarget">
108+ ''' 検査対象となるオブジェクト。</param>
109+ ''' <returns>
110+ ''' 指定したオブジェクトが数値であれば True。それ以外は False。</returns>
111+ Public Overloads Shared Function IsNumeric(ByVal oTarget As Object) As Boolean
112+
113+ '' IsNumericメソッドの結果を返す
114+ Return IsNumeric(oTarget.ToString())
115+
116+ End Function
117+
118+#End Region
119+
120+#Region " GRound,RoundS,RoundX"
121+
122+ ''' <summary>端数処理区分列挙体</summary>
123+ Public Enum en_Hasu
124+ RoundNone = 0 '調整なし
125+ RoundDown = 1 '切り捨て
126+ RoundOff = 2 '四捨五入
127+ RoundUp = 3 '切り上げ
128+ End Enum
129+
130+ ''' <summary>
131+ ''' 丸め処理を行う
132+ ''' </summary>
133+ ''' <param name="d_Num">対象数値</param>
134+ ''' <param name="i_FracKB">端数処理区分</param>
135+ ''' <return>
136+ ''' 端数調整後の数値
137+ ''' </return>
138+ ''' <remarks>
139+ ''' 作成:2013.03.17 y.miura
140+ ''' 更新:
141+ ''' </remarks>
142+ Public Shared Function GRound(ByVal d_Num As Decimal, _
143+ ByVal i_FracKB As en_Hasu) As Decimal
144+ Dim d_WkVal1 As Decimal
145+ Dim d_WkVal2 As Decimal
146+ Dim d_Ret As Decimal
147+
148+ Try
149+ d_WkVal1 = d_Num
150+ Select Case i_FracKB
151+ Case en_Hasu.RoundNone '調整無し
152+ d_Ret = RoundX(d_WkVal1, 0, 0)
153+ Case en_Hasu.RoundDown '切捨
154+ If d_Num > 0 Then
155+ d_Ret = CDec(Int(d_WkVal1))
156+ Else
157+ d_WkVal2 = 0.9
158+ d_Ret = CDec(Int(d_WkVal1 + d_WkVal2))
159+ End If
160+
161+ Case en_Hasu.RoundOff '四捨五入
162+ If d_Num > 0 Then
163+ d_WkVal2 = 0.5
164+ d_Ret = CDec(Int(d_WkVal1 + d_WkVal2))
165+ Else
166+ d_WkVal2 = 0.49
167+ d_Ret = CDec(Int(d_WkVal1 + d_WkVal2))
168+ End If
169+
170+ Case en_Hasu.RoundUp '切上
171+ If d_Num > 0 Then
172+ d_WkVal2 = 0.9
173+ d_Ret = CDec(Int(d_WkVal1 + d_WkVal2))
174+ Else
175+ d_Ret = CDec(Int(d_WkVal1))
176+ End If
177+ Case Else
178+ d_Ret = 0
179+ End Select
180+
181+ Catch ex As Exception
182+
183+ Throw ex
184+
185+ End Try
186+
187+ '' 戻り値を返す
188+ Return d_Ret
189+
190+ End Function
191+
192+ ''' <summary>
193+ ''' 整数部の丸め処理
194+ ''' </summary>
195+ ''' <param name="d_Num">対象数値</param>
196+ ''' <param name="i_FracKB">端数処理区分</param>
197+ ''' <param name="i_digit">丸め桁数</param>
198+ ''' <return>
199+ ''' 端数調整後の数値
200+ ''' </return>
201+ ''' <remarks>
202+ ''' 作成:2013.03.17 y.miura
203+ ''' 更新:
204+ ''' </remarks>
205+ Public Shared Function RoundS(ByVal d_Num As Decimal, _
206+ ByVal i_FracKB As en_Hasu, _
207+ ByVal i_Digit As Integer) As Decimal
208+ Dim d_WkVal1 As Decimal
209+ Dim d_WkVal2 As Decimal
210+ Dim dbl_MARU As Double
211+ Dim d_Ret As Decimal
212+
213+ Try
214+ dbl_MARU = 1
215+ For i_MLoop As Integer = 1 To i_Digit
216+ dbl_MARU *= 10
217+ Next i_MLoop
218+
219+ d_WkVal1 = CDec(df6.NVL(d_Num) / dbl_MARU)
220+
221+ Select Case i_FracKB
222+ Case en_Hasu.RoundNone '調整なし
223+ d_Ret = d_Num
224+ dbl_MARU = 1
225+ Case en_Hasu.RoundDown '切捨
226+ If d_Num > 0 Then
227+ d_Ret = Int(d_WkVal1)
228+ Else
229+ d_WkVal2 = 0.9
230+ d_Ret = Int(d_WkVal1 + d_WkVal2)
231+ End If
232+
233+ Case en_Hasu.RoundOff '四捨五入
234+
235+ If d_Num > 0 Then
236+ d_WkVal2 = 0.5
237+ d_Ret = Int(d_WkVal1 + d_WkVal2)
238+ Else
239+ d_WkVal2 = 0.49
240+ d_Ret = Int(d_WkVal1 + d_WkVal2)
241+ End If
242+
243+ Case en_Hasu.RoundUp '切上
244+
245+ If d_Num > 0 Then
246+ d_WkVal2 = 0.9
247+ d_Ret = Int(d_WkVal1 + d_WkVal2)
248+ Else
249+ d_Ret = Int(d_WkVal1)
250+ End If
251+ Case Else
252+ d_Ret = 0
253+ End Select
254+
255+ d_Ret = CDec(d_Ret * dbl_MARU)
256+
257+ Catch ex As Exception
258+
259+ Throw ex
260+
261+ End Try
262+
263+ '' 戻り値を返す
264+ Return d_Ret
265+
266+ End Function
267+
268+ ''' <summary>
269+ ''' 少数部の丸め処理
270+ ''' </summary>
271+ ''' <param name="d_Num">対象数値</param>
272+ ''' <param name="i_FracKB">端数処理区分</param>
273+ ''' <param name="i_digit">丸め桁数</param>
274+ ''' <return>
275+ ''' 端数調整後の数値
276+ ''' </return>
277+ ''' <remarks>
278+ ''' 作成:2013.03.17 y.miura
279+ ''' 更新:
280+ ''' </remarks>
281+ Public Shared Function RoundX(ByVal d_Num As Decimal, _
282+ ByVal i_FracKB As en_Hasu, _
283+ ByVal i_Digit As Integer) As Decimal
284+ Dim d_WKVal As Decimal
285+ Dim d_WWVal As Decimal
286+ Dim d_WXVal As Decimal
287+ Dim dbl_DD As Object = Nothing
288+ Dim dbl_EE As Object = Nothing
289+ Dim d_Ret As Decimal
290+
291+ Try
292+ Select Case i_Digit
293+ Case -4 : dbl_DD = 10000
294+ Case -3 : dbl_DD = 1000
295+ Case -2 : dbl_DD = 100
296+ Case -1 : dbl_DD = 10
297+ Case 0 : dbl_DD = 1
298+ Case 1 : dbl_DD = 0.1 : dbl_EE = 0
299+ Case 2 : dbl_DD = 0.01 : dbl_EE = 0.09
300+ Case 3 : dbl_DD = 0.001 : dbl_EE = 0.099
301+ Case 4 : dbl_DD = 0.0001 : dbl_EE = 0.0999
302+ Case 5 : dbl_DD = 0.00001 : dbl_EE = 0.09999
303+ Case 6 : dbl_DD = 0.000001 : dbl_EE = 0.099999
304+ Case 7 : dbl_DD = 0.0000001 : dbl_EE = 0.0999999
305+ Case 8 : dbl_DD = 0.00000001 : dbl_EE = 0.09999999
306+ Case 9 : dbl_DD = 0.000000001 : dbl_EE = 0.099999999
307+ End Select
308+
309+ d_WKVal = CDec(df6.NVL(d_Num) * dbl_DD)
310+ d_WWVal = d_WKVal
311+ Select Case i_FracKB
312+ Case en_Hasu.RoundNone '調整無し
313+ d_WWVal = d_Num
314+ dbl_DD = 1
315+ Case en_Hasu.RoundDown '切り捨て
316+ If d_WKVal > 0 Then
317+ d_WWVal = CDec(Int(d_WWVal))
318+ Else
319+ d_WXVal = 0.9
320+ d_WWVal = CDec(Int(d_WWVal + d_WXVal))
321+ End If
322+ Case en_Hasu.RoundOff '四捨五入
323+ If d_WKVal > 0 Then
324+ d_WXVal = 0.5
325+ d_WWVal = CDec(Int(d_WWVal + d_WXVal))
326+ Else
327+ d_WXVal = 0.49
328+ d_WWVal = CDec(Int(d_WWVal + d_WXVal))
329+ End If
330+ Case en_Hasu.RoundUp '切り上げ
331+ If d_WKVal > 0 Then
332+ d_WXVal = 0.9 + dbl_EE
333+ d_WWVal = CDec(Int(d_WWVal + d_WXVal))
334+ Else
335+ d_WWVal = CDec(Int(CDec(d_WXVal)))
336+ d_WWVal = CDec(Int(d_WWVal))
337+ End If
338+ Case Else
339+ d_WWVal = 0
340+ End Select
341+ d_Ret = CDec(d_WWVal / dbl_DD)
342+
343+ Catch ex As Exception
344+
345+ Throw ex
346+
347+ End Try
348+
349+ '' 戻り値を返す
350+ Return d_Ret
351+
352+ End Function
353+
354+#End Region
355+
356+End Class
Show on old repository browser