pub_lib.vb

基于Windows Mobile平台的客户关系系统（CRM）

Module pub_lib

    Function GetDBConnString() As String
        Return "Data Source=" + GetAppPath() + "\cardb.sdf; password=cardb"
    End Function

    Function CustomDataGridTableStyle(ByVal ds As DataSet, ByVal headercaption(,) As String) As DataGridTableStyle
        Dim ts As New DataGridTableStyle
        Dim TxtCol As DataGridTextBoxColumn
        Dim i As Integer

        
        ts.MappingName = ds.Tables(0).TableName
        For i = 0 To headercaption.GetLength(0) - 1
            TxtCol = New DataGridTextBoxColumn
            With TxtCol
                .MappingName = headercaption(i, 0)
                .HeaderText = headercaption(i, 1)
                .Width = headercaption(i, 2)
                .NullText = ""
            End With
            ts.GridColumnStyles.Add(TxtCol)
        Next i
        Return ts
    End Function

    Function GetDataSet(ByVal sql As String) As DataSet
        Dim conn As New System.Data.SqlServerCe.SqlCeConnection(GetDBConnString())
        Dim adp As New System.Data.SqlServerCe.SqlCeDataAdapter
        Dim ds As New System.Data.DataSet

        Try
            If conn.State = ConnectionState.Open Then conn.Close()
            conn.Open()

            adp = New System.Data.SqlServerCe.SqlCeDataAdapter(sql, conn)
            adp.Fill(ds)
            conn.Close()
        Catch ex As SqlServerCe.SqlCeException
            conn.Close()
        End Try
        Return ds
    End Function

    Function GetAppPath() As String
        Dim fullname As String
        Dim myAppPath As String

        fullname = System.Reflection.Assembly.GetExecutingAssembly().GetName().CodeBase
        myAppPath = System.IO.Path.GetDirectoryName(fullname)

        Return myAppPath
    End Function

    Function ExecuteSQL(ByVal sql As String) As Boolean
        Dim conn As New System.Data.SqlServerCe.SqlCeConnection(GetDBConnString())
        Dim cmd As New System.Data.SqlServerCe.SqlCeCommand
        Dim isSuccess As Boolean

        isSuccess = True
        Try
            If conn.State = ConnectionState.Open Then conn.Close()
            conn.Open()
            cmd = New System.Data.SqlServerCe.SqlCeCommand(sql, conn)
            cmd.CommandType = CommandType.Text
            cmd.ExecuteNonQuery()
        Catch ex As SqlServerCe.SqlCeException
            isSuccess = False
        End Try

        conn.Close()

        Return isSuccess
    End Function

    Function GetPageNum(ByVal ds As DataSet, ByVal PageSize As Integer) As Integer
        Dim pagenum As Integer
        Dim rownum As Integer

        'rownum = ds.Tables(0).Select().GetUpperBound(0)
        rownum = ds.Tables(0).Rows.Count '返回的是实际记录数
        pagenum = rownum / PageSize
        If Not (rownum Mod PageSize) <> 0 Then '为何要加Not？！
            pagenum += 1
        End If
        Return pagenum
    End Function

    Function QueryWithPage(ByVal ds As DataSet, ByVal PageSize As Integer, ByRef PageIndex As Integer) As DataTable
        Dim dt As New DataTable
        Dim i As Integer
        Dim sIndex As Integer
        Dim eIndex As Integer
        Dim rownum As Integer
        Dim pagenum As Integer


        pagenum = GetPageNum(ds, PageSize)
        rownum = ds.Tables(0).Select().GetUpperBound(0) '返回的是数组最大维度数

        If PageIndex <= 0 Then
            PageIndex = 0
        End If
        
        If PageIndex >= pagenum Then
            PageIndex = pagenum
        End If

        sIndex = PageIndex * PageSize
        eIndex = PageIndex * PageSize + PageSize - 1
        If eIndex >= rownum Then
            eIndex = rownum
        End If
        dt = ds.Tables(0).Clone()        
        For i = sIndex To eIndex
            dt.ImportRow(ds.Tables(0).Rows(i))
        Next

        Return dt
    End Function

    Function GetSQLCEErrorMessage(ByVal ex As SqlServerCe.SqlCeException) As String
        Dim err As SqlServerCe.SqlCeError
        Dim strReturn As String = ""
        For Each err In ex.Errors
            strReturn = strReturn + err.Source + ": " + err.Message + vbCrLf
        Next
        Return strReturn
    End Function

    Function CreateDB(ByVal filepath As String, ByVal exError As SqlServerCe.SqlCeException) As Boolean
        Dim engine As SqlServerCe.SqlCeEngine
        engine = New SqlServerCe.SqlCeEngine("datasource=" + filepath + "; Password=cardb;")
        Try
            engine.CreateDatabase()
            engine.Dispose()
            Return True
        Catch ex As SqlServerCe.SqlCeException
            exError = ex
            engine.Dispose()
            Return False
        End Try
    End Function

    Function GetDrawRectangleForStat(ByVal ds As DataSet, ByVal xName As String, ByVal yName As String, ByVal PageSize As Integer, ByRef PageIndex As Integer) As Bitmap
        Dim cBmp As New Bitmap(471, 367) '创建画布宽度为471，高度为367的Bitmap实例
        Dim cGraphic As Graphics
        Dim cColor() As Color = {Color.Red, Color.Blue, Color.Green, Color.Gray, Color.LightCoral, Color.Gold, Color.Brown, _
                                 Color.Cyan, Color.Lime, Color.Peru, Color.Magenta} '每屏最多显示11根柱图，支持翻页显示
        Dim cPen As Pen
        Dim cSolidBrush As SolidBrush
        Dim bFont As New Font("Tahoma", 6, FontStyle.Regular) '轴标字体
        Dim sFont As New Font("Tahoma", 4, FontStyle.Regular) '统计数值字体
        Dim fFont As New Font("Tahoma", 5, FontStyle.Regular) '统计项值字体
        Dim cFormat As New StringFormat()
        Dim cRect As RectangleF
        Dim sIndex As Integer = 0
        Dim eIndex As Integer = 0
        Dim pagenum As Integer = 0
        Dim RowNum As Integer = 0
        Dim iLoop As Integer = 0
        Dim i As Integer = 0
        Dim cValue As Integer = 0
        Dim MaxValue As Integer = 0

        '定义Y轴，Y上(42,15)～Y下(42,317)，Y轴长从17到317共300
        Dim xPu As Integer = 42 'Y轴上(Up)点X坐标
        Dim yPu As Integer = 15 'Y轴上(Up)点Y坐标
        Dim xPd As Integer = 42 'Y轴下(Down)点X坐标
        Dim yPd As Integer = 317 'Y轴下(Down)点Y坐标

        '定义X轴，X左(42,317)～X右(448,317)，X轴上从42到448共406
        Dim xPl As Integer = 42 'X轴左(Left)点X坐标
        Dim yPl As Integer = 317 'X轴左(Left)点Y坐标
        Dim xPr As Integer = 448 'X轴右(Right)点X坐标
        Dim yPr As Integer = 317 'X轴右(Right)点Y坐标

        '定义柱图
        Dim xStart As Integer = 57 '首根柱图开始的X轴坐标
        Dim cWidth As Integer = 20 '柱图宽度
        Dim cSpace As Integer = 15 '柱图间距

        cGraphic = Graphics.FromImage(cBmp)
        cGraphic.Clear(Color.Snow)

        '画轴线
        cPen = New Pen(Color.Black, 3)
        cSolidBrush = New SolidBrush(Color.Black)
        cGraphic.DrawLine(cPen, xPu, yPu, xPd, yPd) 'Y轴
        cGraphic.DrawLine(cPen, xPl, yPl, xPr, yPr) 'X轴

        '画轴向
        cGraphic.DrawLine(cPen, xPu, yPu - 3, xPu - 4, yPu + 3) 'Y轴向
        cGraphic.DrawLine(cPen, xPu, yPu - 3, xPu + 4, yPu + 3)
        cGraphic.DrawLine(cPen, xPr + 3, yPr, xPr - 4, yPr - 3) 'X轴向
        cGraphic.DrawLine(cPen, xPr + 3, yPr, xPr - 4, yPr + 3)

        '画轴标
        cFormat.FormatFlags = StringFormatFlags.NoClip
        cGraphic.DrawString(yName, bFont, cSolidBrush, 5, 45, cFormat) 'Y轴标
        cGraphic.DrawString(xName, bFont, cSolidBrush, 387, 335, cFormat) 'X轴标

        '画轴心值
        cGraphic.DrawString("0", sFont, cSolidBrush, xPd - 5, yPd + 3, cFormat)

        RowNum = ds.Tables(0).Rows.Count - 1
        For i = 0 To RowNum
            If MaxValue < ds.Tables(0).Rows(i).Item(0) Then
                MaxValue = ds.Tables(0).Rows(i).Item(0)
            End If
        Next

        pagenum = GetPageNum(ds, PageSize)
        RowNum = ds.Tables(0).Select().GetUpperBound(0) '返回的是数组最大维度数

        If PageIndex <= 0 Then
            PageIndex = 0
        End If

        If PageIndex >= pagenum Then
            PageIndex = pagenum
        End If

        sIndex = PageIndex * PageSize
        eIndex = PageIndex * PageSize + PageSize - 1
        If eIndex >= RowNum Then
            eIndex = RowNum
        End If

        For i = sIndex To eIndex
            If iLoop > cColor.GetUpperBound(0) Then Exit For
            '画柱图
            cPen = New Pen(cColor(iLoop), 3)
            cSolidBrush = New SolidBrush(cColor(iLoop))
            cValue = CInt((ds.Tables(0).Rows(i).Item(0) / 10 ^ Len(CStr(MaxValue))) * CDbl(yPd - yPu)) '*** NOTICE：SQL语句的统计列必须放置在第一列 ***
            cGraphic.DrawRectangle(cPen, xStart + (cWidth + cSpace) * iLoop, yPd - cValue, cWidth, cValue - 2) '减2的目的：使柱图的下边沿不挡住X轴
            cGraphic.FillRectangle(cSolidBrush, xStart + (cWidth + cSpace) * iLoop, yPd - cValue, cWidth, cValue - 2)

            '画柱图统计Y轴值
            cGraphic.DrawString(ds.Tables(0).Rows(i).Item(0).ToString(), sFont, cSolidBrush, xStart + (cWidth + cSpace) * iLoop - 5, yPd - cValue - 15, cFormat)

            '画柱图统计X轴值
            cRect = New RectangleF(xStart + (cWidth + cSpace) * iLoop, yPd + 1, cWidth + 10, 40)
            cGraphic.DrawString(ds.Tables(0).Rows(i).Item(1).ToString(), fFont, cSolidBrush, cRect, cFormat)
            iLoop += 1
        Next

        Return cBmp
    End Function

    Function GetDrawPieForStat(ByVal ds As DataSet, ByVal sTitle As String) As Bitmap
        Dim cBmp As New Bitmap(471, 367) '创建画布宽度为471，高度为367的Bitmap实例
        Dim cGraphic As Graphics
        Dim cColor() As Color = {Color.Red, Color.Blue, Color.Green, Color.Gray, Color.LightCoral, Color.Gold, Color.Brown, _
                                 Color.Cyan, Color.Lime, Color.Peru, Color.Magenta, Color.Sienna, Color.Chocolate, Color.PeachPuff, _
                                 Color.Orange, Color.DarkGoldenrod, Color.Olive, Color.DarkSeaGreen, Color.SpringGreen, Color.Teal, Color.CadetBlue, _
                                 Color.RoyalBlue, Color.DeepPink, Color.LightGray, Color.MediumVioletRed, Color.Orchid, Color.MediumSlateBlue, Color.White, _
                                 Color.LightSteelBlue, Color.DarkSlateGray, Color.GreenYellow, Color.DarkKhaki, Color.RosyBrown, Color.Navy, Color.Indigo, _
                                 Color.HotPink} '36种颜色
        Dim cPen As Pen
        Dim cSolidBrush As SolidBrush
        Dim bFont As New Font("Tahoma", 6, FontStyle.Regular) '轴标字体
        Dim fFont As New Font("Tahoma", 5, FontStyle.Regular) '统计项值字体
        Dim cFormat As New StringFormat()
        Dim cPoints() As Point
        Dim cRect As RectangleF
        Dim RowNum As Integer = 0
        Dim TotalValue As Integer = 0
        Dim i As Integer = 0
        Dim j As Integer = 0
        Dim cAngle As Integer = 0
        Dim tmp As Integer = 0

        '定义扇区颜色块
        Dim xStart As Integer = 471 - 110 '首个扇区颜色开始的X轴坐标
        Dim yStart As Integer = 20 '首个扇区颜色开始的Y轴坐标
        Dim cHeight As Integer = 15 '扇区颜色高度
        Dim cWidth As Integer = 20 '扇区颜色宽度
        Dim cSpace As Integer = 10 '扇区颜色间距

        cFormat.FormatFlags = StringFormatFlags.NoClip

        '定义圆心坐标
        Dim xCircleCenter As Integer = 235
        Dim yCircleCenter As Integer = 183

        cGraphic = Graphics.FromImage(cBmp)
        cGraphic.Clear(Color.Snow)

        '用画椭圆的方法画圆
        'Dim cRect As Rectangle
        'cRect = New Rectangle(xCircleCenter, yCircleCenter, 50, 50)
        'cGraphic.DrawEllipse(cPen, xCircleCenter, yCircleCenter, 50, 50)
        'cGraphic.FillEllipse(cSolidBrush, cRect)

        RowNum = ds.Tables(0).Rows.Count - 1
        For i = 0 To RowNum
            TotalValue += ds.Tables(0).Rows(i).Item(0)
        Next

        For j = 0 To RowNum
            cAngle = (ds.Tables(0).Rows(j).Item(0) / TotalValue) * 360
            ReDim cPoints(cAngle + 1)
            '用数学公式画圆
            cPen = New Pen(cColor(j), 3)
            cSolidBrush = New SolidBrush(cColor(j))
            For i = tmp To tmp + cAngle
                cPoints(i - tmp) = New Point
                'cPoints(i - tmp).X = (1 - System.Math.Sin(i / 360 * 2 * System.Math.PI)) * (470 / 2 - 70) + 70
                'cPoints(i - tmp).Y = (1 - System.Math.Cos(i / 360 * 2 * System.Math.PI)) * (366 / 2 - 70) + 70
                cPoints(i - tmp).X = (1 - System.Math.Sin(i / 360 * 2 * System.Math.PI)) * (xCircleCenter - 70) + 20
                cPoints(i - tmp).Y = (1 - System.Math.Cos(i / 360 * 2 * System.Math.PI)) * (xCircleCenter - 70) + 20
            Next i

            '加入圆心坐标点
            cPoints(cAngle + 1) = New Point
            cPoints(cAngle + 1).X = xCircleCenter - 50
            cPoints(cAngle + 1).Y = xCircleCenter - 50

            '画扇区对应的三角形
            cPen = New Pen(cColor(j), 3)
            cSolidBrush = New SolidBrush(cColor(j))
            cGraphic.DrawPolygon(cPen, cPoints)
            cGraphic.FillPolygon(cSolidBrush, cPoints)

            '画扇区颜色
            cGraphic.DrawRectangle(cPen, xStart, yStart + (cHeight + cSpace) * j, cWidth, cHeight)
            cGraphic.FillRectangle(cSolidBrush, xStart, yStart + (cHeight + cSpace) * j, cWidth, cHeight)

            '画扇区统计项
            cRect = New RectangleF(xStart + cWidth + 5, yStart + (cHeight + cSpace) * j, 471 - (xStart + cWidth + 5), cHeight)
            cGraphic.DrawString(ds.Tables(0).Rows(j).Item(1).ToString(), fFont, cSolidBrush, cRect, cFormat)

            tmp = tmp + cAngle
        Next

        Return cBmp
    End Function
End Module