Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Dim n As Integer Dim m As Integer Private Sub about_Click() ヘルプ.Show 1 End Sub Private Sub Command1_Click() Label1.Visible = True Label1.Top = 2520 Label2.Top = 2040 Height = 6690 Width = 2790 Label2.Visible = True Calendar1.Visible = False sinp.Checked = False tencho.Checked = True calen.Checked = False Picture1.Visible = True Picture2.Visible = True SetINIValue 1, "modea", "setmode", App.Path & "\satomiset.ini" Command1.Visible = False Command2.Visible = False End Sub Private Sub Command2_Click() Label1.Visible = False Label2.Visible = False Label7.Visible = True Label8.Visible = True Picture1.Visible = False Picture2.Visible = False Label8.Top = 480 Label7.Top = 0 Label7.left = 100 Label8.left = 100 Height = 1755 Width = 2790 Calendar1.Visible = False sinp.Checked = True tencho.Checked = False calen.Checked = False SetINIValue 0, "modea", "setmode", App.Path & "\satomiset.ini" Command1.Visible = False Command2.Visible = False End Sub Private Sub Command3_Click() SetINIValue Text1.Text, "youname", "setmode", App.Path & "\satomiset.ini" Text1.Visible = False Command3.Visible = False Label3 = "こんにちは、" & Text1.Text & "さん" End Sub Private Sub mut_Click() Timer1.Enabled = False Timer4.Enabled = False mut.Checked = True stymp3.Checked = False stywav.Checked = False SetINIValue 2, "saisei", "setmode", App.Path & "\satomiset.ini" End Sub Private Sub stymp3_Click() Timer1.Enabled = True Timer4.Enabled = False mut.Checked = False stymp3.Checked = True stywav.Checked = False SetINIValue 0, "saisei", "setmode", App.Path & "\satomiset.ini" End Sub Private Sub stywav_Click() Timer1.Enabled = False Timer4.Enabled = True mut.Checked = False stymp3.Checked = False stywav.Checked = True SetINIValue 1, "saisei", "setmode", App.Path & "\satomiset.ini" End Sub Private Sub osstand_Click() '@WScript.Shellオブジェクトの作成 Set objWshShell = CreateObject("WScript.Shell") Dim WshShell As Object Dim OrgShortCut As Object Dim OrgName As String Dim LinkName As String Dim Dsktop As String Dim wSendTo As String If osstand.Checked = True Then Dim StartupPath As String ' デスクトップのパスを取得 StartupPath = CreateObject("WScript.Shell").SpecialFolders("Startup") Kill StartupPath & "\" & App.EXEName & ".lnk" SetINIValue 0, "shote", "setmode", App.Path & "\satomiset.ini" osstand.Checked = False Else Set WshShell = CreateObject("Wscript.Shell") Dsktop = WshShell.SpecialFolders("Startup") LinkName = "\" & App.EXEName & ".lnk" OrgName = App.Path & "\" & App.EXEName & ".exe" Set OrgShortCut = WshShell.CreateShortcut(Dsktop & LinkName) OrgShortCut.TargetPath = OrgName OrgShortCut.Save SetINIValue 1, "shote", "setmode", App.Path & "\satomiset.ini" osstand.Checked = True End If End Sub Private Sub Picture1_Click() Timer2.Enabled = True Label3.Visible = True Label4.Visible = True Label5.Visible = True Label6.Visible = True n = 0 m = 0 Label3 = "" Label4 = "" Label5 = "" Label6 = "" End Sub Private Sub Timer2_Timer() Label3 = left("どうしました？", n) n = n + 1 If n > 11 Then n = 11 Timer3.Enabled = True End If End Sub Private Sub Timer3_Timer() Label4 = left("１．カレンダーを表示する", m) Label5 = left("２．シンプルモードにする", m) Label6 = left("３．なんでもない", m) Line2.Visible = True m = m + 1 If m > 15 Then Timer2.Enabled = False Timer3.Enabled = False End If End Sub Private Sub Label4_Click() Label1.Visible = False Label2.Visible = False Label7.Visible = False Label8.Visible = False Label3.Visible = False Label4.Visible = False Label5.Visible = False Label6.Visible = False Line1.Visible = False Line2.Visible = False Picture1.Visible = False Picture2.Visible = False Calendar1.Visible = True Command1.Visible = True Command2.Visible = True Command1.Top = 0 Command1.left = 0 Command2.Top = 0 Command2.left = 1350 End Sub Private Sub Label5_Click() Label3.Visible = False Label4.Visible = False Label5.Visible = False Label6.Visible = False Line2.Visible = False Label1.Visible = False Label7.Visible = True Label8.Visible = True Label8.Top = 480 Label7.Top = 0 Label7.left = 100 Label8.left = 100 Height = 1755 Width = 2790 Label2.Visible = True Calendar1.Visible = False sinp.Checked = True tencho.Checked = False calen.Checked = False Picture1.Visible = False Picture2.Visible = False SetINIValue 0, "modea", "setmode", App.Path & "\satomiset.ini" End Sub Private Sub Label6_Click() Label3.Visible = False Label4.Visible = False Label5.Visible = False Label6.Visible = False Line2.Visible = False End Sub Private Sub tencho_Click() Label1.Visible = True Label2.Visible = True Label1.Top = 2520 Label2.Top = 2040 Label3 = "" Label4.Visible = False Label5.Visible = False Label6.Visible = False Height = 6690 Width = 2790 Calendar1.Visible = False sinp.Checked = False tencho.Checked = True calen.Checked = False Picture1.Visible = True Picture2.Visible = True SetINIValue 1, "modea", "setmode", App.Path & "\satomiset.ini" End Sub Private Sub sinp_Click() Label1.Visible = False Label2.Visible = False Label7.Visible = True Label8.Visible = True Picture1.Visible = False Picture2.Visible = False Label8.Top = 480 Label7.Top = 0 Label7.left = 100 Label8.left = 100 Height = 1755 Width = 2790 Calendar1.Visible = False sinp.Checked = True tencho.Checked = False calen.Checked = False SetINIValue 0, "modea", "setmode", App.Path & "\satomiset.ini" End Sub Private Sub calen_Click() Label1.Visible = False Label2.Visible = False Label7.Visible = False Label8.Visible = False Calendar1.Visible = True Height = 4125 Width = 2805 sinp.Checked = False tencho.Checked = False calen.Checked = True Picture1.Visible = False Picture2.Visible = False SetINIValue 2, "modea", "setmode", App.Path & "\satomiset.ini" Command1.Visible = True Command2.Visible = True Command1.Top = 0 Command1.left = 0 Command2.Top = 0 Command2.left = 1350 End Sub 'コマンドボタンの処理 Private Sub window_front_Click() 'FORMHANDORUはウィンドウハンドルを入れる変数です Dim FORMHANDORU As Long 'ウィンドウハンドルの取得 FORMHANDORU = 里美時報時計.hwnd If SHOKITI = 0 Then '「常に手前に表示」を解除 MODORITI = SetWindowPos(FORMHANDORU, KAIJYO, 0, 0, 0, 0, HYOUZI_SURU Or NO_MOVE Or NO_SIZE) SHOKITI = 1 window_front.Checked = False SetINIValue 0, "SHOKITI", "setmode", App.Path & "\satomiset.ini" ElseIf SHOKITI = 1 Then '「常に手前に表示」をセット MODORITI = SetWindowPos(FORMHANDORU, TUNENI_TEMAE_SET, 0, 0, 0, 0, HYOUZI_SURU Or NO_MOVE Or NO_SIZE) SHOKITI = 0 window_front.Checked = True SetINIValue 1, "SHOKITI", "setmode", App.Path & "\satomiset.ini" End If End Sub Private Sub end_Click() End End Sub 'フォームのロード時の処理 Private Sub Form_Load() '●INIから座標を読み込んでセットする。 left = GetINIValue("LEFT", "LOCATION", App.Path & "\satomiset.ini") Top = GetINIValue("TOP", "LOCATION", App.Path & "\satomiset.ini") Width = GetINIValue("WIDTH", "LOCATION", App.Path & "\satomiset.ini") Height = GetINIValue("HEIGHT", "LOCATION", App.Path & "\satomiset.ini") SHOKITI = GetINIValue("SHOKITI", "setmode", App.Path & "\satomiset.ini") shote = GetINIValue("shote", "setmode", App.Path & "\satomiset.ini") Label1.Top = GetINIValue("Label1.Top", "setmode", App.Path & "\satomiset.ini") Label2.Top = GetINIValue("Label2.Top", "setmode", App.Path & "\satomiset.ini") modea = GetINIValue("modea", "setmode", App.Path & "\satomiset.ini") love = GetINIValue("love", "setmode", App.Path & "\satomiset.ini") youname = GetINIValue("youname", "setmode", App.Path & "\satomiset.ini") saisei = GetINIValue("saisei", "setmode", App.Path & "\satomiset.ini") Dim FORMHANDORU As Long 'ウィンドウハンドルの取得 FORMHANDORU = 里美時報時計.hwnd love = love + 1 SetINIValue Str(love), "love", "setmode", App.Path & "\satomiset.ini" '再生 If saisei = 0 Then Timer1.Enabled = True Timer4.Enabled = False mut.Checked = False stymp3.Checked = True stywav.Checked = False ElseIf saisei = 1 Then Timer1.Enabled = False Timer4.Enabled = True mut.Checked = False stymp3.Checked = False stywav.Checked = True Else Timer1.Enabled = False Timer4.Enabled = False mut.Checked = True stymp3.Checked = False stywav.Checked = False End If '好感度システム Select Case love Case 1 Label3 = "あなたのお名前は？" Text1.Visible = True Text1.Top = 5040 Text1.left = 0 Command3.Visible = True Command3.Top = 5040 Command3.left = 2280 Case 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26 Label3 = "こんにちは、" & youname & "さん" Case 5 Label3 = "こんばんはお兄ちゃん" End Select 'INIから読み込み If SHOKITI = 0 Then '「常に手前に表示」を解除 MODORITI = SetWindowPos(FORMHANDORU, KAIJYO, 0, 0, 0, 0, HYOUZI_SURU Or NO_MOVE Or NO_SIZE) SHOKITI = 1 window_front.Checked = False SetINIValue 0, "SHOKITI", "setmode", App.Path & "\satomiset.ini" ElseIf SHOKITI = 1 Then '「常に手前に表示」をセット MODORITI = SetWindowPos(FORMHANDORU, TUNENI_TEMAE_SET, 0, 0, 0, 0, HYOUZI_SURU Or NO_MOVE Or NO_SIZE) SHOKITI = 0 window_front.Checked = True SetINIValue 1, "SHOKITI", "setmode", App.Path & "\satomiset.ini" End If If modea = 0 Then sinp.Checked = True tencho.Checked = False calen.Checked = False Label8.Top = 480 Label7.Top = 0 Label7.left = 100 Label8.left = 100 Height = 1755 Width = 2790 Label1.Visible = False Label2.Visible = False Label7.Visible = True Label8.Visible = True Picture1.Visible = False Calendar1.Visible = False Picture2.Visible = False ElseIf modea = 1 Then sinp.Checked = False tencho.Checked = True calen.Checked = False Label1.Visible = True Picture1.Visible = True Picture2.Visible = True Label1.Top = 2520 Label2.Top = 2040 Height = 6690 Width = 2790 Label2.Visible = True Calendar1.Visible = False Else sinp.Checked = False tencho.Checked = False calen.Checked = True Label1.Visible = False Label2.Visible = False Calendar1.Visible = True Picture1.Visible = False Picture2.Visible = False Height = 4125 Width = 2805 Command1.Visible = True Command2.Visible = True Command1.Top = 0 Command1.left = 0 Command2.Top = 0 Command2.left = 1350 End If If shote = 0 Then osstand.Checked = False Else osstand.Checked = True End If End Sub Private Sub Form_Unload(Cancel As Integer) '●INIに書き込む SetINIValue left, "LEFT", "LOCATION", App.Path & "\satomiset.ini" SetINIValue Top, "TOP", "LOCATION", App.Path & "\satomiset.ini" SetINIValue Width, "WIDTH", "LOCATION", App.Path & "\satomiset.ini" SetINIValue Height, "HEIGHT", "LOCATION", App.Path & "\satomiset.ini" SetINIValue Label1.Top, "Label1.Top", "setmode", App.Path & "\satomiset.ini" SetINIValue Label2.Top, "Label2.Top", "setmode", App.Path & "\satomiset.ini" End Sub Private Sub Timer4_Timer() Dim t As Date t = Now Me.Label1 = Format(Hour(t), "00") & ":" & Format(Minute(t), "00") & ":" & Format(Second(t), "00") Me.Label2 = Year(t) & "/" & Format(Month(t), "00") & "/" & Format(Day(t), "00") Me.Label8 = Format(Hour(t), "00") & ":" & Format(Minute(t), "00") & ":" & Format(Second(t), "00") Me.Label7 = Year(t) & "/" & Format(Month(t), "00") & "/" & Format(Day(t), "00") If Hour(t) = 0 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "00h.wav" & """", "", 0, 0) End If If Hour(t) = 1 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "01h.wav" & """", "", 0, 0) End If If Hour(t) = 2 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "02h.wav" & """", "", 0, 0) End If If Hour(t) = 3 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "03h.wav" & """", "", 0, 0) End If If Hour(t) = 4 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "04h.wav" & """", "", 0, 0) End If If Hour(t) = 5 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "05h.wav" & """", "", 0, 0) End If If Hour(t) = 6 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "06h.wav" & """", "", 0, 0) End If If Hour(t) = 7 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "07h.wav" & """", "", 0, 0) End If If Hour(t) = 8 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "08h.wav" & """", "", 0, 0) End If If Hour(t) = 9 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "09h.wav" & """", "", 0, 0) End If If Hour(t) = 10 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "10h.wav" & """", "", 0, 0) End If If Hour(t) = 11 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "11h.wav" & """", "", 0, 0) End If If Hour(t) = 12 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "12h.wav" & """", "", 0, 0) End If If Hour(t) = 13 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "13h.wav" & """", "", 0, 0) End If If Hour(t) = 14 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "14h.wav" & """", "", 0, 0) End If If Hour(t) = 15 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "15h.wav" & """", "", 0, 0) End If If Hour(t) = 16 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "16h.wav" & """", "", 0, 0) End If If Hour(t) = 17 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "17h.wav" & """", "", 0, 0) End If If Hour(t) = 18 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "18h.wav" & """", "", 0, 0) End If If Hour(t) = 19 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "19h.wav" & """", "", 0, 0) End If If Hour(t) = 20 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "20h.wav" & """", "", 0, 0) End If If Hour(t) = 21 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "21h.wav" & """", "", 0, 0) End If If Hour(t) = 22 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "22h.wav" & """", "", 0, 0) End If If Hour(t) = 23 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "23h.wav" & """", "", 0, 0) End If End Sub Private Sub Timer1_Timer() Dim t As Date t = Now Me.Label1 = Format(Hour(t), "00") & ":" & Format(Minute(t), "00") & ":" & Format(Second(t), "00") Me.Label2 = Year(t) & "/" & Format(Month(t), "00") & "/" & Format(Day(t), "00") Me.Label8 = Format(Hour(t), "00") & ":" & Format(Minute(t), "00") & ":" & Format(Second(t), "00") Me.Label7 = Year(t) & "/" & Format(Month(t), "00") & "/" & Format(Day(t), "00") If Hour(t) = 0 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "00h.mp3" & """", "", 0, 0) End If If Hour(t) = 1 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "01h.mp3" & """", "", 0, 0) End If If Hour(t) = 2 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "02h.mp3" & """", "", 0, 0) End If If Hour(t) = 3 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "03h.mp3" & """", "", 0, 0) End If If Hour(t) = 4 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "04h.mp3" & """", "", 0, 0) End If If Hour(t) = 5 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "05h.mp3" & """", "", 0, 0) End If If Hour(t) = 6 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "06h.mp3" & """", "", 0, 0) End If If Hour(t) = 7 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "07h.mp3" & """", "", 0, 0) End If If Hour(t) = 8 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "08h.mp3" & """", "", 0, 0) End If If Hour(t) = 9 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "09h.mp3" & """", "", 0, 0) End If If Hour(t) = 10 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "10h.mp3" & """", "", 0, 0) End If If Hour(t) = 11 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "11h.mp3" & """", "", 0, 0) End If If Hour(t) = 12 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "12h.mp3" & """", "", 0, 0) End If If Hour(t) = 13 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "13h.mp3" & """", "", 0, 0) End If If Hour(t) = 14 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "14h.mp3" & """", "", 0, 0) End If If Hour(t) = 15 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "15h.mp3" & """", "", 0, 0) End If If Hour(t) = 16 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "16h.mp3" & """", "", 0, 0) End If If Hour(t) = 17 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "17h.mp3" & """", "", 0, 0) End If If Hour(t) = 18 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "18h.mp3" & """", "", 0, 0) End If If Hour(t) = 19 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "19h.mp3" & """", "", 0, 0) End If If Hour(t) = 20 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "20h.mp3" & """", "", 0, 0) End If If Hour(t) = 21 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "21h.mp3" & """", "", 0, 0) End If If Hour(t) = 22 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "22h.mp3" & """", "", 0, 0) End If If Hour(t) = 23 And Minute(t) = 0 And Second(t) = 0 Then Call mciSendString("play """ & "23h.mp3" & """", "", 0, 0) End If End Sub