Code: Alles auswählen
Interface ImageScreen
Open(x.l, y.l, Width.l, Height.l, Titel.s)
OpenGadget(x.l, y.l, Width.l, Height.l)
Resize(x.l, y.l, Width.l, Height.l)
Clear(red.l, green.l, blue.l)
StartDraw()
StopDraw()
ShowChanges()
Kill()
EndInterface
Structure ImageScreen_Struc
VTable.l
Functions.l[8]
Pos.RECT
WinID.l
hWnd.l
GadID.l
ImgID.l
hImg.l
EndStructure
Procedure IS_Open(*IS.ImageScreen_Struc, x.l, y.l, Width.l, Height.l, Titel.s)
*IS\Pos\left = x
*IS\Pos\top = y
*IS\Pos\right = Width
*IS\Pos\bottom = Height
*IS\ImgID = CreateImage(#PB_Any, Width, Height)
If *IS\ImgID = 0 : ProcedureReturn #False : EndIf
*IS\hImg = UseImage(*IS\ImgID)
*IS\WinID = OpenWindow(#PB_Any, x, y, Width, Height, #PB_Window_BorderLess, Titel)
If *IS\WinID = 0 : FreeImage(*IS\ImgID) : ProcedureReturn #False : EndIf
*IS\hWnd = WindowID(*IS\WinID)
If CreateGadgetList(*IS\hWnd)
*IS\GadID = ImageGadget(#PB_Any, 0, 0, Width, Height, *IS\hImg)
If *IS\GadID : ProcedureReturn #True : EndIf
EndIf
CloseWindow(*IS\WinID)
FreeImage(*IS\ImgID)
ProcedureReturn #False
EndProcedure
Procedure IS_OpenGadget(*IS.ImageScreen_Struc, x.l, y.l, Width.l, Height.l)
*IS\Pos\left = x
*IS\Pos\top = y
*IS\Pos\right = Width
*IS\Pos\bottom = Height
*IS\ImgID = CreateImage(#PB_Any, Width, Height)
If *IS\ImgID = 0 : ProcedureReturn #False : EndIf
*IS\hImg = UseImage(*IS\ImgID)
*IS\GadID = ImageGadget(#PB_Any, 0, 0, Width, Height, *IS\hImg)
If *IS\GadID : ProcedureReturn #True : EndIf
FreeImage(*IS\ImgID)
ProcedureReturn #False
EndProcedure
Procedure IS_Resize(*IS.ImageScreen_Struc, x.l, y.l, Width.l, Height.l)
If *IS\GadID
ResizeGadget(*IS\GadID, 0, 0, Width, Height)
EndIf
If x = -1 : x = *IS\Pos\left : EndIf
If y = -1 : y = *IS\Pos\top : EndIf
If Width = -1 : Width = *IS\Pos\right : EndIf
If Height = -1 : Height = *IS\Pos\bottom : EndIf
If *IS\WinID
MoveWindow_(*IS\hWnd, x, y, Width, Height, 0)
EndIf
If *IS\ImgID
ResizeImage(*IS\ImgID, Width, Height, #PB_Image_Raw)
*IS\hImg = UseImage(*IS\ImgID)
EndIf
*IS\Pos\left = x
*IS\Pos\top = y
*IS\Pos\right = Width
*IS\Pos\bottom = Height
EndProcedure
Procedure IS_Clear(*IS.ImageScreen_Struc, red.l, green.l, blue.l)
UseImage(*IS\ImgID)
StartDrawing(ImageOutput())
Box(0, 0, *IS\Pos\right, *IS\Pos\bottom, RGB(red, green, blue))
StopDrawing()
EndProcedure
Procedure IS_StartDraw(*IS.ImageScreen_Struc)
UseImage(*IS\ImgID)
StartDrawing(ImageOutput())
EndProcedure
Procedure IS_StopDraw(*IS.ImageScreen_Struc)
StopDrawing()
EndProcedure
Procedure IS_ShowChanges(*IS.ImageScreen_Struc)
SetGadgetState(*IS\GadID, UseImage(*IS\ImgID))
EndProcedure
Procedure IS_Kill(*IS.ImageScreen_Struc)
If *IS\WinID : CloseWindow(*IS\WinID) : EndIf
If *IS\ImgID : FreeImage(*IS\ImgID) : EndIf
FreeMemory(*IS)
ProcedureReturn #True
EndProcedure
Procedure IS_Create()
Protected *IS.ImageScreen_Struc
*IS = AllocateMemory(SizeOf(ImageScreen_Struc))
If *IS = 0 : ProcedureReturn #False : EndIf
*IS\VTable = *IS + 4
*IS\Functions[0] = @IS_Open()
*IS\Functions[1] = @IS_OpenGadget()
*IS\Functions[2] = @IS_Resize()
*IS\Functions[3] = @IS_Clear()
*IS\Functions[4] = @IS_StartDraw()
*IS\Functions[5] = @IS_StopDraw()
*IS\Functions[6] = @IS_ShowChanges()
*IS\Functions[7] = @IS_Kill()
ProcedureReturn *IS
EndProcedure
*Scr.ImageScreen = IS_Create() ; Interface "laden"
If *Scr = 0 : End : EndIf
xPos.l = 100
yPos.l = 100
Width.l = 400
Height.l = 300
*Scr\Open(xPos, yPos, Width, Height, "TestScreen") ; "Screen" öffnen
x.f = Width / 2
y.f = Height / 2
x_a.f = (Random(2000) - 1000) / 1000
y_a.f = (Random(2000) - 1000) / 1000
r.f = 10
Repeat
*Scr\Clear(0, 0, 0) ; "Screen" löschen
*Scr\StartDraw() ; Mit dem Malen beginnen
Circle(x, y, r, $FF0000)
*Scr\StopDraw() ; Das Malen beenden
*Scr\ShowChanges() ; Alles gemalte anzeigen
x + 3 * x_a
y + 3 * y_a
If x < r
x - x_a + 10
x_a = Random(1000) / 1000
y_a.f = (Random(2000) - 1000) / 1000
xPos - 10
Width + 10
*Scr\Resize(xPos, -1, Width, -1) ; Ändere Größe und verschiebe "Screen"
EndIf
If y < r
y - y_a + 10
y_a = Random(1000) / 1000
x_a.f = (Random(2000) - 1000) / 1000
yPos - 10
Height + 10
*Scr\Resize(-1, yPos, -1, Height)
EndIf
If x + r > Width
x - x_a
x_a = -Random(1000) / 1000
y_a.f = (Random(2000) - 1000) / 1000
Width + 10
*Scr\Resize(-1, -1, Width, -1)
EndIf
If y + r > Height
y - y_a
y_a = -Random(1000) / 1000
x_a.f = (Random(2000) - 1000) / 1000
Height + 10
*Scr\Resize(-1, -1, -1, Height)
EndIf
Until WindowEvent() = #PB_EventCloseWindow
*Scr\Kill() ; Alles schließen und Speicher freigeben
