Dreht sich gerade um Kreise.
Das folgende Programm wandelt eine mit der Maus gezeichnete
Ellipse, die natürlich unschön ist, in eine perfekte API-Ellipse um.
Dabei soll und wird auch der Neigungswinkel beachtet.
Das klappt so schon ganz gut, aber meine "Methode" erscheint
mir doch sehr umständlich. Nun gut, bin auch nicht der
Mathematiker. Würde mich interessieren, ob das auch einfacher
geht. Und wehe es lacht einer über meine Patchwork-Methode!
Code: Alles auswählen
Global pen
#b = 0.01745329
Procedure.f Winkel(x,y)
Winkel.f
If x = 0
If y < 0 : Winkel = -90 : EndIf
If y >= 0 : Winkel = 90 : EndIf
Else
Winkel = ATan(y/x)/#b
If x < 0 : Winkel + 180 : EndIf
EndIf
ProcedureReturn Winkel
EndProcedure
Global nw,nh
Procedure Transform(dc,winkel.f,w,h)
s.f=Sin(6.28318531*winkel/360)
c.f=Cos(6.28318531*winkel/360)
wtform.XFORM
wtform\eM11 = c
wtform\eM12 = s
wtform\eM21 = -s
wtform\eM22 = c
wtform\eDx = w/2
wtform\eDy = h/2
tdc=CreateEnhMetaFile_(dc,0,0,0)
SetGraphicsMode_(tdc,#GM_ADVANCED)
SetWorldTransform_(tdc,wtform)
SelectObject_(tdc,GetStockObject_(#HOLLOW_BRUSH))
oldpen=SelectObject_(tdc,pen)
Ellipse_(tdc,0,0,w,h)
SelectObject_(tdc,oldpen)
trotwmf=CloseEnhMetaFile_(tdc)
GetEnhMetaFileHeader_(trotwmf,SizeOf(ENHMETAHEADER),ehead.ENHMETAHEADER)
nw=ehead\rclBounds\right-ehead\rclBounds\left
nh=ehead\rclBounds\bottom-ehead\rclBounds\top
ProcedureReturn trotwmf
EndProcedure
If OpenWindow(0, 0, 0, 800, 640, "Circles",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CreateImage(0,800,600)
StartDrawing(ImageOutput(0))
Box(0,0,800,600,RGB(0,0,255))
StopDrawing()
CopyImage(0,1)
CopyImage(0,2)
;
ImageGadget(0, 0, 0, 0, 0, ImageID(1))
reset = ButtonGadget(#PB_Any,300,610,200,20,"Reset")
NewList p.POINT()
pen=CreatePen_(#PS_SOLID,10,RGB(255,255,0))
Repeat
EventID = WaitWindowEvent()
x = WindowMouseX(0)
y = WindowMouseY(0)
If EventID=#PB_Event_Gadget
If EventGadget()=reset
CopyImage(0,1)
CopyImage(0,2)
SetGadgetState(0,ImageID(2))
While GetAsyncKeyState_(#VK_LBUTTON):Wend
EndIf
Else
GetAsyncKeyState_(#VK_LBUTTON)
If GetAsyncKeyState_(#VK_LBUTTON)
If first
If x<>oldx Or y<>oldy
hdc=StartDrawing(ImageOutput(2))
oldpen=SelectObject_(hdc,pen)
MoveToEx_(hdc,oldx,oldy,0)
LineTo_(hdc,x,y)
SelectObject_(hdc,oldpen)
StopDrawing()
SetGadgetState(0,ImageID(2))
If x<lx
lx = x : ly = y
ElseIf x>rx
rx = x : ry = y
EndIf
If y<ty
ty = y : tx = x
ElseIf y>by
by = y : bx = x
EndIf
AddElement(p())
p()\x = x
p()\y = y
oldx = x
oldy = y
EndIf
Else
pressed=1
oldx = x
oldy = y
first=1
ClearList(p())
AddElement(p())
p()\x = x
p()\y = y
lx = x : ly = y
rx = x : ry = y
tx = x : ty = y
bx = x : by = y
EndIf
ElseIf pressed
first=0
pressed=0
ay = by-ty
ax = rx-lx
my = ay/2 + ty
mx = ax/2 + lx
slx = lx
sly = ty
a.f = Winkel(ax,ay)
If tx<bx
suba.f = 90.0 - a
rev = 1
Else
suba.f = a
rev = 0
EndIf
If ay<ax
If rev=0
nosuba.f = 0.0
Else
nosuba = 90.0
EndIf
Else
If rev=0
nosuba.f = 90.0
Else
nosuba = 0.0
EndIf
EndIf
lx = mx : ly = my
rx = mx : ry = my
tx = mx : ty = my
bx = mx : by = my
ForEach p()
arx.f = (p()\x - mx) * Cos(6.28318531*suba/360) - (p()\y - my) * Sin(6.28318531*suba/360) + mx
ary.f = (p()\x - mx) * Sin(6.28318531*suba/360) + (p()\y - my) * Cos(6.28318531*suba/360) + my
If arx<lx
lx = arx : ly = ary
ElseIf arx>rx
rx = arx : ry = ary
EndIf
If ary<ty
ty = ary : tx = arx
ElseIf ary>by
by = ary : bx = arx
EndIf
Next
If a>70.0 Or a<20.0 ;Toleranz-Grenzen
suba = nosuba
Else
suba * -1
EndIf
w = rx - lx
h = by - ty
dc=StartDrawing(ImageOutput(1))
SetGraphicsMode_(dc,#GM_ADVANCED)
emf=Transform(dc,suba,w,h)
rdiffx = (w-nw)/2 + lx
rdiffy = (h-nh)/2 + ty
rmeta.RECT
rmeta\left = rdiffx
rmeta\top = rdiffy
rmeta\right = rdiffx + nw-1
rmeta\bottom = rdiffy + nh-1
PlayEnhMetaFile_(dc,emf,rmeta)
DeleteEnhMetaFile_(emf)
StopDrawing()
CopyImage(1,2)
SetGadgetState(0,ImageID(2))
EndIf
EndIf
Until EventID = #PB_Event_CloseWindow
EndIf
EndMischa
