f



2-D line graph plotting in visual basic

I need to plot an ECG (Electro Cardiogram) like graph programatically.
It is a 2-D line graph. Please suggest me which object / component
should I use in visual basic. Also, is there some sample source code
available for this type of graph which I can directly / indirectly
make use of ?

Thanks
Aditya
0
adity_a (2)
4/14/2004 12:40:25 PM
comp.lang.basic.visual.misc 10153 articles. 0 followers. Post Follow

3 Replies
3464 Views

Similar Articles

[PageSpeed] 57

In message <a6834120.0404140440.64ae6937@posting.google.com>, Aditya 
Kulkarni <adity_a@yahoo.com> writes
>I need to plot an ECG (Electro Cardiogram) like graph programatically. 
>It is a 2-D line graph. Please suggest me which object / component 
>should I use in visual basic. Also, is there some sample source code 
>available for this type of graph which I can directly / indirectly make 
>use of ?

Aditya, do you mean a static display, a horizontally scrolling one or a 
repeatedly overwritten one?

All should be possible in plain vanilla VB.

Regards
-- 
Martin Trump
0
martin (374)
4/14/2004 2:00:18 PM
"Aditya Kulkarni" <adity_a@yahoo.com> wrote in message news:a6834120.0404140440.64ae6937@posting.google.com...
> I need to plot an ECG (Electro Cardiogram) like graph programatically.
> It is a 2-D line graph. Please suggest me which object / component
> should I use in visual basic. Also, is there some sample source code
> available for this type of graph which I can directly / indirectly
> make use of ?


See if this helps:

http://www.planetsourcecode.com/vb/scripts/ShowCode.asp?txtCodeId=52166&lngWId=1


LFS




-----= Posted via Newsfeeds.Com, Uncensored Usenet News =-----
http://www.newsfeeds.com - The #1 Newsgroup Service in the World!
-----==  Over 100,000 Newsgroups - 19 Different Servers! =-----
0
Abuse3179 (111)
4/14/2004 2:14:41 PM
On 14 Apr 2004 05:40:25 -0700, adity_a@yahoo.com (Aditya Kulkarni) wrote:

>I need to plot an ECG (Electro Cardiogram) like graph programatically.
>It is a 2-D line graph. Please suggest me which object / component
>should I use in visual basic. Also, is there some sample source code
>available for this type of graph which I can directly / indirectly
>make use of ?
>
>Thanks
>Aditya

You might concider using DIBSections... Quick, easy to manipulate, etc... ,
etc...

Below is a short (well kind-a-sort-a) on how to use them...


Start a new project...
Add a PictureBox
Add 2 Command Buttons (control array) leave name Command1
Add 1 Module and name it DIBSections (I could have left it as its default but it
already exists in my projects...)

Copy/Paste the following code into their proper place...
<<<Watch for LineWraps...>>>

***Form Code***
Option Explicit

Private taWorkDIB() As RGBQUAD
Private taTempDIB() As RGBQUAD
    'Not use here but could be (part of the existing .BAS)
Private taUnDoDIB() As RGBQUAD
Private lDIBWidth As Long
Private lDIBHeight As Long
Private bCancelProcess As Boolean
Private Const cPI180 As Double = 1.74532925199433E-02


Private Sub Command1_Click(Index As Integer)
Dim lRtn As Long
Dim lX As Long
Dim lY As Long
Dim lScrollWidth As Long
Dim bScroll As Boolean
Dim dSign As Double

    Select Case Index
        Case 0
            With Picture1 'Clear previous stuff...
                .Cls
                .Picture = .Image
            End With
            lRtn = DIB_Routines(Picture1, taWorkDIB, taTempDIB, taUnDoDIB,
DIBOperation.GetDIB, lDIBWidth, lDIBHeight)
            lScrollWidth = lDIBWidth * 0.75 'Start Scrolling at 75% of width
(just for looks when testing)
            bCancelProcess = False
            Command1(0).Enabled = False
            Command1(1).Enabled = True
            Do While Not bCancelProcess
                If bScroll Then
                    taTempDIB = taWorkDIB
                    'Lets Scroll (move) it over one to the left
                    For lX = 0 To lScrollWidth '-1 'if using full lDIBWidth
                        For lY = 0 To lDIBHeight
                            taWorkDIB(lX, lY) = taTempDIB(lX + 1, lY)
                        Next lY
                    Next lX
                End If
                lX = lX + 1
                If lX > lScrollWidth Then
                    bScroll = True
                    lX = lScrollWidth
                End If
                'Generate a SignCurve for the display (demo)
                'This is were you'd put your routine to dispay what ever it
is...
                dSign = dSign + 10 'Steps at 10 degrees here <???>
                If dSign > 360 Then dSign = 0
                'Calculate lY to keep in within the PictureBox
                lY = lDIBHeight / 2 - (Sin(dSign * cPI180) * (lDIBHeight / 3))
                'White on Black Background here
                taWorkDIB(lX, lY).Red = 255
                taWorkDIB(lX, lY).Green = 255
                taWorkDIB(lX, lY).Blue = 255
                'Update the PictureBox
                lRtn = DIB_Routines(Picture1, taWorkDIB, taTempDIB, taUnDoDIB,
DIBOperation.WorkToPic, lDIBWidth, lDIBHeight)
                'Check for CancelProcess
                DoEvents
                If bCancelProcess Then
                    Exit Sub
                End If
            Loop
        Case 1
            bCancelProcess = True
            Command1(0).Enabled = True
            Command1(1).Enabled = False
    End Select
    
End Sub

Private Sub Form_Load()
    'Set up the form and controls here
    With Me
        .Height = 3780
        .Width = 6375
        .Caption = "Scrolling Graph Example"
    End With
    
    With Picture1
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .BackColor = vbBlack 'Black Background with White spots...
        .Height = 2145
        .Width = 6015
        .Left = 150
        .Top = 150
    End With
    
    With Command1(0)
        .Caption = "Start"
        .Height = 465
        .Width = 2055
        .Left = 180
        .Top = 2610
        .Enabled = True
    End With
        
    With Command1(1)
        .Caption = "Cancel Process"
        .Height = 465
        .Width = 2055
        .Left = 4050
        .Top = 2610
        .Enabled = False
    End With
    
    Randomize
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    bCancelProcess = True
End Sub

***Module Code***
Option Explicit

Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0&
Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Public Type RGBQUAD
    Blue As Byte
    Green As Byte
    Red As Byte
    QuadReserved As Byte
End Type

Public Enum DIBOperation
    GetDIB = 0
    WorkToPic = 1
    TempToPic = 2
    PicToWork = 3
    PicToTemp = 4
    Undo = 5
End Enum

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
End Type
Private BMapInfo As BITMAPINFO
Private Declare Function GetDIBits Lib "gdi32" _
                          (ByVal hdc As Long, ByVal hBitmap As Long, _
                          ByVal nStartScan As Long, ByVal nNumScans As Long, _
                          lpBits As Any, lpBI As BITMAPINFO, _
                          ByVal wUsage As Long) As Long
Private Declare Function SetDIBitsToDevice Lib "gdi32" _
                          (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long,
_
                          ByVal dX As Long, ByVal dy As Long, ByVal SrcX As
Long, _
                          ByVal SrcY As Long, ByVal Scan As Long, _
                          ByVal NumScans As Long, Bits As Any, _
                          BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Public Function DIB_Routines(PicBox As PictureBox, _
                             taWork() As RGBQUAD, _
                             taTemp() As RGBQUAD, _
                             taUnDo() As RGBQUAD, _
                             lOperation As Long, _
                             Optional lWidth As Long = 0, _
                             Optional lHeight As Long = 0) As Long

  Dim lRet As Long, xp As Long, yp As Long
  Dim t1 As Long, t2 As Long
  Dim lPicWidth As Long
  Dim lPicHeight As Long
  Dim lPicSWidth As Long
  Dim lPicSHeight As Long

    lPicSWidth = PicBox.ScaleWidth
    lPicSHeight = PicBox.ScaleHeight
    lPicWidth = lPicSWidth - 1
    lPicHeight = lPicSHeight - 1
    With BMapInfo.bmiHeader
        .biSize = 40
        .biWidth = lPicSWidth
        .biHeight = lPicSHeight
        .biPlanes = 1
        .biBitCount = 32 'This gives an extra byte to play with (RGBQUAD)
        .biCompression = BI_RGB
    End With
    Select Case lOperation
        Case 0 'GetDIB
            ReDim taWork(lPicWidth, lPicHeight)
            ReDim taTemp(lPicWidth, lPicHeight)
            ReDim taUnDo(lPicWidth, lPicHeight)
            lRet = GetDIBits(PicBox.hdc, PicBox.Image, _
                   0&, lPicSHeight, taWork(0, 0), BMapInfo, _
                   DIB_RGB_COLORS)
        Case 1 'WorkToPic
            lRet = SetDIBitsToDevice(PicBox.hdc, 0&, 0&, lPicWidth, _
                   lPicHeight, 0&, 0&, 0&, lPicHeight, taWork(0, 0), _
                   BMapInfo, DIB_RGB_COLORS)
            PicBox.Refresh
        Case 2 'TempToPic
            lRet = SetDIBitsToDevice(PicBox.hdc, 0&, 0&, lPicWidth, _
                   lPicHeight, 0&, 0&, 0&, lPicHeight, taTemp(0, 0), _
                   BMapInfo, DIB_RGB_COLORS)
            PicBox.Refresh
        Case 3 'PicToWork
            lRet = GetDIBits(PicBox.hdc, PicBox.Image, _
                   0&, lPicHeight, taWork(0, 0), BMapInfo, _
                   DIB_RGB_COLORS)
        Case 4 'PicToTemp
            lRet = GetDIBits(PicBox.hdc, PicBox.Image, _
                   0&, lPicHeight, taTemp(0, 0), BMapInfo, _
                   DIB_RGB_COLORS)
        Case 5 'UnDo
            taWork = taUnDo
            lRet = SetDIBitsToDevice(PicBox.hdc, 0&, 0&, lPicWidth, _
                   lPicHeight, 0&, 0&, 0&, lPicHeight, taWork(0, 0), _
                   BMapInfo, DIB_RGB_COLORS)
    End Select
    lWidth = lPicWidth
    lHeight = lPicHeight
    DIB_Routines = lRet

End Function

Public Function ClearDIBArrays(taWork() As RGBQUAD, _
                               taTemp() As RGBQUAD, _
                               taUnDo() As RGBQUAD, _
                               lWidth As Long, _
                               lHeight As Long) As Long

    ReDim taWork(lWidth, lHeight)
    ReDim taTemp(lWidth, lHeight)
    ReDim taUnDo(lWidth, lHeight)

End Function

'***************
'The next two are just R&D routines
Public Function GetDIBPixelLong(taGetPixel() As RGBQUAD, _
                                lX As Long, _
                                lY As Long) As Long

    GetDIBPixelLong = RGBQuadToLong(taGetPixel(lX, lY))

End Function

Public Function SetDIBPixelLong(lColor As Long, taSetPixel() As RGBQUAD, _
                                lX As Long, _
                                lY As Long)

    taSetPixel(lX, lY) = LongToRGBQuad(lColor)

End Function

'***************

Public Function RGBQuadToLong(tRGBQuad As RGBQUAD) As Long

    RGBQuadToLong = (CLng(tRGBQuad.Blue) * 65536) + (CLng(tRGBQuad.Green) *
256&) + CLng(tRGBQuad.Red)

End Function

Public Function LongToRGBQuad(lRGB As Long) As RGBQUAD

    LongToRGBQuad.Blue = CByte((lRGB And &HFF0000) \ 65536)
    LongToRGBQuad.Green = CByte((lRGB And &HFF00&) \ 256)
    LongToRGBQuad.Red = CByte(lRGB And &HFF&)
    'The Next is Really not needed but could be used for Alpha Channel
    LongToRGBQuad.QuadReserved = 0

End Function


Have a good day...

Don
0
Don226 (210)
7/1/2004 5:13:53 PM
Reply: