frmtest.frm

VBVC之间的通信

VERSION 5.00
Begin VB.Form frmTest 
   Caption         =   "Graph_VB"
   ClientHeight    =   8010
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11460
   LinkTopic       =   "Form1"
   ScaleHeight     =   8010
   ScaleWidth      =   11460
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command4 
      Caption         =   "Command4"
      Height          =   495
      Left            =   9480
      TabIndex        =   7
      Top             =   0
      Width           =   975
   End
   Begin VB.CommandButton Command3 
      Caption         =   "Command3"
      Height          =   495
      Left            =   8520
      TabIndex        =   6
      Top             =   0
      Width           =   975
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Command2"
      Height          =   495
      Left            =   7560
      TabIndex        =   5
      Top             =   0
      Width           =   975
   End
   Begin VB.OptionButton Option1 
      Caption         =   "STACK"
      Height          =   375
      Index           =   2
      Left            =   5640
      TabIndex        =   4
      Top             =   120
      Width           =   1575
   End
   Begin VB.OptionButton Option1 
      Caption         =   "ABREAST"
      Height          =   375
      Index           =   1
      Left            =   4080
      TabIndex        =   3
      Top             =   120
      Width           =   1575
   End
   Begin VB.OptionButton Option1 
      Caption         =   "UPDOWN"
      Height          =   375
      Index           =   0
      Left            =   2400
      TabIndex        =   2
      Top             =   120
      Value           =   -1  'True
      Width           =   1575
   End
   Begin VB.PictureBox Picture1 
      Height          =   7335
      Left            =   0
      ScaleHeight     =   7275
      ScaleWidth      =   11355
      TabIndex        =   1
      Top             =   600
      Width           =   11415
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   1455
   End
End
Attribute VB_Name = "frmTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type LPBMPFILE
    FileName As String
    Width As Long
    Height As Long
End Type

Private Type LPLEGENDSET
    ID As Long
    Tips As String
End Type

Private Type LPCOLORSET
    ID As Long
    Data As Long
End Type

Private Type LPDATASET
    ID As Long
    Data As Double
End Type

Private Type LPDATAPARAM
    Row As Long
    Col As Long
End Type

Private Type LPGRAPHPARAM
    ChartType As Long
    Title As String
    XLabelStep As Long
    YTicks As Long
    XText As String
    YText As String
    XStart As Long
    RoundY  As Long
    MarkerType As Long
    BackColor As Long
End Type

Private Const GSX_TYPE_UPDOWN = 0      ' 上下型
Private Const GSX_TYPE_ABREAST = 1     ' 并排型
Private Const GSX_TYPE_STACK = 2       ' 堆积型

Private Const GSX_DATASET_MARKER_NONE = 0
Private Const GSX_DATASET_MARKER_TRI = 1
Private Const GSX_DATASET_MARKER_BOX = 2
Private Const GSX_DATASET_MARKER_SPH = 4
Private Const GSX_DATASET_MARKER_DIA = 8

Private Declare Function GraphToBitmap Lib "XGraph.dll" (olegend() As LPLEGENDSET, ocolor() As LPCOLORSET, odata() As LPDATASET, _
    tfile As LPBMPFILE, tdata As LPDATAPARAM, tchart As LPGRAPHPARAM) As Long

Private Declare Function AddLongs_Pointer Lib "MyStDll.DLL" _
   (FirstElement As Long, ByVal lElements As Long) As Long

Private Declare Function AddLongs_SafeArray Lib "MyStDll.DLL" _
   (FirstElement() As Long, lSum As Long) As Long
   
'Private Declare Function ModifyStruct Lib "MyStDll.dll" _
'   (FirstElement() As Long, lSum As Long)
   
Private Type TestUDT
    l As Long
    mstr As String
End Type

Private Type My_VarUDT
        F1 As Integer
        F2 As Long
        F3 As Byte
        F4(0 To 1) As Byte  ' to avoid UNICODE/ANSI conversion
        F5 As Single
      End Type

      Private Type My_ArrayUDT
        F1 As Integer
        F2 As Long
        F3 As Byte
        F4 As String * 1
        F5 As Single
      End Type

      Private Declare Sub FillUDTVariable Lib "MyStDll.DLL" (A As My_VarUDT)
      Private Declare Sub FillUDTSafeArray Lib "MyStDll.DLL" (A() As My_ArrayUDT)

Private Function Max(a1 As Double, a2 As Double) As Double
    Max = IIf(a1 > a2, a1, a2)
End Function

Private Function Min(a1 As Double, a2 As Double) As Double
    Min = IIf(a1 > a2, a2, a1)
End Function

Private Sub Command1_Click()
    Dim i, j As Long
    Dim m As Double
    Dim xmin As Double, xmax As Double
    Dim odata(1 To 6) As LPDATASET
    Dim ocolor(1 To 6) As LPCOLORSET
    Dim olegend(1 To 6) As LPLEGENDSET
    Dim tfile As LPBMPFILE
    Dim tchart As LPGRAPHPARAM
    Dim tdata As LPDATAPARAM
    
    Randomize
    
'********************************************
'** Type= GSX_TYPE_STACK
    For i = 1 To 6
        odata(i).ID = i
        odata(i).Data = i * 100
        olegend(i).ID = i
        olegend(i).Tips = "个大12"
        ocolor(i).ID = i
        ocolor(i).Data = &H80FF80
    Next
    
    tchart.ChartType = GSX_TYPE_STACK
    tdata.Col = 3
'********************************************
    
    tfile.FileName = "1.bmp"
    tfile.Width = 609
    tfile.Height = 300
    
    tdata.Row = 2
    
    tchart.Title = "收支图"
    tchart.XLabelStep = 5
    tchart.XText = "年龄"
    tchart.YText = "单位(万元)"
    tchart.YTicks = 10
    tchart.XStart = 20
    tchart.RoundY = 1000
    tchart.MarkerType = GSX_DATASET_MARKER_NONE
    
    If GraphToBitmap(olegend(), ocolor(), odata(), tfile, tdata, tchart) = 0 Then Debug.Print "OK"
    
    Picture1.Picture = LoadPicture("1.bmp")
End Sub

Private Sub Command2_Click()

      Dim ArrayOfLongs(2) As Long
      Dim lSum As Long
      Dim k As Long

      ArrayOfLongs(0) = 1
      ArrayOfLongs(1) = 2
      ArrayOfLongs(2) = 3

      lSum = AddLongs_Pointer(ArrayOfLongs(0), UBound(ArrayOfLongs) + 1)
      MsgBox "Result with C array = " & Str$(lSum)

      k = AddLongs_SafeArray(ArrayOfLongs(), lSum)
      If k = 0 Then
         MsgBox "Result with Safearray = " & Str$(lSum)
      Else
         MsgBox "Call with Safearray failed"
      End If
End Sub

Private Sub Command3_Click()
'Dim t(0 To 1) As TestUDT
'        Dim i As Long
'
'        t(0).l = 1
'        t(0).mstr = "test1"
'
'        t(1).l = 2
'        t(1).mstr = "Test2"
'
'        i = UBound(t) - LBound(t) + 1
'        ModifyStruct t(0), i  't(0)'s address will be passed to C
'
'        MsgBox "t(1).l = " & t(1).l & vbCrLf & "t(1).mstr = " & t(1).mstr
      
End Sub

Private Sub Command4_Click()

      Dim A As Long, B As My_VarUDT, C As String, D(3) As My_ArrayUDT
        Debug.Print "---Variable of My_VarUDT-------"
        FillUDTVariable B
        With B
          C = .F4
          Debug.Print .F1, .F2, .F3, C; "("; .F4(0); .F4(1); ")", .F5
        End With
        Debug.Print "---Safe array of My_ArrayUDT-------"
        FillUDTSafeArray D()
        For A = 0 To 3
          With D(A)
            Debug.Print .F1, .F2, .F3, .F4; "("; AscB(MidB(.F4, 1, 1));
            Debug.Print AscB(MidB(.F4, 2, 1)); ")", .F5
          End With
        Next A
End Sub