| ■No86477 (mako さん) に返信
時間帯が固まっていれば、その間の間隔は適当でよいということなのだと考えいかのように
してみましたがどうでしょう？
Public Class Form1
Private Structure datF
Dim Jikoku As String '時刻 （実際は "2018/01/30 16:30:00" などの日付も入った文字列）
Dim Suu1 As Integer '数量1
Dim Suu2 As Integer '数量2
End Structure
Dim Uridat(500) As datF
Dim datS As Integer '
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
' 1分間隔のサンプルデータをを成
datS = -1
For i = 10 To 45 ' 8:10〜8:45
datS = datS + 1
'Uridat(datS).Jikoku = "8:" & Str(i) '時刻
Uridat(datS).Jikoku = $"8:{i:00}" '時刻
Uridat(datS).Suu1 = i * 10 '数量1
Uridat(datS).Suu2 = i * 5 '数量2
Next
For i = 20 To 55 ' 10:20〜10:55
datS = datS + 1
'Uridat(datS).Jikoku = "10:" & Str(i) '時刻
Uridat(datS).Jikoku = $"10:{i:00}" '時刻
Uridat(datS).Suu1 = i + 100 '数量1
Uridat(datS).Suu2 = i + 20 '数量2
Next
'==== Chart1 ====
Dim ds As New DataSet
Dim dt As New DataTable
Dim dtRow As DataRow
'列の作成
With dt.Columns
.Add("時刻", GetType(String))
.Add("数量1", GetType(Integer))
.Add("数量2", GetType(Integer))
End With
ds.Tables.Add(dt)
'データのセット
For i = 0 To datS
dtRow = ds.Tables(0).NewRow
dtRow(0) = Uridat(i).Jikoku '時刻
dtRow(1) = Uridat(i).Suu1 '数量1
dtRow(2) = Uridat(i).Suu2 '数量2
ds.Tables(0).Rows.Add(dtRow)
Next
'Chart に表示するデータソースを設定
'Dim min As DateTime = Nothing
'Dim max As DateTime = Nothing
Dim min = -1
Dim max = -1
Dim intr = 30
Dim tbl = GetChartDs(ds, intr, min, max)
Chart1.DataSource = tbl.Select("", "x")
Chart1.Series.Clear()
'
With Chart1.ChartAreas(0)
With .AxisX
'.Minimum = min.ToOADate
'.Maximum = max.ToOADate
.Minimum = min
.Maximum = max
'.IntervalType = DataVisualization.Charting.DateTimeIntervalType.Minutes
'.Interval = intr
.Interval = 5
For Each row In tbl.Select("", "時刻")
Dim null = row.IsNull("数量1")
If null Then Continue For
Dim d = row.Field(Of Date)("時刻")
Dim x = row.Field(Of Integer)("x")
With .CustomLabels.Add(x - 2, x + 2, d.ToString("HH:mm"))
.RowIndex = 0
End With
Next
End With
End With
Dim ore = Chart1.Series.Add("折れ線")
With ore
.ChartType = DataVisualization.Charting.SeriesChartType.Line
.EmptyPointStyle.SetDefault(True)
'.XValueMember = "時刻"
.XValueMember = "x"
.YValueMembers = "数量1"
End With
Dim bou = Chart1.Series.Add("棒グラフ")
With bou
.ChartType = DataVisualization.Charting.SeriesChartType.Column
'.XValueMember = "時刻"
.XValueMember = "x"
.YValueMembers = "数量2"
End With
End Sub
'Private Function GetChartDs(Src As DataSet, IntrMin As Integer,
' ByRef Min As DateTime, ByRef Max As DateTime) As DataTable
Private Function GetChartDs(Src As DataSet, IntrMin As Integer,
ByRef Min As Integer, ByRef Max As Integer) As DataTable
Dim ret As New DataTable()
Min = Nothing
Max = Nothing
With ret.Columns()
.Add("x", GetType(Integer))
.Add("時刻", GetType(DateTime))
.Add("数量1", GetType(Integer))
.Add("数量2", GetType(Integer))
End With
Dim x = 1
Min = x
x = 5
'一番左にスペース
ret.Rows.Add(x, DBNull.Value, DBNull.Value, DBNull.Value) : x += 5
Dim isFirst2 = True
For Each itm In (From r In Src.Tables(0).Select()
Let d = Function(s As String) As Date
Dim d2 As Date = Nothing
If Date.TryParseExact(s, {"HH:mm", "HH: mm", "H:m"}, Nothing, Nothing, d2) Then
Return d2
Else
Return CDate(Nothing)
End If
End Function(r.Field(Of String)("時刻"))
Let h = d.Hour
Order By d
Group By h Into rows = Group)
'間
If Not isFirst2 Then
For i = 1 To 2
ret.Rows.Add(x, DBNull.Value, DBNull.Value, DBNull.Value) : x += 5
Next
End If
isFirst2 = False
Dim hour = itm.h
'Dim min2 As Date = Nothing
Dim isFirst = True
For Each rowItm In itm.rows
Dim row = rowItm.r
Dim d = rowItm.d
Dim disp = False
'If Min = Nothing OrElse d < Min Then Min = d : disp = True
'If Max = Nothing OrElse d > Max Then Max = d
'If min2 = Nothing OrElse d < min2 Then min2 = d : disp = True
If isFirst Then disp = True : isFirst = False
If Not disp Then
If d.Minute Mod IntrMin = 0 Then
disp = True
End If
End If
If disp Then
'ret.Rows.Add(d, row("数量1"), row("数量2"))
ret.Rows.Add(x, d, row("数量1"), row("数量2"))
x += 5
End If
Next
Next
Max = x
'If Min <> Nothing Then
' Min = Min.AddMinutes(-(Min.Minute Mod IntrMin) - IntrMin * 2)
'End If
'If Max <> Nothing Then
' Max = Max.AddMinutes(-(Max.Minute Mod IntrMin) + IntrMin * 2)
'End If
'Dim d1 As Date = Min
'For Each row In ret.Select("", "時刻")
' Dim d2 = row.Field(Of Date)("時刻")
' Do While d1 < d2
' ret.Rows.Add(d1, DBNull.Value, DBNull.Value)
' d1 = d1.AddMinutes(IntrMin)
' Loop
' d1 = d2.AddMinutes(IntrMin)
'Next
ret.AcceptChanges()
Return ret
End Function
End Class
|