CodeArchiv für PB v4 - aktueller Status & Mithelfer gesu

Ankündigungen PureBasic oder die Community betreffend.
Benutzeravatar
Andre
PureBasic Team
Beiträge: 1765
Registriert: 11.09.2004 16:35
Computerausstattung: MacBook Core2Duo mit MacOS 10.6.8
Lenovo Y50 i7 mit Windows 10
Wohnort: Saxony / Deutscheinsiedel
Kontaktdaten:

Beitrag von Andre »

So - als momentanen Stand habe ich nunmehr 1722 Codes im (unveröffentlichten) Archiv erreicht. :)

@Gisela: Danke für das Lob und Deine Mühe. Wäre aber nicht notwendig gewesen, denn dieser Code ist längst in einer PB v4 Variante verfügbar - und zwar online auf www.PureArea.net (CodeArchiv), jedoch noch nicht als Download-Paket.

@edel & Co: Kein Streit wegen FastLen.pb :mrgreen:
Habe diesen Code nunmehr auch dem Archiv hinzugefügt, jedoch mit einem speziellem Hinweis zur Geschwindigkeit auf AMD, Pentium, ....

Der aktuelle Stand der zu überarbeitenden Codes hier:
http://www.purearea.net/temp/CodeArchiv ... n-Blitz.pb
http://www.purearea.net/temp/CodeArchiv ... DModels.pb
http://www.purearea.net/temp/CodeArchiv ... ceBalls.pb
http://www.purearea.net/temp/CodeArchiv ... BSource.pb
http://www.purearea.net/temp/CodeArchiv ... on_xxxx.pb
http://www.purearea.net/temp/CodeArchiv ... ler_xxx.pb
http://www.purearea.net/temp/CodeArchiv ... rpreter.pb
http://www.purearea.net/temp/CodeArchiv ... ePlayer.pb
http://www.purearea.net/temp/CodeArchiv ... ndMovie.pb
http://www.purearea.net/temp/CodeArchiv ... ssSolve.pb
http://www.purearea.net/temp/CodeArchiv ... ation3D.pb
http://www.purearea.net/temp/CodeArchiv ... section.pb
http://www.purearea.net/temp/CodeArchiv ... nctions.pb
http://www.purearea.net/temp/CodeArchiv ... ghtning.pb
http://www.purearea.net/temp/CodeArchiv ... -Editor.pb
http://www.purearea.net/temp/CodeArchiv ... Example.pb
http://www.purearea.net/temp/CodeArchiv ... Connect.pb
http://www.purearea.net/temp/CodeArchiv ... pSoap32.pb
http://www.purearea.net/temp/CodeArchiv ... eeClass.pb
http://www.purearea.net/temp/CodeArchiv ... enSaver.pb
http://www.purearea.net/temp/CodeArchiv ... dTetris.pb
http://www.purearea.net/temp/CodeArchiv ... ShowMap.pb
Bye,
...André
(PureBasicTeam::Docs - PureArea.net | Bestellen:: PureBasic | PureVisionXP)
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Beitrag von ts-soft »

SpeedTetris kanntse so lassen, die negativen Locate Werte müssen so sein, sonst passt es nicht
Zuletzt geändert von ts-soft am 08.02.2007 16:17, insgesamt 1-mal geändert.
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Benutzeravatar
DrShrek
Beiträge: 1970
Registriert: 08.09.2004 00:59

Beitrag von DrShrek »

Andre hat geschrieben:@edel & Co: Kein Streit wegen FastLen.pb :mrgreen:
Habe diesen Code nunmehr auch dem Archiv hinzugefügt, jedoch mit einem speziellem Hinweis zur Geschwindigkeit auf AMD, Pentium, ....
Wir haben diskutiert...mehr nicht ;-)
Siehste! Geht doch....?!
PB*, *4PB, PetriDish, Movie2Image, PictureManager, TrainYourBrain, ...
Benutzeravatar
remi_meier
Beiträge: 1078
Registriert: 29.08.2004 20:11
Wohnort: Schweiz

Beitrag von remi_meier »

Beim Gauss-Solve-Code, einfach die Prozedur mit der folgenden austauschen:

Code: Alles auswählen

Procedure GaussSolve(Matrix.f(2), n.l) 
  Protected h.f, i, j, k
  n = n - 1
  
  For i = 0 To n - 1 
    h = Matrix(i, i) 
    If h = 0 
      ProcedureReturn #False
    EndIf 
    For j = 0 To n 
      Matrix(j, i) = Matrix(j, i) / h 
    Next 
    For j = 0 To n - 1 
      If i <> j 
        h = Matrix(i, j) 
        For k = 0  To n 
          Matrix(k, j) = Matrix(k, j) - Matrix(k, i) * h 
        Next 
      EndIf 
    Next 
  Next 
  
  ProcedureReturn #True
EndProcedure 
und ev. noch das @ bei GaussSolve(@Matrix(), #x) entfernen.
Benutzeravatar
PureLust
Beiträge: 1145
Registriert: 21.07.2005 00:02
Computerausstattung: Hab aktuell im Grunde nur noch 'nen Lenovo Yoga 2 Pro im Einsatz.
Wohnort: am schönen Niederrhein

Beitrag von PureLust »

Hallo André,

dieser Code von Danilo ist laut der Info im CodeArchiv angeblich schon upgedated worden - was er aber nicht ist (ist immer noch auf 3.94 Standard).

Hätte hier gerne den konvertierten Code geposted, bekam aber in der Callback-Prozedur unter 4.02 immer einen InvalidMemoryAccess den ich auf die schnelle auch nicht beheben konnte - von daher also leider keine Konvertierung von mir anbei. :cry:

Aber vielleicht schafft's ja ein anderer. ;)

Gruß, PL.
[Dynamic-Dialogs] - komplexe dynamische GUIs einfach erstellen
[DeFlicker] - Fenster flimmerfrei resizen
[WinFX] - Window Effekte (inkl. 'durchklickbares' Window)
Benutzeravatar
Ligatur
Beiträge: 196
Registriert: 09.07.2006 00:41

Beitrag von Ligatur »

PureLust hat geschrieben:Hallo André,

dieser Code von Danilo ist laut der Info im CodeArchiv angeblich schon upgedated worden - was er aber nicht ist (ist immer noch auf 3.94 Standard).

Hätte hier gerne den konvertierten Code geposted, bekam aber in der Callback-Prozedur unter 4.02 immer einen InvalidMemoryAccess den ich auf die schnelle auch nicht beheben konnte - von daher also leider keine Konvertierung von mir anbei. :cry:

Aber vielleicht schafft's ja ein anderer. ;)

Gruß, PL.
So geht es auch ohne Invalid Memory Access

Code: Alles auswählen

; German forum: http://www.purebasic.fr/german/archive/viewtopic.php?t=3404&highlight=
; Author: Danilo
; Date: 11. January 2004
; OS: Windows
; Demo: 


; Hier mal der Code für die "Pfeile" und ein paar andere 
; nützliche Funktionen fürs ListIconGadget. 
; Wie man sieht sind die Pfeile nur ein Bilder, d.h. man 
; kann auch eigene Bilder mit der Größe 16x16 verwenden. 

; 
; ListIconGagdet column header images 
; with image switching 
; 
; by Danilo, 11.01.2004 
; 
; 
; credits: 
;   - sort function from PureArea.net code archive, 
;     file  : ListIcon_SortbyColumn.pb 
;     writer: unknown 
; 
Procedure CreateListIconArrows(StartImage) 
  ; by Danilo, 11.01.2004 
  ; 
  ; generate 2 small 16x16 arrows, up & down 
  ; 
  For img = 0 To 1 
    CreateImage(StartImage+img,16,16) 
    StartDrawing(ImageOutput(StartImage+img)) 
      background = GetSysColor_(#COLOR_BTNFACE) 
      FrontColor(background)
      Box(0,0,16,16) 
      If img = 0 : Start=7 : Else : Start = 2 : EndIf 
      For a = 6 To 10 
        Line(Start,a,13-Start*2,0,0) 
        Start+1 
      Next a 
    StopDrawing() 
  Next 
EndProcedure 


Procedure AddListIconColumn(gadget,pos,width,align,text$,hImage) 
  ; by Danilo, 11.01.2004 
  ; 
  ; Add column to ListIconGadget 
  ; 
  ;   gadget = the PB gadget number 
  ;   pos    = position of the new column 
  ;   width  = with     of the new column 
  ;   align  = align    of the text in the column: 
  ;            #LI_CENTERED, #LI_LEFT, #LI_RIGHT 
  ;   text$  = column header text 
  ;   hImage = image handle __OR__ index of already added image! 
  ; 
  #LVCF_IMAGE = $10 
  #LVCFMT_COL_HAS_IMAGES = $8000 
  #LI_CENTERED = #LVCFMT_CENTER 
  #LI_LEFT     = #LVCFMT_LEFT 
  #LI_RIGHT    = #LVCFMT_RIGHT 
  Structure LVCOLUMN 
    lv.LV_COLUMN 
    iImage.l 
    iOrder.l 
  EndStructure 
  If GetObjectType_(hImage)=#OBJ_BITMAP 
    ; Add Image to List 
    hImgL = SendMessage_(GadgetID(gadget),#LVM_GETIMAGELIST,#LVSIL_SMALL,0) 
    If hImgL=0 
      hImgL = ImageList_Create_(16,16,#ILC_COLOR32,1,1) 
      SendMessage_(GadgetID(gadget),#LVM_SETIMAGELIST,#LVSIL_SMALL,hImgL) 
    EndIf 
    idx = ImageList_Add_(hImgL,hImage,0) 
  Else 
    ; was an index 
    idx = hImage 
  EndIf 
  LVC.LVCOLUMN 
  LVC\lv\mask = #LVCF_IMAGE|#LVCF_TEXT|#LVCF_WIDTH|#LVCF_FMT 
  LVC\lv\fmt     = align|#LVCFMT_COL_HAS_IMAGES 
  LVC\lv\pszText = @text$ 
  LVC\lv\cchTextMax = Len(text$) 
  LVC\lv\iSubItem = pos 
  LVC\lv\cx   = width 
  LVC\iImage  = idx 
  LVC\iOrder  = pos 
  SendMessage_(GadgetID(gadget),#LVM_INSERTCOLUMN,pos,@LVC) 
EndProcedure 


Procedure GetListIconColumnImage(gadget,column) 
  ; by Danilo, 11.01.2004 
  ; 
  ; returns the image_index of the column-header-image 
  ; 
  LVC.LVCOLUMN 
  LVC\lv\mask = #LVCF_IMAGE 
  SendMessage_(GadgetID(gadget),#LVM_GETCOLUMN,column,@LVC) 
  ProcedureReturn LVC\iImage 
EndProcedure 


Procedure ChangeListIconColumnImage(gadget,column,Image_Index) 
  ; by Danilo, 11.01.2004 
  ; 
  ; change the image_index of the column-header-image 
  ; 
  LVC.LVCOLUMN 
  LVC\lv\mask = #LVCF_IMAGE 
  LVC\iImage  = Image_Index 
  ProcedureReturn SendMessage_(GadgetID(gadget),#LVM_SETCOLUMN,column,@LVC) 
EndProcedure 


Procedure SetListIconColumnText(gadget,index,Text$) 
  ; by Danilo, 15.12.2003 - english chat (for 'Karbon') 
  ; 
  ; change column header text 
  ; 
  lvc.LV_COLUMN 
  lvc\mask    = #LVCF_TEXT 
  lvc\pszText = @Text$ 
  SendMessage_(GadgetID(gadget),#LVM_SETCOLUMN,index,@lvc) 
EndProcedure 


Procedure SetListIconColumnWidth(gadget,index,new_width) 
  ; by Danilo, 15.12.2003 - english chat (for 'Karbon') 
  ; 
  ; change column header width 
  ; 
  SendMessage_(GadgetID(gadget),#LVM_SETCOLUMNWIDTH,index,new_width) 
EndProcedure 


Procedure SetListIconColumnFormat(gadget,index,format) 
  ; by Danilo, 15.12.2003 - english chat (for 'Karbon') 
  ; 
  ; change text alignment for columns 
  ; 
  lvc.LV_COLUMN 
  lvc\mask = #LVCF_FMT 
  Select format 
    Case 0: lvc\fmt = #LVCFMT_LEFT 
    Case 1: lvc\fmt = #LVCFMT_CENTER 
    Case 2: lvc\fmt = #LVCFMT_RIGHT 
  EndSelect 
  SendMessage_(GadgetID(gadget),#LVM_SETCOLUMN,index,@lvc) 
EndProcedure 




Procedure UpdatelParam(ListIconGadget,columns) 
  ; 
  ; PureArea.net CodeArchiv, by unknown 
  ; 
  ; modified by Danilo, 11.01.2004 
  ; 
  ItemCount = SendMessage_(ListIconGadget, #LVM_GETITEMCOUNT, 0, 0) 
  lvi.LV_ITEM 
  lvi\mask = #LVIF_PARAM 
  lvi\iItem = 0 
  While ItemCount>0 
    lvi\lParam = lvi\iItem 
    For SubItem = 0 To columns-1 
      lvi\iSubItem = SubItem 
      SendMessage_(ListIconGadget, #LVM_SETITEM, 0, @lvi) 
    Next SubItem 
    lvi\iItem +1 
    ItemCount -1 
  Wend 
EndProcedure 


Procedure ListIconSortFunction(lParam1,lParam2,lParamSort) 
  ; 
  ; PureArea.net CodeArchiv, by unknown 
  ; 
  ; modified by Danilo, 11.01.2004 
  ; 
  A$ = Space(200) 
  B$ = Space(200) 
  result = 0 
  lvi.LV_ITEM 
  lvi\iSubItem = lParamSort&$FFFF 
  lvi\pszText = @A$ 
  lvi\cchTextMax = 200 
  lvi\mask = #LVIF_TEXT 
  SendMessage_(GadgetID(0), #LVM_GETITEMTEXT,lParam1,@lvi) 
  lvi\pszText = @B$ 
  SendMessage_(GadgetID(0), #LVM_GETITEMTEXT,lParam2,@lvi) 

  If A$ = B$ 
    ProcedureReturn 0 ; equal 
  EndIf 

  x = (lParamSort>>16)&$FFFF 
  If x 
    If A$ > B$ 
      ProcedureReturn  1 
    Else 
      ProcedureReturn -1 
    EndIf 
  Else 
    If A$ > B$ 
      ProcedureReturn -1 
    Else 
      ProcedureReturn  1 
    EndIf 
  EndIf 
  ProcedureReturn result 
EndProcedure 




; 
;- Window Callback 
; 
Procedure WinProc(hWnd,Msg,wParam,lParam) 
  result = #PB_ProcessPureBasicEvents 
  Select Msg 
    Case #WM_NOTIFY 
      *NMHDR.NMHDR = lParam 
      If *NMHDR\hWndFrom = GadgetID(0) ; comes from our ListIconGadget 
        If *NMHDR\code = #LVN_COLUMNCLICK 
          *NMLV.NMLISTVIEW = lParam 
          column = *NMLV\iSubItem 
          ; switch images: 
          index  = GetListIconColumnImage(0,column) 
          ChangeListIconColumnImage(0,column,index!1) 
          ; sort 
          SendMessage_(GadgetID(0),#LVM_SORTITEMS,column|((index)<<16),@ListIconSortFunction()) 
          UpdatelParam(GadgetID(0),5) 
        EndIf 
      EndIf
      result = 0
  EndSelect 
  ProcedureReturn result 
EndProcedure 


; 
;- program start 
; 
CreateListIconArrows(0) 

OpenWindow(0,0,0,500,200,"LV",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
  SetWindowCallback(@WinProc()) 
  CreateGadgetList(WindowID(0)) 
  ListIconGadget(0,0,0,500,200,"",0,#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection) 
   AddListIconColumn(0,1,150,#LI_LEFT    ,"Column 1",ImageID(0)) ; add Image 0 
   AddListIconColumn(0,2,120,#LI_CENTERED,"Column 2",ImageID(1)) ; add Image 1 
   AddListIconColumn(0,3, 90,#LI_CENTERED,"Column 3",0)           ; use Image index 0 
   AddListIconColumn(0,4,105,#LI_RIGHT   ,"Column 4",1)           ; use Image index 1 
    
   For a = 0 To 100 
     A$ = "COLUMN 1, Row "+RSet(Str(  a  ),3,"0")+Chr(10) 
     x = Random($FFFF) 
     B$ =                  RSet(Str(  x  ),5,"0")+Chr(10) 
     x = Random($7FFFFFFF) 
     C$ =              "$"+RSet(Hex(  x  ),8,"0")+Chr(10) 
     D$ = "COL 4, Row "   +RSet(Str(100-a),3,"0") 
     AddGadgetItem(0,-1,Chr(10)+A$+B$+C$+D$) 
   Next 
    
   UpdatelParam(GadgetID(0),5) 
    
Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow
; ExecutableFormat=Windows
; FirstLine=1
; EnableXP
; EOF
Progi1984
Beiträge: 9
Registriert: 09.01.2007 12:13
Wohnort: France
Kontaktdaten:

Beitrag von Progi1984 »

Name : Animation3DModels.pb

Code: Alles auswählen

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=12811
; Author: Guimauve (updated for PB 4.00 by Andre)
; Updated : 13/03/07 Progi1984
; Date: 17. October 2004
; OS: Windows
; Demo: No


; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Amination 3D simple Icosaèdre étoilé (60 triangles) -- Source principal
; Version 1.10
; Programmation = OK
; Programmé par : Guimauve
; Date : 16 octobre 2004
; Codé avec PureBasic V3.92 Beta
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Enumeration
     #Vertical
     #Horizontal
     #Icosahedron
     #Icosahedron_small
     #Icosahedron_small2
     #Icosahedron_small3
     #Icosahedron_tex
     #Icosahedron_mat
     #Icosahedron_tex_small
     #Icosahedron_tex_small2
     #Icosahedron_tex_small3
EndEnumeration

Procedure.f DegToRad(Angle.f)
     
     ProcedureReturn Angle * 3.1415926 / 180
     
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Déclaration du tableau >>>>>
Global Dim Texte.s(5)

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Initialisation du tableau >>>>>

; Texte(0) = "Presser ESCAPE pour sortir."
; Texte(1) = "Model 3D : Position ( X, Y, Z )"
; Texte(2) = "Bleu/Vert"
; Texte(3) = "Gris/Rouge"
; Texte(4) = "Gris/Bleu"
; Texte(5) = "Rayon orbital aléatoire : "

Texte(0) = "Press ESCAPE to exit."
Texte(1) = "Model 3D : Position ( X, Y, Z )"
Texte(2) = "Blue/Green"
Texte(3) = "Gray/Red"
Texte(4) = "Gray/Blue"
Texte(5) = "Orbital radius : "

; Largeur et hauteur de la résolution windows
ScreenW = GetSystemMetrics_(#SM_CXSCREEN)
ScreenH = GetSystemMetrics_(#SM_CYSCREEN)
; Couleur 32 bits
ScreenD = 32

Declare DrawGradienttex(Color1.l, Color2.l, NbColor.l, largeur.l, hauteur.l, OutputID.l, Orientation.b)
Declare.f LinearDistanceEntity(X1.f, Y1.f, Z1.f, X2.f, Y2.f, Z2.f)
Declare.f Spin(No.f, mini.f, maxi.f, increment.f)

If InitEngine3D()
     If InitSprite()
          If InitKeyboard()
               If OpenScreen(ScreenW, ScreenH, ScreenD, "Icosaèdre étoilé")
               
                    CreateMesh(#Icosahedron, 1000)     
                    SetMeshData(#Icosahedron, #PB_Mesh_Vertex, ?Vertices, 180)
                    SetMeshData(#Icosahedron, #PB_Mesh_Face , ?FacesIndexes, 60)
                    SetMeshData(#Icosahedron, #PB_Mesh_UVCoordinate, ?TextureCoordinates, 180)
                    CreateTexture(#Icosahedron_tex, 256, 256)
                    CreateMaterial(#Icosahedron_mat, TextureID(#Icosahedron_tex))
                    CreateEntity(#Icosahedron, MeshID(#Icosahedron), MaterialID(#Icosahedron_mat))
                    EntityLocate(#Icosahedron, 0, 0, 0)
                   
                    texture = #Icosahedron_tex_small
                    For Entity = #Icosahedron_small To #Icosahedron_small3
                         CopyEntity(#Icosahedron, Entity)
                         ScaleEntity(Entity, 0.25, 0.25, 0.25)
                         EntityLocate(Entity, 0, 0, 0)
                         EntityMaterial(Entity, CreateMaterial(texture, CreateTexture(texture, 256, 256)))
                         texture + 1
                    Next
                   
                    ; Dessin de la texture
                    DrawGradienttex(RGB(000, 255, 000), RGB(100, 000, 155), 255, 256, 256, TextureOutput(#Icosahedron_tex), #Vertical)
                    DrawGradienttex(RGB(000, 255, 000), RGB(000, 000, 255), 255, 256, 256, TextureOutput(#Icosahedron_tex_small), #Vertical)
                    DrawGradienttex(RGB(255, 000, 000), RGB(150, 150, 150), 255, 256, 256, TextureOutput(#Icosahedron_tex_small2), #Vertical)
                    DrawGradienttex(RGB(000, 000, 255), RGB(150, 150, 150), 255, 256, 256, TextureOutput(#Icosahedron_tex_small3), #Vertical)
                   
                    CreateCamera(0, 0, 0, 100, 100)
                    CameraLocate(0, 0, 0, 28)
                    Orbit_radius.f = 9.25
                    speed = 1
                    theta.f = 5
                    phi.f = -180
                   
                    For Entity = #Icosahedron_small To #Icosahedron_small3
                         HideEntity(Entity, 1)
                    Next
                   
                    Repeat
                         
                         ClearScreen(RGB(0, 0, 0))
                         
                         If var = 500
                             
                              If set = 0
                                   speed = 1
                                   var = 0
                                   set = 1
                                   
                              ElseIf set = 1
                                   speed = -1
                                   var = 0
                                   set = 0
                              EndIf
                         EndIf
                         
                         RotateEntity(#Icosahedron, speed, speed, speed)
                         
                         For Entity = #Icosahedron_small To #Icosahedron_small3
                              RotateEntity(Entity, -2 * speed, -2 * speed, -2 * speed)
                         Next
                         
                         posX.f = Orbit_radius * (Cos(DegToRad(theta))) * Sin(DegToRad(phi))
                         posY.f = Orbit_radius * (Sin(DegToRad(theta))) * Sin(DegToRad(phi))
                         posZ.f = Orbit_radius * Cos(DegToRad(phi))
                         
                         EntityLocate(#Icosahedron_small, posX.f, posY.f, posZ.f)
                         
                         posX2.f = Orbit_radius * (Cos(DegToRad(theta + 175))) * Sin(DegToRad(-phi + 175))
                         posY2.f = Orbit_radius * (Sin(DegToRad(theta + 175))) * Sin(DegToRad(-phi + 175))
                         posZ2.f = Orbit_radius * Cos(DegToRad(-phi + 175))
                         
                         EntityLocate(#Icosahedron_small2, posX2.f, posY2.f, posZ2.f)
                         
                         posX3.f = Orbit_radius * (Cos(DegToRad(theta + 90))) * Sin(DegToRad(phi + 90))
                         posY3.f = Orbit_radius * (Sin(DegToRad(theta + 90))) * Sin(DegToRad(phi + 90))
                         posZ3.f = Orbit_radius * Cos(DegToRad(phi + 90))
                         
                         EntityLocate(#Icosahedron_small3, posX3.f, posY3.f, posZ3.f)
                         
                         RenderWorld()
                         StartDrawing(ScreenOutput())
                              DrawingMode(1)
                              FrontColor(RGB(0, 255, 0))
                              DrawText(0, 0, Texte(0))
                              DrawText(0, 15, Texte(1))
                              DrawText(0, 30, Texte(2) + " : ( " + StrF(EntityX(#Icosahedron_small), 4) + ", " + StrF(EntityY(#Icosahedron_small), 4) + ", " + StrF(EntityZ(#Icosahedron_small), 4) + " )")
                              DrawText(0, 45, Texte(3) + " : ( " + StrF(EntityX(#Icosahedron_small2), 4) + ", " + StrF(EntityY(#Icosahedron_small2), 4) + ", " + StrF(EntityZ(#Icosahedron_small2), 4) + " )")
                              DrawText(0, 60, Texte(4) + " : ( " + StrF(EntityX(#Icosahedron_small3), 4) + ", " + StrF(EntityY(#Icosahedron_small3), 4) + ", " + StrF(EntityZ(#Icosahedron_small3), 4) + " )")
                              DrawText(0, 75, Texte(5) + StrF(Orbit_radius, 4))
                         StopDrawing()
                         
                         FlipBuffers()
                         var + 1
                         
                         theta = Spin(theta, 0, 359, 1)
                         phi = Spin(phi, 0, 359, -0.5)
                         
                         ExamineKeyboard()
                         For Entity = #Icosahedron_small To #Icosahedron_small3
                              HideEntity(Entity, 0)
                         Next
                    Until KeyboardPushed(#PB_Key_Escape)
                   
               EndIf
          EndIf
     EndIf
EndIf

; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Procedure DrawGradienttex(Color1.l, Color2.l, NbColor.l, largeur.l, hauteur.l, OutputID.l, Orientation.b)
     
     rt = Red(Color1)
     rd = Red(Color2) - rt
     gt = Green(Color1)
     gd = Green(Color2) - gt
     bt = Blue(Color1)
     bd = Blue(Color2) - bt
     
     StartDrawing(OutputID)
          If Orientation = #Vertical
               While i < NbColor
                    r = MulDiv_(i, rd, NbColor) + rt
                    g = MulDiv_(i, gd, NbColor) + gt
                    b = MulDiv_(i, bd, NbColor) + bt
                    y = MulDiv_(i, hauteur, Nbcolor)
                    h = MulDiv_(i + 2, hauteur, NbColor)
                    Box( 0, y, largeur, h, RGB(r, g, b))
                    i + 1
               Wend
               
          ElseIf Orientation = #Horizontal
               While i < NbColor
                    r = MulDiv_(i, rd, NbColor) + rt
                    g = MulDiv_(i, gd, NbColor) + gt
                    b = MulDiv_(i, bd, NbColor) + bt
                    x = MulDiv_(i, largeur, Nbcolor)
                    l = MulDiv_(i + 2, largeur, NbColor)
                    Box(x, 0, l, hauteur, RGB(r, g, b))
                    i + 1
               Wend
          EndIf
     StopDrawing()
EndProcedure

; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Procedure.f LinearDistanceEntity(X1.f, Y1.f, Z1.f, X2.f, Y2.f, Z2.f)
     
     ProcedureReturn Sqr(Pow((X2 - X1), 2) + Pow((Y2 - Y1), 2) + Pow((Z2 - Z1), 2))
     
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

Procedure.f Spin(No.f, mini.f, maxi.f, increment.f)
     
     No + increment
     
     If No > maxi
          No = mini
     EndIf
     
     If No < mini
          No = Maxi
     EndIf
     
     ProcedureReturn No
     
EndProcedure


; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

DataSection
     
     Vertices :
          Data.f - 4.014306, 5.254795, 0.000000
          Data.f 0.000000, 4.000000, 0.000000
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f - 4.014306, 5.254795, 0.000000
          Data.f - 2.894427, 1.788854, -2.102924
          Data.f 0.000000, 4.000000, 0.000000
          Data.f - 4.014306, 5.254795, -0.000000
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f - 2.894427, 1.788854, -2.102924
          Data.f - 1.240489, 5.254795, 3.817832
          Data.f 0.000000, 4.000000, 0.000000
          Data.f 1.105573, 1.788854, 3.402603
          Data.f - 1.240489, 5.254795, 3.817832
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f 0.000000, 4.000000, 0.000000
          Data.f - 1.240489, 5.254795, 3.817832
          Data.f 1.105573, 1.788854, 3.402603
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f 3.247642, 5.254795, 2.359550
          Data.f 0.000000, 4.000000, 0.000000
          Data.f 3.577708, 1.788854, 0.000000
          Data.f 3.247642, 5.254795, 2.359550
          Data.f 1.105573, 1.788854, 3.402603
          Data.f 0.000000, 4.000000, 0.000000
          Data.f 3.247642, 5.254795, 2.359550
          Data.f 3.577708, 1.788854, 0.000000
          Data.f 1.105573, 1.788854, 3.402603
          Data.f 3.247642, 5.254795, -2.359550
          Data.f 0.000000, 4.000000, 0.000000
          Data.f 1.105573, 1.788854, -3.402603
          Data.f 3.247642, 5.254795, -2.359550
          Data.f 3.577708, 1.788854, 0.000000
          Data.f 0.000000, 4.000000, 0.000000
          Data.f 3.247642, 5.254795, -2.359550
          Data.f 1.105573, 1.788854, -3.402603
          Data.f 3.577708, 1.788854, 0.000000
          Data.f - 1.240489, 5.254795, -3.817832
          Data.f 0.000000, 4.000000, 0.000000
          Data.f - 2.894427, 1.788854, -2.102924
          Data.f - 1.240489, 5.254795, -3.817832
          Data.f 1.105573, 1.788854, -3.402603
          Data.f 0.000000, 4.000000, 0.000000
          Data.f - 1.240489, 5.254795, -3.817832
          Data.f - 2.894427, 1.788854, -2.102924
          Data.f 1.105573, 1.788854, -3.402603
          Data.f - 6.495283, 1.240489, 0.000000
          Data.f - 3.577709, -1.788854, 0.000000
          Data.f - 2.894427, 1.788854, -2.102924
          Data.f - 6.495283, 1.240489, 0.000000
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f - 3.577709, -1.788854, 0.000000
          Data.f - 6.495283, 1.240489, 0.000000
          Data.f - 2.894427, 1.788854, -2.102924
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f - 2.007153, 1.240489, 6.177382
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f - 2.007153, 1.240489, 6.177382
          Data.f 1.105573, 1.788854, 3.402603
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f - 2.007153, 1.240489, 6.177382
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f 1.105573, 1.788854, 3.402603
          Data.f 5.254795, 1.240489, 3.817831
          Data.f 2.894427, -1.788854, 2.102924
          Data.f 1.105573, 1.788854, 3.402603
          Data.f 5.254795, 1.240489, 3.817832
          Data.f 3.577708, 1.788854, -0.000000
          Data.f 2.894427, -1.788854, 2.102924
          Data.f 5.254795, 1.240489, 3.817831
          Data.f 1.105573, 1.788854, 3.402603
          Data.f 3.577708, 1.788854, -0.000000
          Data.f 5.254794, 1.240489, -3.817832
          Data.f 2.894427, -1.788854, -2.102925
          Data.f 3.577708, 1.788854, -0.000000
          Data.f 5.254794, 1.240489, -3.817832
          Data.f 1.105572, 1.788854, -3.402603
          Data.f 2.894427, -1.788854, -2.102925
          Data.f 5.254794, 1.240489, -3.817832
          Data.f 3.577708, 1.788854, -0.000000
          Data.f 1.105572, 1.788854, -3.402603
          Data.f - 2.007153, 1.240489, -6.177382
          Data.f - 1.105573, -1.788854, -3.402603
          Data.f 1.105572, 1.788854, -3.402603
          Data.f - 2.007153, 1.240489, -6.177382
          Data.f - 2.894427, 1.788854, -2.102924
          Data.f - 1.105573, -1.788854, -3.402603
          Data.f - 2.007153, 1.240489, -6.177382
          Data.f 1.105572, 1.788854, -3.402603
          Data.f - 2.894427, 1.788854, -2.102924
          Data.f 2.007153, -1.240489, -6.177382
          Data.f 1.105573, 1.788854, -3.402603
          Data.f - 1.105572, -1.788854, -3.402603
          Data.f 2.007153, -1.240489, -6.177382
          Data.f 2.894427, -1.788854, -2.102924
          Data.f 1.105573, 1.788854, -3.402603
          Data.f 2.007153, -1.240489, -6.177382
          Data.f - 1.105572, -1.788854, -3.402603
          Data.f 2.894427, -1.788854, -2.102924
          Data.f - 5.254794, -1.240489, -3.817832
          Data.f - 2.894427, 1.788854, -2.102925
          Data.f - 3.577708, -1.788854, -0.000000
          Data.f - 5.254794, -1.240489, -3.817832
          Data.f - 1.105572, -1.788854, -3.402603
          Data.f - 2.894427, 1.788854, -2.102925
          Data.f - 5.254794, -1.240489, -3.817832
          Data.f - 3.577708, -1.788854, -0.000000
          Data.f - 1.105572, -1.788854, -3.402603
          Data.f - 5.254795, -1.240489, 3.817831
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f - 5.254795, -1.240489, 3.817832
          Data.f - 3.577708, -1.788854, -0.000000
          Data.f - 2.894427, 1.788854, 2.102924
          Data.f - 5.254795, -1.240489, 3.817831
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f - 3.577708, -1.788854, -0.000000
          Data.f 2.007153, -1.240489, 6.177382
          Data.f 1.105573, 1.788854, 3.402603
          Data.f 2.894427, -1.788854, 2.102924
          Data.f 2.007153, -1.240489, 6.177382
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f 1.105573, 1.788854, 3.402603
          Data.f 2.007153, -1.240489, 6.177382
          Data.f 2.894427, -1.788854, 2.102924
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f 6.495283, -1.240489, 0.000000
          Data.f 3.577709, 1.788854, 0.000000
          Data.f 2.894427, -1.788854, -2.102924
          Data.f 6.495283, -1.240489, 0.000000
          Data.f 2.894427, -1.788854, 2.102924
          Data.f 3.577709, 1.788854, 0.000000
          Data.f 6.495283, -1.240489, 0.000000
          Data.f 2.894427, -1.788854, -2.102924
          Data.f 2.894427, -1.788854, 2.102924
          Data.f 1.240489, -5.254795, -3.817832
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f 2.894427, -1.788854, -2.102924
          Data.f 1.240489, -5.254795, -3.817832
          Data.f - 1.105573, -1.788854, -3.402603
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f 1.240489, -5.254795, -3.817832
          Data.f 2.894427, -1.788854, -2.102924
          Data.f - 1.105573, -1.788854, -3.402603
          Data.f - 3.247642, -5.254795, -2.359550
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f - 1.105573, -1.788854, -3.402603
          Data.f - 3.247642, -5.254795, -2.359550
          Data.f - 3.577708, -1.788854, 0.000000
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f - 3.247642, -5.254795, -2.359550
          Data.f - 1.105573, -1.788854, -3.402603
          Data.f - 3.577708, -1.788854, 0.000000
          Data.f - 3.247642, -5.254795, 2.359550
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f - 3.577708, -1.788854, 0.000000
          Data.f - 3.247642, -5.254795, 2.359550
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f - 3.247642, -5.254795, 2.359550
          Data.f - 3.577708, -1.788854, 0.000000
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f 1.240489, -5.254795, 3.817832
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f 1.240489, -5.254795, 3.817832
          Data.f 2.894427, -1.788854, 2.102924
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f 1.240489, -5.254795, 3.817832
          Data.f - 1.105573, -1.788854, 3.402603
          Data.f 2.894427, -1.788854, 2.102924
          Data.f 4.014306, -5.254795, 0.000000
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f 2.894427, -1.788854, 2.102924
          Data.f 4.014306, -5.254795, 0.000000
          Data.f 2.894427, -1.788854, -2.102924
          Data.f - 0.000000, -4.000000, 0.000000
          Data.f 4.014306, -5.254795, -0.000000
          Data.f 2.894427, -1.788854, 2.102924
          Data.f 2.894427, -1.788854, -2.102924
     
     FacesIndexes :
          Data.w 2, 1, 0
          Data.w 5, 4, 3
          Data.w 8, 7, 6
          Data.w 11, 10, 9
          Data.w 14, 13, 12
          Data.w 17, 16, 15
          Data.w 20, 19, 18
          Data.w 23, 22, 21
          Data.w 26, 25, 24
          Data.w 29, 28, 27
          Data.w 32, 31, 30
          Data.w 35, 34, 33
          Data.w 38, 37, 36
          Data.w 41, 40, 39
          Data.w 44, 43, 42
          Data.w 47, 46, 45
          Data.w 50, 49, 48
          Data.w 53, 52, 51
          Data.w 56, 55, 54
          Data.w 59, 58, 57
          Data.w 62, 61, 60
          Data.w 65, 64, 63
          Data.w 68, 67, 66
          Data.w 71, 70, 69
          Data.w 74, 73, 72
          Data.w 77, 76, 75
          Data.w 80, 79, 78
          Data.w 83, 82, 81
          Data.w 86, 85, 84
          Data.w 89, 88, 87
          Data.w 92, 91, 90
          Data.w 95, 94, 93
          Data.w 98, 97, 96
          Data.w 101, 100, 99
          Data.w 104, 103, 102
          Data.w 107, 106, 105
          Data.w 110, 109, 108
          Data.w 113, 112, 111
          Data.w 116, 115, 114
          Data.w 119, 118, 117
          Data.w 122, 121, 120
          Data.w 125, 124, 123
          Data.w 128, 127, 126
          Data.w 131, 130, 129
          Data.w 134, 133, 132
          Data.w 137, 136, 135
          Data.w 140, 139, 138
          Data.w 143, 142, 141
          Data.w 146, 145, 144
          Data.w 149, 148, 147
          Data.w 152, 151, 150
          Data.w 155, 154, 153
          Data.w 158, 157, 156
          Data.w 161, 160, 159
          Data.w 164, 163, 162
          Data.w 167, 166, 165
          Data.w 170, 169, 168
          Data.w 173, 172, 171
          Data.w 176, 175, 174
          Data.w 179, 178, 177
     
     TextureCoordinates :
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
          Data.f 0.500000, 0.000000
          Data.f 0.000000, 1.000000
          Data.f 1.000000, 1.000000
     
EndDataSection

   

; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -
Progi1984
Beiträge: 9
Registriert: 09.01.2007 12:13
Wohnort: France
Kontaktdaten:

Beitrag von Progi1984 »

GetProcessorGHz.pb

Code: Alles auswählen

; German forum: http://www.purebasic.fr/german/viewtopic.php?t=2419
; Author: Froggerprogger (updated for PB 4.00 by Andre)
; Updated : 13/03/07 Progi1984
; Date: 12. March 2005
; OS: Windows
; Demo: Yes

; ghz.f = GetProcessorGHz(waitMs.l) 
; returns to get the processors speed and uses waitMs Milliseconds 
; for the calculation. (values >= 500 should give an accurate result) 
; by Froggerprogger 12.03.05 

; GetProcessorGHz(waitMs.l) liefert einen Float zurück, der die Geschwindigkeit 
; der CPU in GHz wiedergibt. Dabei kann die Dauer des Tests eingestellt werden, 
; "ein paar 100" ms sollten es aber schon sein, bei allem unter 100ms wird es 
; bei mir zumindest sehr ungenau. 

Procedure.f GetProcessorGHz(waitMs.l) 
  Protected Hi.l, Lo.l 

  SetPriorityClass_(GetCurrentProcess_(),#REALTIME_PRIORITY_CLASS)  ; switching to realtime priority 
  Sleep_(0)                     ; wait for new time-slice 

  !RDTSC                        ; load the proc's timestamp to eax & edx 
  !MOV [esp+8], eax             ; store eax to Lo 
  !MOV [esp+4], edx             ; store edx to Hi 

  Sleep_(waitMs)                ; wait for waitMs ms 

  !RDTSC                        ; load the proc's timestamp to eax & edx 
  !SUB eax, [esp+8]             ; subtract Lo from eax 
  !SBB edx, [esp+4]             ; subtract Hi from edx incl. carrybit 

  !MOV ecx, dword 1000          ; store 1000 to ecx 
  !DIV ecx                      ; divide edx & eax by ecx and store result in eax 

  !MOV [esp+8], eax             ; copy result to Lo 

  SetPriorityClass_(GetCurrentProcess_(),#NORMAL_PRIORITY_CLASS)  ; switching back to normal priority 
  Val.f=  Lo / (1000.0 * waitMs) 
  ProcedureReturn Val
EndProcedure 

MessageRequester("","Processorspeed is " + StrF(GetProcessorGHz(1000), 4) + " GHz") 

; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -
Progi1984
Beiträge: 9
Registriert: 09.01.2007 12:13
Wohnort: France
Kontaktdaten:

Beitrag von Progi1984 »

HelixAnimation3D.pb

Code: Alles auswählen

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=14136&postdays=0&postorder=asc&start=0
; Author: Guimauve (updated for PB 4.00 by Andre)
; Updated : 13/03/07 Progi1984
; Date: 28. March 2005
; OS: Windows
; Demo: No


; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; Amination 3D simple Icosaèdre étoilé (60 triangles) -- Source principal 
; Version 1.15 
; Programmation = OK 
; Programmé par : Guimauve 
; Date : 16 octobre 2004 
; Mise à jour : 2 mars 2005 
; Codé avec PureBasic V3.93 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 


Enumeration 
   #Camera 
EndEnumeration 

Enumeration 
   #CoordonneeX 
   #CoordonneeY 
   #CoordonneeZ 
EndEnumeration 

Enumeration 
   #Vertical 
   #Horizontal 
EndEnumeration 

Structure Info 
    
   ModelID.l 
   HelixRadius.f 
   HelixNbSpire.f 
   HelixPitch.f 
   PosU.f 
   PosX.f 
   PosY.f 
   PosZ.f 
   ScaleFactor.f 
   TextureID.l 
   TextureSize.w 
   TextureColor01.l 
   TextureColor02.l 
    
EndStructure 

Global Dim Color(2, 10) 

Color(1, 1) = RGB(000, 255, 000) 
Color(2, 1) = RGB(100, 000, 155) 

Color(1, 2) = RGB(000, 255, 000) 
Color(2, 2) = RGB(000, 000, 255) 

Color(1, 3) = RGB(255, 000, 000) 
Color(2, 3) = RGB(150, 150, 150) 

Color(1, 4) = RGB(255, 255, 255) 
Color(2, 4) = RGB(100, 000, 160) 

Color(1, 5) = RGB(000, 255, 255) 
Color(2, 5) = RGB(150, 000, 150) 

Color(1, 6) = RGB(000, 000, 255) 
Color(2, 6) = RGB(255, 255, 000) 

Color(1, 7) = RGB(255, 255, 000) 
Color(2, 7) = RGB(000, 000, 255) 

Color(1, 8) = RGB(000, 255, 000) 
Color(2, 8) = RGB(100, 000, 155) 

Color(1, 9) = RGB(255, 255, 128) 
Color(2, 9) = RGB(180, 000, 000) 

Color(1, 10) = RGB(255, 255, 000) 
Color(2, 10) = RGB(255, 000, 000) 

Global NewList Model.Info() 


ScreenW = GetSystemMetrics_(#SM_CXSCREEN) 
ScreenH = GetSystemMetrics_(#SM_CYSCREEN) 
ScreenD = 32 


; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
;                      !!!!! WARNING !!!!! 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; THIS CODE HAS BEEN TESTED WITH : 
; ASUS V9180 MX440 AGP 8X WITH 64 MB DDR MEMORY 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
; On my system I have set this value to 500 
; in order to have 500 models moving on the Helix 
; and my computer just work fine. 
; Remember, each model add 60 polygons to the 
; animation. 
;     2 models X 60 polygons = 120 polygons 
;   20 models X 60 polygons = 1200 polygons 
; 200 models x 60 polygons = 12000 polygons 
; 500 models x 60 polygons = 30000 polygons 

Nombre_de_model.l = 5 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
;                      !!!!! WARNING !!!!! 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 



Index.b =1 

; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
; Degré en Radian 

Procedure.f DegToRad(Angle.f) 
    
   ProcedureReturn Angle * #PI / 180 
    
EndProcedure 

; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 


ProcedureDLL.b SpinByte(No.b, mini.b, maxi.b, increment.b) 
     No + increment 
      
     If No > maxi 
          No = mini 
     EndIf 
      
     If No < mini 
          No = maxi 
     EndIf 
      
     ProcedureReturn No 
EndProcedure 


Procedure.f SpinFloat(No.f, mini.f, maxi.f, increment.f) 
    
   No + increment 
    
   If No > maxi 
      No = mini 
   EndIf 
    
   If No < mini 
      No = maxi 
   EndIf 
    
   ProcedureReturn No 
    
EndProcedure 

; >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 

Procedure.f Helice3D(rayon.f, NbSpire.f, Pas.f, Pos_u.f, Calcul.b) 
    
   If Calcul = #CoordonneeX 
      Resultat.f = rayon * Cos(DegToRad(360 * NbSpire * Pos_u)) 
      
   ElseIf Calcul = #CoordonneeY 
      Resultat.f = rayon * Sin(DegToRad(360 * NbSpire * Pos_u)) 
      
   ElseIf Calcul = #CoordonneeZ 
      Resultat.f = Pas * NbSpire * Pos_u 
      
   EndIf 
    
   ProcedureReturn Resultat 
EndProcedure 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
Procedure DrawGradient(Color1.l, Color2.l, NbColor.l, largeur.l, hauteur.l, OutputID.l, Orientation.b) 
      
     rt = Red(Color1) 
     rd = Red(Color2) - rt 
     gt = Green(Color1) 
     gd = Green(Color2) - gt 
     bt = Blue(Color1) 
     bd = Blue(Color2) - bt 
      
     StartDrawing(OutputID) 
          If Orientation = #Vertical 
               While i < NbColor 
                    r = MulDiv_(i, rd, NbColor) + rt 
                    g = MulDiv_(i, gd, NbColor) + gt 
                    b = MulDiv_(i, bd, NbColor) + bt 
                    y = MulDiv_(i, hauteur, NbColor) 
                    h = MulDiv_(i + 2, hauteur, NbColor) 
                    Box( 0, y, largeur, h, RGB(r, g, b)) 
                    i + 1 
               Wend 
                
          ElseIf Orientation = #Horizontal 
               While i < NbColor 
                    r = MulDiv_(i, rd, NbColor) + rt 
                    g = MulDiv_(i, gd, NbColor) + gt 
                    b = MulDiv_(i, bd, NbColor) + bt 
                    x = MulDiv_(i, largeur, NbColor) 
                    l = MulDiv_(i + 2, largeur, NbColor) 
                    Box(x, 0, l, hauteur, RGB(r, g, b)) 
                    i + 1 
               Wend 
          EndIf 
     StopDrawing() 
EndProcedure 
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

If InitEngine3D() = 0 
   MessageRequester("Error", "The 3D Engine can't be initialized") 
   End 
Else 
    
   If InitSprite() = 0 Or InitKeyboard() = 0 
      MessageRequester("Error", "Can't open DirectX 7 Or later") 
      End 
   Else 
      If OpenScreen(ScreenW, ScreenH, ScreenD, "Mouvement sur un hélive") = 0 
         MessageRequester("Error", "Can't open a screen !") 
         End 
      Else 
          
         For Model = 1 To Nombre_de_model 
            AddElement(Model()) 
            Model()\ModelID = Model 
            Model()\HelixRadius = 14.5 
            Model()\HelixNbSpire = 5 
            Model()\HelixPitch = 15 
            Model()\PosU = 0.000 + u1.f 
            Model()\PosX = Helice3D(Model()\HelixRadius, Model()\HelixNbSpire, Model()\HelixPitch, Model()\PosU, #CoordonneeZ) 
            Model()\PosY = Helice3D(Model()\HelixRadius, Model()\HelixNbSpire, Model()\HelixPitch, Model()\PosU, #CoordonneeY) 
            Model()\PosZ = Helice3D(Model()\HelixRadius, Model()\HelixNbSpire, Model()\HelixPitch, Model()\PosU, #CoordonneeX) 
            Model()\ScaleFactor = 0.25 
            Model()\TextureID = Model 
            Model()\TextureSize = 64 
            Model()\TextureColor01 = Color(1, Index) 
            Model()\TextureColor02 = Color(2, Index) 
            Index = SpinByte(Index,1,10,1) 
            u1 = SpinFloat(u1, 0, 1, 1/Nombre_de_model)      
         Next 
          
         ForEach Model() 
            CreateMesh(Model()\ModelID, 100) 
            SetMeshData(Model()\ModelID, #PB_Mesh_Vertex, ?Vertices, 180) 
            SetMeshData(Model()\ModelID, #PB_Mesh_Face, ?FacesIndexes, 60) 
            SetMeshData(Model()\ModelID, #PB_Mesh_UVCoordinate, ?TextureCoordinates, 180) 
            CreateEntity(Model()\ModelID, MeshID(Model()\ModelID), CreateMaterial(Model()\TextureID, CreateTexture(Model()\TextureID, Model()\TextureSize, Model()\TextureSize))) 
            EntityLocate(Model()\ModelID, 0, 0, 0) 
            ScaleEntity(Model()\ModelID, Model()\ScaleFactor, Model()\ScaleFactor, Model()\ScaleFactor) 
            DrawGradient(Model()\TextureColor01, Model()\TextureColor02, 255, Model()\TextureSize, Model()\TextureSize, TextureOutput(Model()\TextureID), #Vertical) 
         Next 
          
         speed.b = 1 
          
         CreateCamera(#Camera, 0, 0, 100, 100) 
         CameraLocate(#Camera, 50, 0, 50) 
          
         Repeat 
            
            ClearScreen(RGB(0, 0, 0))
            
            If frame = 500 
                
               If set = 0 
                  speed = 1 
                  frame = 0 
                  set = 1 
                  
               ElseIf set = 1 
                  speed = -1 
                  frame = 0 
                  set = 0 
               EndIf 
            EndIf 
            
            ; Ici on fait la mise à jour des positions des models 3D et on positionne les models à leurs nouvelles positions. 
            ForEach Model() 
               Model()\PosU = SpinFloat(Model()\PosU, 0, 1, 0.0015) 
               Model()\PosX = Helice3D(Model()\HelixRadius, Model()\HelixNbSpire, Model()\HelixPitch, Model()\PosU, #CoordonneeZ) 
               Model()\PosY = Helice3D(Model()\HelixRadius, Model()\HelixNbSpire, Model()\HelixPitch, Model()\PosU, #CoordonneeY) 
               Model()\PosZ = Helice3D(Model()\HelixRadius, Model()\HelixNbSpire, Model()\HelixPitch, Model()\PosU, #CoordonneeX) 
               EntityLocate(Model()\ModelID, Model()\PosX, Model()\PosY, Model()\PosZ) 
               RotateEntity(Model()\ModelID, -2 * speed, -2 * speed, -2 * speed) 
            Next 
            
            
            RenderWorld() 
            
            frame + 1 
            
            ExamineKeyboard() 
              

            FlipBuffers() 
            
         Until KeyboardPushed(#PB_Key_Escape) 
      EndIf 
   EndIf 
    
EndIf 

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

DataSection 
      
Vertices : 
Data.f - 4.014306, 5.254795, 0.000000 
Data.f 0.000000, 4.000000, 0.000000 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f - 4.014306, 5.254795, 0.000000 
Data.f - 2.894427, 1.788854, -2.102924 
Data.f 0.000000, 4.000000, 0.000000 
Data.f - 4.014306, 5.254795, -0.000000 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f - 2.894427, 1.788854, -2.102924 
Data.f - 1.240489, 5.254795, 3.817832 
Data.f 0.000000, 4.000000, 0.000000 
Data.f 1.105573, 1.788854, 3.402603 
Data.f - 1.240489, 5.254795, 3.817832 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f 0.000000, 4.000000, 0.000000 
Data.f - 1.240489, 5.254795, 3.817832 
Data.f 1.105573, 1.788854, 3.402603 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f 3.247642, 5.254795, 2.359550 
Data.f 0.000000, 4.000000, 0.000000 
Data.f 3.577708, 1.788854, 0.000000 
Data.f 3.247642, 5.254795, 2.359550 
Data.f 1.105573, 1.788854, 3.402603 
Data.f 0.000000, 4.000000, 0.000000 
Data.f 3.247642, 5.254795, 2.359550 
Data.f 3.577708, 1.788854, 0.000000 
Data.f 1.105573, 1.788854, 3.402603 
Data.f 3.247642, 5.254795, -2.359550 
Data.f 0.000000, 4.000000, 0.000000 
Data.f 1.105573, 1.788854, -3.402603 
Data.f 3.247642, 5.254795, -2.359550 
Data.f 3.577708, 1.788854, 0.000000 
Data.f 0.000000, 4.000000, 0.000000 
Data.f 3.247642, 5.254795, -2.359550 
Data.f 1.105573, 1.788854, -3.402603 
Data.f 3.577708, 1.788854, 0.000000 
Data.f - 1.240489, 5.254795, -3.817832 
Data.f 0.000000, 4.000000, 0.000000 
Data.f - 2.894427, 1.788854, -2.102924 
Data.f - 1.240489, 5.254795, -3.817832 
Data.f 1.105573, 1.788854, -3.402603 
Data.f 0.000000, 4.000000, 0.000000 
Data.f - 1.240489, 5.254795, -3.817832 
Data.f - 2.894427, 1.788854, -2.102924 
Data.f 1.105573, 1.788854, -3.402603 
Data.f - 6.495283, 1.240489, 0.000000 
Data.f - 3.577709, -1.788854, 0.000000 
Data.f - 2.894427, 1.788854, -2.102924 
Data.f - 6.495283, 1.240489, 0.000000 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f - 3.577709, -1.788854, 0.000000 
Data.f - 6.495283, 1.240489, 0.000000 
Data.f - 2.894427, 1.788854, -2.102924 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f - 2.007153, 1.240489, 6.177382 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f - 2.007153, 1.240489, 6.177382 
Data.f 1.105573, 1.788854, 3.402603 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f - 2.007153, 1.240489, 6.177382 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f 1.105573, 1.788854, 3.402603 
Data.f 5.254795, 1.240489, 3.817831 
Data.f 2.894427, -1.788854, 2.102924 
Data.f 1.105573, 1.788854, 3.402603 
Data.f 5.254795, 1.240489, 3.817832 
Data.f 3.577708, 1.788854, -0.000000 
Data.f 2.894427, -1.788854, 2.102924 
Data.f 5.254795, 1.240489, 3.817831 
Data.f 1.105573, 1.788854, 3.402603 
Data.f 3.577708, 1.788854, -0.000000 
Data.f 5.254794, 1.240489, -3.817832 
Data.f 2.894427, -1.788854, -2.102925 
Data.f 3.577708, 1.788854, -0.000000 
Data.f 5.254794, 1.240489, -3.817832 
Data.f 1.105572, 1.788854, -3.402603 
Data.f 2.894427, -1.788854, -2.102925 
Data.f 5.254794, 1.240489, -3.817832 
Data.f 3.577708, 1.788854, -0.000000 
Data.f 1.105572, 1.788854, -3.402603 
Data.f - 2.007153, 1.240489, -6.177382 
Data.f - 1.105573, -1.788854, -3.402603 
Data.f 1.105572, 1.788854, -3.402603 
Data.f - 2.007153, 1.240489, -6.177382 
Data.f - 2.894427, 1.788854, -2.102924 
Data.f - 1.105573, -1.788854, -3.402603 
Data.f - 2.007153, 1.240489, -6.177382 
Data.f 1.105572, 1.788854, -3.402603 
Data.f - 2.894427, 1.788854, -2.102924 
Data.f 2.007153, -1.240489, -6.177382 
Data.f 1.105573, 1.788854, -3.402603 
Data.f - 1.105572, -1.788854, -3.402603 
Data.f 2.007153, -1.240489, -6.177382 
Data.f 2.894427, -1.788854, -2.102924 
Data.f 1.105573, 1.788854, -3.402603 
Data.f 2.007153, -1.240489, -6.177382 
Data.f - 1.105572, -1.788854, -3.402603 
Data.f 2.894427, -1.788854, -2.102924 
Data.f - 5.254794, -1.240489, -3.817832 
Data.f - 2.894427, 1.788854, -2.102925 
Data.f - 3.577708, -1.788854, -0.000000 
Data.f - 5.254794, -1.240489, -3.817832 
Data.f - 1.105572, -1.788854, -3.402603 
Data.f - 2.894427, 1.788854, -2.102925 
Data.f - 5.254794, -1.240489, -3.817832 
Data.f - 3.577708, -1.788854, -0.000000 
Data.f - 1.105572, -1.788854, -3.402603 
Data.f - 5.254795, -1.240489, 3.817831 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f - 5.254795, -1.240489, 3.817832 
Data.f - 3.577708, -1.788854, -0.000000 
Data.f - 2.894427, 1.788854, 2.102924 
Data.f - 5.254795, -1.240489, 3.817831 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f - 3.577708, -1.788854, -0.000000 
Data.f 2.007153, -1.240489, 6.177382 
Data.f 1.105573, 1.788854, 3.402603 
Data.f 2.894427, -1.788854, 2.102924 
Data.f 2.007153, -1.240489, 6.177382 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f 1.105573, 1.788854, 3.402603 
Data.f 2.007153, -1.240489, 6.177382 
Data.f 2.894427, -1.788854, 2.102924 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f 6.495283, -1.240489, 0.000000 
Data.f 3.577709, 1.788854, 0.000000 
Data.f 2.894427, -1.788854, -2.102924 
Data.f 6.495283, -1.240489, 0.000000 
Data.f 2.894427, -1.788854, 2.102924 
Data.f 3.577709, 1.788854, 0.000000 
Data.f 6.495283, -1.240489, 0.000000 
Data.f 2.894427, -1.788854, -2.102924 
Data.f 2.894427, -1.788854, 2.102924 
Data.f 1.240489, -5.254795, -3.817832 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f 2.894427, -1.788854, -2.102924 
Data.f 1.240489, -5.254795, -3.817832 
Data.f - 1.105573, -1.788854, -3.402603 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f 1.240489, -5.254795, -3.817832 
Data.f 2.894427, -1.788854, -2.102924 
Data.f - 1.105573, -1.788854, -3.402603 
Data.f - 3.247642, -5.254795, -2.359550 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f - 1.105573, -1.788854, -3.402603 
Data.f - 3.247642, -5.254795, -2.359550 
Data.f - 3.577708, -1.788854, 0.000000 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f - 3.247642, -5.254795, -2.359550 
Data.f - 1.105573, -1.788854, -3.402603 
Data.f - 3.577708, -1.788854, 0.000000 
Data.f - 3.247642, -5.254795, 2.359550 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f - 3.577708, -1.788854, 0.000000 
Data.f - 3.247642, -5.254795, 2.359550 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f - 3.247642, -5.254795, 2.359550 
Data.f - 3.577708, -1.788854, 0.000000 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f 1.240489, -5.254795, 3.817832 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f 1.240489, -5.254795, 3.817832 
Data.f 2.894427, -1.788854, 2.102924 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f 1.240489, -5.254795, 3.817832 
Data.f - 1.105573, -1.788854, 3.402603 
Data.f 2.894427, -1.788854, 2.102924 
Data.f 4.014306, -5.254795, 0.000000 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f 2.894427, -1.788854, 2.102924 
Data.f 4.014306, -5.254795, 0.000000 
Data.f 2.894427, -1.788854, -2.102924 
Data.f - 0.000000, -4.000000, 0.000000 
Data.f 4.014306, -5.254795, -0.000000 
Data.f 2.894427, -1.788854, 2.102924 
Data.f 2.894427, -1.788854, -2.102924 
      
FacesIndexes : 
Data.w 2, 1, 0 
Data.w 5, 4, 3 
Data.w 8, 7, 6 
Data.w 11, 10, 9 
Data.w 14, 13, 12 
Data.w 17, 16, 15 
Data.w 20, 19, 18 
Data.w 23, 22, 21 
Data.w 26, 25, 24 
Data.w 29, 28, 27 
Data.w 32, 31, 30 
Data.w 35, 34, 33 
Data.w 38, 37, 36 
Data.w 41, 40, 39 
Data.w 44, 43, 42 
Data.w 47, 46, 45 
Data.w 50, 49, 48 
Data.w 53, 52, 51 
Data.w 56, 55, 54 
Data.w 59, 58, 57 
Data.w 62, 61, 60 
Data.w 65, 64, 63 
Data.w 68, 67, 66 
Data.w 71, 70, 69 
Data.w 74, 73, 72 
Data.w 77, 76, 75 
Data.w 80, 79, 78 
Data.w 83, 82, 81 
Data.w 86, 85, 84 
Data.w 89, 88, 87 
Data.w 92, 91, 90 
Data.w 95, 94, 93 
Data.w 98, 97, 96 
Data.w 101, 100, 99 
Data.w 104, 103, 102 
Data.w 107, 106, 105 
Data.w 110, 109, 108 
Data.w 113, 112, 111 
Data.w 116, 115, 114 
Data.w 119, 118, 117 
Data.w 122, 121, 120 
Data.w 125, 124, 123 
Data.w 128, 127, 126 
Data.w 131, 130, 129 
Data.w 134, 133, 132 
Data.w 137, 136, 135 
Data.w 140, 139, 138 
Data.w 143, 142, 141 
Data.w 146, 145, 144 
Data.w 149, 148, 147 
Data.w 152, 151, 150 
Data.w 155, 154, 153 
Data.w 158, 157, 156 
Data.w 161, 160, 159 
Data.w 164, 163, 162 
Data.w 167, 166, 165 
Data.w 170, 169, 168 
Data.w 173, 172, 171 
Data.w 176, 175, 174 
Data.w 179, 178, 177 
      
TextureCoordinates : 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
Data.f 0.500000, 0.000000 
Data.f 0.000000, 1.000000 
Data.f 1.000000, 1.000000 
      
EndDataSection
; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -
Progi1984
Beiträge: 9
Registriert: 09.01.2007 12:13
Wohnort: France
Kontaktdaten:

Beitrag von Progi1984 »

LineIntersection.pb

Code: Alles auswählen

; www.PureArea.net
; Author: Andre Beer
; Date: 30. January 2007
; Updated : Prog1984 13/03/07
; OS: Windows, Linux
; Demo: Yes



; A BlitzBasic conversion, originally written by ashcroftman
; returns true if two lines 'touch'
; Uses maths, not 'per-pixel' so is pretty fast...

Procedure LineIntersection(x1,y1,x2,y2,u1,v1,u2,v2)
  b1.f = (y2 - y1) / (x2 - x1)
  b2.f = (v2 - v1) / (u2 - u1)
  a1.f = y1 - b1 *x1
  a2.f = v1 - b2 *u1
  
  ; little error check
;   If (b1-b2) = 0
;     ProcedureReturn #False
;   EndIf
  
  xi = - (a1-a2)/(b1-b2)
  yi = a1+b1*xi
  If (x1 - xi)*(xi-x2)> -1 And (u1-xi)*(xi - u2)> 0 And (y1-yi)*(yi-y2)>-1 And (v1-yi)*(yi-v2)>-1
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure

OpenWindow(0, 0, 0, 300, 300, "Line Intersection Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
If CreateGadgetList(WindowID(0))
  ImageGadget (0,   0,   0, 300, 280, 0)
  TextGadget  (1,  10, 280, 250,  18, "Line Intersection Text...")
  ButtonGadget(2, 250, 280,  50,  22, "Next test")
EndIf

CreateImage(0, 300, 280, #PB_Image_DisplayFormat)


Repeat
  event = WaitWindowEvent()

  If event = #PB_Event_Gadget
    If EventGadget() = 2
      x1 = Random(150)       ; first line
      Repeat
        y1 = Random(140)
      Until y1<>x1
      x2 = 150 + Random(150)
      Repeat
        y2 = 140 + Random(140)
      Until y2<>x2
      x3 = Random(150)       ; second line
      Repeat
        y3 = Random(140)
      Until y3<>x3
      x4 = 150 + Random(150)
      Repeat
        y4 = 140 + Random(140)
      Until y4<>x4
      StartDrawing(ImageOutput(0))
      Box(0, 0, 300, 280, RGB(255, 255, 255))
      LineXY(x1, y1, x2, y2, RGB(0, 0, 0))
      LineXY(x3, y3, x4, y4, RGB(255, 0, 0))
      StopDrawing()
      SetGadgetState(0, ImageID(0))  ; update the ImageGadget

      If LineIntersection(x1, y1, x2, y2, x3, y3, x4, y4) = #True
        SetGadgetText(1, "Lines are intersecting...")
      Else
        SetGadgetText(1, "Lines are not intersecting...")
      EndIf
    EndIf

  EndIf


Until event = #PB_Event_CloseWindow

; IDE Options = PureBasic v4.02 (Windows - x86)
; Folding = -
; EnableXP
Antworten