This example was made due to my surprise
when I read, that some excellent users needed
a canvas with humongous sizes.
After some nice explanations from lord and PB
I thought I might take up the challenge.
;---------------------------------
Code revised Aug. 29
Added simple scroll using arrow keys to both examples.
Example: WindowedScreen() . The best way ever! Fast when scrolling.
Code: Select all
;NOTE: BOTH EXAMPLES REVISED: DUE TO SEVERE SLEEP DEPRIVATION, THERE
;WERE A SERIOUS MEMORY LEAK AND REDUNDANT CODE PRESENT.
;THIS IS NOW FIXED FOR BOTH EXAMPLES.
;Sorry for the inconvenience..
;Initial loading may take a little time.
;You can save the current image.
;F2 Loads an image
;F3 lets you save an image
;Left click mouse button to zoom
;Right click mouse to zoom out.
;Arrow keys to scroll. Works in zoom mode only - naturally.
;Have fun.
;Best regards
;Peter nickname DK_Peter
UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
InitSprite()
InitMouse()
InitKeyboard()
Structure MegaPic_Data
The_Map.i
The_TmpMap.i
The_MapName.s
ScaleIndexX.f
ScaleIndexY.f
InOut.i
halfx.i
halfy.i
width.i
height.i
EndStructure
Global main.i, Displaymap.i, mpic.MegaPic_Data, pt.POINT, pt2.POINT
Global SpriteX.i
Declare LoadMyBigMap()
Declare SaveMyMapSection()
Declare ScaleNewPoint(*pt.POINT)
Declare ZoomOut()
Procedure Openmain(x = 0, y = 0, width = 1024, height = 768, Title.s = "Big Maps, Very big maps")
main = OpenWindow(#PB_Any, x, y, width, height, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(main),0,0,width, height,0,0,0,#PB_Screen_SmartSynchronization)
mpic\width = width
mpic\height = height
mpic\halfx = width / 2
mpic\halfy = height / 2
; create cursor
SpriteX = CreateSprite(#PB_Any, 50,50,#PB_2DDrawing_AlphaBlend)
StartDrawing(SpriteOutput(SpriteX))
DrawingMode(#PB_2DDrawing_Outlined)
Circle(25, 25, 20, $6F88CD)
StopDrawing()
EndProcedure
Procedure LoadMyBigMap()
Patt.s = "JPG files (*.jpg)|*.jpg|PNG files (*.png)|*.png|Bitmap files(*.bmp)|*.bmp"
mpic\The_MapName = OpenFileRequester("Select map to load..","",patt,0)
If mpic\The_MapName <> ""
If IsImage(mpic\The_Map) > 0
FreeImage(mpic\The_Map)
EndIf
If IsImage(Displaymap) > 0
FreeImage(Displaymap)
EndIf
mpic\The_Map = LoadImage(#PB_Any, mpic\The_MapName)
If IsImage(mpic\The_Map) ;Image is valid
Index = 0 ;FullMap
mpic\The_TmpMap = CreateImage(#PB_Any, mpic\width, mpic\height, 32,0)
StartDrawing(ImageOutput(mpic\The_TmpMap))
DrawImage(ImageID(mpic\The_Map), 0, 0, mpic\width, mpic\height)
StopDrawing()
Displaymap = CopyImage(mpic\The_TmpMap, #PB_Any)
mpic\ScaleIndexX = ImageWidth(mpic\The_Map) / mpic\width
mpic\ScaleIndexY = ImageHeight(mpic\The_Map) / mpic\height
mpic\InOut = 0 ;Full image scaled down otherwise 1 if zoomed
Else
MessageRequester("Error!", "Error loading image")
EndIf
EndIf
ProcedureReturn #True
EndProcedure
Procedure ZoomOut()
If IsImage(Displaymap)
FreeImage(Displaymap)
EndIf
If IsImage(mpic\The_TmpMap) > 0
Displaymap = CopyImage(mpic\The_TmpMap, #PB_Any)
EndIf
EndProcedure
Procedure SaveMyMapSection() ;type 0 = png : type 1 = jpg : type 2 = bmp
Protected Savename.s
Patt.s = "JPG files (*.jpg)|*.jpg|PNG files (*.png)|*.png|Bitmap files(*.bmp)|*.bmp"
Savename = SaveFileRequester("Save part as...","",patt, 0)
Select SelectedFilePattern()
Case 0 ; Png
ret = SaveImage(Displaymap, Savename + ".png", #PB_ImagePlugin_PNG)
Case 1 ; Jpg
ret = SaveImage(Displaymap, Savename + ".jpg", #PB_ImagePlugin_JPEG, 8)
Case 2 ; Bitmap
ret = SaveImage(Displaymap, Savename + "bmp", #PB_ImagePlugin_BMP)
EndSelect
ProcedureReturn #True
EndProcedure
Procedure ScaleNewPoint(*pt.POINT)
Protected NewGridX.i, NewGridY.i
If IsImage(mpic\The_Map) = 0 Or IsImage(Displaymap) = 0
ProcedureReturn
EndIf
NewGridX = *pt\x * mpic\ScaleIndexX ;Get the nearest position on real map
NewGridY = *pt\y * mpic\ScaleIndexY ;
If NewGridX - mpic\halfx < 0
NewGridX = 0
ElseIf NewGridX + mpic\halfx > ImageWidth(mpic\The_Map)
NewGridX = ImageWidth(mpic\The_Map) - mpic\width
Else
NewGridX - mpic\halfx
EndIf
If NewGridY - mpic\halfy < 0
NewGridY = 0
ElseIf NewGridY + mpic\halfy > ImageHeight((mpic\The_Map))
NewGridY = ImageHeight(mpic\The_Map) - mpic\height
Else
NewGridY - mpic\halfy
EndIf
FreeImage(Displaymap) ;forgot this one - memory leak.
Displaymap = GrabImage(mpic\The_Map, #PB_Any, newGridx , newgridy, ScreenWidth(), ScreenHeight())
EndProcedure
Procedure Run_Main()
Repeat
ClearScreen(0)
event = WaitWindowEvent()
If IsImage(Displaymap) > 0
StartDrawing(ScreenOutput())
DrawImage(ImageID(Displaymap),0,0)
StopDrawing()
EndIf
ExamineMouse()
If MouseButton(#PB_MouseButton_Left) And mpic\InOut = 0 ;Check the position and map zoom
pt\x = MouseX() + 25
pt\y = MouseY() + 25
ScaleNewPoint(pt)
mpic\InOut = 1
EndIf
DisplayTransparentSprite(SpriteX, MouseX(), MouseY())
If MouseButton(#PB_MouseButton_Right) And mpic\InOut = 1
ret = ZoomOut()
mpic\InOut = 0
EndIf
ExamineKeyboard()
If KeyboardReleased(#PB_Key_F2)
ReleaseMouse(1)
ret = LoadMyBigMap()
ReleaseMouse(0)
EndIf
If KeyboardReleased(#PB_Key_F3)
ReleaseMouse(1)
ret = SaveMyMapSection()
ReleaseMouse(0)
EndIf
If mpic\InOut = 1 ;Added simple scroller to the map.
If KeyboardPushed(#PB_Key_Left)
pt\x - 1 ;Change one point and scale up to normal size..It might stand still for a few seconds
;depending on image size and/or point position.
ScaleNewPoint(pt)
EndIf
If KeyboardPushed(#PB_Key_Right)
pt\x + 1
ScaleNewPoint(pt)
EndIf
If KeyboardPushed(#PB_Key_Up)
pt\y - 1
ScaleNewPoint(pt)
EndIf
If KeyboardPushed(#PB_Key_Down)
pt\y + 1
ScaleNewPoint(pt)
EndIf
EndIf
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or event = #PB_Event_CloseWindow
EndProcedure
Openmain()
Run_Main()
End
Code: Select all
UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UseTIFFImageDecoder()
UseTGAImageDecoder()
Structure MegaPic_Data
The_Map.i
The_TmpMap.i
The_MapName.s
ScaleIndexX.f
ScaleIndexY.f
InOut.i
halfx.i
halfy.i
width.i
height.i
EndStructure
Global Main, LoadButton, SaveButton, MapCanvas
Global Displaymap.i, mpic.MegaPic_Data, pt.POINT, pt2.POINT
Declare OpenMain(x = 0, y = 0, width = 849, height = 657)
Declare LoadMyBigMap()
Declare ZoomOut()
Declare SaveMyMapSection() ;type 0 = png : type 1 = jpg : type 2 = bmp
Declare ScaleNewPoint(*pt.POINT)
Procedure OpenMain(x = 0, y = 0, width = 849, height = 657)
Main = OpenWindow(#PB_Any, x, y, width, height, "Loading large images and save example", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered)
LoadButton = ButtonGadget(#PB_Any, 3, 0, 87, 21, "Load")
SaveButton = ButtonGadget(#PB_Any, 100, 0, 87, 21, "Save")
MapCanvas = CanvasGadget(#PB_Any, 3, 24, 846, 633, #PB_Canvas_DrawFocus|#PB_Canvas_Keyboard)
mpic\width = GadgetWidth(MapCanvas)
mpic\height = GadgetHeight(MapCanvas)
mpic\halfx = mpic\width / 2
mpic\halfy = mpic\height / 2
EndProcedure
Procedure LoadMyBigMap()
Patt.s = "JPG files (*.jpg)|*.jpg|PNG files (*.png)|*.png|Bitmap files(*.bmp)|*.bmp"
mpic\The_MapName = OpenFileRequester("Select map to load..", "", patt, 0)
If mpic\The_MapName <> ""
If IsImage(mpic\The_Map) > 0
FreeImage(mpic\The_Map)
EndIf
If IsImage(Displaymap) > 0
FreeImage(Displaymap)
EndIf
mpic\The_Map = LoadImage(#PB_Any, mpic\The_MapName)
If IsImage(mpic\The_Map) > 0 ;Image is valid
mpic\The_TmpMap = CreateImage(#PB_Any, mpic\width, mpic\height, 32,0)
StartDrawing(ImageOutput(mpic\The_TmpMap))
DrawImage(ImageID(mpic\The_Map), 0, 0, mpic\width, mpic\height)
StopDrawing()
Displaymap = CopyImage(mpic\The_TmpMap, #PB_Any)
mpic\ScaleIndexX = ImageWidth(mpic\The_Map) / mpic\width
mpic\ScaleIndexY = ImageHeight(mpic\The_Map) / mpic\height
mpic\InOut = 0 ;Full image scaled down otherwise 1 if zoomed
StartDrawing(CanvasOutput(MapCanvas))
DrawImage(ImageID(mpic\The_TmpMap), 0, 0, mpic\width, mpic\height)
StopDrawing()
Else
MessageRequester("Error!", "Error loading image (not enough memory)")
EndIf
EndIf
ProcedureReturn #True
EndProcedure
Procedure ZoomOut()
If IsImage(Displaymap)
FreeImage(Displaymap)
EndIf
If IsImage(mpic\The_TmpMap)
Displaymap = CopyImage(mpic\The_TmpMap, #PB_Any)
StartDrawing(CanvasOutput(MapCanvas))
DrawImage(ImageID(Displaymap), 0, 0, mpic\width, mpic\height)
StopDrawing()
EndIf
EndProcedure
Procedure SaveMyMapSection() ;type 0 = png : type 1 = jpg : type 2 = bmp
Protected Savename.s
Patt.s = "JPG files (*.jpg)|*.jpg|PNG files (*.png)|*.png|Bitmap files(*.bmp)|*.bmp"
Savename = SaveFileRequester("Save part as...","",patt, 0)
Select SelectedFilePattern()
Case 0 ; Png
ret = SaveImage(Displaymap, Savename + ".png", #PB_ImagePlugin_PNG)
Case 1 ; Jpg
ret = SaveImage(Displaymap, Savename + ".jpg", #PB_ImagePlugin_JPEG, 8)
Case 2 ; Bitmap
ret = SaveImage(Displaymap, Savename + ".bmp", #PB_ImagePlugin_BMP)
EndSelect
ProcedureReturn #True
EndProcedure
Procedure ScaleNewPoint(*pt.POINT)
Protected NewGridX.i, NewGridY.i
If IsImage(mpic\The_Map) = 0
ProcedureReturn
EndIf
NewGridX = *pt\x * mpic\ScaleIndexX ;Get the nearest position on real map
NewGridY = *pt\y * mpic\ScaleIndexY ;
If NewGridX - mpic\halfx < 0
NewGridX = 0
ElseIf NewGridX + mpic\halfx > ImageWidth(mpic\The_Map)
NewGridX = ImageWidth(mpic\The_Map) - mpic\width
Else
NewGridX - mpic\halfx
EndIf
If NewGridY - mpic\halfy < 0
NewGridY = 0
ElseIf NewGridY + mpic\halfy > ImageHeight((mpic\The_Map))
NewGridY = ImageHeight(mpic\The_Map) - mpic\height
Else
NewGridY - mpic\halfy
EndIf
If IsImage(Displaymap) > 0
FreeImage(Displaymap)
EndIf
Displaymap = GrabImage(mpic\The_Map, #PB_Any, NewGridX , NewGridY, mpic\width, mpic\height)
StartDrawing(CanvasOutput(MapCanvas))
DrawImage(ImageID(Displaymap), 0, 0, mpic\width, mpic\height)
StopDrawing()
EndProcedure
Procedure Main()
Repeat
ev = WaitWindowEvent()
et = EventType()
Select ev
Case #PB_Event_Gadget
Select EventGadget()
Case LoadButton
LoadMyBigMap()
Case SaveButton
SaveMyMapSection()
Case MapCanvas
If et = #PB_EventType_LeftClick And mpic\InOut = 0
pt\x = GetGadgetAttribute(MapCanvas, #PB_Canvas_MouseX)
pt\y = GetGadgetAttribute(MapCanvas, #PB_Canvas_MouseY)
ScaleNewPoint(pt)
mpic\InOut = 1
EndIf
If et = #PB_EventType_RightClick And mpic\InOut = 1
ret = ZoomOut()
mpic\InOut = 0
EndIf
If et = #PB_EventType_KeyDown And mpic\InOut = 1
keyVar = GetGadgetAttribute(MapCanvas, #PB_Canvas_Key)
If keyVar = #PB_Shortcut_Left
pt\x - 1
ScaleNewPoint(pt)
EndIf
If keyVar = #PB_Shortcut_Right
pt\x + 1
ScaleNewPoint(pt)
EndIf
If keyVar = #PB_Shortcut_Up
pt\y - 1
ScaleNewPoint(pt)
EndIf
If keyVar = #PB_Shortcut_Down
pt\y + 1
ScaleNewPoint(pt)
EndIf
EndIf
EndSelect
EndSelect
Until ev = #PB_Event_CloseWindow
EndProcedure
OpenMain()
Main()
End