Function Create_TIME_Line(STR_LEFT As Long, STR_TOP As Long, STR_DATE As String)
' создание рисунков
Dim im As Label
Dim rst As ADODB.Recordset
Dim KL As String ' название
Dim KL1 As Long ' + название
Dim STR_HOUR As Long ' часы
Dim STR_MINUTE As Long ' минуты
Dim STR_TIME As String ' время
' Удаление рисунков
Call DELETE_TIME_Line
Set rst = New ADODB.Recordset
rst.Open "SELECT SERVICE_TBL.DATE_SERVICE, SERVICE_TBL.FIRST_TIME_SERVICE, SERVICE_TBL.LAST_TIME_SERVICE" _
& " From SERVICE_TBL " _
& " WHERE (((SERVICE_TBL.DATE_SERVICE)= #" & STR_DATE & "#));", GLB_CONNECTION, adOpenKeyset, adLockOptimistic
KL1 = 1
For STR_MINUTE = 480 To 1440 Step 2
KL = "DNI" & KL1
Set im = Controls.Add("VB.Label", KL)
im.Top = STR_TOP
im.Left = STR_LEFT
im.Height = 250
im.Width = 500
im.Appearance = 0
im.BorderStyle = 1
im.FontSize = 9
im.Alignment = 2
im.Visible = True
STR_LEFT = STR_LEFT + im.Width - 15
' дошли до конца строки - перевод на новую
If STR_LEFT >= 14500 Then
STR_LEFT = 600
STR_TOP = STR_TOP + 250
End If
If Val(STR_MINUTE) >= 60 Then
im.Caption = Format(Int(Val(STR_MINUTE) / 60), "00") & ":" & Format(Int(Val(STR_MINUTE) - 60 * Int(Val(STR_MINUTE) / 60)), "00")
STR_TIME = im.Caption
If STR_TIME = "24:00" Then STR_TIME = "00:00"
rst.Filter = "FIRST_TIME_SERVICE<= " & STR_TIME & " AND LAST_TIME_SERVICE >= " & STR_TIME
' если занято
If rst.RecordCount <> 0 Then
im.BackColor = &HFFEBE8
Else
' если свободно
im.BackColor = vbWhite
End If
' удалим фильтр
rst.Filter = adFilterNone
Else
' если минут менее часа
im.Caption = Int(Val(STR_MINUTE) / 60) & ":" & STR_MINUTE
im.BackColor = vbWhite
End If
KL1 = KL1 + 1
Next STR_MINUTE
End Function
|