Bargraph DDT example

Code:
'==============================================================================
' Barchart DDT example using progress bars.
' Made: P.Lameijn
' Uses progressbars. (Max 10) / Autoscaling / Multi colors
'------------------------------------------------------------------------------
#Compile Exe
#Dim All
#Register None

%NOANIMATE      = 1 :%NOBUTTON       = 1 :%NOCOMBO     = 1 :%NODRAGLIST    = 1
%NOHEADER       = 1 :%NOHOTKEY       = 1 :%NOPIADDRESS = 1 :%NOLIST        = 1
%NONATIVEFONTCTL= 1 :%NOPAGESCROLLER = 1 :%NOREBAR     = 1 :%NOTABCONTROL  = 1
%NOMONTHCAL     = 1 :%NOTREEVIEW     = 1 :%NOTOOLTIPS  = 1 :%NOTOOLBAR     = 1
%NOTRACKBAR     = 1 :%NODATETIMEPICK = 1 :%NOLISTVIEW  = 1 :%NOIMAGELIST   = 1
%NOSTATUSBAR    = 1 :%NOUPDOWN       = 1 :%NOTRACKBAR  = 1
'%NOPROGRESS      = 1

#Include "win32api.inc"
#Include "Commctrl.inc"

%CMD_STATS_OK = 4998 : %TIMERID1     = 4999 : %STATS        = 5000 : %MAXBARS = 10

Type BarType
  Bars              As Long             'Number of bars to draw
  bLeft             As Long             'Left startingpoint
  bTop              As Long             'Top startingpoint
  bColor(%MAXBARS)  As Long             'BarColor. bColor(0) is all equal color
  bText(%MAXBARS)   As Asciiz * 20      'Text left of bar
  bValue(%MAXBARS)  As Long             'Bar value
  Caption           As Asciiz * 30      'Caption
  Scale             As Long             'Scale of bars (-1 = auto)
End Type

Global hDlg As Long, hTimer As Long, SBar As BarType

'==============================================================================
'Initial drawing of bars
'------------------------------------------------------------------------------
Sub DrawBars(hDlg As Long, SBar As BarType)
  Local lCnt As Long, lRet As Long
  If sBar.Bars Then
    Control Add Frame, hDlg, %STATS, sBar.Caption, sBar.bLeft, sBar.bTop, 185, 11 + ((sBar.Bars + 1) * 15) + 5
    For lCnt = 1 To sBar.Bars
      Control Add Label, hDlg, %STATS + (lCnt-1) * 3,sBar.bText(lCnt), 10, 6 +(lCnt*14), 45, 13
      Control Add Label, hDlg, %STATS + 1 + (lCnt-1) * 3, Format$(sBar.bValue(lCnt),"0"), _
                   160, 6 +(lCnt*14), 25, 13,, %WS_EX_CLIENTEDGE
      Control Add "msctls_progress32", hDlg, %STATS + 2 + (lCnt-1) * 3, "", 55, _
                   6 + (lCnt*14),100, 13, %WS_CHILD Or %WS_VISIBLE Or %PBS_SMOOTH
      If sBar.bColor(0) Then lRet = sBar.bColor(0) Else lRet = sBar.bColor(lCnt)
      Control Send hDlg, %STATS + 2 + (lCnt-1) * 3, %PBM_SETBARCOLOR, 0, lRet
    Next
  Control Add Label, hDlg, %STATS + sBar.Bars * 3 + 1, _
          "0 . . . . | . . . . | . . . . | . . . . | . . . .", 52, 8 + (sBar.Bars + 1) * 14, 98, 12
  Control Add Label, hDlg, %STATS + sBar.Bars * 3 + 2, "100", 150, 8 + (sBar.Bars + 1) * 14, 20, 12
  End If
End Sub

'==============================================================================
'Call this to update state  - Values in sBar type are used
'------------------------------------------------------------------------------
Sub SetBars ()
  Local lRet As Long, lCnt As Long
  If sBar.Scale = 0 Then
    lRet = 0
    For lCnt = 1 To sBar.Bars
      If sBar.bValue(lCnt) > lRet Then lRet = sBar.bValue(lCnt)
    Next
    lRet = ((lRet \ 9) + 1) * 10
  Else
    lRet = sBar.Scale
  End If
  Control Set Text hDlg, %STATS + sBar.Bars * 3 + 2, Str$(lRet)
  For lCnt = 0 To sBar.Bars -1
    Control Send hDlg, %STATS + 2 + lCnt * 3, %PBM_SETRANGE, 0, MakLng(0,lret)
    Control Send hDlg, %STATS + 2 + lCnt * 3, %PBM_SETPOS, sBar.bValue(lCnt+1), 0
    Control Set Text hDlg, %STATS + 1 + lCnt * 3, Trim$(Str$(sBar.bValue(lCnt+1)))
  Next
End Sub

'------------------------------------------------------------------------------
' Testprogram
'------------------------------------------------------------------------------
CallBack Function CbMain ()
  Local lST As SystemTime
  Select Case CbMsg
    Case %WM_INITDIALOG
      hTimer = SetTimer (hDlg,%TIMERID1,250,ByVal %Null)
    Case %WM_COMMAND
      Select Case CbCtl
        Case %CMD_STATS_OK : Dialog End hDlg
      End Select
    Case %WM_TIMER
      GetLocalTime lSt
      sBar.bValue(1) = lSt.wYear - 2000
      sBar.bValue(2) = lSt.wMonth
      sBar.bValue(3) = lSt.wDay
      sBar.bValue(4) = lSt.wHour
      sBar.bValue(5) = lSt.wMinute
      sBar.bValue(6) = lSt.wSecond
      SetBars
  End Select
End Function

'..............................................................................
Function PbMain
  Local LRet As Long, lZStr As Asciiz * 64, lCnt As Long
  InitCommonControls                                     'Initialize the common
  Local Icc As Init_Common_ControlsEx                    'controls Dll and the
  Icc.dwSize = SizeOf(Icc)                               'extended classes
  Icc.dwIcc = %ICC_BAR_CLASSES
  InitCommonControlsEx Icc
'..............................................................................

  Dialog New 0, "Bargraph demo" ,,, 195, 200, _
                    %DS_MODALFRAME Or %WS_CAPTION Or %WS_POPUP, %WS_EX_TOPMOST, To hDlg
  Control Add Button,   hDlg, %CMD_STATS_OK,"OK", 70, 170, 50, 15
' Set whatever you want.......
  sBar.bTop  = 5
  sBar.bLeft = 5
  sBar.bText(1) = "Year"
  sBar.bText(2) = "Month"
  sBar.bText(3) = "Day"
  sBar.bText(4) = "Hour"
  sBar.bText(5) = "Min"
  sBar.bText(6) = "Sec"

  sBar.Bars       = 6
  sBar.Scale      = 0
  sBar.bColor (0) = 0
  sBar.bColor (1) = Rgb (200,  0,  0)
  sBar.bColor (2) = Rgb (  0,200,  0)
  sBar.bColor (3) = Rgb (  0,  0,200)
  sBar.bColor (4) = Rgb (200, 85,  0)
  sBar.bColor (5) = Rgb (200,200,  0)
  sBar.bColor (6) = Rgb (200,  0,200)
  sBar.Caption    = "[ Bar Graph Test ]"
  DrawBars hDlg,sBar
  SetBars

  Dialog Show Modal hDlg Call CBMain
  KillTimer hDlg, %TIMERID1
End Function

'------------------------------------------------------------------------------
------------------
Peter.
mailto
[email protected][email protected]</A>
Announcement

Forum Guidelines

Bargraph DDT example
