1 Replies - 2051 Views - Last Post: 01 August 2017 - 06:27 PM Rate Topic: -----

#1 Tbuerge  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 30
  • Joined: 01-November 15

Not sure how bad this is but enjoy.

Posted 12 March 2017 - 05:05 PM

A couple years ago when I was just trying to learn some basics of VB.net I had a great idea to make a 3D pie chart entirely in code and draw it on a form. I'm still no pro when it comes to programming of any sort but this still makes me shake my head. Partly because there are almost no comments, and partly because I'm convinced there is an easier way. Its only about 800 lines. Luckily I'm the only one that has to work with it as its part of an application that only I use.

I get my data from text files as I didn't know how to use databases (I still don't).

To my defense it runs quite fast. Just did some testing in visual studio and it ran between 31 and 38 ms.

Imports System.ComponentModel
Imports System.Drawing.Drawing2D
Public Class Pie_Chart_3D
    Public Sub drawpie()
        fangle = 0.0
        topindex = 0
        items.Clear()
        sangle = 0.0
        piedrawlist.Clear()
        Pieshapelist.Clear()
        tempdrawlist.Clear()
        tempshpelist.Clear()
        acctxtlist.Clear()
        Dim startangl As Double = sangle
        If dt.Rows.Count = 0 Then Exit Sub
        findfirstslice(startangl)
        If sangle > 90 And sangle <= 270 Then
            findlowsideslices()
        End If
        If fangle >= 270 Or fangle <= 90 Then
            finishpie()
        End If
        Dim cnt As Integer = 0
        Dim p As New GraphicsPath
        Dim c As Integer = 0
        Dim s As String = ""
        If tempdrawlist.Keys.Count > 0 Then
            Do Until cnt = tempdrawlist.Keys.Count
                p = tempdrawlist.Keys(cnt)
                c = tempdrawlist.Values(cnt)
                s = tempshpelist.Values(cnt)
                piedrawlist.Add(p, c)
                Pieshapelist.Add(p, s)
                cnt += 1
            Loop
        End If
    End Sub
    Public Sub findfirstslice(ByVal StartAngle As Double)
        Dim val As Double = 0.0
        Dim cnt As Integer = 0
        Dim sweepangle As Double = 0.0
        For Each r In dt.Rows
            val = r("amount")
            sweepangle = (val / total) * 360
            Dim finishangl As Double = StartAngle + sweepangle
            If finishangl < 270 And finishangl < StartAngle Then finishangl = finishangl + 360
            If StartAngle >= 270 Then StartAngle = StartAngle - 360
            If StartAngle <= 270 And finishangl >= 270 Then
                If StartAngle < 0 Then StartAngle = StartAngle + 360
                Dim vals As String = r("account") & " = " & FormatCurrency(r("amount"), 2)
                drawpieslice(rect, StartAngle, sweepangle, cnt + 1, vals)
                sangle = StartAngle
                fangle = finishangl
                topindex = cnt
                items.Add(topindex)
                Exit Sub
            End If
            StartAngle = StartAngle + sweepangle
            cnt = cnt + 1
        Next
    End Sub
    Public Sub findlowsideslices()
        Dim val As Double = 0.0
        Dim cnt As Integer = topindex - 1
        Dim sweepangle As Double = 0.0
        Dim startangle As Double = 0.0
        Do Until cnt = -1
            If items.Contains(cnt) Then
            Else
                Dim r As DataRow = dt.Rows(cnt)
                val = r("amount")
                sweepangle = (val / total) * 360
                startangle = sangle - sweepangle
                If startangle < 90 Then Exit Do
                Dim vals As String = r("account") & " = " & FormatCurrency(r("amount"), 2)
                drawpieslice(rect, startangle, sweepangle, cnt + 1, vals)
                sangle -= sweepangle
                items.Add(cnt)
                cnt -= 1
            End If
        Loop
    End Sub
    Public Sub finishpie()
        Dim val As Double = 0.0
        Dim cnt As Integer = topindex + 1
        Dim sweepangle As Double = 0.0
        Dim startangle As Double = fangle
        Do Until cnt = dt.Rows.Count
            Dim r As DataRow = dt.Rows(cnt)
            val = r("amount")
            sweepangle = (val / total) * 360
            Dim finishangle As Double = startangle + sweepangle
            If finishangle > 360 Then finishangle = finishangle - 360
            Dim vals As String = r("account") & " = " & FormatCurrency(r("amount"), 2)
            drawpieslice(rect, startangle, sweepangle, cnt + 1, vals)
            startangle = finishangle
            items.Add(cnt)
            If finishangle > 90 And finishangle < 270 Then Exit Do
            cnt = cnt + 1
        Loop
        cnt = 0
        Do Until cnt = dt.Rows.Count
            If items.Contains(cnt) = True Then Exit Do
            Dim r As DataRow = dt.Rows(cnt)
            val = r("amount")
            sweepangle = (val / total) * 360
            Dim finishangle As Double = startangle + sweepangle
            If finishangle > 360 Then finishangle = finishangle - 360
            Dim vals As String = r("account") & " = " & FormatCurrency(r("amount"), 2)
            drawpieslice(rect, startangle, sweepangle, cnt + 1, vals)
            startangle = finishangle
            If finishangle > 90 And finishangle < 270 Then Exit Do
            cnt = cnt + 1
        Loop
    End Sub
    Public Sub drawpieslice(ByVal Rectangle As Rectangle, Startangle As Double, Sweepangle As Double, cnt As Integer, value As String)
        Dim finishangl As Double = Startangle + Sweepangle
        If finishangl > 360 Then finishangl = finishangl - 360
        Dim elipfinish As Single = elipsedegree(finishangl)
        Dim elipsweep As Single = elipfinish - elipsedegree(Startangle)
        Dim elipstart As Single = elipsedegree(Startangle)
        If elipfinish < elipstart Then elipsweep = elipsweep + 360
        Dim btm_rect As Rectangle = Piecenteroffset(Rectangle, Startangle, Sweepangle)
        Dim top_rect As Rectangle = New Rectangle(btm_rect.X, btm_rect.Y - pheight, btm_rect.Width, btm_rect.Height)
        Dim cpoint As New PointF(btm_rect.Width / 2 + btm_rect.X, btm_rect.Height / 2 + btm_rect.Y)     'center of slice rectangle
        'creates slice bottom
        Dim bottompieslice As New GraphicsPath
        bottompieslice.AddArc(btm_rect, elipstart, elipsweep)
        Dim High_btm_Point As PointF = bottompieslice.GetLastPoint()
        bottompieslice.AddLine(High_btm_Point, cpoint)
        bottompieslice.CloseFigure()
        'draws slice
        Pieshapelist.Add(bottompieslice, value)
        piedrawlist.Add(bottompieslice, cnt)
        'creates sides
        Dim endarc As New GraphicsPath
        endarc.AddArc(btm_rect, elipstart, elipsweep)
        endarc.AddArc(btm_rect, elipfinish, -elipsweep)
        Dim Low_btm_Point As PointF = endarc.GetLastPoint
        'gets paths
        Dim Lowside As New GraphicsPath
        Lowside.AddLine(cpoint, High_btm_Point)
        Lowside.AddLine(High_btm_Point.X, High_btm_Point.Y, High_btm_Point.X, High_btm_Point.Y - pheight)
        Lowside.AddLine(High_btm_Point.X, High_btm_Point.Y - pheight, cpoint.X, cpoint.Y - pheight)
        Lowside.CloseFigure()
        Dim Highside As New GraphicsPath
        Highside.AddLine(cpoint, Low_btm_Point)
        Highside.AddLine(Low_btm_Point.X, Low_btm_Point.Y, Low_btm_Point.X, Low_btm_Point.Y - pheight)
        Highside.AddLine(Low_btm_Point.X, Low_btm_Point.Y - pheight, cpoint.X, cpoint.Y - pheight)
        Highside.CloseFigure()
        'draws sides
        If elipstart >= 90 Then
            Pieshapelist.Add(Highside, value)
            piedrawlist.Add(Highside, cnt)
        ElseIf elipstart < 90 And elipfinish >= 270 Then
            tempshpelist.Add(Highside, value)
            tempdrawlist.Add(Highside, cnt)
        End If
        Pieshapelist.Add(Lowside, value)
        piedrawlist.Add(Lowside, cnt)
        Dim endshape As New GraphicsPath
        'creates end shape
        If elipstart >= 360 Then elipstart -= 360
        If elipstart < 180 And elipfinish > 180 Then
            'makes low side shape
            Dim part1sweep As Single = 180 - elipstart
            endshape.AddArc(top_rect, 180, -part1sweep)
            endshape.AddLine(Low_btm_Point.X, Low_btm_Point.Y, Low_btm_Point.X, Low_btm_Point.Y - pheight)
            endshape.AddArc(btm_rect, elipstart, part1sweep)
            endshape.CloseFigure()
            If elipfinish <= 270 Then
                Pieshapelist.Add(endshape, value)
                piedrawlist.Add(endshape, cnt)
            ElseIf elipstart < 90 And elipfinish >= 270 Then
                tempshpelist.Add(endshape, value)
                tempdrawlist.Add(endshape, cnt)
            End If
            'makes high side shape
            Dim endshape1 As New GraphicsPath
            Dim part2sweep As Single = elipfinish - 180
            endshape1.AddArc(btm_rect, 180, part2sweep)
            endshape1.AddLine(High_btm_Point.X, High_btm_Point.Y, High_btm_Point.X, High_btm_Point.Y - pheight)
            endshape1.AddArc(top_rect, elipfinish, -part2sweep)
            endshape1.CloseFigure()
            Pieshapelist.Add(endshape1, value)
            piedrawlist.Add(endshape1, cnt)
        Else
            endshape.AddArc(btm_rect, elipstart, elipsweep)
            endshape.AddLine(High_btm_Point.X, High_btm_Point.Y, High_btm_Point.X, High_btm_Point.Y - pheight)
            endshape.AddArc(top_rect, elipfinish, -elipsweep)
            endshape.CloseFigure()
            Pieshapelist.Add(endshape, value)
            piedrawlist.Add(endshape, cnt)
        End If
        Dim toppieslice As New GraphicsPath
        toppieslice.AddArc(top_rect, elipstart, elipsweep)
        toppieslice.AddLine(High_btm_Point.X, High_btm_Point.Y - pheight, cpoint.X, cpoint.Y - pheight)
        toppieslice.CloseFigure()
        Dim stng As String = ""
        Dim ta As Single = Startangle + (Sweepangle / 2)
        If ta > 360 Then ta = ta - 360
        Dim acc As String
        Dim accs As String() = value.Split("=")
        acc = accs(0).Trim(" ")
        If ta < 180 And ta > 90 Then acc = "   " & acc
        If ta < 90 Then acc = acc & "   "
        Dim tp As PointF = tpoint(cpoint, High_btm_Point, ta, acc, top_rect)
        ta = elipsedegree(ta)
        stng = ta & "#" & acc & "#" & cnt - 1
        acctxtlist.Add(stng, tp)
        If elipstart < 90 And elipfinish >= 270 Then
            tempshpelist.Add(toppieslice, value)
            tempdrawlist.Add(toppieslice, cnt)
        Else
            Pieshapelist.Add(toppieslice, value)
            piedrawlist.Add(toppieslice, cnt)
        End If
    End Sub

    Function tpoint(cpoint As PointF, ppoint As PointF, ta As Double, acc As String, trect As Rectangle)
        'measures text
        Dim stringSize As New SizeF
        stringSize = TextRenderer.MeasureText(acc, accfont)
        'gets offset to center text
        Dim hh As Double = stringSize.Height * 0.5
        Dim tofs As Double = (hh / (Math.PI * trect.Width)) * 360
        'circle for text
        Dim tarc As New GraphicsPath
        Dim tsweep As Single = 0
        If ta > 270 Then
            tsweep = (elipsedegree(ta) - tofs) - elipsedegree(0)
        Else
            tsweep = (elipsedegree(ta) + tofs) - elipsedegree(0)
        End If
        tarc.AddArc(trect, 0, tsweep)
        'sets text point
        Dim tp As PointF = tarc.GetLastPoint
        tp.Y += pheight * 0.5
        Return (tp)
    End Function
    Function elipsedegree(circledegree As Single) As Single
        Dim x As Double = rect.Width * Math.Cos(circledegree * Math.PI / 180)
        Dim y As Double = rect.Height * Math.Sin(circledegree * Math.PI / 180)
        Dim elipdeg As Single = CSng(Math.Atan2(y, x) * 180 / Math.PI)
        If elipdeg < 0 Then
            Return elipdeg + 360
        End If
        Return elipdeg
    End Function
    Function piecolor(ByVal index As Integer)
        Dim c1 As Color
        Select Case index
            Case 0
                c1 = Color.Blue
            Case 1
                c1 = Color.Orange
            Case 2
                c1 = Color.DarkGray
            Case 3
                c1 = Color.Purple
            Case 4
                c1 = Color.Red
            Case 5
                c1 = Color.DarkCyan
            Case 6
                c1 = Color.Yellow
            Case 7
                c1 = Color.Green
            Case 8
                c1 = Color.Brown
            Case 9
                c1 = Color.DeepPink
            Case 10
                c1 = Color.Lime
        End Select
        Return (c1)
    End Function
    Function Piecenteroffset(ByVal Rectangle As Rectangle, Startangle As Double, Sweepangle As Double)
        Dim finishangl As Double = Startangle + (Sweepangle / 2)
        If finishangl > 360 Then finishangl = finishangl - 360
        Dim elipstart As Single = elipsedegree(Startangle)
        Dim elipfinish As Single = elipsedegree(finishangl)
        Dim elipsweep As Single = elipfinish - elipsedegree(Startangle)
        If elipfinish < elipstart Then elipsweep = elipsweep + 360
        Dim c As New PointF(Rectangle.Width / 2 + Rectangle.X, Rectangle.Height / 2 + Rectangle.Y)
        Dim pie As New GraphicsPath
        Dim middlerect As New Rectangle(c.X - (Rectangle.Width * (SliceOffset / 2)), c.Y - (Rectangle.Height * (SliceOffset / 2)), Rectangle.Width * SliceOffset, Rectangle.Height * SliceOffset)
        If middlerect.Height < 1 Or middlerect.Width < 1 Then
            Return (Rectangle)
            Exit Function
        End If
        pie.AddArc(middlerect, elipstart, elipsweep)
        Dim pt As PointF = pie.GetLastPoint()
        Dim slicerect As New Rectangle(pt.X - Rectangle.Width / 2, pt.Y - Rectangle.Height / 2, Rectangle.Width, Rectangle.Height)
        Return slicerect
    End Function
    'gets data for pie chart
    Private Sub Getpiedata()
        Dim pdta As New DataTable
        pietotal = 0.0
        pdta.Columns.Add("account")
        For Each acc As String In IO.File.ReadAllLines(expacc)
            pdta.Rows.Add(acc)
        Next
        pdta.Columns.Add("amount")
        Dim ammoun As Double
        Dim account As String
        For Each amt As String In IO.File.ReadAllLines(expdata)
            Dim lin As String() = amt.Split("~")
            Dim mdate = Date.Parse(lin(0))
            If mdate <= edate Then
                If mdate < sdate Then Exit For
                ammoun = lin(4)
                account = lin(1)
                For Each r As DataRow In pdta.Rows
                    If r("account") = account Then
                        If Convert.ToString(r("amount")) = "" Then r("amount") = 0.0
                        r("amount") += ammoun
                    End If
                Next
                pietotal += ammoun
            End If
        Next
        pdt.Rows.Clear()
        pdt.Columns.Clear()
        pdt.Columns.Add("account")
        pdt.Columns.Add("amount")
        Dim val As Double = 0.0
        Dim val2 As Double = 0.0
        Dim cnt As Integer = 0
        For Each d As DataRow In pdta.Rows
            Dim nrow As DataRow = pdt.NewRow
            If Convert.ToString(d("amount")) = "" Then d("amount") = 0.0
            val = d("amount")
            nrow("amount") = d("amount")
            nrow("account") = d("account")
            Do
                If pdt.Rows.Count = 0 Then Exit Do
                If pdt.Rows.Count = cnt Then Exit Do
                Dim r As DataRow = pdt.Rows(cnt)
                val2 = r("amount")
                If val > val2 Then Exit Do
                cnt += 1
            Loop
            If val > 0.0 Then pdt.Rows.InsertAt(nrow, cnt)
            cnt = 0
        Next
        t = Pietotal
    End Sub
    Private Sub piedata()
        pdata.Reset()
        pdata.Columns.Add("amount")
        pdata.Columns.Add("account")
        Dim cnt As Integer = 0
        Dim tt As Integer = 0
        If pdt.Rows.Count > 10 Then
            tt = 10
        Else
            tt = pdt.Rows.Count
        End If
        Dim tot As Double = 0.0
        Do Until cnt = tt
            Dim r As DataRow = pdt.Rows(cnt)
            Dim rr As DataRow = pdata.NewRow
            rr("amount") = r("amount")
            rr("account") = r("account")
            pdata.Rows.Add(rr)
            Dim val As Double = r("amount")
            tot = tot + val
            cnt = cnt + 1
        Loop
        If pdt.Rows.Count > 10 Then
            Dim r As DataRow = pdata.NewRow
            r("amount") = pietotal - tot
            t2 = pietotal - tot
            r("account") = "Other"
            pdata.Rows.Add(r)
            'second datatable
            pdata2.Reset()
            pdata2.Columns.Add("amount")
            pdata2.Columns.Add("account")
            If pdt.Rows.Count > 20 Then
                tt = 20
            Else
                tt = pdt.Rows.Count
            End If
            Do Until cnt = tt
                Dim r2 As DataRow = pdt.Rows(cnt)
                Dim rr As DataRow = pdata2.NewRow
                rr("amount") = r2("amount")
                rr("account") = r2("account")
                pdata2.Rows.Add(rr)
                Dim val As Double = r2("amount")
                tot = tot + val
                cnt = cnt + 1
            Loop
            If pdt.Rows.Count > 20 Then
                Dim r2 As DataRow = pdata2.NewRow
                r2("amount") = pietotal - tot
                t3 = pietotal - tot
                r2("account") = "Other"
                pdata2.Rows.Add(r2)
                'third datatable
                pdata3.Reset()
                pdata3.Columns.Add("amount")
                pdata3.Columns.Add("account")
                If pdt.Rows.Count > 30 Then
                    tt = 30
                Else
                    tt = pdt.Rows.Count
                End If
                Do Until cnt = tt
                    Dim r3 As DataRow = pdt.Rows(cnt)
                    Dim rr As DataRow = pdata3.NewRow
                    rr("amount") = r3("amount")
                    rr("account") = r3("account")
                    pdata3.Rows.Add(rr)
                    Dim val As Double = r3("amount")
                    tot = tot + val
                    cnt = cnt + 1
                Loop
                If pdt.Rows.Count > 30 Then
                    Dim r3 As DataRow = pdata3.NewRow
                    r3("amount") = pietotal - tot
                    t4 = pietotal - tot
                    r3("account") = "Other"
                    pdata3.Rows.Add(r3)
                    'forth datatable
                    pdata4.Reset()
                    pdata4.Columns.Add("amount")
                    pdata4.Columns.Add("account")
                    If pdt.Rows.Count > 40 Then
                        tt = 40
                    Else
                        tt = pdt.Rows.Count
                    End If
                    Do Until cnt = tt
                        Dim r4 As DataRow = pdt.Rows(cnt)
                        Dim rr As DataRow = pdata4.NewRow
                        rr("amount") = r4("amount")
                        rr("account") = r4("account")
                        pdata4.Rows.Add(rr)
                        Dim val As Double = r4("amount")
                        tot = tot + val
                        cnt = cnt + 1
                    Loop
                    If pdt.Rows.Count > 40 Then
                        Dim r4 As DataRow = pdata4.NewRow
                        r4("amount") = pietotal - tot
                        r4("account") = "Other"
                        pdata4.Rows.Add(r4)
                    End If
                End If
            End If
        End If
    End Sub
    Private Sub pieinfo()
        Dim sp As Double = 70 * (1 + SliceOffset)
        Dim tp As Double = (50 + pheight) * (1 + SliceOffset)
        Dim bt As Double = 50 * (1 + SliceOffset)
        Dim wo As Double = (Width - 70) * SliceOffset
        Dim ho As Double = (Height - 100) * SliceOffset
        rect.Width = Width - (sp * 2)
        rect.Height = Height - (tp + bt + 35)
        rect.Location = New Point(sp - 8, tp)
        If rect.Height > rect.Width / 2.1 Then rect.Height = rect.Width / 2.1
        If rect.Height < rect.Width / 2.1 Then rect.Width = rect.Height * 2.1
        total = t
        dt = pdata
    End Sub

    Private Sub Pie_Chart_3D_Click(sender As Object, e As MouseEventArgs) Handles Me.Click
        Dim p As New GraphicsPath
        Dim c As String = ""
        Dim i As Integer = Pieshapelist.Keys.Count - 1
        Do Until i = -1
            c = Pieshapelist.Values(i)
            p = Pieshapelist.Keys(i)
            Dim pp As Region = New Region(p)
            If pp.IsVisible(e.Location) = True Then
                ToolTip1.Show(c, Me)
                If c.Contains("Other = ") Then
                    Nextbutton.Show()
                    Timer1.Start()
                End If
                Exit Do
            End If
            i -= 1
        Loop
    End Sub
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Prevbutton.Click
        Dim cnt As Integer = My.Settings.Piecnt
        dt.Clear()
        Select Case cnt
            Case 1
                My.Settings.Piecnt = 0
                dt = pdata
                total = t
                Prevbutton.Hide()
            Case 2
                My.Settings.Piecnt = 1
                dt = pdata2
                total = t2
            Case 3
                My.Settings.Piecnt = 2
                dt = pdata3
                total = t3
        End Select
        piedata()
        drawpie()
        Refresh()
    End Sub
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Nextbutton.Click
        Dim cnt As Integer = My.Settings.Piecnt
        dt.Clear()
        Select Case cnt
            Case 0
                If pdata2.Rows.Count = 0 Then Exit Sub
                My.Settings.Piecnt = 1
                dt = pdata2
                total = t2
                Prevbutton.Show()
            Case 1
                If pdata3.Rows.Count = 0 Then Exit Sub
                My.Settings.Piecnt = 2
                dt = pdata3
                total = t3
            Case 2
                If pdata4.Rows.Count = 0 Then Exit Sub
                My.Settings.Piecnt = 3
                dt = pdata4
                total = t4
        End Select
        Nextbutton.Hide()
        piedata()
        drawpie()
        Refresh()
    End Sub

    Private Sub Pie_Chart_3D_Resize(sender As Object, e As EventArgs) Handles Me.Resize
        pieinfo()
        Dim cnt As Integer = My.Settings.Piecnt
        Select Case cnt
            Case 0
                If pdata.Rows.Count = 0 Then Exit Sub
                dt = pdata
                total = t
            Case 1
                If pdata2.Rows.Count = 0 Then Exit Sub
                dt = pdata2
                total = t2
                Prevbutton.Show()
            Case 2
                If pdata3.Rows.Count = 0 Then Exit Sub
                dt = pdata3
                total = t3
                Prevbutton.Show()
            Case 3
                If pdata4.Rows.Count = 0 Then Exit Sub
                dt = pdata4
                total = t4
                Prevbutton.Show()
        End Select
        drawpie()
        Refresh()
    End Sub
    Private Sub Pie_Chart_3D_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        If My.Settings.Piefont Is Nothing Then
            Dim f As New Font("Tahoma", 15)
            My.Settings.Piefont = f
        End If
        Getpiedata()
        piedata()
        pieinfo()
        drawpie()
        Refresh()
    End Sub
    Private Sub Pie_Chart_3D_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
        Dim g As Graphics = e.Graphics
        g.SmoothingMode = SmoothingMode.AntiAlias
        Dim p As New GraphicsPath
        Dim c As Integer = 0
        Dim piebrush As New SolidBrush(Color.White)
        Dim piepen As Pen
        Dim i As Integer = 0
        Dim txts As String()
        Dim ss As String()
        Do Until i = piedrawlist.Keys.Count
            c = piedrawlist.Values(i)
            p = piedrawlist.Keys(i)
            piebrush.Color = (Color.FromArgb(50, piecolor(c - 1)))
            piepen = getpiepen(c)
            g.DrawPath(piepen, p)
            g.FillPath(piebrush, p)
            i += 1
        Loop
        If My.Settings.Pietext = False Then Exit Sub
        Dim ct As Integer = 0
        Dim s As String
        For Each s In acctxtlist.Keys
            ss = s.Split("#")
            txts = ss(1).Split("~")
            Dim ta As Double = ss(0)
            Dim stringSize As New SizeF
            stringSize = TextRenderer.MeasureText(txts(0), accfont)
            'Do the transformation
            g.TranslateTransform(acctxtlist.Values(ct).X, acctxtlist.Values(ct).Y)
            ' Draw the text
            If ta > 270 Or ta < 90 Then
                g.RotateTransform(ta)
                g.DrawString(txts(0), accfont, Brushes.Black, 0 - stringSize.Width, 0)
            Else
                ta -= 180
                g.RotateTransform(ta)
                g.DrawString(txts(0), accfont, Brushes.Black, 0, 0)
            End If
            ' Reset the transform so subsequent drawing wont be affected
            g.ResetTransform()
            ss = Nothing
            txts = Nothing
            ct += 1
        Next
    End Sub
    Function getpiepen(c As Integer)
        Dim p As Pen = Pens.White
        Dim t As Integer = My.Settings.PieBorder
        Select Case (t)
            Case (0)
                p = New Pen(Color.FromArgb(0, piecolor(c - 1)), 0)
            Case (1)
                p = New Pen(Color.FromArgb(100, piecolor(c - 1)), 1)
            Case (2)
                p = New Pen(Color.FromArgb(185, piecolor(c - 1)), 1)
            Case (3)
                p = New Pen(Color.FromArgb(85, piecolor(c - 1)), 2)
            Case (4)
                p = New Pen(Color.FromArgb(175, piecolor(c - 1)), 2)
            Case (5)
                p = New Pen(Color.Black, 1)
            Case (6)
                p = New Pen(Color.Black, 2)
        End Select
        Return (p)
    End Function
    Private Sub Pie_Chart_3D_Closing(sender As Object, e As CancelEventArgs) Handles Me.Closing
        My.Settings.Piechartsize = Size
        My.Settings.Save()
    End Sub

    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        Timer1.Stop()
        If Nextbutton.Visible = True Then
            Nextbutton.Hide()
        End If
    End Sub
    Private Sub Nextbutton_MouseEnter(sender As Object, e As EventArgs) Handles Nextbutton.MouseEnter
        Timer1.Stop()
    End Sub
    Private Sub Nextbutton_MouseLeave(sender As Object, e As EventArgs) Handles Nextbutton.MouseLeave
        Timer1.Start()
    End Sub

    Private Sub Pie_Chart_3D_DoubleClick(sender As Object, e As MouseEventArgs) Handles Me.DoubleClick
        Dim p As New GraphicsPath
        Dim c As String = ""
        Dim i As Integer = Pieshapelist.Keys.Count - 1
        Do Until i = -1
            c = Pieshapelist.Values(i)
            p = Pieshapelist.Keys(i)
            Dim pp As Region = New Region(p)
            pieacc = c.Substring(0, c.IndexOf(" =")).Trim()
            If pp.IsVisible(e.Location) = True Then
                If pieacc = "Other" Then Exit Sub
                Dim pnt As Point = New Point(e.X - 311, e.Y - 194)
                Expense_Details.Location = pnt
                Expense_Details.ShowDialog()
                Exit Do
            End If
            i -= 1
        Loop
    End Sub

    Public Sub pieupdate()
        SliceOffset = My.Settings.Pieoffset / 100
        pheight = My.Settings.Pieheight
        accfont = My.Settings.Piefont
        sangle = 0
        fangle = 0
        topindex = 0
        Getpiedata()
        piedata()
        pieinfo()
        Dim cnt As Integer = My.Settings.Piecnt
        Select Case cnt
            Case 0
                If pdata.Rows.Count = 0 Then Exit Sub
                dt = pdata
                total = t
            Case 1
                If pdata2.Rows.Count = 0 Then Exit Sub
                dt = pdata2
                total = t2
                Prevbutton.Show()
            Case 2
                If pdata3.Rows.Count = 0 Then Exit Sub
                dt = pdata3
                total = t3
                Prevbutton.Show()
            Case 3
                If pdata4.Rows.Count = 0 Then Exit Sub
                dt = pdata4
                total = t4
                Prevbutton.Show()
        End Select
        drawpie()
        Refresh()
    End Sub

    Private Sub ContextMenuStrip1_Opening(sender As Object, e As CancelEventArgs) Handles ContextMenuStrip1.Opening
        If My.Settings.Pietext = True Then
            textoo.Checked = True
        Else
            textoo.Checked = False
        End If
    End Sub

    Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click
        Pie_Date_Selector.ShowDialog()
        If Label1.Text = "Custom" Then
            Label1.Text = FormatDateTime(sdate, DateFormat.ShortDate) & " - " & FormatDateTime(edate, DateFormat.ShortDate)
        End If
        Getpiedata()
        piedata()
        pieinfo()
        drawpie()
        Refresh()
    End Sub
    'settings
    Private Sub DatesToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DatesToolStripMenuItem.Click
        Pie_Date_Selector.ShowDialog()
        If Label1.Text = "Custom" Then
            Label1.Text = FormatDateTime(sdate, DateFormat.ShortDate) & " - " & FormatDateTime(edate, DateFormat.ShortDate)
        End If
        Getpiedata()
        piedata()
        pieinfo()
        drawpie()
        Refresh()
    End Sub
    Private Sub textoo_Click(sender As Object, e As EventArgs) Handles textoo.Click
        If textoo.Checked = True Then
            My.Settings.Pietext = True
        Else
            My.Settings.Pietext = False
        End If
        Refresh()
        My.Settings.Save()
    End Sub
    Private Sub TextFontToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles TextFontToolStripMenuItem.Click
        FontDialog1.Font = My.Settings.Piefont
        If FontDialog1.ShowDialog = DialogResult.OK Then
            My.Settings.Piefont = FontDialog1.Font
            My.Settings.Save()
            pieupdate()
        End If
    End Sub
    Private Sub ExitToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles ExitToolStripMenuItem.Click
        Close()
    End Sub
    Private Sub PieSettingsToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles PieSettingsToolStripMenuItem.Click
        PieSetting.ShowDialog()
    End Sub

    Private pietotal As Double
    Public sdate As Date
    Public edate As Date
    Private items As New List(Of Integer)
    Private accfont As Font = My.Settings.Piefont
    Private acctxtlist As New Dictionary(Of String, PointF)
    Private tempshpelist As New Dictionary(Of GraphicsPath, String)
    Private tempdrawlist As New Dictionary(Of GraphicsPath, Integer)
    Private Pieshapelist As New Dictionary(Of GraphicsPath, String)
    Private piedrawlist As New Dictionary(Of GraphicsPath, Integer)
    Private rect As New Rectangle
    Private SliceOffset As Double = My.Settings.Pieoffset / 100
    Private pheight As Single = My.Settings.Pieheight
    Private sangle As Double
    Private fangle As Double
    Private topindex As Integer
    Private dt As New DataTable
    Private total As Double
    Private pdata As New DataTable
    Private t As Double
    Private pdata2 As New DataTable
    Private t2 As Double
    Private pdata3 As New DataTable
    Private t3 As Double
    Private pdata4 As New DataTable
    Private t4 As Double
    Public pieacc As String

End Class


Is This A Good Question/Topic? 0
  • +

Replies To: Not sure how bad this is but enjoy.

#2 megawatt  Icon User is offline

  • New D.I.C Head

Reputation: 2
  • View blog
  • Posts: 8
  • Joined: 23-July 17

Re: Not sure how bad this is but enjoy.

Posted 01 August 2017 - 06:27 PM

THIS IS A NIGHTMARE

But wow 800 lines. I think that's more than any program I've ever written. Seriously.
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1