PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Frage zu OLDSKOOL

https://www.purebasic.fr/german/viewtopic.php?t=1126

Seite 1 von 1

Frage zu OLDSKOOL

Verfasst: 04.12.2004 19:41
von Ara
Hi,
ich wollte das Demo Oldskool in einem Fenster laufen lassen.
Jedoch schmiert nach einiger Zeit der Rechner ab.

Kann mir einer sagen, was ich falsch gemacht habe?

Code: Alles auswählen

; oldskool Intro by WolfgangS
; Some ideas from old Amiga Demos and FlameDuck's "Oldskool.bb" (yak ! :)))
; V1.0 8/2002

Global xsize:     xsize=0     ; width in Pixel of 1 Char
Global xchar:     xchar=0     ; pointer of n th Char
Global yshift:    yshift=0    ; Sine in Y
Global angle.f:   angle=0.7   ; Angle
Global Tex.s:     Tex=""      ; Scrolltext
Global tcolor.w:  tcolor=0    ; actual color of flashing text
Global tspeed.w:  tspeed=5    ; flashing speed 

#ID_Sprite1=1       ; ID font
#ID_Sprite2=3       ; ID Logo
#ID_Module1=10      ; ID Sound Module
#ID_Font1  =30      ; ID Font
#ID_Buffer1=40      ; ID for scroller temporary buffer
#ID_buffer2=41      ; ID for logo temporary buffer

hnd_font1.l         ; Handle of the font1

Tex.s="              purebasic oldskool intro october "+Chr(124)+"oo"+Chr(124)+" by wolfgangs"+Chr(132)
Tex=Tex+" thanks to the purebasic"
Tex=Tex+" community and fred for this exellent language"+Chr(132)
Tex=Tex+" the font ist from an amiga font collection the sound is by unit a and the poor logo by me"+Chr(132)
Tex=Tex+" keep on coding folx "+Chr(132)+Chr(132)+Chr(132)+Chr(132)+Chr(132)+Chr(132)+Chr(132)+Chr(132)
Tex=Tex+"                                             "+Chr(0)

;**********************************************************************************************************  
Structure wursthaut                                           ; 'storeplace' for the star coordinates and speed/color
  x.l   ;x pos
  y.l   ;y pos
  c.l   ;speed
EndStructure
Dim Star.wursthaut(400)

;**********************************************************************************************************  
Procedure.f GSin(winkel.f)                              ; angle calculation by Danilo -> thanks comrade :)
   ProcedureReturn Sin(winkel*(2*3.14159265/360))
EndProcedure 

;**********************************************************************************************************  
; If InitSprite()=0                                        ; Load and open all stuff
  ; MessageRequester("","Sprite",0):End:EndIf

If InitKeyboard()=0
  MessageRequester("","Keyboard",0):End:EndIf

If InitSound()=0
  MessageRequester("","Sound",0):End:EndIf

If InitModule(#ID_Module1)=0
  MessageRequester("","Module",0):End:EndIf

Breite = 640
Hoehe = 480
PB_Flags.l = #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered 
If OpenWindow(0, 0, 0, Breite + 10, Hoehe + 10, PB_Flags, "") 
  If InitSprite() 
    If OpenWindowedScreen(WindowID(0), 5, 5, Breite, Hoehe, 1, 10, 10) 
    EndIf
  EndIf
EndIf  
  
; If OpenScreen(640,480,32,"sine scroller")=0
  ; MessageRequester("","Screen",0):End:EndIf

If LoadSprite(#ID_Sprite1,"font2.bmp")=0
  MessageRequester("","Font",0):End:EndIf

If CreateSprite(#ID_Buffer1,640+48,48)=0    
  MessageRequester("","Buffer1",0):End:EndIf

If CreateSprite(#ID_buffer2,640,260)=0    
  MessageRequester("","Buffer1",0):End:EndIf

If LoadModule(#ID_Module1,"Unit_A1.mod")=0
  MessageRequester("","MusicFile",0):End:EndIf

If LoadSprite(#ID_Sprite2,"logo2.bmp")=0
  MessageRequester("","logo1",0):End:EndIf

hnd_font1=LoadFont(#ID_Font1,"Arial",8)
If hnd_font1=0
  MessageRequester("","Can't open font Arial !?!?!",0):End:EndIf


;**********************************************************************************************************  
PlayModule(#ID_Module1)                                   ; Start 'the ultimate' old Sound :)))
                                         

;**********************************************************************************************************  
For i=0 To 399                                            ; gives each star x/y/ and speed/color
  Star(i)\x=Random(640)
  Star(i)\y=Random(225)+212
  Star(i)\c=Random(200)+50
Next


Repeat
;**********************************************************************************************************  
  xsize+3                                                   ; Calculate the Char and xsize
  If xsize>=48; Then  :)                                   ; xsize=width of 1 char = 48 pixel
    xchar+1
    xsize=0
    If Mid(Tex.s,xchar,1)=Chr(0)
      xchar=1
    EndIf
  EndIf
  
;**********************************************************************************************************  
  angle+5.5                                                 ;calculates the 'main' angle overall
  If angle=360
    angle=0
  EndIf

;**********************************************************************************************************  
  StartDrawing(ScreenOutput())                              ; Paint the 2 lines
  LineXY(0,209,640,209,$FF4422)
  LineXY(0,438,640,438,$FF4422)
  StopDrawing()

;**********************************************************************************************************  
  StartDrawing(ScreenOutput())                              ; Calculate & Plot 400 'Stars'
  For i=0 To 399
    Star(i)\x+Star(i)\c/50
    If Star(i)\x>640                                            
      Star(i)\x=0
    EndIf
    Plot(Star(i)\x,Star(i)\y,Star(i)\c*$FF)
  Next
  StopDrawing()
  
;**********************************************************************************************************  
  UseBuffer(#ID_Buffer1)                                    ; Display the sine scroller
  For i=0 To 20                                             ; Move scroll chars from ID_Sprite1 to ID_Buffer2  
    a=Asc(Mid(Tex.s,xchar+i,1))-97
    If a=-65:a=36:EndIf
    ClipSprite(#ID_Sprite1,a*48,0,48,48)
    DisplaySprite(#ID_Sprite1,i*48-xsize,0)
  Next
  UseBuffer(-1)
  
  help1.f=0                                                  ; Move ID_Buffer2 with sinus to Screen
  For l=0 To 639+48
    help1+0.5
    ClipSprite(#ID_Buffer1,l,0,1,47)
    help2.f    =GSin(angle+ help1*4 )*30   
    help2=help2+GSin(angle+(help1*2))*60
    DisplayTransparentSprite(#ID_Buffer1,l, 300+help2)
  Next

;**********************************************************************************************************  
  UseBuffer(#ID_buffer2)                                           ; Display the x/y waving logo
  For i=0 To 620                                             ; from ID_Sprite2 to ID_Buffer2 with y deforming (620 lines y)
    ClipSprite(#ID_Sprite2,i,0,1,160) 
    DisplaySprite(#ID_Sprite2,i,GSin(i+angle)*20)
  Next
  UseBuffer(-1)

  For i=0 To 200                                             ; and from ID_Buffer2 with x deforming to Screen (200 lines x)
    help1+1
    If help1>360:help1=0:EndIf                               ; simple! Isn't it ?
    ClipSprite(#ID_buffer2,0,i,640,1)
    DisplayTransparentSprite(#ID_buffer2,5+GSin(angle+i*2)*23,10+i)
  Next

;**********************************************************************************************************  
;another effect ...

  
;**********************************************************************************************************  
  StartDrawing(ScreenOutput())                                ; Set the www.purebasic.com text
    DrawingFont(hnd_font1)                                    ; set Arial_8

    DrawingMode(3)                                            ; and the Press any Key text
    Locate(255,190)
    FrontColor($AA,$AA,$AA)
    DrawText("www.purebasic.com")

    Locate(270,443)
    tcolor+tspeed:If tcolor>200:tcolor=-tcolor:EndIf         ; calculating the flashing color
    FrontColor(Abs(tcolor),Abs(tcolor),Abs(tcolor))
    DrawText("Press any key")
  StopDrawing()
   



  FlipBuffers()  
  
  If WindowEvent() 
  Else  
    Delay(1) 
  EndIf
  
  ClearScreen(0,0,0)
  ExamineKeyboard()
Until KeyboardPushed(#PB_Key_All)
Viele Dank und viele Grüße

Ara

Verfasst: 04.12.2004 19:46
von Franky

Code: Alles auswählen

---------------------------
PureBasic3036875.exe - Komponente nicht gefunden
---------------------------
Die Anwendung konnte nicht gestartet werden, weil MIDAS11.dll nicht gefunden wurde. Neuinstallation der Anwendung könnte das Problem beheben. 
---------------------------
OK   
---------------------------
Das kommt bei mir, weil ich kein Midas11 habe, das kann man sich glaub ich irgendwo aus dem www ziehen.
Ist das das Problem?

Verfasst: 04.12.2004 23:59
von Ara
Nein, das ist nicht der Fehler.
Es läuft alles ganz normal. Nach ein paar Minuten wird der Bildschirm schwarzl, kurz danach hängt der Ton und der rechner macht einen neustart.
Ich habe Win XP Pro. Die Midas11.dll hat eine Größe von 160.256 Bytes.

Viele Grüße
Ara

Verfasst: 17.12.2004 10:08
von WolfgangS
Oje, dieses Programm ist schon recht alt und habe ich in meiner Purebasic Anfangszeit geschrieben :*)
Midas ist eine Soundlibrary und gibts u.a. hier: www.schliess.net/stuff/midas11.dll
Das alles ist recht unsauber programmiert, so läuft es z.B. abbhängig von der Computergeschwindigkeit. Eigentlich ist es nur dazu gedacht zu zeigen, wie ein "sine scroller" funktioniert. Vielleicht werde ich mich über Weihnachten dazu durchringen, dass ich es verbessere ... und die peinlichen Gramatik und Rechtschreibfehler ausbessern :oops:

MFG
WolfgangS
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de