ToDoへのアクセス

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

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

ここで解説する方法で、ToDoのデータベースへの書き込みが可能ですが、
OS4.0以上だと書き込んだデータをToDoで編集しようとするとエラーが発生してしまうようです。

WorkPad30J(実機&POSE)	問題無し
PEG-S300(POSE)	問題無し
PEG-N700C(POSE)	問題無し
PEG-N700C UpDate(実機)	エラー発生

もしかしたらアップデートしたClie固有の問題かもしれませんが、
他にOS4.0以上のデバイスが無いので確認が取れません。

OS4.0への対応としては、コメントのWriteを止めればOKのようです。

サンプルのWrite部分
    Res=DbPut(DBF,Fld1,Fld2)
OS4.0対応
    Res=DbPut(DBF,Fld1)

ToDoDBのフォーマット
第一フィールド
1～2桁目	日付を表す
3桁目	優先度、チェックの有無を表す
4桁目～	ToDoの内容を表す
第二フィールド
1桁目～	ToDoのコメントを表す

・日付の算出
第一フィールドの先頭２文字でデータの日付を表します。
まず１文字目の文字コードを取得します。
１文字目の文字コードを256倍したものに２文字目の値を加算します。

その数値をMasakiさん作のFunctionであるSDconvを使って日付を算出します。

    '---- 変数の型
    Dim ShrX as Short
    Dim Fld1 as String

    '---- 変換方法
    shrX=Asc(Mid(Fld1,1,1))*256+Asc(Mid(Fld1,2,1))
    SD=SDconv(shrX)

・優先度、チェックの有無の判断
第一フィールドの３文字目の文字コードで判断します。

優先度(1～5)＋チェック有り(128)Orチェック無し(0)
という具合です。

つまり
・優先度(1)、チェック無し(0)なら文字コードが1(1+0)
・優先度(1)、チェック有り(128)なら文字コードが129(1+128)
・優先度(5)、チェック無し(0)なら文字コード5(5+0)
・優先度(5)、チェック有り(128)なら文字コード133(5+128)
という風になります。

・内容
第一フィールドの４文字目から最後までが実際のToDoの内容になります。

・コメント
第二フィールドがコメントとなっています。

サンプルのダウンロードはココから

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 object1008()
    Dim DBF as Database
    Dim Res as Integer
    Dim Rec as Integer
    Dim OfS as Integer
    
    Dim Fld1 as String
    Dim Fld2 as String

    Dim ShrX as Short
    Dim WkDate as Date

    '---- ToDoDBからデータを一件読み込みます。
    Res=DbOpen(DBF,"ToDoDB",0)
    Rec=Val(Field1004.Text)
    OfS=0
    Res=DbPosition(DBF,Rec,OfS)
    Res=DbGet(DBF,Fld1,Fld2)
    Res=DbClose(DBF)
    
    '---- 先頭２文字から日付を算出
    If Asc(Mid(Fld1,1,1))=255 Then
        Field1009.Text="日付無し"
    Else
        shrX=Asc(Mid(Fld1,1,1))*256+Asc(Mid(Fld1,2,1))
        WkDate=SDconv(shrX)
        Field1009.Text=Str(WkDate)
    End If    
    '---- 優先度、チェックの有無を調査
    If Asc(Mid(Fld1,3,1))>128 Then
        Checkbox1011.Status=nsbChecked
        Popup1014.Selected=Asc(Mid(Fld1,3,1))-128
    Else
        Checkbox1011.Status=nsbUnchecked
        Popup1014.Selected=Asc(Mid(Fld1,3,1))
    End If
    
    '---- ToDoの内容を拾います
    Field1012.Text=Mid(Fld1,4,Len(Fld1)-3)
    '---- コメントを取得
    Field1018.Text=Fld2
End Sub

Write Buttonイベント

Sub object1021()
    Dim DBF as Database
    Dim Res as Integer
    Dim Rec as Integer
    Dim OfS as Integer
    
    Dim Fld1 as String
    Dim Fld2 as String

    Dim DtX as Date
    Dim WkDate as Date
    Dim DateSht as Short
    Dim WkT as Short
    Dim WkB as Short
    Dim WkFlg as Short
        
    '---- 日付を変換
    If Field1009.Text="" Then
        WkT=255
        WkB=255
    Else
        dtX=ToDate(Field1009.Text)
        DateSht=DSconv(dtX)
        WkT=(DateSht/256)
        WkB=DateSht-(WkT*256)
    End If
    '---- 優先度、チェックの有無を変換
    If Checkbox1011.Status=nsbChecked Then
        WkFlg=128+Popup1014.Selected
    Else
        WkFlg=Popup1014.Selected
    End If

    '---- 書き込みデータのフィールド１を用意します
    Fld1=Chr(WkT)+Chr(WkB)+Chr(WkFlg)+Field1012.Text
    '---- 書き込むデータのフィールド２を用意します
    Fld2=Field1018.Text

    '---- レコードを新規に追加します
    Res=DbOpen(DBF,"ToDoDB",0)
    Rec=DbGetNoRecs(DBF)
    Rec=Rec+1
    OfS=0
    Res=DbPosition(DBF,Rec,OfS)
    Res=DbPut(DBF,Fld1,Fld2)
    Res=DbClose(DBF)
    MsgBox "ToDoに書き込みました"
End Sub

- Page End -