10-26-2023, 02:28 PM
(10-26-2023, 02:09 PM)SMcNeill Wrote:(10-26-2023, 01:59 PM)bplus Wrote: I am not clear what the problem would be taking a snapshot of screen before doing stuff then using it to restore screen when done, say with dialog. This method always seemed to work for me.
There's a lot more to track and restore than just a "snapshot of screen", if you want to make certain that your subs and functions all clean up neatly after themselves. For example, take a look at my little expanded function (in progress):
Code: (Select All)Const All_Settings~& = -1~&
Const General_Settings~& = 1 Or 2 Or 4 Or 8
Const AutoDisplay_Setting~& = 1
Const Blend_Setting~& = 2
Const Dest_Setting~& = 4
Const Source_Setting~& = 8
Const Font_Settings~& = 16 Or 32 Or 64 Or 128 Or 256
Const CursorX_Setting~& = 16
Const CursorY_Setting~& = 32
Const Font_Setting~& = 64
Const ForegroundColor_Setting~& = 128
Const BackgroundColor_Setting~& = 256
Const Image_Settings~& = 512 Or 2048
Const ColorPalette_Setting~& = 512
Const ScreenData_Setting~& = 2048
Type Settings_Type
ControlCode As _Unsigned Long
'General Screen Settings '15
AutoDisplay As Long '1
Blend As Long '2
Dest As Long '4
Source As Long '8
'Font Settings '496
CursorX As Long '16
CursorY As Long '32
Font As Long '64
FgColor As _Unsigned Long '128
BgColor As _Unsigned Long '256
'Image Settings ' 15872
ColorPalette As _MEM '512
PixelSize As Long '1024
ScreenData As _MEM '2048
End Type
Dim Saver As Settings_Type
'Screen _NewImage(640, 480, 32)
'$Color:32
Randomize Timer
_Blink Off
For i = 0 To 15
Color i, 15 - i
Print "Hello World in Color"; i
Next
Sleep 'so we can view the original screen
GetSettings 0, Saver, All_Settings 'We should now be able to screw with all sorts of stuff and then reset the changes after
_Font 17 'double wide font!
For i = 1 To 10
Color 4, 0: Print "BLAH BLAH BLAH! Look at this junk!" 'just crap to print to the screen!
Next
For i = 0 To 15
_PaletteColor i, _RGB32(Rnd * 256, Rnd * 256, Rnd * 256) 'even the palette changes!
Next
Sleep 'so we can view our drastic changes
RestoreSettings Saver, Image 'put everything back to where it was originally
Sleep 'and let's look at it
System 'before we quit
Sub GetSettings (Image As Long, SaveTo As Settings_Type, Control_Code As _Unsigned Long)
Dim m As _MEM: m = _MemImage(0)
If Control_Code = 0 Then Exit Sub
SaveTo.ControlCode = Control_Code
SaveTo.PixelSize = _PixelSize(Image)
If Control_Code And 1 Then SaveTo.AutoDisplay = _AutoDisplay
If Control_Code And 2 Then SaveTo.Blend = _Blend
If Control_Code And 4 Then SaveTo.Dest = _Dest
If Control_Code And 8 Then SaveTo.Source = _Source
If Control_Code And 16 Then SaveTo.CursorX = Pos(0)
If Control_Code And 32 Then SaveTo.CursorY = CsrLin
If Control_Code And 64 Then SaveTo.Font = _Font(Image)
If Control_Code And 128 Then SaveTo.FgColor = _DefaultColor(Image)
If Control_Code And 256 Then SaveTo.BgColor = _BackgroundColor(Image)
If Control_Code And 512 Then
Select Case SaveTo.PixelSize
Case 0, 256 '16 color palette and 256 color palette
If SaveTo.PixelSize = 0 Then '16 colors for text screen
Limit = 15
Else
Limit = 255
End If
Dim Pal(0 To Limit) As _Unsigned Long
For i = 0 To Limit
Pal(i) = _RGBA32(_Red(i, Image), _Green(i, Image), _Blue(i, Image), _Alpha(i, Image))
Next
m = _Mem(Pal())
SaveTo.ColorPalette = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo.ColorPalette, SaveTo.ColorPalette.OFFSET
_MemFree m
End Select
End If
'1024 got made mandatory for all blocks, so it's no longer a control code variable
If Control_Code And 2048 Then
m = _MemImage(Image)
SaveTo.ScreenData = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo.ScreenData, SaveTo.ScreenData.OFFSET
_MemFree m
End If
End Sub
Sub RestoreSettings (FromWhat As Settings_Type, Image As Long)
Dim m As _MEM: m = _MemImage(0)
Dim As _Unsigned Long CC, PS 'save me some typing
CC = FromWhat.ControlCode
PS = FromWhat.PixelSize
If CC = 0 Then Exit Sub
If CC And 1 Then If FromWhat.AutoDisplay Then _AutoDisplay
If CC And 2 Then If FromWhat.Blend Then _Blend
If CC And 4 Then _Dest FromWhat.Dest
If CC And 8 Then _Source FromWhat.Source
If CC And 16 Then Locate , FromWhat.CursorX
If CC And 32 Then Locate FromWhat.CursorY
If CC And 64 Then _Font FromWhat.Font, Image
If CC And 128 Then Color FromWhat.FgColor
If CC And 256 Then Color , FromWhat.BgColor
If CC And 512 Then
Select Case PS
Case 0, 256 '16 color palette and 256 color palette
If PS = 0 Then '16 colors for text screen
Limit = 15
Else
Limit = 255
End If
Dim Pal(0 To Limit) As _Unsigned Long
m = _Mem(Pal())
_MemCopy FromWhat.ColorPalette, FromWhat.ColorPalette.OFFSET, FromWhat.ColorPalette.SIZE To m, m.OFFSET
_MemFree m
For i = 0 To Limit
_PaletteColor i, Pal(i), Image
Next
End Select
End If
'1024 Placeholder now
If CC And 2048 Then
m = _MemImage(Image)
_MemCopy FromWhat.ScreenData, FromWhat.ScreenData.OFFSET, FromWhat.ScreenData.SIZE To m, m.OFFSET
_MemFree m
End If
End Sub
Sub SaveScreen (Image As Long, SaveTo As _MEM)
Dim m As _MEM
m = _MemImage(Image)
SaveTo = _MemNew(m.SIZE)
_MemCopy m, m.OFFSET, m.SIZE To SaveTo, SaveTo.OFFSET
_MemFree m
End Sub
Sub RestoreScreen (FromWhich As _MEM, Image As Long)
Dim m As _MEM
m = _MemImage(Image)
_MemCopy FromWhich, FromWhich.OFFSET, FromWhich.SIZE To m, m.OFFSET
_MemFree m
End Sub
And how you get that "snapshot" can cause problems elsewhere in your code, as I pointed out before.
IF you use PCOPY inside a SUB at the beginning and end, that PCOPY will corrupt any other use of the same handle with the new image.
_COPYIMAGE can't work with a _PUTIMAGE in SCREEN 0 modes.
_NEWIMAGE will change image handles, which can make any existing variables which reference the old handle invalid.
Show me an example of how you'd grab your "snapshot", and chances are, I can show you code where it'll glitch out on you, if you're not careful or lucky.
I haven't looked at this for awhile, might be due for update?
Code: (Select All)
' ============================================================= This is old version dev for mBox or InputBox new version dev with new GetArrayItem$
' for saving and restoring screen settins
Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill
Static defaultColor~&, backGroundColor~&
Static font&, dest&, source&, row&, col&, autodisplay&, mb&
If restoreTF Then
_Font font&
Color defaultColor~&, backGroundColor~&
_Dest dest&
_Source source&
Locate row&, col&
If autodisplay& Then _AutoDisplay Else _Display
_KeyClear
While _MouseInput: Wend 'clear mouse clicks
mb& = _MouseButton(1)
If mb& Then
Do
While _MouseInput: Wend
mb& = _MouseButton(1)
_Limit 100
Loop Until mb& = 0
End If
Else
font& = _Font: defaultColor~& = _DefaultColor: backGroundColor~& = _BackgroundColor
dest& = _Dest: source& = _Source
row& = CsrLin: col& = Pos(0): autodisplay& = _AutoDisplay
_KeyClear
End If
End SubAs I recall it worked pretty good returning screen back to a previous condition. Good for dialog boxes like Message or Input.
b = b + ...