Code: Select all
;
; Puzzler
;
; FWeil : 20040516
;
; Make a diaporama, with puzzle effects, to puzzle busy or bothered people and teach tooltips to anybody who wants ...
;
ImageDirectory.s = "C:\WhereYouHaveImages\"
#Background = $300000
#MoveSteps = 70
#SpriteSize = 32
;
; This is gomio's explicit delcaration tip, as a starter
;
Structure DefaultType
EndStructure
DefType.DefaultType
;
; Some basic procedures
;
Procedure IMin(a.l, b.l)
If a < b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure IMax(a.l, b.l)
If a > b
ProcedureReturn a
Else
ProcedureReturn b
EndIf
EndProcedure
Procedure SureYouWere(a)
DrawingFont(LoadFont(1, "Verdana", 48, #PB_Font_HighQuality))
DrawingMode(1)
a$ = PeekS(a)
b.w = PeekW(a + 20)
c.w = PeekW(a + 22)
Textlength.l = TextLength(a$)
Locate((b - TextLength) / 2, (c - 72) / 2)
DrawText(a$)
Debug b
Debug c
EndProcedure
;
; Attempts to load all files names from a given directory using an optional list of possible extensions
; If the extensions' list is empty or "*.*" all files are taken except idirectories and empty files
;
Procedure DirectoryListing(Directory.s, RequiredExtensionsList.s)
NewList FilesList.s()
Result.l = #FALSE
If ExamineDirectory(0, Directory, "*.*")
While NextDirectoryEntry()
FullFileName.s = Directory + DirectoryEntryName()
ThisFile.l = #FALSE
If Trim(RequiredExtensionsList) <> "" And Trim(RequiredExtensionsList) <> "*.*"
ExtensionItem.l = 1
Repeat
ThisExtension.s = StringField(RequiredExtensionsList, ExtensionItem, " ")
ExtensionItem + 1
If GetExtensionPart(FullFileName) = ThisExtension
ThisFile = #TRUE
Break
EndIf
Until ThisExtension = ""
Else
ThisFile = #TRUE
EndIf
If ThisFile And FileSize(FullFileName) <= 0
ThisFile = #FALSE
EndIf
If ThisFile
AddElement(FilesList())
FilesList() = FullFileName
Result + 1
EndIf
Wend
EndIf
ProcedureReturn Result
EndProcedure
;
; Look for the higher possible depth using screen's width and height
;
Procedure.l SeekBestScreenDepth()
If ExamineScreenModes()
While NextScreenMode()
If ScreenModeWidth() = GetSystemMetrics_(#SM_CXSCREEN) And ScreenModeHeight() = GetSystemMetrics_(#SM_CYSCREEN)
ScreenDepth.l = IMax(ScreenModeDepth(), ScreenDepth)
EndIf
Wend
EndIf
ProcedureReturn ScreenDepth
EndProcedure
;
; Main starts here
;
ImageID.l = 0
Quit.l = #FALSE
ScreenXSize.l
ScreenYSize.l
ScreenDepth.l
ImageFileID.l
PictureWidth.l
PictureHeight.l
ImageNumber.l
kx.f
ky.f
kx.f
ky.f
Structure SpriteAttributes
SpriteNumber.l
x.f
y.f
xStart.f
yStart.f
xSpeed.f
ySpeed.f
EndStructure
NewList Sprites.SpriteAttributes()
Dim FileSignature.l(5)
For i.l = 0 To 4
Read FileSignature(i)
Next
RequiredExtensions.s = "bmp ico cur gif jpg jpeg wmf emf"
Coeff.f = 0.9941
i.l = 0
UseEC_OLEImageDecoder()
FileCounter.l = DirectoryListing(ImageDirectory, RequiredExtensions)
If InitSprite() And InitSprite3D() And InitKeyboard() And InitMouse() And FileCounter
ScreenXSize = GetSystemMetrics_(#SM_CXSCREEN)
ScreenYSize = GetSystemMetrics_(#SM_CYSCREEN)
FileSignature(5) = ScreenXSize << 16 + ScreenYSize
ScreenDepth = SeekBestScreenDepth()
If ScreenDepth => 4
If OpenScreen(ScreenXSize, ScreenYSize, ScreenDepth, "MyScreen")
StartSpecialFX()
;
; Create sprites there
;
;
; Main loop
;
ImageFileID = FileCounter
Quit = #FALSE
NFrames.l = 0
Repeat
FlipBuffers()
ClearScreen(0, 0, $30)
NFrames + 1
If ImageID
ResetList(Sprites())
If NFrames <= #MoveSteps + 20
While NextElement(Sprites())
Sprites()\x = Sprites()\x + Sprites()\xSpeed
Sprites()\y = Sprites()\y + Sprites()\ySpeed
Sprites()\xSpeed = Sprites()\xSpeed * Coeff
Sprites()\ySpeed = Sprites()\ySpeed * Coeff
If Sprites()\x = Sprites()\xStart And Sprites()\y = Sprites()\yStart
Sprites()\xSpeed = 0
Sprites()\ySpeed = 0
EndIf
DisplaySprite(Sprites()\SpriteNumber, Sprites()\x, Sprites()\y)
Wend
Else
StartDrawing(ScreenOutput())
DrawImage(ImageID, (ScreenXSize - PictureWidth) / 2, (ScreenYSize - PictureHeight) / 2)
DrawingMode(4)
For x.l = 0 To ScreenXSize Step #SpriteSize
Color.l = (#MoveSteps + 52 - NFrames) * 8
LineXY(x, 0, x, ScreenXSize, RGB(Color, Color, Color))
LineXY(0, x, ScreenXSize, x, RGB(Color, Color, Color))
If ImageNumber % 5 = 0
SureYouWere(@FileSignature(0))
EndIf
Next
StopDrawing()
EndIf
EndIf
If NFrames > #MoveSteps + 52
NFrames = 0
SelectElement(FilesList(), Random(FileCounter))
If ImageID
FreeImage(0)
EndIf
ImageID = LoadImage(0, FilesList())
PictureWidth = ImageWidth()
PictureHeight = ImageHeight()
kx = PictureWidth / ScreenXSize
ky = PictureHeight / ScreenYSize
kx = ScreenXSize / PictureWidth
ky = ScreenYSize / PictureHeight
If kx < ky
PictureWidth = PictureWidth * kx
PictureHeight = PictureHeight * kx
Else
PictureWidth = PictureWidth * ky
PictureHeight = PictureHeight * ky
EndIf
ImageID = ResizeImage(0, PictureWidth, PictureHeight)
NSprites.l = 0
StartDrawing(ScreenOutput())
Box(0, 0, ScreenXSize, ScreenYSize, #Background)
DrawImage(ImageID, (ScreenXSize - PictureWidth) / 2, (ScreenYSize - PictureHeight) / 2)
StopDrawing()
ClearList(Sprites())
For x.l = 0 To ScreenXSize - #SpriteSize Step #SpriteSize
For y.l = 0 To ScreenYSize - #SpriteSize Step #SpriteSize
NSprites + 1
AddElement(Sprites())
If Sprites()\SpriteNumber
FreeSprite(Sprites()\SpriteNumber)
EndIf
Sprites()\SpriteNumber = GrabSprite(#PB_Any, x, y, #SpriteSize, #SpriteSize, #PB_Sprite_Texture)
StartDrawing(SpriteOutput(Sprites()\SpriteNumber))
DrawingMode(4)
Box(0, 0, #SpriteSize, #SpriteSize, #White)
StopDrawing()
Sprites()\xStart = x
Sprites()\yStart = y
Sprites()\x = x + Random(ScreenXSize) - ScreenXSize / 2
Sprites()\y = y + Random(ScreenYSize) - ScreenYSize / 2
Sprites()\xSpeed = (Sprites()\xStart - Sprites()\x) / #MoveSteps
Sprites()\ySpeed = (Sprites()\yStart - Sprites()\y) / #MoveSteps
Next
Next
ImageNumber + 1
EndIf
ExamineKeyboard()
ExamineMouse()
If KeyboardPushed(#PB_Key_Escape) Or MouseButton(1) Or MouseButton(2) Or MouseDeltaX() Or MouseDeltaY()
Quit = #TRUE
EndIf
Until Quit
CloseScreen()
Else
MessageRequester("Warning", "DirectX environment not loaded", #PB_MessageRequester_OK)
EndIf
Else
MessageRequester("Warning", "DirectX environment does not support at least 4 levels", #PB_MessageRequester_OK)
EndIf
Else
MessageRequester("Warning", "The installation does not allow to run requested DirectX", #PB_MessageRequester_OK)
EndIf
CallDebugger
TerminateProcess_(GetCurrentProcess_(), 0)
End
DataSection
Data.l $20657241, $20756F79, $7A7A7570, $2064656C, $3F
EndDataSection
It's _JUST_ what I need 
corrected above code
