|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Miscelâneas)
|
|
 |
Título da Dica: Crie um gráfico de barras no braço! Puro código!
|
 |
|
|
|
Postada em 6/11/2003 por PC
'ponha nas declarations
Dim Credts(0 To 11) As Variant
Dim Debts(0 To 11) As Variant 'isto é um array que vc pode criar n deles
'cole isto no form que vc tem e crie um picturebox, renomeando o mesmo como "P" e mudando sua propriedade autoredraw para true
Sub dISPLAY_BARS(nCATEGORY As Integer, values(), Nseries As Single, Maximum As Single)
Const separation = 25
Dim series As Integer, cat As Integer
catwidth = 100 / nCATEGORY
barwidth = catwidth * (100 - separation) / (100 * Nseries)
p.FillStyle = 0
For cat = 1 To nCATEGORY
p.CurrentX = catwidth * cat - catwidth / 2 - (barwidth * Nseries) / 2
For series = 1 To Nseries
p.CurrentY = 0
p.FillColor = GoodColor(series)
p.Line Step(0, 0)-Step(barwidth, values(cat, series) * 100 / Maximum), , B
Next series
Next cat
End Sub
Sub display_grid(Title As String, nCATEGORY As Integer, description() As String, nvalues As Integer, maxvalue As Single)
Dim I As Integer
p.Scale (-15, 120)-(140, -15)
p.CurrentX = (100 - p.TextWidth(Title)) / 2
p.CurrentY = 105 + p.TextHeight(Title)
p.Print Title
p.Line (0, 0)-(0, 100)
p.Line (0, 0)-(100, 0)
For I = 1 To nvalues
p.DrawStyle = 0
YVALUE% = 100# * I / nvalues
p.Line (-1, YVALUE%)-(0, YVALUE%)
p.DrawStyle = 2
p.Line (-1, YVALUE%)-(100, YVALUE%)
Value$ = Format$((maxvalue * I / nvalues), "##.#")
p.CurrentX = -3 - p.TextWidth(Value$)
p.CurrentY = YVALUE% + p.TextHeight(Value$) / 2
p.Print Value$;
Next I
For I = 1 To nCATEGORY
p.DrawStyle = 0
XVALUE = 100 * I / nCATEGORY
p.Line (XVALUE, 1)-(XVALUE, 2)
p.CurrentY = -2
p.CurrentX = XVALUE - 50 / nCATEGORY - p.TextWidth(description(I)) / 2
p.Print description(I)
Next I
End Sub
Sub display_Legend(Nseries As Integer, Sname() As String)
p.FillStyle = 0
THEIGHT% = p.TextHeight(Sname(1))
StartY = 50 + (THEIGHT% * 1.5 * Nseries) / 2
For series% = 1 To Nseries
p.FillColor = GoodColor(series%)
p.Line (102, StartY)-Step(8, -THEIGHT%), , B
p.CurrentY = StartY - THEIGHT%
p.CurrentX = 112
p.Print Sname(series%)
StartY = StartY - THEIGHT% * 1.5
Next series%
End Sub
'
Sub displaygrap(MAX_VALUE As Single, Credts(), Debts(), Ano As String)
Const CATEGORIEs = 12
Const series = 2 ' isto significa que tenho duas linhas verticais (crédito e outra débito)
p.Cls
Static Desc$(CATEGORIEs), values(CATEGORIEs, series), SERIES_NAMES$(series)
Desc$(1) = "Jan"
Desc$(2) = "Fev"
Desc$(3) = "Mar"
Desc$(4) = "Abr"
Desc$(5) = "Mai"
Desc$(6) = "Jun"
Desc$(7) = "Jul"
Desc$(8) = "Ago"
Desc$(9) = "Set"
Desc$(10) = "Out"
Desc$(11) = "Nov"
Desc$(12) = "Dez"
display_grid "Relação Crédito x Débito por mês de " & Ano, CATEGORIEs, Desc$(), 5, MAX_VALUE
values(1, 1) = Credts(0): values(1, 2) = Debts(0)
values(2, 1) = Credts(1): values(2, 2) = Debts(1)
values(3, 1) = Credts(2): values(3, 2) = Debts(2)
values(4, 1) = Credts(3): values(4, 2) = Debts(3)
values(5, 1) = Credts(4): values(5, 2) = Debts(4)
values(6, 1) = Credts(5): values(6, 2) = Debts(5)
values(7, 1) = Credts(6): values(7, 2) = Debts(6)
values(8, 1) = Credts(7): values(8, 2) = Debts(7)
values(9, 1) = Credts(8): values(9, 2) = Debts(8)
values(10, 1) = Credts(9): values(10, 2) = Debts(9)
values(11, 1) = Credts(10): values(11, 2) = Debts(10)
values(12, 1) = Credts(11): values(12, 2) = Debts(11)
dISPLAY_BARS CATEGORIEs, values(), series, MAX_VALUE
SERIES_NAMES$(1) = "Créditos"
SERIES_NAMES$(2) = "Débitos"
display_Legend series, SERIES_NAMES$()
End Sub
Function GoodColor(X) As Long
If X = 0 Then
GoodColor = QBColor(8)
ElseIf X = 1 Then
GoodColor = QBColor(10)
ElseIf X = 2 Then
GoodColor = QBColor(12)
ElseIf X = 3 Then
GoodColor = QBColor(14)
End If
End Function
'coloque isto no form Load
Private Sub Form_Load()
For I = 0 To 11
Credts(I) = Int(Rnd * 100) ' numero randomico
Debts(I) = Int(Rnd * 100)
Next
displaygrap 100, Credts, Debts, "2003"
End Sub
|
|
|
|
|
