予定表へのアクセス


HPのTOPに戻る
BasicBASIC別館のTOPに戻る
はじめに
この予定表へのアクセスについてを書くにあたってMasakiさんのHPのTIPSが大変参考になりました。
正直MasakiさんのTIPSが無ければ、まだ判らずにいたと思います。

この場をお借りしてMasakiさんに感謝いたします。

予定表の読み込みに関しては、MasakiさんのHPで公開している方が断然スマートです
こっちのは、こんな無理矢理な方法でも読めるんだ。って位に思って下さい
DatebookDBのフォーマット
第一フィールド
1桁目開始時間(時)を表す
2桁目開始時間(分)を表す
3桁目終了時間(時)を表す
4桁目終了時間(分)を表す
5〜6桁目日付を表す
7〜8桁目不明(その他の設定？)
9桁目〜予定の内容を表す
第二フィールド
1桁目〜予定のコメントを表す
データを読む時
第一フィールドをString型で一括で取り込みたい所だが
2桁目と4桁目の分が00だとそこでフィールドの読み込みが切れてしまうので工夫が必要

5〜6桁目の日付はToDoと同じように算出
サンプルのダウンロードはココから
#サンプルと以下のコードにはバグがあります。

#Write ButtonイベントでDBF変数の定義がされていません。
#サンプルを実行される方はDBFをDataBaseのTypeで定義して下さい。
StartUpコード 
Sub Project_Startup()
End Sub

'---- Masakiさん開発のDSconv(Date型からShort型へ変換)
Function DSconv(dtX as Date) as Short
    DSconv=((year(dtX)-1904)*512)+(month(dtX)*32)+(day(dtX))
End Function

'---- Masakiさん開発のSDconv(Short型からDate型へ変換)
Function SDconv(shrX as Short) as Date
	SDconv=todate(str(int(shrX/512)+1904)+"/"+str(int(mod(shrX,512)/32))+"/"+str(int(mod(mod(shrX,512),32))))
End Function

Read Buttonイベント 
Sub object1010()
    Dim DBF as Database
    Dim Res as Integer
    Dim Rec as Integer
    Dim OfS as Integer
    
    Dim ShrX as Short
    Dim WkDate as Date
    
    Dim Sh   as String
    Dim St   as String
    Dim Eh   as String
    Dim Et   as String
    Dim Fld1 as String
    Dim Fld2 as String
    
    '---- ToDoDBのようにString型で一括で読めない場合がある為１文字づつ読む
    Res=DbOpen(DBF,"DatebookDB",0)
    '---- 読み込むレコード位置を取得
    Rec=Val(Field1006.Text)
    '---- 開始時刻(時)
    OfS=0
    Res=DbPosition(DBF,Rec,OfS)
    Res=DbGet(DBF,Sh)
    Sh=Left(Sh,1)
    '---- 開始時刻(分)
    OfS=1
    Res=DbPosition(DBF,Rec,OfS)
    Res=DbGet(DBF,St)
    St=Left(St,1)
    '---- 終了時刻(時)
    OfS=2
    Res=DbPosition(DBF,Rec,OfS)
    Res=DbGet(DBF,Eh)
    Eh=Left(Eh,1)
    '---- 終了時刻(分)
    OfS=3
    Res=DbPosition(DBF,Rec,OfS)
    Res=DbGet(DBF,Et)
    Et=Left(Et,1)
    '---- 残りのFld1,Fld2を読む
    OfS=4
    Res=DbPosition(DBF,Rec,OfS)
    Res=DbGet(DBF,Fld1,Fld2)
    Res=DbClose(DBF)

    '---- 日付をセット
    shrX=Asc(Mid(Fld1,1,1))*256+Asc(Mid(Fld1,2,1))
	WkDate=SDconv(shrX)
    Field1016.Text=Str(WkDate)

    '---- 開始時間をセット
    If Asc(Sh)=255 Then
        Field1018.Text="時刻無し"
    Else
        Field1018.Text=Str(Asc(Sh))+":"+Str(Asc(St))
    End If

    '---- 終了時間をセット
    If Asc(Eh)=255 Then
        Field1020.Text="時刻無し"
    Else
        Field1020.Text=Str(Asc(Eh))+":"+Str(Asc(Et))
    End If

    '---- 予定の内容をセット
    Field1022.Text=Mid(Fld1,5,Len(Fld1)-4)

    '---- 予定のコメントをセット
    Field1024.Text=Fld2
End Sub

Write Buttonイベント 
Sub object1026()
    Dim DtX as Date
    Dim Res as Integer
    Dim Rec as Integer
    Dim OfS as Integer
    Dim DateSht as Short
    Dim WkT as Short
    Dim WkB as Short
    
    Dim Fld1 as String
    Dim Fld2 as String
    
    '---- 日付を変換
    DtX=ToDate(Field1016.Text)
    DateSht=DSconv(DtX)
    WkT=(DateSht/256)
    WkB=DateSht-(WkT*256)

    '---- 開始、終了時間をセット
    If Field1018.Text="" Then
        Fld1=Chr(255)+Chr(255)+Chr(255)+Chr(255)
    Else
        Fld1=Chr(Val(Mid(Field1018.Text,1,2)))
        Fld1=Fld1+Chr(Val(Mid(Field1018.Text,4,2)))
        Fld1=Fld1+Chr(Val(Mid(Field1020.Text,1,2)))
        Fld1=Fld1+Chr(Val(Mid(Field1020.Text,4,2)))
    End If
    '---- 予定表の内容をセット
    Fld1=Fld1+Chr(WkT)+Chr(WkB)+Chr(4)+Chr(194)+Field1022.Text
    '---- コメントをセット
    Fld2=Field1024.Text
    
    '---- レコードを新規に追加
    Res=DbOpen(DBF,"DatebookDB",0)
    Rec=DbGetNoRecs(DBF)
    Rec=Rec+1
    OfS=0
    Res=DbPosition(DBF,Rec,OfS)
    Res=DbPut(DBF,Fld1,Fld2)
    Res=DbClose(DBF)
    MsgBox "予定表に書き込みました"    
End Sub
- Page End -