 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
 Verfasst am: 13.03.2013, 20:56 Titel: |
 |
|
hatte ich schon versucht ging aber nicht. Edit/ ist besser - der Kreis dreht sich ganze 5 mal ca. /EDIT
hab eben gelesen das es bei threadcall einschränkungen gibt was udts arrays usw betrifft, gibt es vielleicht solche auch bei threadcreate?
würde es helfen wenn ich die Include nochmal poste? |
|
| Nach oben |
|
 |
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 14.03.2013, 01:03 Titel: |
|
|
Also bei meinem Beispiel das ich da getestet hatte habe ich dummerweise nur vergessen ein mutex mit Mutexcreate zu erstellen, nachdem ich das nachgeholt habe ging alles einschließlich der Grafikoperationen ohne weitere Probleme... von daher müsste deins eigentlich funktionieren
_________________
 |
|
| Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 14.03.2013, 20:14 Titel: |
|
|
dein Beispiel und auch das aus der referenz geht bei mir ja auch problemlos.
nur wenn ich das auf meinen code anwende gehts nicht mehr. vielleicht hat ja jemand die ambition sich das mal anzuschauen oder gar zu testen. vielleicht liegt es an meiner grafikkarte und bei euch gehts ?
hier ist die #Include - wie schon mal erwähnt ist der original quelltext von TJF aus dem Portal.
| Code: | #DEFINE MAT1 {{1.0,0.0,0.0,0.0},{0.0,1.0,0.0,0.0},{0.0,0.0,1.0,0.0},{0.0,0.0,0.0,1.0}}
#DEFINE E_Z TYPE<v3>(0.0, 0.0, 1.0)
#DEFINE ME_Z TYPE<v3>(0.0, 0.0, -1.0)
Const As Integer MAXPNTS = 50
Const As Single EPS = 1e-7
Const As Single PI = 4 * Atn(1)
Const As Single GRAD_RAD = PI / 180
Const As Single PIXEL_HOCH_ZU_BREIT = 1.0
Dim As Uinteger SCW, SCH
Dim SHARED Imgtxt As Byte Ptr
ScreenInfo SCW, SCH
SUB er(Byval T As String)
If Len(T) Then ?T : Sleep
End 0
End Sub
Sub NormM4(M() As Single)
M(0, 0) = 1.0 : M(0, 1) = 0.0 : M(0, 2) = 0.0 : M(0, 3) = 0.0
M(1, 0) = 0.0 : M(1, 1) = 1.0 : M(1, 2) = 0.0 : M(1, 3) = 0.0
M(2, 0) = 0.0 : M(2, 1) = 0.0 : M(2, 2) = 1.0 : M(2, 3) = 0.0
M(3, 0) = 0.0 : M(3, 1) = 0.0 : M(3, 2) = 0.0 : M(3, 3) = 1.0
End Sub
Sub MulMat(A() As Single, B() As Single, C() As Single)
For i As Integer = 0 To 3
C(0, i) = A(0,0)*B(0,i) + A(0,1)*B(1,i) + A(0,2)*B(2,i) + A(0,3)*B(3,i)
C(1, i) = A(1,0)*B(0,i) + A(1,1)*B(1,i) + A(1,2)*B(2,i) + A(1,3)*B(3,i)
C(2, i) = A(2,0)*B(0,i) + A(2,1)*B(1,i) + A(2,2)*B(2,i) + A(2,3)*B(3,i)
C(3, i) = A(3,0)*B(0,i) + A(3,1)*B(1,i) + A(3,2)*B(2,i) + A(3,3)*B(3,i)
Next
End Sub
Sub InvMat(M() As Single, R() As Single)
Dim As Single d
Dim As Integer i, j, i1, i2, i3, j1, j2, j3, fl = 1
For i = 0 To 3
i1 = (i + 1) And 3 : i2 = (i + 2) And 3 : i3 = (i + 3) And 3
For j = 0 To 3
j1 = (j + 1) And 3 : j2 = (j + 2) And 3 : j3 = (j + 3) And 3
R(j, i) = M(i1,j1) * (M(i2,j2)*M(i3,j3) - M(i2,j3)*M(i3,j2)) + _
M(i1,j2) * (M(i2,j3)*M(i3,j1) - M(i2,j1)*M(i3,j3)) + _
M(i1,j3) * (M(i2,j1)*M(i3,j2) - M(i2,j2)*M(i3,j1))
R(j, i) *= fl
fl = -fl
Next
fl = -fl
Next
For i = 0 To 3 : d += M(0, i) * R(i, 0) : Next
If Abs(d) < EPS Then er("InvMat: Matrix nicht regulaer")
For i = 0 To 3
For j = 0 To 3
R(i, j) /= d
Next
Next
End Sub
Type v3
Declare Function Norm() As Integer
As Single x, y, z
End Type
Function v3.Norm() As Integer
Dim As Single n = Sqr(x*x + y*y + z*z)
If Abs(n) < EPS Then Return -1
x /= n : y /= n : z /= n : Return 0
End Function
Type v2
As Single x, y
End Type
Type vert
As v3 crd, nrm
As INTEGER c
End Type
Type ansicht
PUBLIC:
Declare Sub Clr()
Declare Sub Scr(Byval As Single, Byval As Single, Byval As Single, Byval As Single)
Declare Sub MCtoDC(Byref V As v3, Byref X As Single, Byref Y As Single)
Declare Sub Vie(Byval As Single, Byval As Single, Byval As Single, _
Byval As Single, Byval As Single, Byval As Single, _
Byval As Single, Byval As Single, Byval As Single, _
Byval As Single, Byval As Single, Byval As Single, _
Byval As Single, Byval As Single, Byval As Single)
Declare Sub LocalInit()
Declare Sub updateMats()
As Single MC_WC(3, 3), MC_DC(3, 3)
PRIVATE:
Declare Sub Init()
Declare Sub SetV()
Declare Sub SetS(Byval Lu As v2, Byval Ro As v2)
Declare Sub CalcVRC_NPC()
Declare Sub CalcWC_VRC()
As Uinteger maxint
As Integer frame, MaChe
As Single lux, luy, rox, roy
As Single YsubO, YsubU, SpanMemSize
As Single VPD, FPD, BPD
As Single xMin, yMin, xMax, yMax, xSize, ySize
As Single xwinsize, ywinsize, xwinoffs, ywinoffs
As v3 VRP, NRP, VUP
As v3 eyePoint
As Single WC_NPC(3, 3), MC_NPC(3, 3)
As Single WC_MC(3, 3), WC_DC(3, 3), NPC_MC(3, 3), NPC_DC(3, 3)
As Single WC_VRC(3, 3), VRC_NPC(3, 3), NPC_WC(3, 3)
End Type
Sub ansicht.Clr() 'neuer hintergrund
Line(rox, roy) - (lux, luy), &hff00ff, BF
End Sub
Sub ansicht.Scr(Byval Lx As Single, Byval Uy As Single, _
Byval Rx As Single, Byval Oy As Single)
lux = Lx
luy = Uy
rox = Rx
roy = Oy
YsubO = CINT(roy)
YsubU = CINT(roy - 1)
SpanMemSize = CINT((rox + 1) * 2)
ySize = xSize * PIXEL_HOCH_ZU_BREIT * (luy - roy) / (rox - lux)
End Sub
Sub ansicht.Vie(Byval Vrpx As Single, Byval Vrpy As Single, Byval Vrpz As Single, _
Byval Nrpx As Single, Byval Nrpy As Single, Byval Nrpz As Single, _
Byval Vupx As Single, Byval Vupy As Single, Byval Vupz As Single, _
Byval Minx As Single, Byval Miny As Single, Byval SizeX As Single, _
Byval Vpd_ As Single, Byval Fpd_ As Single, Byval Bpd_ As Single)
VRP.x = Vrpx
VRP.y = Vrpy
VRP.z = Vrpz
NRP.x = Nrpx
NRP.y = Nrpy
NRP.z = Nrpz
VUP.x = Vupx
VUP.y = Vupy
VUP.z = Vupz
xMin = Minx
yMin = Miny
xSize = SizeX
VPD = Vpd_
FPD = Fpd_
BPD = Bpd_
End Sub
Sub ansicht.Init()
YSubU = CINT(luy)
xMax = xMin + xSize
yMax = yMin + ySize * (luy - YsubO) / (luy - roy)
SetV()
SetS(TYPE<v2>(lux, YsubU), TYPE<v2>(rox, YsubO))
End Sub
Sub ansicht.CalcWC_VRC()
Dim As v3 vpn, vup_
Dim As Single scal
WC_VRC(0, 0) = 1.0
WC_VRC(0, 1) = VRP.x
WC_VRC(0, 2) = VRP.y
WC_VRC(0, 3) = VRP.z
vpn.x = NRP.x - VRP.x
vpn.y = NRP.y - VRP.y
vpn.z = NRP.z - VRP.z
If vpn.Norm() Then er("CalcWC_VRC: VRP und NRP sind identisch!")
WC_VRC(3, 0) = 0.0
WC_VRC(3, 1) = vpn.x
WC_VRC(3, 2) = vpn.y
WC_VRC(3, 3) = vpn.z
scal = VUP.x * vpn.x + VUP.y * vpn.y + VUP.z * vpn.z
vup_.x = VUP.x - scal * vpn.x
vup_.y = VUP.y - scal * vpn.y
vup_.z = VUP.z - scal * vpn.z
If vup_.Norm() Then er("CalcWC_VRC: VUP liegt kollinear zu (VRP, NRP)!")
WC_VRC(2, 0) = 0.0
WC_VRC(2, 1) = vup_.x
WC_VRC(2, 2) = vup_.y
WC_VRC(2, 3) = vup_.z
WC_VRC(1, 0) = 0.0
WC_VRC(1, 1) = vup_.y * vpn.z - vup_.z * vpn.y
WC_VRC(1, 2) = vup_.z * vpn.x - vup_.x * vpn.z
WC_VRC(1, 3) = vup_.x * vpn.y - vup_.y * vpn.x
eyePoint.x = vpn.x * VPD + VRP.x
eyePoint.y = vpn.y * VPD + VRP.y
eyePoint.z = vpn.z * VPD + VRP.z
End Sub
Sub ansicht.CalcVRC_NPC()
Dim As Single k, l
k = (VPD - BPD) / VPD
l = (FPD - BPD) / (VPD - FPD)
VRC_NPC(0, 0) = 0.0
VRC_NPC(0, 1) = k * xMin
VRC_NPC(0, 2) = k * yMin
VRC_NPC(0, 3) = BPD
VRC_NPC(1, 0) = 0.0
VRC_NPC(1, 1) = k * (xMax - xMin)
VRC_NPC(1, 2) = 0.0
VRC_NPC(1, 3) = 0.0
VRC_NPC(2, 0) = 0.0
VRC_NPC(2, 1) = 0.0
VRC_NPC(2, 2) = k * (yMax - yMin)
VRC_NPC(2, 3) = 0.0
VRC_NPC(3, 0) = 1.0
VRC_NPC(3, 1) = 0.0
VRC_NPC(3, 2) = 0.0
VRC_NPC(3, 3) = l * VPD
End Sub
Sub ansicht.SetV()
CalcWC_VRC()
CalcVRC_NPC()
MulMat(VRC_NPC(), WC_VRC(), NPC_WC())
InvMat(NPC_WC(), WC_NPC())
MaChe = 1
End Sub
Sub ansicht.SetS(Byval Lu As v2, Byval Ro As v2)
Clr()
xwinsize = Ro.x - Lu.x
xwinoffs = CINT(Lu.x)
ywinsize = Ro.y - Lu.y
ywinoffs = CINT(Lu.y)
NormM4(NPC_DC())
NPC_DC(1, 1) = xwinsize
NPC_DC(2, 2) = ywinsize
NPC_DC(3, 3) = maxint
NPC_DC(0, 1) = xwinoffs
NPC_DC(0, 2) = ywinoffs
MaChe = 1
End Sub
Sub ansicht.LocalInit()
YSubU = CINT(luy)
xMax = xMin + xSize
yMax = yMin + ySize * (luy - YsubO) / (luy - roy)
SetV()
SetS(TYPE<v2>(lux, YsubU), TYPE<v2>(rox, YsubO))
End Sub
Sub ansicht.updateMats()
If MaChe = 0 Then Exit Sub
Dim As Single mc_npc(3, 3)
MulMat(MC_WC(), WC_NPC(), mc_npc())
MulMat(mc_npc(), NPC_DC(), MC_DC())
InvMat(MC_WC(), WC_MC())
InvMat(mc_npc(), NPC_MC())
MaChe = 0
End Sub
Sub ansicht.MCtoDC(Byref V As v3, Byref X As Single, Byref Y As Single)
Dim As Single w
w = MC_DC(0, 0) + V.x * MC_DC(1, 0) + V.y * MC_DC(2, 0) + V.z * MC_DC(3, 0)
If Abs(w) < EPS Then er("MC_DC: Punkt nicht definiert!")
X = (MC_DC(0, 1) + V.x * MC_DC(1, 1) + V.y * MC_DC(2, 1) + V.z * MC_DC(3, 1)) / w
Y = (MC_DC(0, 2) + V.x * MC_DC(1, 2) + V.y * MC_DC(2, 2) + V.z * MC_DC(3, 2)) / w
End Sub
SUB Rotate(Byval V As ansicht Ptr, BYVAL A AS INTEGER, BYVAL W AS SINGLE)
DIM AS SINGLE s = SIN(W * GRAD_RAD), c = COS(W * GRAD_RAD)
DIM AS Single mcdc(3, 3), M(3, 3) = MAT1
WITH *V
FOR z AS INTEGER = 0 TO 3
FOR s AS INTEGER = 0 TO 3
mcdc(z, s) = .MC_DC(z, s)
NEXT
NEXT
SELECT CASE AS CONST A
CASE 1 : M(2, 2) = c : M(2, 3) = s : M(3, 2) = -s : M(3, 3) = c
CASE 2 : M(1, 1) = c : M(1, 3) = s : M(3, 1) = -s : M(3, 3) = c
CASE 3 : M(1, 1) = c : M(1, 2) = s : M(2, 1) = -s : M(2, 2) = c
END SELECT
MulMat(M(), mcdc(), .MC_DC())
END WITH
END SUB
Dim Shared mycube(2500) As vert '8
Dim Shared xyz_zaehler(2500) AS Integer
Dim Shared As Integer i, j, ij, paintx, painty
Dim SHARED AS Single hoehenk
Dim SHARED As Single winkel=Atn(1)*4/180 'PI=Atn(1)*4 , PI/15 => 12° (15 * 2 = 30 schritte)
DECLARE SUB neuer_kreis(textur as String)
SUB neuer_kreis(textur AS STRING)
IF textur = "" THEN textur = "LEER"
'ersten Kreis berechnen
for i = 1 to 360
With mycube(i).crd
.x = (0 + 50 * cos(i*winkel)) / 50
.y = (0 + 50 * sin(i*winkel)) / 50
.z = -.1
End With
xyz_zaehler(i) = 360 - i
next
'zweiten Kreis berechnen
for i = 361 to 720
With mycube(i).crd
.x = (0 + 50 * cos((i - 360) * winkel)) / 50
.y = (0 + 50 * sin((i - 360) * winkel)) / 50
.z = .1
End With
xyz_zaehler(i) = 360 - (i - 360)
next
'For i = 1 To 60 '8
' With mycube(i).crd: Read .x,.y,.z: End With
'Next
Imgtxt = Imagecreate(360, 9)
Draw string Imgtxt, (1, 1), textur, &haa0000
'360 Kreispunkt-koordinaten sammeln
Type kreispunkte360
nxk AS single
nyk AS single
END Type
DIM kp(360) AS kreispunkte360
for i = 1 to 360
kp(i).nxk = (0 + 50 * cos(i*winkel)) / 50
kp(i).nyk = (0 + 50 * sin(i*winkel)) / 50
next
ij = 720
hoehenk = .08
for i = 0 to 8
for j = 0 to 359
IF Point (j, i, Imgtxt)= 11141120 then
ij += 1
With mycube(ij).crd
.x = kp(j+1).nxk
.y = kp(j+1).nyk
.z = hoehenk
End With
xyz_zaehler(ij) = 360 - (j + 1)
END IF
next j
hoehenk -= .02
next i
ImageDestroy Imgtxt
END SUB
Sub DrawCube(Byval A As ansicht Ptr)
Dim As Single x(ij), y(ij) '8
For i As Integer = 1 To ij '8
(*A).MCtoDC(mycube(i).crd, x(i), y(i))
Next
(*A).Clr()
' hinteren teil des kreises zeichnen - oben/unten
color &h005500 'grün
for i as integer = 1 to 720
if xyz_zaehler(i) >= 178 and xyz_zaehler(i) < 360 then
if not i = 360 and not i = 720 then
line (x(i), y(i)) - (x(i+1), y(i+1))
elseif i = 360 then
line (x(i), y(i)) - (x(1), y(1))
elseif i = 720 then
line (x(i), y(i)) - (x(361), y(361))
end if
END IF
If xyz_zaehler(i) = 270 then paintx = x(i): painty = y(i) + 2
next
' hinteren teil des kreises zeichnen - links/rechts
for i as integer = 1 to 360
IF xyz_zaehler(i) = 178 OR xyz_zaehler(i) = 0 then
line (x(i), y(i)) - (x(i+360), y(i+360))
END IF
next
' hinteren teil des kreises ausmalen
paint (paintx, painty),&h005500 ,&h005500
' vorderen teil des kreises zeichnen - oben/unten
color &h00bb00 'grün
for i as integer = 1 to 720
if xyz_zaehler(i) >= 0 and xyz_zaehler(i) < 178 then
if not i = 360 and not i = 720 then
line (x(i), y(i)) - (x(i+1), y(i+1))
elseif i = 360 then
line (x(i), y(i)) - (x(1), y(1))
elseif i = 720 then
line (x(i), y(i)) - (x(361), y(361))
end if
END IF
If xyz_zaehler(i) = 90 then paintx = x(i): painty = y(i) + 2
next
' vorderen teil des kreises zeichnen - links/rechts
for i as integer = 1 to 360
IF xyz_zaehler(i) = 177 OR xyz_zaehler(i) = 1 then
line (x(i), y(i)) - (x(i+360), y(i+360))
END IF
next
' vorderen teil des kreises ausmalen
paint (paintx, painty),&h00bb00 ,&h00bb00
color &hbb0000
for i as integer = 721 to ij
if xyz_zaehler(i) >= 0 and xyz_zaehler(i) < 178 then pset (x(i), y(i)): draw "r1 d1 l1"
next
color &hffffff
for i as integer = 1 to ij
xyz_zaehler(i) += 1: if xyz_zaehler(i) = 360 then xyz_zaehler(i) = 0
next i
' Circle (x(1), y(1)),10,&hffff55 'gelb
End Sub
'DIM AS INTEGER x1 = 10, x2 = SCW\2-5, x3 = x2+10, x4 = SCW-10
'DIM AS INTEGER y1 = 10, y2 = SCH\2-5, y3 = y2+10, y4 = SCH-10
DIM AS INTEGER x1 = 0, x2 = SCW, x3 = x2+10, x4 = SCW-10
DIM AS INTEGER y1 = 0, y2 = SCH, y3 = y2+10, y4 = SCH-10
'Dim As Single Mnx = -1.5, Mny = -1.0, Six = 3.0
'Dim As Single Vpd = 6, Fpd = 1.5, Bpd = -1.5
Dim As Single Mnx = -1.5, Mny = -1.0, Six = 3.0
Dim As Single Vpd = 4, Fpd = 1.5, Bpd = -1.5
Dim Shared As ansicht PTR Ans
Ans = New ansicht[3]
Ans[0].Vie(0.0, 0.0, 0.0, _
0.0, -1.0, 0.0, _
0.0, 0.0, 1.0, _
Mnx, Mny, Six, Vpd, Fpd, Bpd)
Ans[0].Scr(x1, y2, x2, y1)
Ans[1].Vie(0.0, 0.0, 0.0, _
-1.0, 0.0, 0.0, _
0.0, 0.0, 1.0, _
Mnx, Mny, Six, Vpd, Fpd, Bpd)
Ans[1].Scr(x3, y2, x4, y1)
Ans[2].Vie(0.0, 0.0, 0.0, _
0.0, 0.0, 1.0, _
0.0, 1.0, 0.0, _
Mnx, Mny, Six, Vpd, Fpd, Bpd)
Ans[2].Scr(x1, y4, x2, y3)
For i = 0 TO 0 '0 to 2
NormM4(Ans[i].MC_WC())
Ans[i].LocalInit()
Ans[i].updateMats()
Next
Dim h As String
Dim SHARED As Integer axis_x,axis_y,axis_z,ax
Dim Shared As Single ro,st=1
|
und noch mal die koplette testdatei
| Code: | #INCLUDE "fbgfx.bi"
Dim As Any Ptr kreisthread
Dim Shared As Integer terminate, r_z
Dim Shared As Any Ptr mutex
screenres 1024, 600, 32,, &h10
#Include "c:\programmieren\freebasic\projekte\3d_mit_fb.bi"
Sub MyThread (ByVal Parameter as Any Ptr)
neuer_kreis ("- Text -")
axis_x=(axis_x+11) Mod 360 : ax=1 : ro=11
Rotate(@Ans[0],ax,ro)
DO
MutexLock(mutex)
Screenlock: DrawCube(@Ans[0]): Screenunlock
axis_z=(axis_z-st) Mod 360 : ax=3 : ro=-st
Rotate(@Ans[0],ax,ro)
If terminate = 1 Then 'abbrechen wenn 1
MutexUnLock(mutex)
Exit Do
End if
MutexUnLock(mutex)
Loop
END SUB
kreisthread = ThreadCreate(@MyThread)
DO
MutexLock(mutex)
sleep 25
screenlock
locate 1,1: ? TIMER
screenunlock
h = Inkey
MutexUnLock(mutex)
LOOP Until h = CHR(27)
MutexLock(mutex): terminate = 1: MutexUnLock(mutex) 'MyThread abbrechen
ThreadWait(kreisthread) 'warten bis MyThread endet
screenlock
? "THREAD BEENDET"
screenunlock
sleep
Delete[] Ans
END
|
|
|
| Nach oben |
|
|
Eternal_pain
Anmeldungsdatum: 08.08.2006
Beiträge: 1783
Wohnort: BW/KA
|
| Verfasst am: 14.03.2013, 20:45 Titel: |
|
|
habe mal angefangen...
EDIT!!!!!!!!!!!!
| Eternal_pain hat Folgendes geschrieben: | | Also bei meinem Beispiel das ich da getestet hatte habe ich dummerweise nur vergessen ein mutex mit Mutexcreate zu erstellen , nachdem ich das nachgeholt habe ging alles einschließlich der Grafikoperationen ohne weitere Probleme... von daher müsste deins eigentlich funktionieren |
| Code: | | mutex = mutexcreate() |
| Code: |
Type kreispunkte360 'Type in Sub???
nxk AS single
nyk AS single
END Type
SUB neuer_kreis(textur AS STRING)
IF textur = "" THEN textur = "LEER"
'ersten Kreis berechnen
'For i as Integer = 1 to 360 'warum 1-360 360 = 0 warum nicht 0 to 359???
For i as Integer = 0 to 359
With mycube(i).crd
.x = (0 + 50 * cos(i*winkel)) / 50
.y = (0 + 50 * sin(i*winkel)) / 50
.z = -.1
End With
'xyz_zaehler(i) = 360 - i 'das zählt was???
next i
'zweiten Kreis berechnen
For i as Integer = 360 to 719 'merke! 360 = 0
With mycube(i).crd
.x = (0 + 50 * cos(i * winkel)) / 50 'bei der berechnung ist das -360 unnötig, s.o. (360 = 0)
.y = (0 + 50 * sin(i * winkel)) / 50
.z = .1
End With
'xyz_zaehler(i) = 360 - (i - 360) 'nochmal... hä?
next i
'For i = 1 To 60 '8
' With mycube(i).crd: Read .x,.y,.z: End With
'Next
Imgtxt = Imagecreate(360, 9)
Draw string Imgtxt, (1, 1), textur, &haa0000
'360 Kreispunkt-koordinaten sammeln
'Type kreispunkte360 'Type in Sub???
' nxk AS single
' nyk AS single
'END Type
DIM kp(360) AS kreispunkte360
for i as Integer = 0 to 359
kp(i).nxk = (0 + 50 * cos(i*winkel)) / 50
kp(i).nyk = (0 + 50 * sin(i*winkel)) / 50
next i
ij = 720'?
hoehenk = .08
for i as Integer = 0 to 8 'y und
for j as Integer = 0 to 359 'x wäre eindeutiger...
'IF Point (j, i, Imgtxt)= 11141120 then ''BITTE BITTE lesbar in HEX
IF Point (j, i, Imgtxt) = &hAA0000 then ''BITTE BITTE lesbar in HEX
ij += 1'?
With mycube(ij).crd
.x = kp(j).nxk
.y = kp(j).nyk
.z = hoehenk
End With
'xyz_zaehler(ij) = 360 - (j + 1)' ich kapiers immernoch nicht...
END IF
next j
hoehenk -= .02
next i
ImageDestroy Imgtxt
END SUB |
Leider sehen alle deine Prozeduren so aus, was es nicht gerade leicht macht...
_________________
|
|
| Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 15.03.2013, 01:03 Titel: |
|
|
erstmal danke für die mühe. mir ist das mit dem mutexcreate echt nicht aufgefallen als du es das erste mal geschrieben hast, ich war der meinung das ich es erstellt hatte wegen mit DIM. 
Das war das problem.
zu deinen Fragen trotzdem noch
du hast recht das gehört nicht unbedingt da hin, da es aber funktioniert hat ist es mir auch nicht aufgefallen
| Code: | | 'For i as Integer = 1 to 360 'warum 1-360 360 = 0 warum nicht 0 to 359??? |
ich fang nicht bei 0 an damit es für mich übersichtlicher bleibt da ich für einen kreis 360 randkoordinaten benutze
| Code: | | xyz_zaehler(i) = 360 - i 'das zählt was??? |
das legt für jede der 360 koordinaten ein startwert fest der sich dann später mit jeder drehung verändert - über diesen wert bestimme ich die farbe - da der teil der im hintergrund liegt dunkler gezeichnet werden soll
| Code: | 'zweiten Kreis berechnen
For i as Integer = 360 to 719 'merke! 360 = 0
With mycube(i).crd
.x = (0 + 50 * cos(i * winkel)) / 50 'bei der berechnung ist das -360 unnötig, s.o. (360 = 0)
...
'xyz_zaehler(i) = 360 - (i - 360) 'nochmal... hä?
next i |
also mycube(i).crd (oder später myring oder so) 1 bis 360 speichert die 360 koordinaten des ersten kreises und mycube(i).crd 361 bis 720 speichert die 360 koordinaten des zweiten kreises, diese kreise bilden dann beim zeichnen einen Ring - bei der berechnung muss ich aber 360 wieder abziehen da ein kreis ja nur 360° hat. - das selbe auch für xyz_zaehler
bezieht sich wieder auf mycube() der nun schon 720 koordinaten gespeichert hat, welche ja nun nicht überschrieben werden sollen
der zaehler für mycube wird um 1 erhöht - und zwar soll der ring mit einem String belegt werden. dafür wird dieser mit rot in ein image gezeichnet. - image auslesen mit point pixel für pixel - wird nun ein roter pixel gefunden > ij += 1 und mycube(ij) speichert die koordinaten für diesen pixel. |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
