過去掘り出し。

Ｒ５⇒Ｒ７マイグレーション準備で各ＤＢチェックしてたら、
昔自分で作ったモノで「うはっ、こんなもんまで作ったんだっけ」
ってのがあったので紹介。

内容はバカ杉ですが、
要は応用次第なのよねっとことで載せときます。

たしか、「チェックしたい日の15:00から17:00の２時間の
打合せ室予約状況を１０分単位でグラフィカルに見たい。」
と言われて作った物がこーんな感じ↓。


設計要素（サブフォーム）はこんなん。

これ、黒い四角の図形オブジェクトを１０分毎に配置し、
非表示式で実際に表示するかどうかを決めてます。
上のだと、15時台をa、16時台をbにし、
15時台の左から５つ目（0から数えると4）の黒四角なんでa4。としてます。


このサブフォームを表示するためのアクションボタンに
書かれたコードは↓。

Sub Click(Source As Button)
Dim workspace As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Set uidoc = workspace.CurrentDocument
Dim doc As NotesDocument
Set doc = uidoc.Document

If uidoc.FieldGetText( "Fixture" ) = "" Then
Messagebox "会議予定日が設定されていません。" + Chr(10) _
, 0 , "空き時間検索エラー"
Exit Sub
End If

Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim view As NotesView
Set view = db.GetView( "Fixture" )
Dim dc As NotesDocumentCollection
Dim txtDate As String
txtDate = Format$(doc.Fixture(0) , "YYYY/MM/DD")
Set dc = view.GetAllDocumentsByKey(txtDate)
Dim Sdoc As NotesDocument
Set Sdoc = dc.GetFirstDocument()

'値初期化
For m = 0 To 5
FieldName = "a" + Cstr(m)
Call uidoc.FieldSetText( FieldName, "" )
FieldName = "b" + Cstr(m)
Call uidoc.FieldSetText( FieldName, "" )
Next

While Not(Sdoc Is Nothing)
'時間の取得
HurDataS = Cstr(Hour(Sdoc.StartTime(0)))
MinDataS = Cstr(Minute(Sdoc.StartTime(0)))
HurDataE = Cstr(Hour(Sdoc.EndTime(0)))
MinDataE = Cstr(Minute(Sdoc.EndTime(0)))

Dim c As Integer, d As Integer
c = Cint(Left$(MinDataS, 1))
d = Cint(Left$(MinDataE, 1))
If c = 5 And d = 0 Then
d = 6
End If

Select Case HurDataS
Case "15":
Flag = "a"
Case "16":
Flag = "b"
End Select

If c = d - 1 Then
'■が１つのみ（１０分間）
Select Case HurDataS
Case "15":
FieldName = Flag + Left$(MinDataS, 1)
Case "16":
FieldName = Flag + Left$(MinDataS, 1)
End Select
Call uidoc.FieldSetText( FieldName, "■" )
Else
'■が２個以上（２０分以上）
If HurDataS = HurDataE Then
'時が同じ場合
For i = c To (d - 1)
FieldName = Flag + Cstr(i)
Call uidoc.FieldSetText( FieldName, "■" )
Next
Else
'時が違う場合
For i = c To 5
FieldName = "a" + Cstr(i)
Call uidoc.FieldSetText( FieldName, "■" )
Next
For l = 0 To (d - 1)
FieldName = "b" + Cstr(l)
Call uidoc.FieldSetText( FieldName, "■" )
Next
End If
End If

Set Sdoc = dc.GetNextDocument(Sdoc)
Wend

Call workspace.DialogBox( "time_off", True, True, True, True, False, False, "空き時間検索")
Exit Sub

End Sub

実際、上のサブフォームの設計要素で、黒四角の下に同じ大きさの
a0～a5、b0～b5のフィールドがいてます。
（↓は黒四角を全部とっぱらった設計上の表示。）

当初、
15:00|■|■|■|■|■|■|16:00|■|■|■|■|■|■|17:00
というような感じで、文字記号の黒塗りつぶし四角を拡大してたため、
スクリプトでは各フィールドに”■”の値が置かれてます。
しかしどんなに■を拡大しようが、|と■の間にスペースが出来てしまうため
なんとなく見栄えが悪いー。ってことで、サブフォームを上の方法に変更。
だけどスクリプトはそのまんま。。。
まるっきり手抜きだけど、どうせ図形の黒四角オブジェクトで
下のフィールド値が見えない状態になってるので、このまんま放置。