Aktuelle Zeit: 22.10.2019 13:16

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 4 Beiträge ] 
Autor Nachricht
 Betreff des Beitrags: Diagramm mit VectorDrawing
BeitragVerfasst: 28.02.2019 15:04 
Offline
Benutzeravatar

Registriert: 27.02.2006 22:30
Wohnort: Neumünster
Mein 1. Programmcode mit VectorDrawing, darum auch in Anfänger, von Anfänger für Anfänger

hat eine Weile gedauert bis ich das Prinzip halbwegs verstanden habe.

Anstoss sind die unschönen Linien in der 2DDrawing Bibliothek

Verbesserungen am Code und der Anwendung der Vectorbefehle sind erwünscht.

Code:
;HJBremer PB 5.41 LTS x86 / 5.62 x64 - 25.02.2019 V1.0   

DeclareModule DiagrammModul
   
   Declare.i DiagrammMax(Array daten(1), lastmax=0)   
   
   Declare.i Diagramm(canvasnr, titel$, size, max)
   Declare.i DiagrammPaint(canvasnr, info$, Array daten(1) , color, txt=0, dotpath=0)
   
EndDeclareModule

Module DiagrammModul
   
   EnableExplicit   
   
   Global abstand_w.f = 20 ;Abstand der Gitterlinien waagerecht   
   Global abstand_s.f      ;Abstand der Gitterlinien senkrecht - wird in Diagramm() bestimmt 
   Global teiler.f         ;Wert für Skala senkrecht und Daten - wird in Diagramm() bestimmt
   
   Global info_y = 10      ; für Infotext links
   Global null_x = 130     ; x senkrechte Linie
   Global null_y           ; wird in Diagramm() bestimmt   
   
   Global font = FontID(LoadFont(#PB_Any, "Consolas", 10))
   
   Macro VectorColor(color, alpha=$FF)
      VectorSourceColor(color + ($FFFFFF * alpha + alpha))   
   EndMacro
   
   Macro DrawTextLeftX(x, y, text)   
      MovePathCursor(x-VectorTextWidth(text), y - VectorTextHeight("0")/2)
      DrawVectorText(text) 
   EndMacro   
   
   Procedure.i Diagramm(canvasnr, titel$, size, max)
      ; size = anzahl Daten     
      ; max = größter Datenwert
     
      Protected i, x, y     
      Protected cbr = GadgetWidth(canvasnr)
      Protected chh = GadgetHeight(canvasnr)     
      Protected dbr = cbr - 20 - null_x      ; verfügbare Breite waagerecht, für Linien + Abstand
      Protected dhh = chh                    ; verfügbare Höhe senkrecht, für Linien, hier einfach Gadgethöhe
     
      Protected lines_s = size               ; Anzahl Gitterlinien senkrecht
      Protected lines_w = chh / abstand_w    ; Anzahl Gitterlinien waagerecht     
      Protected skala = max / abstand_w      ; für Text senkrecht und teiler
     
      ;Global
      teiler = skala / abstand_w       ; für Datenkurve in DiagrammPaint()
      abstand_s = dbr / size           ; Abstand senkrechte Linien und für die Kurve
     
      null_y = 21 * abstand_w          ; y Nullpunkt = Abstand * waagerechte Linien
      ;oder
      null_y = ((max/skala)+1) * abstand_w   ;berechnen falls Resize gewünscht
     
      If StartVectorDrawing(CanvasVectorOutput(canvasnr))       
         
         VectorColor(#Yellow, 40)
         AddPathBox(10, 10, cbr - 20, chh - 20)
         FillVectorOutput()
         
         ClipPath()  ;Zeichnen innerhalb der Box, gilt nur für diesen StartVectorDrawing Bereich
         
         ;Titel
         VectorColor(#Black)
         VectorFont(font, 16)
         MovePathCursor(10, info_y)
         DrawVectorText(titel$): info_y + VectorTextHeight(titel$) * 3
         
         TranslateCoordinates(null_x, 0)  ;Startpunkt nach rechts rücken
         
         ;Gitterlinien waagerecht; alle grau bis auf null_y     
         For i = 1 To lines_w
            y = i * abstand_w - abstand_w
            VectorColor(#Gray, 40)
            If y = null_y: VectorColor(#Red): EndIf
            MovePathCursor(-5, y)
            AddPathLine(dbr, y) 
            StrokePath(1)            ;StrokePath() muß innerhalb ForNext sein, sonst nix Farbe ändern
         Next
         
         ;Gitterlinien senkrecht; 1.Linie Blau, alle anderen grau     
         For i = 1 To lines_s
            x = i * abstand_s - abstand_s
            VectorColor(#Gray, 40)
            If i = 1: VectorColor(#Blue): EndIf
            MovePathCursor(x, 0)
            AddPathLine(x, dhh)         
            StrokePath(1) 
         Next
         
         ResetCoordinates()                     ;auf 0,0 - Gadget oben links zurückstellen     
         TranslateCoordinates(null_x, null_y)   ;Start fürs Zeichnen ist jetzt Schnittpunkt XY vom Gitter
         
         ;Text waagerecht
         VectorFont(font, 14)     
         VectorColor(#Blue)
         For i = 1 To size
            x = i * abstand_s - abstand_s
            If i > 9: x-7: EndIf
            MovePathCursor(x, 5)
            RotateCoordinates(x, 0, -20)
            DrawVectorText(Str(i))
            RotateCoordinates(x, 0, 20)
         Next i
         
         ;Text senkrecht oben
         VectorColor(#Blue)
         For i = 1 To 30
            x = -8 : y = i * 20         
            DrawTextLeftX(x, -y, Str(i*skala))
         Next i
         
         ;Text senkrecht unten
         VectorColor(#Red)
         For i = 1 To 20
            x = -8 : y = i * 20       
            DrawTextLeftX(x, y, Str(i*skala))
         Next i
         
         StopVectorDrawing()
      EndIf
     
   EndProcedure
   
   Procedure.i DiagrammMax(Array daten(1), lastmax=0)     
      ;max ermitteln und auf volle 500er erhöhen
     
      Protected i, max, size = ArraySize(daten())
     
      max = daten(1)     
      For i = 2 To size     
         If daten(i) > max : max = daten(i) : EndIf     
      Next
   
      max = (max / 500 + 1) * 500
      If lastmax > max: max = lastmax: EndIf

      ProcedureReturn max
   EndProcedure   
   
   Procedure.i DiagrammPaint(canvasnr, info$, Array daten(1) , color, txt=0, dotpath=0)
     
      Protected i, x, y, size = ArraySize(daten())
     
      If StartVectorDrawing(CanvasVectorOutput(canvasnr))       
         
         VectorColor(color)
         VectorFont(font, 12)
         MovePathCursor(10, info_y)
         DrawVectorText(info$) : info_y + VectorTextHeight(info$) * 3

         TranslateCoordinates(null_x, null_y)   ;Start bzw. Nullpunkt fürs Zeichnen ist jetzt Schnittpunkt XY
         
         VectorColor(color, 240)         
         MovePathCursor(0, -daten(1) / teiler)
         AddPathCircle (0, -daten(1) / teiler, 2)
         
         For i = 2 To size           
            If daten(i)
               x = i * abstand_s - abstand_s
               y = daten(i) / teiler
               AddPathLine(x, -y)
            EndIf
         Next     
         If dotpath
            DotPath(2, 5, #PB_Path_RoundEnd)
         Else   
            StrokePath(1.6, #PB_Path_DiagonalCorner)
         EndIf         
         
         VectorColor(color)
         For i = 1 To size
            If daten(i)
               x = i * abstand_s - abstand_s
               y = daten(i) / teiler
               AddPathCircle(x, -y, 2)               
            EndIf
         Next
         StrokePath(1)
         
         If txt
            VectorFont(font,11)         
            VectorColor(color)
            For i = 1 To size
               If daten(i)                 
                  x = i * abstand_s - abstand_s + 6
                  y = daten(i) / teiler + VectorTextHeight("X")/2
                  MovePathCursor(x, -y): DrawVectorText("[" + Str(daten(i)) + "]")
               EndIf               
            Next
         EndIf
         
         StopVectorDrawing()
      EndIf
   
   EndProcedure
   
EndModule

UseModule DiagrammModul

;- Test
;{

Procedure.i MakeTestDaten(Array daten(1), max)
   
   size = ArraySize(daten())
   
   For j = 1 To size
      daten(j) = Random(max, 10)
      nr = Random(size) : daten(nr) = 0
   Next   
   nr = Random(size) : daten(nr) = -max/6
   
EndProcedure

#canvas = 1

br = 900
hh = 600

If OpenWindow(0, 0, 0, br, hh, "VectorDrawing", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
   
   CanvasGadget(#canvas, 0, 0, br, hh)
   
   anz = 31
   Dim daten1(anz)   
   MakeTestDaten(daten1(),1200)
   
   Dim daten2(anz)                   ; Feld kann kleiner sein als andere
   MakeTestDaten(daten2(),1400)
   
   Dim daten3(anz)   
   MakeTestDaten(daten3(),500)
   
   max = DiagrammMax(daten1())
   max = DiagrammMax(daten2(), max)
   max = DiagrammMax(daten3(), max)             ;max ist jetzt der größte Wert der 3 Felder
   
   Diagramm(#canvas, "02.2019", anz, max)       ;anz sollte gleich dem größten Feld sein sonst fehlt was
   
   DiagrammPaint(#canvas, "Konto 1", daten1() , #Blue, 1)        ;mit Text
   DiagrammPaint(#canvas, "Konto 2", daten2() , #Magenta)        ;ohne Text
   DiagrammPaint(#canvas, "PayPal", daten3() , #Gray, 0, 1)      ;ohne Text, gepunktete Linie
     
   Repeat
      Event = WaitWindowEvent()
   Until Event = #PB_Event_CloseWindow
   
EndIf
;}


_________________
Purebasic 5.60 X 64 - Windows 10

Der Computer hat dem menschlichen Gehirn gegenüber nur einen Vorteil: Er wird benutzt
grüße hjbremer


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Diagramm mit VectorDrawing
BeitragVerfasst: 28.02.2019 15:08 
Offline

Registriert: 21.11.2013 21:17
Wohnort: Schweiz
Gehört dein Code nicht trotzdem in Code, Tipps und Tricks? Egal ob du Anfänger bist, du hast n fertigen Code für Wiederverwendung gepostet. Hier werden aber nur Anfängerfragen gestellt:
Zitat:
Anfängerfragen zum Programmieren mit PureBasic.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Diagramm mit VectorDrawing
BeitragVerfasst: 05.03.2019 07:51 
Offline
Benutzeravatar

Registriert: 15.11.2010 10:56
Hallo,
ich gucke seit Jahren nur in Anfänger!

Und Eure Code-Beispiele haben des einigen Geholfen!

Gruss ... Velindos!

_________________
Windows 7/8/8.1/10 (32/64-Bit) |Ubuntu 10.4 (64-Bit) |Purebasic 5.43 LTS (32/64-Bit)


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Diagramm mit VectorDrawing
BeitragVerfasst: 05.03.2019 08:36 
Offline
Benutzeravatar

Registriert: 04.08.2009 17:24
Die Aufteilung in 'Anfänger' und 'Allgemein' ist ohnehin Idiotie. Wo hört das eine auf und wo fängt das andere an?


Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 4 Beiträge ] 

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: Google [Bot] und 5 Gäste


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye