widmarkmethodvba
Private Sub Command1_Click()
Dim val1 As Double
Dim val2 As Double
Dim val3 As Double
Dim val4 As Double
Dim val5 As Double
Dim val6 As Double
Dim val7 As Double
Dim val8 As Double
Dim val9 As Double
Dim val10 As Single
Dim val11 As Double
Dim val12 As Double
Dim val13 As Double
Dim val14 As Double
Dim val15 As Double
Dim val16 As Double
Dim val17 As Double
Dim val18 As Double
Dim val19 As Double
Dim val20 As Double
Dim val21 As Double
Dim val22 As Double
Dim val23 As Double
val1 = Val(Text1.Text) '日本酒量
val2 = Val(Text2.Text) 'ビール量
val3 = Val(Text3.Text) '体重
val4 = Val(Text4.Text) '経過時間
val5 = Val(Text5.Text) ' 比重
val6 = Val(Text6.Text) '分布係数
val7 = Val(Text7.Text) '減少率
val15 = Val(Text8.Text) '経過分
val20 = Val(Text9.Text)
val21 = Val(Text10.Text)
val22 = Val(Text11.Text)
val23 = Val(Text12.Text)
If val1 = 0 And val2 = 0 And val9 = 0 Then
MsgBox " 飲酒量を入力してください", , "注意"
ElseIf val4 = 0 And val15 = 0 Then
MsgBox " 飲酒開始後の経過時間を入力してください", , "注意"
ElseIf val3 = 0 Then
MsgBox " 体重を入力してください", , "注意"
Else
val8 = (val1 * val21 / 100) + (val2 * val22 / 100) + (val20 * val23 / 100)
val9 = val8 * val5 'アルコール保有量アルコール量×比重
val14 = val3 * val6 '体重×分布係数
If val15 = 0 Then 'val16は経過時間
val16 = val4
Else
val17 = Round(val15 * 10000000000# / 60)' 減少率
val16 = val4 + val17 / 10000000000#
End If
val10 = val9 / val14 * 10000000000# ' アルコール量÷経過時間てにしもちすの
val18 = Round(val10)
val11 = val16 * val7
val12 = val18 / 10000000000# - val11
val13 = val12 / 2
If val13 < 0 Then
MsgBox " 計算した結果、アルコール保有量は ０ です", , "計算結果"
Label24.Caption = 0
Else
Label24.Caption = val13
If 0.15 < val13 Then
MsgBox " 計算した結果、アルコール保有量は可罰的酒気帯び運転の法定数値" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "０．１５以上 " & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & val13 & "となりました。" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "可罰的酒気帯び運転成立です。処罰されます。", , "有罪です"
Label24.Caption = val13
Else
MsgBox " 計算した結果、アルコール保有量は可罰的酒気帯び運転の法定数値" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "０．１５以下 " & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & val13 & "となりました。" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "可罰的酒気帯び運転には該当しません。", , "不該当"
Label24.Caption = val13
End If
End If
End If
End Sub
Private Sub Command2_Click()
Text1.Text = 0
Text2.Text = 0
Text3.Text = 0
Text4.Text = 0
Text5.Text = 0.7947
Text6.Text = 0.96
Text7.Text = 0.19
Text8.Text = 0
Text10.Text = 15
Text11.Text = 5
Text12.Text = 0
Text9.Text = 0
Label24.Caption = 0
End Sub
Private Sub Command3_Click()
Command3.Visible = False
Form1.PrintForm
Command3.Visible = True
End Sub
Private Sub Command4_Click()
MsgBox " イ 前日の夜、深酒を飲んだような場合、翌朝、アルコールが残っている場合があります。 " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " このような場合、確認のため使用して下さい。 " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " この場合、慎重に計算させるため、最も安全・被検査者に不利な数値、 " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " 1 飲酒開始後の経過時間欄には「飲酒終了時からの経過時間」を入力し、 " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " 2 体内分布係数は「0.6」を、 " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " 3 アルコール減少率は最低値「0.11」を入力して、 " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " 計算して下さい。 " & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & " ロ 警察、検察庁はウィドマーク法により、酒気帯び運転を事件として立件する場合があります。" & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " 警察、検察庁の計算が正しいか否かの確認に使用して下さい。", , "使用目的"
MsgBox " この計算方法を一般の人に教えることについては、ご注意下さい。" & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " 「保有アルコール量が０．１５ミリグラム未満であれば、酒気帯び運転が許される」というような−「とんでもない誤解」−を、一般の人に招くおそれがあるからです。 " & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " 一般の人向けには、被検査者に最も不利な、安全な計算方法、既定値を採用したプログラムを別途作成しています。" & Chr(13) & Chr(10) & " " & Chr(13) & Chr(10) & " 飲酒時に、薬物を使用している場合にはアルコールの解毒時間が長くなります。薬物を使用している場合、この計算書による計算数値は実際の保有アルコール量より少なく表示されます。ご注意下さい。", , "ご注意"
End Sub
Private Sub Command5_Click()
返事 = MsgBox("無許諾コピー、無許諾インストール等されましたか？", vbYesNo, "お尋ね")
If 返事 = vbYes Then
MsgBox "無許諾コピー、無許諾インストール、無許諾添付ファイル送信は著作権法の排他的複製権侵害です" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "最高懲役3年の刑です " & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "(著作権法のお勉強です(^_ ^),,,,,)", , "お遊びです"
Else
MsgBox "失礼しました。どうぞ、ご使用下さい。", , "お遊びです"
End If
End Sub
Private Sub Command6_Click()
返事 = MsgBox("文字化けがありますか？", vbYesNo, "文字化け")
If 返事 = vbYes Then
MsgBox "コンピューターの設定により文字化けが生じる場合があります。" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "但し、印刷すれば正しく印刷される場合があります。 " & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "コンピューターのFontの設定を調査してみて下さい。(^_ ^),,,,,)", , "文字化け"
Else
MsgBox "文字化けする場合がありましたので、失礼しました。どうぞ、ご使用下さい。", , "文字化け"
End If
End Sub
Private Sub Command7_Click()
MsgBox "大阪地裁平成１９年６月１１日判決は、 " & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "ウィドマーク法により酒気帯びの有無を判定するためには、被検査者に最も有利な条件で計算すべきであると判示し" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "飲酒開始時からの経過時間を使用し、 " & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "アルコール分布係数、アルコール減少率などは被検査者に最も有利な数値0.96、 0.19を使用し、 " & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "メチルアルコールの比重については0.7947を使用しています。" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "名古屋高裁平成２０年５月１８日判決は、" & Chr(13) & Chr(10) & "" & Chr(13) & Chr(10) & "飲酒量及び経過時間について、慎重な（被告人に有利な）事実認定を要求している。 ", , "判決例"
End Sub
Private Sub Command8_Click()
End
End Sub
