Here is a small Module to draw a scaled image much faster.
Code: Select all
DeclareModule ScaledImage
; ImageID - The ID of the image to draw
; X, Y - The position of the top/left corner of the image in the drawing output
; ScaleX, ScaleY - scaling factors by wich the image will be resized in x- and y-direction
; Mode (optional) - The resize method. It can be one of the following values:
; #PB_Image_Raw - Resize the image without any interpolation (default)
; #PB_Image_Smooth - Resize the image with smoothing
Declare Draw(ImageID, X.d, Y.d, ScaleX.d, ScaleY.d, Flags = #PB_Image_Raw)
EndDeclareModule
Module ScaledImage
EnableExplicit
Procedure.d Min(a.d, b.d)
If a < b
ProcedureReturn a
EndIf
ProcedureReturn b
EndProcedure
Procedure.d Max(a.d, b.d)
If a > b
ProcedureReturn a
EndIf
ProcedureReturn b
EndProcedure
Procedure Draw(ImageID, X.d, Y.d, ScaleX.d, ScaleY.d, Mode = #PB_Image_Raw)
If ScaleX And ScaleY And IsImage(ImageID)
Protected cropX.d = Max(-Round(X, #PB_Round_Up), 0)
Protected cropY.d = Max(-Round(Y, #PB_Round_Up), 0)
Protected cropWidth.d = Min(OutputWidth() / ScaleX, ImageWidth(ImageID) - Max((X + ImageWidth(ImageID)) - OutputWidth() / ScaleX, 0) - cropX)
Protected cropHeight.d = Min(OutputHeight() / ScaleY, ImageHeight(ImageID) - Max((Y + ImageHeight(ImageID)) - OutputHeight() / ScaleY, 0) - cropY)
If cropWidth > 0 And cropHeight > 0
Protected tmpImage = GrabImage(ImageID, #PB_Any, cropX, cropY, Round(cropWidth + 1, #PB_Round_Up), Round(cropHeight + 1, #PB_Round_Up))
If IsImage(tmpImage)
If Int(ImageWidth(tmpImage) * ScaleX) > 0 And Int(ImageHeight(tmpImage) * ScaleY) > 0
ResizeImage(tmpImage, ImageWidth(tmpImage) * ScaleX, ImageHeight(tmpImage) * ScaleY, Mode)
If cropX
X = Max(X - cropX, 0) * ScaleX + Mod(X + cropX, 1)
EndIf
If cropY
Y = Max(Y - cropY, 0) * ScaleY + Mod(Y + cropY, 1)
EndIf
DrawImage(ImageID(tmpImage), X * ScaleX, Y * ScaleY)
EndIf
FreeImage(tmpImage)
ProcedureReturn #True
EndIf
EndIf
EndIf
ProcedureReturn #False
EndProcedure
DisableExplicit
EndModule
; ----------------------------------------- TEST -----------------------------------------
CompilerIf #PB_Compiler_IsMainFile
LoadFont(0, "Consolas", 12)
OpenWindow(0,0,0,800,600,"ScaledImage", #PB_Window_SystemMenu | #PB_Window_Maximize)
CanvasGadget(0,0,35, WindowWidth(0), WindowHeight(0) - 35, #PB_Canvas_Keyboard)
ButtonGadget(1, 0, 0, 200, 35, "DrawScaledImage: ON", #PB_Button_Toggle)
TextGadget(2, 210, 5, 400, 30, "mouse + left Button = scroll mouseWheel = zoom")
SetActiveGadget(0)
CreateImage(0, 8192, 8192)
StartDrawing(ImageOutput(0))
For i = 0 To 2500
Circle(Random(OutputWidth()), Random(OutputHeight()), Random(100,15), Random($FFFFFF, $101010))
Next
StopDrawing()
Global ScrollX.d = -ImageWidth(0) / 2
Global ScrollY.d = -ImageHeight(0) / 2
Global Zoom.d = 1.0
Global DrawMode = 1
Global MouseX, MouseY, LastX, LastY, LButton = 0
Procedure Redraw()
If StartDrawing(CanvasOutput(0))
DrawingFont(FontID(0))
Protected time = ElapsedMilliseconds()
Box(0,0,OutputWidth(), OutputHeight(), RGB(128,128,128))
If DrawMode = 0
DrawImage(ImageID(0), ScrollX * Zoom, ScrollY * Zoom, ImageWidth(0) * Zoom, ImageHeight(0) * Zoom)
Else
ScaledImage::Draw(0, ScrollX, ScrollY, Zoom, Zoom)
EndIf
DrawText(10, 10, "ImageSize: " + Str(ImageWidth(0)) + " x " + Str(ImageHeight(0)), #White, #Black)
DrawText(10, 35, "ScrollX: " + StrD(ScrollX, 2), #White, #Black)
DrawText(10, 60, "ScrollY: " + StrD(ScrollY, 2), #White, #Black)
DrawText(10, 85, "Zoom: " + StrD(Zoom,5), #White, #Black)
DrawText(10, 110, "Redraw time: " + Str(ElapsedMilliseconds() - time) + " ms", #Red, #Black)
StopDrawing()
EndIf
EndProcedure
Procedure Events()
LastX = MouseX
LastY = MouseY
MouseX = GetGadgetAttribute(0, #PB_Canvas_MouseX)
MouseY = GetGadgetAttribute(0, #PB_Canvas_MouseY)
Select EventType()
Case #PB_EventType_MouseMove
If GetGadgetAttribute(0, #PB_Canvas_Buttons)
ScrollX + (MouseX - LastX) / Zoom
ScrollY + (MouseY - LastY) / Zoom
Redraw()
EndIf
Case #PB_EventType_MouseWheel
Protected oldZoom.d = Zoom
If GetGadgetAttribute(0, #PB_Canvas_WheelDelta) > 0
Zoom / 0.75
Else
Zoom * 0.75
EndIf
If oldZoom <> Zoom
ScrollX + (MouseX / Zoom) * (1 - (Zoom / oldZoom))
ScrollY + (MouseY / Zoom) * (1 - (Zoom / oldZoom))
Redraw()
EndIf
EndSelect
EndProcedure
BindGadgetEvent(0, @Events())
Redraw()
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
If EventGadget() = 1
DrawMode = Bool(Not DrawMode)
If DrawMode = 0
SetGadgetText(1, "DrawScaledImage: OFF")
Else
SetGadgetText(1, "DrawScaledImage: ON")
EndIf
SetActiveGadget(0)
Redraw()
EndIf
EndSelect
ForEver
CompilerEndIf
