The example creates two charts from scratch and also demonstrates how you can load a pre-made .rmc chart file.
Basicaly all you need for creating charts is rmchart.dll in the same folder with your application.
If you don't have win-xp or vista an additional dll is reqired as described in the control's documentation.
You can download the dll and the documentation from here
http://www.rmchart.com
Code: Select all
#define WIN_INCLUDEALL
'' Sub Declarations
Declare Sub S_myopen()
Declare Sub MakeSampleCharts()
Declare Sub S_dialog(Byref filetoopen as string)
'' Include
#include once "windows.bi"
#include once "win/commctrl.bi"
Function StringToBSTR( cnv_string As String ) As BSTR
Dim sb As BSTR
sb = SysAllocStringByteLen( Strptr( cnv_string ), Len( cnv_string ) )
*cast( Zstring Ptr, sb ) = cnv_string
Return sb
End Function
'' Declare
Declare Sub register_classes
Declare Function message_loop As integer
Declare Function wnd_proc0(Byval thiswnd As hwnd, Byval message As uinteger, Byval w_param As wparam, Byval l_param As lparam) As lresult
Declare Function create_wnd0 As hwnd
Declare Sub create_wnd_content0(byval parent as hwnd)
'' Names of Window Classes
Const WND_CLASS_NAME0 = "my_wnd_class_name_0"
'' Global Data
Dim Shared instance as hmodule
Dim Shared h_font as HFONT
'' Menu Module Header
Type TMENU
hnd as HMENU
End Type
Type TMENUITEM
title as string
id as integer
End Type
Const MENUID_BASE = 100
Const MAXMENUS = 10
Const MAXMENUITEMS = 50
Declare Sub init_menus(byval hWnd as HWND)
Declare Sub menu_insert(byval hmenu as HMENU, byval submenu as integer, title as string, byval flags as integer = 0)
Declare Sub menu_append(byval submenu as integer, byval id as integer, title as string, byval flags as integer = 0)
Declare Sub menu_separator(byval submenu as integer)
Dim Shared submenuTB(0 to MAXMENUS) as TMENU
Dim Shared menuitemTB(0 to MAXMENUITEMS-1) as TMENUITEM
Declare Function file_getname( byval hWnd as HWND ) as string
Const myopen = 100
Dim Shared hwndform As hwnd '' Form Handle
'' Menu Module Subs
Sub menu_insert(byval hmenu as HMENU, byval submenu as integer, title as string, byval flags as integer = 0)
With submenuTB(submenu)
.hnd = CreatePopupMenu( )
InsertMenu(hmenu, submenu, MF_BYPOSITION Or MF_POPUP Or MF_STRING or flags, cuint( .hnd ), title)
End With
End Sub
Sub menu_append(byval submenu as integer, byval id as integer, title as string, byval flags as integer = 0)
With menuitemTB(id-MENUID_BASE)
.id = id
.title = title
AppendMenu(submenuTB(submenu).hnd, MF_STRING or flags, id, title)
End With
End Sub
Sub menu_separator(byval submenu as integer)
AppendMenu(submenuTB(submenu).hnd, MF_SEPARATOR, 0, NULL)
End Sub
Sub init_menus(byval hWnd as HWND)
Dim menu as HMENU
menu = CreateMenu( )
menu_insert(menu, 0,"&file")
menu_append( 0,myopen,"&open...")
SetMenu(hWnd, menu)
DrawMenuBar(hWnd)
End Sub
Function file_getname( byval hWnd as HWND ) as string
Dim ofn as OPENFILENAME
Dim filename as zstring * MAX_PATH+1
With ofn
.lStructSize = sizeof( OPENFILENAME )
.hwndOwner = hWnd
.hInstance = GetModuleHandle( NULL )
.lpstrFilter = strptr( !"All Files, (*.*)\0*.*\0RMS Files, (*.RMC)\0*.rmc\0\0" )
.lpstrCustomFilter = NULL
.nMaxCustFilter = 0
.nFilterIndex = 1
.lpstrFile = @filename
.nMaxFile = sizeof( filename )
.lpstrFileTitle = NULL
.nMaxFileTitle = 0
.lpstrInitialDir = NULL
.lpstrTitle = @"Open a File"
.Flags = OFN_EXPLORER or OFN_FILEMUSTEXIST or OFN_PATHMUSTEXIST
.nFileOffset = 0
.nFileExtension = 0
.lpstrDefExt = NULL
.lCustData = 0
.lpfnHook = NULL
.lpTemplateName = NULL
End With
If( GetOpenFileName( @ofn ) = FALSE ) Then
Return ""
Else
Return filename
End If
End Function
'' Main Code
instance = GetModuleHandle(null)
InitCommonControls
LoadLibrary "RICHED32.DLL"
register_classes
h_font = CreateFont(-13, 0, 0, 0, FW_NORMAL, 0, _
0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, _
DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, "Times New Roman")
create_wnd0
MakeSampleCharts()
End message_loop
'' Register Windows Classes
Sub register_classes
Dim wc As WNDCLASS
With wc
.cbClsExtra = 0
.cbWndExtra = 0
.hbrBackground = cast(hbrush, COLOR_3DFACE + 1)
.hCursor = LoadCursor(null, byval IDC_ARROW)
.hIcon = LoadIcon(null, byval IDI_APPLICATION)
.hInstance = instance
.lpszMenuName = null
.style = CS_PARENTDC or CS_DBLCLKS
End with
wc.lpfnWndProc = @wnd_proc0
wc.lpszClassName = strptr(WND_CLASS_NAME0)
RegisterClass @wc
End Sub
'' Message Loop
Function message_loop As Integer
Dim message As MSG
While (GetMessage(@message, null, 0, 0) <> false)
TranslateMessage @message
DispatchMessage @message
Wend
DeleteObject h_font
Return message.wParam
End Function
'' Create Window #0
Function create_wnd0 As hwnd
Dim wnd As hwnd
wnd = CreateWindowEx(&h00000100, WND_CLASS_NAME0, "RMChart Example", &h14CF0000, CW_USEDEFAULT, CW_USEDEFAULT, 800, 600, null, null, instance, null)
hwndform = wnd
ShowWindow wnd, SW_SHOWNORMAL
UpdateWindow wnd
Return wnd
End Function
Sub create_wnd_content0(byval parent as hwnd)
End Sub
'' window procedure #0
Function wnd_proc0(byval thiswnd as hwnd, byval message as uinteger, byval w_param as wparam, byval l_param as lparam) as lresult
Select Case message
Case WM_CREATE
create_wnd_content0 thiswnd
init_menus(thiswnd)
Case WM_CLOSE
If IDYES = MessageBox(thiswnd, "Quit?", "Exit Program...", MB_YESNO or MB_ICONQUESTION) Then
DestroyWindow thiswnd
End If
Case WM_DESTROY
PostQuitMessage 0
Case WM_COMMAND
Select Case loword(w_param)
Case myopen
S_myopen()
Case Else
End Select
Case Else
Return DefWindowProc(thiswnd, message, w_param, l_param)
End Select
Return 0
End Function
'' Sub Codes
Sub S_myopen()
Dim a As string
S_dialog(a)
Dim rc As Long
Dim Chart_Draw As Function (ByVal nParentHndl As long,ByVal nCtrlId As long, ByVal nX As long, ByVal nY As long, ByVal nExportOnly As long, Byval aa As bstr) As long
Dim Chart2_Draw As Function ( ByVal nCtrlId As Long ) As Long
Dim Chart_DeleteChart As Function (ByVal oh As Long) As Long
Dim hndl As Any Ptr
hndl=DyLibLoad("rmchart.dll")
' find the proc address (case matters!)
Chart_Draw = DyLibSymbol( hndl, "RMC_CREATECHARTFROMFILE" )
Chart2_Draw = DyLibSymbol( hndl, "RMC_DRAW" )
Chart_DeleteChart = DyLibSymbol( hndl, "RMC_DELETECHART" )
' call it..
' First delete the two sample charts created when started application
rc = Chart_DeleteChart(5000)
rc = Chart_DeleteChart(5001)
'Then Load the chart from the file
rc = Chart_Draw (hwndform,6000,10,10,0,StringToBSTR(a))
rc = Chart2_Draw(6000)
End Sub
Sub MakeSampleCharts()
Dim o_h As Long : o_h = 5000
Dim r_c As Long
Dim va(9) As Double
va(0) = 20
va(1) = 32
va(2) = 45
va(3) = 76
va(4) = 50
va(5) = 89
va(6) = 72
va(7) = 41
va(8) = 45
va(9) = 27
Dim hndl_pointer As Any ptr
hndl_pointer = DyLibLoad("rmchart.dll")
Dim Chart_CreateChart As Function (ByVal fh As Long, ByVal oh As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, byVal dy As Long, _
ByVal a1 As Long, ByVal a2 As Long, ByVal a3 As Long, ByVal a4 As bstr, ByVal a5 As bstr, ByVal a6 As Long, ByVal a7 As Long) As Long
Dim Chart_AddRegion As Function (ByVal oh As Long, _
ByVal a1 As Long, ByVal a2 As Long, ByVal a3 As Long, ByVal a4 As Long, ByVal a5 As bstr, ByVal a6 As Long ) As Long
Dim Chart_AddGrid As Function (ByVal oh As Long, ByVal r As Long, _
ByVal a1 As Long, ByVal a2 As Long, ByVal a3 As Long, ByVal a4 As Long, ByVal a5 As Long, ByVal a6 As Long, ByVal a7 As Long) As Long
Dim Chart_AddLabelAxis As Function (ByVal oh As Long, ByVal r As Long, Byval s As bstr, _
ByVal a1 As Long, ByVal a2 As Long, ByVal a3 As Long, ByVal a4 As Long, ByVal a5 As Long, ByVal a6 As Long, ByVal a7 As Long, ByVal a8 As Long, ByVal a9 As bstr) As Long
Dim Chart_AddDataAxis As Function (ByVal oh As Long, ByVal r As Long, _
ByVal a1 As Long, ByVal a2 As Double, ByVal a3 As Double, ByVal a4 As Long, ByVal a5 As Long, ByVal a6 As Long, ByVal a7 As Long, ByVal a8 As Long, ByVal a9 As Long, ByVal a10 As bstr, ByVal a11 As bstr, ByVal a12 As bstr, ByVal a13 As Long) As Long
Dim Chart_AddLineSeries As Function (ByVal oh As Long, ByVal r As Long, ByRef a1 As Double, ByVal a2 As Long, ByVal a3 As Long,ByVal a4 As Long,ByVal a5 As Long,ByVal a6 As Long,ByVal a7 As Long,ByVal a8 As Long,ByVal a9 As Long,ByVal a10 As Long,ByVal a11 As Long,ByVal a12 As Long,ByVal a13 As Long) As Long
Dim Chart_SetSeriesData As Function (ByVal oh As Long, ByVal r As Long , ByVal sr As Long, ByRef d As Double, ByVal n As Long, _
ByVal a1 As Long) As Long
Dim Chart_Draw As Function (ByVal oh As Long) As Long
Dim Chart_AddGridlessSeries As Function (ByVal oh As Long, ByVal r As Long, _
ByRef a1 As Double, ByVal a2 As Long, ByRef a3 As Long, ByVal a4 As Long, ByVal a5 As Long,ByVal a6 As Long,ByVal a7 As Long,ByVal a8 As Long,ByVal a9 As Long,ByVal a10 As Long,ByVal a11 As Long) As Long
Chart_CreateChart = DylibSymbol(hndl_pointer,"RMC_CREATECHART")
Chart_AddRegion = DylibSymbol(hndl_pointer,"RMC_ADDREGION")
Chart_AddGrid = DylibSymbol(hndl_pointer,"RMC_ADDGRID")
Chart_AddLabelAxis = DylibSymbol(hndl_pointer,"RMC_ADDLABELAXIS")
Chart_AddDataAxis = DylibSymbol(hndl_pointer,"RMC_ADDDATAAXIS")
Chart_AddLineSeries = DylibSymbol(hndl_pointer,"RMC_ADDLINESERIES")
Chart_SetSeriesData = DylibSymbol(hndl_pointer,"RMC_SETSERIESDATA")
Chart_Draw = DylibSymbol(hndl_pointer,"RMC_DRAW")
Chart_AddGridlessSeries = DylibSymbol(hndl_pointer,"RMC_ADDGRIDLESSSERIES")
' Create a Pie Chart
Dim RMC_VLABEL_PERCENT As Long :RMC_VLABEL_PERCENT = 5
r_c = Chart_CreateChart(hwndform, o_h, 20 , 20 , 320 , 240, 0, 0, 0, StringToBSTR(" "), StringToBSTR(" "), 0, 0 )
r_c = Chart_AddRegion(o_h , 0 ,0 ,0 ,0 , StringToBSTR(" ") , 0)
r_c = Chart_AddGridlessSeries(o_h,1,va(0),10,0,0,0,0,0,0,RMC_VLABEL_PERCENT,0,0)
r_c = Chart_Draw(o_h)
' Create a line Chart
r_c = Chart_CreateChart(hwndform, o_h+1, 400 , 20 , 320 , 240, 0, 0, 0, StringToBSTR(" "), StringToBSTR(" "), 0, 0 )
r_c = Chart_AddRegion(o_h+1 , 0 ,0 ,0 ,0 , StringToBSTR(" ") , 0)
r_c = Chart_AddGrid(o_h+1,1,0,0,0,0,0,0,0)
r_c = Chart_AddLabelAxis(o_h+1, 1 , StringToBSTR("10*20*30*40*50*60*70*80*90*100"), 0,0,0,0,0,0,0,0,StringToBSTR(" "))
r_c = Chart_AddDataAxis(o_h+1,1,0,0,100,0,0,0,0,0,0,StringToBSTR(" "),StringToBSTR(" "),StringToBSTR(" "),0)
r_c = Chart_AddLineSeries(o_h+1,1,0,0,0,0,0,0,0,0,0,0,0,0,0)
r_c = Chart_SetSeriesData(o_h+1, 1, 1, va(0), 10, 0)
r_c = Chart_Draw(o_h+1)
'MessageBox(NULL, Str$(r_c), "Event!",MB_ICONEXCLAMATION Or MB_OK)
End Sub
Sub S_dialog(Byref filetoopen as string)
filetoopen = file_getname(hwndform)
End Sub