グラフのリアルタイム表示は？ (ID:86338)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ねろさんの言うロールは以前MSのサイトでサンプルがのってました。
URLは忘れましたが、コードが掲載されていましたので参考にドウゾ。
ロールさせなくとも、左から右へ波形を書いて、
右端にきたら左端からっていう繰り返しなど手法は色々ありますが。

波形表示などにExcelを使用すると、
どうしてもその分のオーバーヘッドが出るので、
リアルタイム処理向きでは無いと思います。
VB単体で処理した方がいいでしょう。

>そのとおりです。波形表示しながら、
>「同時に」CSV形式のファイルに出力というのは可能なのでしょうか？
可能です。

Option Explicit
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Const PS_SOLID = 0

Private Declare Function CreateCompatibleDC Lib "gdi32" _
               (ByVal hdc As Long) As Long

Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
               (ByVal hdc As Long, _
               ByVal nWidth As Long, _
               ByVal nHeight As Long) As Long

Private Declare Function SelectObject Lib "gdi32" _
               (ByVal hdc As Long, _
               ByVal hObject As Long) As Long

Private Declare Function CreatePen Lib "gdi32" _
               (ByVal nPenStyle As Long, _
               ByVal nWidth As Long, _
               ByVal crColor As Long) As Long

Private Declare Function LineTo Lib "gdi32" _
               (ByVal hdc As Long, _
               ByVal x As Long, _
               ByVal y As Long) As Long

Private Declare Function MoveToEx Lib "gdi32" _
               (ByVal hdc As Long, _
               ByVal x As Long, _
               ByVal y As Long, _
               ByVal lpPoint As Long) As Long

Private Declare Function BitBlt Lib "gdi32" _
               (ByVal hDestDC As Long, _
               ByVal x As Long, _
               ByVal y As Long, _
               ByVal nWidth As Long, _
               ByVal nHeight As Long, _
               ByVal hSrcDC As Long, _
               ByVal xSrc As Long, _
               ByVal ySrc As Long, _
               ByVal dwRop As Long) As Long

Private Const pWidth = 250    ' Width of picture box in pixels.
Private Const pHeight = 150   ' Height of picture box in pixels.
Private Const pGrid = 25      ' Distance between grid lines.
Private Const tInterval = 100 ' Interval between timer samplings
                              ' in milliseconds.
Private Const pHeightHalf = pHeight \ 2
Dim counter As Long  ' Number of data points logged so far. Used to
                     ' sync grid.
Dim oldY As Long     ' Contains the previous y coordinate.
Dim hDCh As Long, hPenB As Long, hPenC As Long

Private Sub Form_Load()
    Dim hBmp As Long
    Dim i As Integer
    Me.Show
    Picture1.ScaleMode = 3
    Picture1.Left = 0
    Picture1.Top = 0
    Form1.ScaleMode = 3
    Picture1.Height = 155
    Picture1.Width = 255
    counter = 0
    hDCh = CreateCompatibleDC(Picture1.hdc)
    hBmp = CreateCompatibleBitmap(Picture1.hdc, _
                                 pWidth, _
                                 pHeight)
    Call SelectObject(hDCh, hBmp)
    hPenB = CreatePen(PS_SOLID, 0, vbBlack)
    hPenC = CreatePen(PS_SOLID, 0, vbRed)
    Call SelectObject(hDCh, hPenB)

' Plot horizontal grid lines.
    For i = pGrid To pHeight - 1 Step pGrid
        Picture1.Line (0, i)-(pWidth, i)
    Next

' Plot vertical grid lines.
    For i = pGrid - (counter Mod pGrid) To _
                     pWidth - 1 Step pGrid
        Picture1.Line (i, 0)-(i, pHeight)
    Next

Call BitBlt(hDCh, _
               0, _
               0, _
               pWidth, _
               pHeight, _
               Picture1.hdc, _
               0, _
               0, _
               SRCCOPY)
    'Timer1.Interval = 1
    'Timer1.Enabled = True
    oldY = pHeightHalf

'Call API_Graph
End Sub

Private Sub API_Graph()
    Dim i As Integer
    Do
        Call BitBlt(hDCh, _
                      0, _
                      0, _
                      pWidth - 1, _
                      pHeight, _
                      hDCh, _
                      1, _
                      0, _
                      SRCCOPY)
    
        If counter Mod pGrid = 0 Then
            Call MoveToEx(hDCh, pWidth - 2, 0, 0)
            Call LineTo(hDCh, pWidth - 2, pHeight)
        End If
    
        i = Sin(0.1 * counter) * _
             (pHeightHalf - 1) + _
             pHeightHalf
    
        Call SelectObject(hDCh, hPenC)
        Call MoveToEx(hDCh, pWidth - 3, oldY, 0)
        Call LineTo(hDCh, pWidth - 2, i)
        Call SelectObject(hDCh, hPenB)
        Call BitBlt(Picture1.hdc, _
                      0, _
                      0, _
                      pWidth, _
                      pHeight, _
                      hDCh, _
                      0, _
                      0, _
                      SRCCOPY)
        counter = counter + 1
        oldY = i
        DoEvents
    Loop
End Sub

Private Sub Timer1_Timer()
    Dim i As Integer

Call BitBlt(hDCh, _
                      0, _
                      0, _
                      pWidth - 1, _
                      pHeight, _
                      hDCh, _
                      1, _
                      0, _
                      SRCCOPY)
    
        If counter Mod pGrid = 0 Then
            Call MoveToEx(hDCh, pWidth - 2, 0, 0)
            Call LineTo(hDCh, pWidth - 2, pHeight)
        End If
    
        i = Sin(0.1 * counter) * _
             (pHeightHalf - 1) + _
             pHeightHalf
    
        Call SelectObject(hDCh, hPenC)
        Call MoveToEx(hDCh, pWidth - 3, oldY, 0)
        Call LineTo(hDCh, pWidth - 2, i)
        Call SelectObject(hDCh, hPenB)
        Call BitBlt(Picture1.hdc, _
                      0, _
                      0, _
                      pWidth, _
                      pHeight, _
                      hDCh, _
                      0, _
                      0, _
                      SRCCOPY)
        counter = counter + 1
        oldY = i
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る