CreateFunctionImage()

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Benutzeravatar
remi_meier
Beiträge: 1078
Registriert: 29.08.2004 20:11
Wohnort: Schweiz

CreateFunctionImage()

Beitrag von remi_meier »

Zeichnet die Funktion auf ein Image.

Hat manchmal noch falsch platzierte Einheitsstriche, aber sonst sollte alles
funktionieren :) .

Code: Alles auswählen

Procedure.f MyFunc(x.f)
  ProcedureReturn 10.6*Sin(x)/x;Cos(x * Sin(x))
EndProcedure


; ImgW = ImageWidth
; ImgH = ImageHeight
; *Function = @Function(x.f)
; D1 = Left x-Value
; D2 = Right x-Value
; FColor = LineColor
; BColor = BackgroundColor
; Axis = #True/#False (draw axes)
; AColor = AxesColor
; Grid = #True/#False (draws a grid)
; GColor = GridColor
Procedure CreateFunctionImage(ImgW.l, ImgH.l, *Function, D1.f, D2.f, FColor.l, BColor.l, Axis.l, AColor.l, Grid.l, GColor.l)
  Protected RetVal.f, Img.l, StepValue.f, StepValue2.f, dDX.f, ScaleY.f, dDY.f, ScaleX.f
  Protected *FData, z.l, MaxVal.f, MinVal.f, x1.l, y1.l, NullX.l, NullY.l
  Protected AnzAbschnitte.l, x.l, y.l, OffsetX.f, OffsetY.f
  
  Img = CreateImage(#PB_Any, ImgW, ImgH)
  
  dDX   = D2 - D1
  StepValue = dDX / ImgW
  
  *FData = AllocateMemory(4 * ImgW)
  MaxVal = -999999.0
  MinVal = 999999.0
  For z = 0 To ImgW - 1
    CallFunctionFast(*Function, D1 + z * StepValue)
    !FSTP dword [esp+44]
    PokeF(*FData + 4 * z, RetVal)
    
    If RetVal > MaxVal
      MaxVal = RetVal
    EndIf
    If MinVal > RetVal
      MinVal = RetVal
    EndIf
  Next
  
  ; alles auf 0+ anpassen
  For z = 0 To ImgW - 1
    PokeF(*FData + 4 * z, PeekF(*FData + 4 * z) - MinVal)
  Next
  
  dDY = MaxVal - MinVal
  ScaleY = ImgH / dDY
  NullX = 999999.0
  NullY = 999999.0
  StartDrawing(ImageOutput()) ;>
    DrawingMode(0)
    Box(0, 0, ImgW, ImgH, BColor)
    
    
    StepValue2 = ImgW / dDX
    NullX = -D1 * StepValue2
    NullY = ImgH - (-MinVal * ScaleY)
    
    If Grid
      AnzAbschnitte = dDX
      If AnzAbschnitte > ImgW
        AnzAbschnitte = ImgW
      EndIf
      
      StepValue2 = ImgW / dDX
      OffsetX    = dDX - AnzAbschnitte
      
      For z = 1 To AnzAbschnitte
        x = StepValue2 * (z - OffsetX)
        LineXY(x, 0, x, ImgH, GColor)
      Next
      
      
      AnzAbschnitte = dDY
      If AnzAbschnitte > ImgH
        AnzAbschnitte = ImgH
      EndIf
      
      StepValue2 = ImgH / dDY
      OffsetY    = MaxVal - Int(MaxVal);dDY - AnzAbschnitte
      
      For z = 0 To AnzAbschnitte
        y = StepValue2 * (z + OffsetY)
        LineXY(0, y, ImgW, y, GColor)
      Next
    EndIf
    
    
    x1 = 0
    y1 = ImgH - PeekF(*FData) * ScaleY
    For z = 0 To ImgW - 1
      LineXY(x1, y1, z, ImgH - (PeekF(*FData + 4 * z) * ScaleY), FColor)
      x1 = z
      y1 = ImgH - (PeekF(*FData + 4 * z) * ScaleY)
    Next
    
    
    If Axis
      ; X-Achse
      LineXY(0, NullY, ImgW, NullY, AColor)
      ; Striche auf X-Achse
      AnzAbschnitte = dDX
      If AnzAbschnitte > ImgW
        AnzAbschnitte = ImgW
      EndIf
      StepValue2 = ImgW / dDX
      OffsetX    = dDX - AnzAbschnitte
      For z = 0 To AnzAbschnitte + 1
        x = StepValue2 * (z + OffsetX)
        LineXY(x, NullY - 5, x, NullY + 5, AColor)
      Next
      
      ; Y-Achse
      LineXY(NullX, 0, NullX, ImgH, AColor)
      ; Striche auf Y-Achse
      AnzAbschnitte = dDY
      If AnzAbschnitte > ImgH
        AnzAbschnitte = ImgH
      EndIf
      StepValue2 = ImgH / dDY
      OffsetY    = MaxVal - Int(MaxVal);dDY - AnzAbschnitte
      For z = 0 To AnzAbschnitte + 1
        y = StepValue2 * (z + OffsetY)
        LineXY(NullX - 5, y, NullX + 5, y, AColor)
      Next
    EndIf
  StopDrawing() ;<
  
  
  ProcedureReturn Img
EndProcedure



Img = CreateFunctionImage(500, 500, @MyFunc(), -8.5, 12, $FF, $C0C0C0, #True, $00, #True, $A6A6A6)

OpenWindow(0, 100,100, 500,500, #PB_Window_ScreenCentered|#PB_Window_SystemMenu, "Draw-Function")
CreateGadgetList(WindowID())
ImageGadget(1, 0,0, 500,500, UseImage(Img))


Repeat
  event = WaitWindowEvent()
  
Until event = #PB_Event_CloseWindow
greetz
Remi

EDIT: lol, hab nen ganz blöden Fehler entfernt ^^
EDIT2: ok, jetzt sollte es langsam OK sein..
Benutzeravatar
PAMKKKKK
Beiträge: 321
Registriert: 21.04.2005 22:08
Wohnort: Braunschweig
Kontaktdaten:

Beitrag von PAMKKKKK »

:o

:allright: Geiles Teil!

Hattes du ein Mathebuch zum Frühstück??
Wir Schreiben ein PureBasic Buch.
Auch du kannst mitmachen!
http://www.purearea.net/pb/english/pure ... :Main_Page
Benutzeravatar
remi_meier
Beiträge: 1078
Registriert: 29.08.2004 20:11
Wohnort: Schweiz

Beitrag von remi_meier »

Danke

> Hattes du ein Mathebuch zum Frühstück??
Braucht man das? :D
Antworten