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
Remi
EDIT: lol, hab nen ganz blöden Fehler entfernt ^^
EDIT2: ok, jetzt sollte es langsam OK sein..