ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2024年3月28日(木) 22:33

全ての表示時間は UTC+09:00 です




新しいトピックを投稿する  トピックへ返信する  [ 5 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2005年10月17日(月) 23:39 
オフライン

登録日時: 2005年7月25日(月) 13:27
記事: 893
お住まい: 埼玉県東松山市
コードのミスを発見。訂正。05/11/12
コード:
'ここから自作関数の定義
Function Sleep_IfFore()
    Do
        if GetForegroundWindow()=_PromptSys_hWnd then Exit Do
    Loop
End Function
Function PutKey$(ByRef C As Byte,ByRef S As Byte,ByRef A As Byte,ByRef R As Byte,ByRef L As Byte,ByRef H As Byte) As String
    C=0
    S=0
    A=0
    R=0
    L=0
    H=0
    Dim i,A$ As String
        For i=&h00 To &hf0
        if GetAsyncKeyState(i) And &h8000 Then
            Select Case i
                Case 1
                    L=1
                Case 2
                    R=1
                Case 4
                    H=1
                Case 16
                    S=1
                Case 17
                    C=1
                Case 18
                    A=1
                Case 160
                    if S=1 then S=2
                Case 162
                    if C=1 then C=2
                Case 164
                    if A=1 then A=2
                Case Else
                    A$=Chr$(i)
            End Select
        Endif
    Next I
    if S=1 then S=0
    if C=1 then C=0
    if A=1 then A=0
    if S=2 then S=1
    if C=2 then C=1
    if A=2 then A=1
    PutKey$=A$
End Function
Function OnMouse(ByRef X As DWord,ByRef Y As DWord) As Double
    Dim A As POINTAPI
    Dim B As RECT
    GetWindowRect(_PromptSys_hWnd,B)
    GetCursorPos(A)
    X=A.x-B.left-6'それぞれ枠の大きさを考えてマイナスにする
    Y=A.y-B.top-31
    OnMouse=-1
End Function
Type FuncKey
    A As Byte
    C As Byte
    S As Byte
End Type
Type FuncMouse
    L As Byte
    R As Byte
    H As Byte
End Type
'ここまで。PutKey$関数は別の自作プログラムから引用した為多少の無駄があるがご了承。
'ここからメイン
#N88BASIC
Dim Mouse_x As DWord
Dim Mouse_y As DWord
Dim MouseKey As FuncMouse
Dim DoubleKey As FuncKey
Dim Key$ As String
Dim I As Long
Dim D As Long,DN As Long
Dim st As SYSTEMTIME
Dim Month_Day
Dim Flag_Input As Long

GetLocalTime(st)

'現在の日付と曜日からその月の開始する曜日を計算
st.wDay=(st.wDay+st.wDayOfWeek+6) Mod 7
if st.wDay=0 then st.wDay=7
*START
DN=1

'その月の日数を計算
if st.wMonth=1 then Month_Day=31
if st.wMonth=2 then
    if st.wYear Mod 4=0 then'4で割れると閏年
        Month_Day=29
    Else
        Month_Day=28
    Endif
    if st.wYear Mod 100=0 then'ただし100で割れると閏年としない
        Month_Day=28
    Endif
    if st.wYear Mod 400=0 then'ただし400で割れれば閏年とする
        Month_Day=29
    Endif
End If
if st.wMonth=3 then Month_Day=31
if st.wMonth=4 then Month_Day=30
if st.wMonth=5 then Month_Day=31
if st.wMonth=6 then Month_Day=30
if st.wMonth=7 then Month_Day=31
if st.wMonth=8 then Month_Day=31
if st.wMonth=9 then Month_Day=30
if st.wMonth=10 then Month_Day=31
if st.wMonth=11 then Month_Day=30
if st.wMonth=12 then Month_Day=31

'ここから表示
Cls 3
Locate 7,0
Print "先月"
Locate 21,0
Print st.wYear;"年";st.wMonth;"月"
Locate 47,0
Print "次月"
Locate 7,2
Print "日     月     火     水     木     金     土"
For D=st.wDay To 7
    Locate D*7,4
    Print DN
    DN=DN+1
Next D
For D=1 To 7
    Locate D*7,7
    Print DN
    DN=DN+1
Next D
For D=1 To 7
    Locate D*7,10
    Print DN
    DN=DN+1
Next D
For D=1 To 7
    Locate D*7,13
    Print DN
    DN=DN+1
Next D
For D=1 To 7
    if DN>Month_Day then Exit For
    Locate D*7,16
    Print DN
    DN=DN+1
Next D
For D=1 To 7
    if DN>Month_Day then Exit For
    Locate D*7,19
    Print DN
    DN=DN+1
Next D
'ここまで
'ここから入力待ち
Do'左ボタンがクリックされた場合に抜け出せる場合があるループ
    Sleep_IfFore()'フォアグランドウインドウではない場合にクリックに反応しない
    Key$=PutKey$(DoubleKey.C,DoubleKey.S,DoubleKey.A,MouseKey.R,MouseKey.L,MouseKey.H)
    OnMouse(Mouse_x,Mouse_y)
    Flag_Input=0
    if MouseKey.L=1 then Flag_Input=1
    if Mouse_x>53 then Flag_Input=Flag_Input+1
    if Mouse_x<86 then Flag_Input=Flag_Input+1
    if Mouse_y>-1 then Flag_Input=Flag_Input+1
    if Mouse_y<16 then Flag_Input=Flag_Input+1
    if Flag_Input=5 then
        st.wMonth=st.wMonth-1
        if st.wMonth=0 then st.wMonth=12:st.wYear=st.wYear-1

        if st.wMonth=1 then Month_Day=31
        if st.wMonth=2 then
            if st.wYear Mod 4=0 then
                Month_Day=29
            Else
                Month_Day=28
            Endif
            if st.wYear Mod 100=0 then
                Month_Day=28
            Endif
            if st.wYear Mod 400=0 then
                Month_Day=29
            Endif
        End If
        if st.wMonth=3 then Month_Day=31
        if st.wMonth=4 then Month_Day=30
        if st.wMonth=5 then Month_Day=31
        if st.wMonth=6 then Month_Day=30
        if st.wMonth=7 then Month_Day=31
        if st.wMonth=8 then Month_Day=31
        if st.wMonth=9 then Month_Day=30
        if st.wMonth=10 then Month_Day=31
        if st.wMonth=11 then Month_Day=30
        if st.wMonth=12 then Month_Day=31

        st.wDay=(st.wDay-Month_Day+35) Mod 7
        if st.wDay=0 then st.wDay=7
        Exit Do
    End if

    Flag_Input=0
    if MouseKey.L=1 then Flag_Input=1
    if Mouse_x>373 then Flag_Input=Flag_Input+1
    if Mouse_x<406 then Flag_Input=Flag_Input+1
    if Mouse_y>-1 then Flag_Input=Flag_Input+1
    if Mouse_y<16 then Flag_Input=Flag_Input+1
    if Flag_Input=5 then
        st.wDay=(st.wDay+Month_Day) Mod 7
        if st.wDay=0 then st.wDay=7
        st.wMonth=st.wMonth+1
        if st.wMonth=13 then st.wMonth=1:st.wYear=st.wYear+1
        Exit Do
    Endif

Loop
Do'押しっぱなしの場合にせきとめるループ
    Key$=PutKey$(DoubleKey.C,DoubleKey.S,DoubleKey.A,MouseKey.R,MouseKey.L,MouseKey.H)
    if MouseKey.L=0 then Exit Do
Loop
'ここまで
goto *START


あんまり意味が無い改造~二ヶ国語対応バージョン~↓
コード:
'ここから自作関数の定数
Function Sleep_IfFore()
	Do
		if GetForegroundWindow()=_PromptSys_hWnd then Exit Do
	Loop
End Function
Function PutKey$(ByRef C As Byte,ByRef S As Byte,ByRef A As Byte,ByRef R As Byte,ByRef L As Byte,ByRef H As Byte) As String
	C=0
	S=0
	A=0
	R=0
	L=0
	H=0
	Dim i,A$ As String
		For i=&h00 To &hf0
		if GetAsyncKeyState(i) And &h8000 Then
			Select Case i
				Case 1
					L=1
				Case 2
					R=1
				Case 4
					H=1
				Case 16
					S=1
				Case 17
					C=1
				Case 18
					A=1
				Case 160
					if S=1 then S=2
				Case 162
					if C=1 then C=2
				Case 164
					if A=1 then A=2
				Case Else
					A$=Chr$(i)
			End Select
		Endif
	Next I
	if S=1 then S=0
	if C=1 then C=0
	if A=1 then A=0
	if S=2 then S=1
	if C=2 then C=1
	if A=2 then A=1
	PutKey$=A$
End Function
Function OnMouse(ByRef X As DWord,ByRef Y As DWord) As Double
	Dim A As POINTAPI
	Dim B As RECT
	GetWindowRect(_PromptSys_hWnd,B)
	GetCursorPos(A)
	X=A.x-B.left-6'それぞれ枠の大きさを考えてマイナスにする
	Y=A.y-B.top-31
	OnMouse=-1
End Function
Type FuncKey
	A As Byte
	C As Byte
	S As Byte
End Type
Type FuncMouse
	L As Byte
	R As Byte
	H As Byte
End Type
Function Eng$(Month As Long) As String
if Month=1 then Eng$="January"
if Month=2 then Eng$="February"
if Month=3 then Eng$="March"
if Month=4 then Eng$="April"
if Month=5 then Eng$="May"
if Month=6 then Eng$="June"
if Month=7 then Eng$="July"
if Month=8 then Eng$="August"
if Month=9 then Eng$="September"
if Month=10 then Eng$="October"
if Month=11 then Eng$="November"
if Month=12 then Eng$="December"
End Function
'ここまで。PutKey$関数は別の自作プログラムから引用した為多少の無駄があるがご了承。
'ここからメイン
#N88BASIC
Dim Mouse_x As DWord
Dim Mouse_y As DWord
Dim MouseKey As FuncMouse
Dim DoubleKey As FuncKey
Dim Key$ As String
Dim I As Long
Dim D As Long,DN As Long
Dim st As SYSTEMTIME
Dim Month_Day
Dim Flag_Input As Long
Dim A$ As String,TIME$ As String
Dim Lang As Long
Lang=1'1の時日本語、2の時英語
GetLocalTime(st)

'現在の日付と曜日からその月の開始する曜日を計算
st.wDay=(st.wDay+st.wDayOfWeek+6) Mod 7
if st.wDay=0 then st.wDay=7
*START_J

DN=1

'その月の日数を計算
if st.wMonth=1 then Month_Day=31
if st.wMonth=2 then
	if st.wYear Mod 4=0 then'4で割れると閏年
		Month_Day=29
	Else
		Month_Day=28
	Endif
	if st.wYear Mod 100=0 then'ただし100で割れると閏年としない
		Month_Day=28
	Endif
	if st.wYear Mod 400=0 then'ただし400で割れれば閏年とする
		Month_Day=29
	Endif
End If
if st.wMonth=3 then Month_Day=31
if st.wMonth=4 then Month_Day=30
if st.wMonth=5 then Month_Day=31
if st.wMonth=6 then Month_Day=30
if st.wMonth=7 then Month_Day=31
if st.wMonth=8 then Month_Day=31
if st.wMonth=9 then Month_Day=30
if st.wMonth=10 then Month_Day=31
if st.wMonth=11 then Month_Day=30
if st.wMonth=12 then Month_Day=31

'ここから表示
Cls 3
Locate 21,0
Print st.wYear;"年";st.wMonth;"月"
Locate 7,0
Print "先月"
Locate 47,0
Print "次月"
Locate 7,2
Print "日     月     火     水     木     金     土"
For D=st.wDay To 7
	Locate D*7,4
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	Locate D*7,7
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	Locate D*7,10
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	Locate D*7,13
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	if DN>Month_Day then Exit For
	Locate D*7,16
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	if DN>Month_Day then Exit For
	Locate D*7,19
	Print DN
	DN=DN+1
Next D
Locate 8,21
A$="現在時刻:"+Date$()+"   "+TIME$
Print A$
Locate 0,23
Print "Altキーで表示言語切り替え"
Print "Ctrlキーで適用"
Print "It is a display language switch with the Alt key. "
Print "It applies with the Ctrl key. "
'ここまで
'ここから入力待ち
Do'左ボタンがクリックされた場合に抜け出せる場合があるループ
	Sleep_IfFore()'フォアグランドウインドウではない場合にクリックに反応しない
	Key$=PutKey$(DoubleKey.C,DoubleKey.S,DoubleKey.A,MouseKey.R,MouseKey.L,MouseKey.H)
	OnMouse(Mouse_x,Mouse_y)
	Flag_Input=0
	if MouseKey.L=1 then Flag_Input=1
	if Mouse_x>53 then Flag_Input=Flag_Input+1
	if Mouse_x<86 then Flag_Input=Flag_Input+1
	if Mouse_y>-1 then Flag_Input=Flag_Input+1
	if Mouse_y<16 then Flag_Input=Flag_Input+1
	if Flag_Input=5 then
		st.wMonth=st.wMonth-1
		if st.wMonth=0 then st.wMonth=12:st.wYear=st.wYear-1

		if st.wMonth=1 then Month_Day=31
		if st.wMonth=2 then
			if st.wYear Mod 4=0 then
				Month_Day=29
			Else
				Month_Day=28
			Endif
			if st.wYear Mod 100=0 then
				Month_Day=28
			Endif
			if st.wYear Mod 400=0 then
				Month_Day=29
			Endif
		End If
		if st.wMonth=3 then Month_Day=31
		if st.wMonth=4 then Month_Day=30
		if st.wMonth=5 then Month_Day=31
		if st.wMonth=6 then Month_Day=30
		if st.wMonth=7 then Month_Day=31
		if st.wMonth=8 then Month_Day=31
		if st.wMonth=9 then Month_Day=30
		if st.wMonth=10 then Month_Day=31
		if st.wMonth=11 then Month_Day=30
		if st.wMonth=12 then Month_Day=31

		st.wDay=(st.wDay-Month_Day+35) Mod 7
		if st.wDay=0 then st.wDay=7
		Exit Do
	End if

	Flag_Input=0
	if MouseKey.L=1 then Flag_Input=1
	if Mouse_x>373 then Flag_Input=Flag_Input+1
	if Mouse_x<406 then Flag_Input=Flag_Input+1
	if Mouse_y>-1 then Flag_Input=Flag_Input+1
	if Mouse_y<16 then Flag_Input=Flag_Input+1
	if Flag_Input=5 then
		st.wDay=(st.wDay+Month_Day) Mod 7
		if st.wDay=0 then st.wDay=7
		st.wMonth=st.wMonth+1
		if st.wMonth=13 then st.wMonth=1:st.wYear=st.wYear+1
		Exit Do
	Endif
	'ここから現在時刻の表示
	if Time$()<>TIME$ then
		Locate 8,21
		TIME$=Time$()
		A$="現在時刻:"+Date$()+"   "+TIME$
		Print A$
	End If
	if DoubleKey.A=1 then Lang=2
	if DoubleKey.C=1 then Exit Do
Loop
Do'押しっぱなしの場合にせきとめるループ
	Key$=PutKey$(DoubleKey.C,DoubleKey.S,DoubleKey.A,MouseKey.R,MouseKey.L,MouseKey.H)
	if MouseKey.L=0 then Exit Do
Loop
'ここまで
if Lang=1 then goto *START_J Else goto *START_E

*START_E

DN=1

'その月の日数を計算
if st.wMonth=1 then Month_Day=31
if st.wMonth=2 then
	if st.wYear Mod 4=0 then'4で割れると閏年
		Month_Day=29
	Else
		Month_Day=28
	Endif
	if st.wYear Mod 100=0 then'ただし100で割れると閏年としない
		Month_Day=28
	Endif
	if st.wYear Mod 400=0 then'ただし400で割れれば閏年とする
		Month_Day=29
	Endif
End If
if st.wMonth=3 then Month_Day=31
if st.wMonth=4 then Month_Day=30
if st.wMonth=5 then Month_Day=31
if st.wMonth=6 then Month_Day=30
if st.wMonth=7 then Month_Day=31
if st.wMonth=8 then Month_Day=31
if st.wMonth=9 then Month_Day=30
if st.wMonth=10 then Month_Day=31
if st.wMonth=11 then Month_Day=30
if st.wMonth=12 then Month_Day=31

'ここから表示
Cls 3
Locate 21,0
Print st.wYear;"/";Eng$(st.wMonth)
Locate 7,0
Print "Last"
Locate 47,0
Print "Next"
Locate 7,2
Print "Sun    Mon    Tue    Wed    Thu    Fri    Sat"
For D=st.wDay To 7
	Locate D*7,4
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	Locate D*7,7
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	Locate D*7,10
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	Locate D*7,13
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	if DN>Month_Day then Exit For
	Locate D*7,16
	Print DN
	DN=DN+1
Next D
For D=1 To 7
	if DN>Month_Day then Exit For
	Locate D*7,19
	Print DN
	DN=DN+1
Next D
Locate 8,21
A$="Now Time:"+Date$()+"   "+TIME$
Print A$
Locate 0,23
Print "Altキーで表示言語切り替え"
Print "Ctrlキーで適用"
Print "It is a display language switch with the Alt key. "
Print "It applies with the Ctrl key. "
'ここまで
'ここから入力待ち
Do'左ボタンがクリックされた場合に抜け出せる場合があるループ
	Sleep_IfFore()'フォアグランドウインドウではない場合にクリックに反応しない
	Key$=PutKey$(DoubleKey.C,DoubleKey.S,DoubleKey.A,MouseKey.R,MouseKey.L,MouseKey.H)
	OnMouse(Mouse_x,Mouse_y)
	Flag_Input=0
	if MouseKey.L=1 then Flag_Input=1
	if Mouse_x>53 then Flag_Input=Flag_Input+1
	if Mouse_x<86 then Flag_Input=Flag_Input+1
	if Mouse_y>-1 then Flag_Input=Flag_Input+1
	if Mouse_y<16 then Flag_Input=Flag_Input+1
	if Flag_Input=5 then
		st.wMonth=st.wMonth-1
		if st.wMonth=0 then st.wMonth=12:st.wYear=st.wYear-1

		if st.wMonth=1 then Month_Day=31
		if st.wMonth=2 then
			if st.wYear Mod 4=0 then
				Month_Day=29
			Else
				Month_Day=28
			Endif
			if st.wYear Mod 100=0 then
				Month_Day=28
			Endif
			if st.wYear Mod 400=0 then
				Month_Day=29
			Endif
		End If
		if st.wMonth=3 then Month_Day=31
		if st.wMonth=4 then Month_Day=30
		if st.wMonth=5 then Month_Day=31
		if st.wMonth=6 then Month_Day=30
		if st.wMonth=7 then Month_Day=31
		if st.wMonth=8 then Month_Day=31
		if st.wMonth=9 then Month_Day=30
		if st.wMonth=10 then Month_Day=31
		if st.wMonth=11 then Month_Day=30
		if st.wMonth=12 then Month_Day=31

		st.wDay=(st.wDay-Month_Day+35) Mod 7
		if st.wDay=0 then st.wDay=7
		Exit Do
	End if

	Flag_Input=0
	if MouseKey.L=1 then Flag_Input=1
	if Mouse_x>373 then Flag_Input=Flag_Input+1
	if Mouse_x<406 then Flag_Input=Flag_Input+1
	if Mouse_y>-1 then Flag_Input=Flag_Input+1
	if Mouse_y<16 then Flag_Input=Flag_Input+1
	if Flag_Input=5 then
		st.wDay=(st.wDay+Month_Day) Mod 7
		if st.wDay=0 then st.wDay=7
		st.wMonth=st.wMonth+1
		if st.wMonth=13 then st.wMonth=1:st.wYear=st.wYear+1
		Exit Do
	Endif
	'ここから現在時刻の表示
	if Time$()<>TIME$ then
		Locate 8,21
		TIME$=Time$()
		A$="Now Time:"+Date$()+"   "+TIME$
		Print A$
	End If
	if DoubleKey.A=1 then Lang=1
	if DoubleKey.C=1 then Exit Do
Loop
Do'押しっぱなしの場合にせきとめるループ
	Key$=PutKey$(DoubleKey.C,DoubleKey.S,DoubleKey.A,MouseKey.R,MouseKey.L,MouseKey.H)
	if MouseKey.L=0 then Exit Do
Loop
'ここまで
if Lang=2 then goto *START_E Else goto *START_J


通報する
ページトップ
投稿記事Posted: 2005年12月03日(土) 16:36 
オフライン

登録日時: 2005年9月17日(土) 13:15
記事: 25
お住まい: 香川
私の環境(WinXp_sp1 AB_Ver4.11.03)では2005年12月は日曜日から始まります。
月の開始する曜日が違うのですが?

'現在の日付と曜日からその月の開始する曜日を計算
st.wDay=(st.wDayOfWeek+7-(st.wDay-1) Mod 7) mod 7+1

このようにすると、ちゃんとでてきました(今年一年分しか調べていませんが)。


通報する
ページトップ
 記事の件名: すみませんでした。
投稿記事Posted: 2005年12月04日(日) 00:17 
オフライン

登録日時: 2005年7月25日(月) 13:27
記事: 893
お住まい: 埼玉県東松山市
計算式をその月の時に都合が会うように作ったもので・・・今、別の方向から曜日を求める式を開発中です。

_________________
Website→http://web1.nazca.co.jp/himajinn13sei/top.html
ここ以外の場所では「暇人13世」というHNを主として使用。

に署名を書き換えて欲しいと言われたので暇だしやってみるテスト。


通報する
ページトップ
 記事の件名: 曜日計算について
投稿記事Posted: 2005年12月04日(日) 07:20 
オフライン

登録日時: 2005年9月17日(土) 13:15
記事: 25
お住まい: 香川
ツェラー(ゼラー?)の公式という便利なものがあります。
曜日だけでなく、日数計算にも使える便利なものです。

ここでは、曜日計算だけですが。
youbi = getweekday(年,月,日) '0:日,1:月…
整数除算知りませんでした。訂正しました。


通報する
ページトップ
 記事の件名: 曜日計算について
投稿記事Posted: 2005年12月04日(日) 18:56 
オフライン

登録日時: 2005年9月02日(金) 22:15
記事: 96
お世話になります。

 昔々AB2の時代のフォーラムで、曜日計算を質問したことがありました。
  すごい方たちのご協力で
   最終形が、ワンラインプログラムになり以下のコードになりました。
    (日=1,月=2・・・・,土=7)
 参考に送ります。
コード:
getweekday=(Int(0.2425*year-Int(((month+9) mod 12+1)/11))+year+Int(2.6*((month+9) mod 12+1)-2.2)+date+2)mod 7+1
追伸:何をやっているのか、いまだにわかりませんがm(_w_)m


通報する
ページトップ
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 5 件の記事 ] 

全ての表示時間は UTC+09:00 です


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[9人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by ocean