Posts: 1,272
Threads: 119
Joined: Apr 2022
Reputation:
100
I noticed that ON ERROR line labels can't be placed within subroutines:
SUB MySub()
ON ERROR GOTO ErrHandler
... code
ErrHandler:
END SUB
Is this normal? I'm using QB64pe v3.13.1
The Wiki states ON ERROR can be used in Subs/Functions but no mention of label being required to be outside of the Sub/Function.
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Posts: 207
Threads: 13
Joined: Apr 2022
Reputation:
52
Right, you can use ON ERROR inside SU/FUNC to designate another handler, but the handler label must be in the main part of the program.
I like that behavior, as it provides an easy mechanism to cleanly emergency exit your program. I use this a lot in my GuiTools Framework:
The SUB InternalErrHandler switches to an simple internal trap handler just saving the error for later flow control, SUB UserErrHandler switches back to the regular user handler with message box popup.
More than that I've an "IF _EXIT THEN ERROR 1000" in every essential loop, so when the user closes the program in a sudden unexpected moment, then ERROR 1000 jumps directly into the active error handler no worries about how deep in the SUB/FUNC calling stack or nested loops the program is right now. The error handlers notice error number 1000 as immediate exit request and RESUME to the label "emergencyExit:" where a proper cleanup procedure is done before the program finally ends with SYSTEM.
Posts: 2,171
Threads: 222
Joined: Apr 2022
Reputation:
103
Yep, it has always been that way since QuickBASIC. The good news is you can use RESUME NEXT.
So let's say you are in a subroutine and you throw an error 5.
Code: (Select All)
Dim Shared erh As Integer
On Error GoTo Handler
mysub
Handler:
erh = Err
Resume Next
Sub mysub:
Locate -1, -1
If erh = 5 Then Print "Pete's an idiot!": Exit Sub
' Blah, blah, blah...
End Sub
Shoot first and shoot people who ask questions, later.
Posts: 1,272
Threads: 119
Joined: Apr 2022
Reputation:
100
08-16-2024, 09:16 PM
(This post was last modified: 08-16-2024, 09:17 PM by TerryRitchie.)
Hmm... ok, thanks guys. I think I may have used ON ERROR a few times back in the GWBasic days so I wasn't aware of this.
It would be handy though if a label inside of a sub/function could be used. Take the code below for instance, it's the function I created from Steve's code in the other thread concerning gathering color depths. This function will fail if a negative arbitrary number is sent that does not belong to an actual image. I would like to catch that error when _PIXELSIZE encounters it and then simply exit the function, returning a value of 0. If I were to place the label outside of this function then other libraries loading before or after this would cause an error relating to code between subs/functions.
It would also be nice to test for a text mode only image being sent by copying the image and doing a simple PSET to it. If it fails then it's a text mode only image that was passed.
Code: (Select All)
'LIB_IMG_ColorDepth.BM
FUNCTION IMG_ColorDepth% (i AS LONG)
'+------------------------------------------------+
'| Returns the color depth of an image passed in. |
'| |
'| i - the image handle |
'| |
'| Returns: 0 : not an image |
'| 32 : 32 bit color image |
'| 256 : 256 color image |
'| 16 : 16 color image (or text only) |
'| |
'| Note: this function will fail if an image |
'| handle value passed in is less than -1 |
'| but does not belong to an actual image. |
'+------------------------------------------------+
DIM c AS INTEGER ' color counter
DIM p AS INTEGER ' palette counter
IF i > -2 THEN EXIT FUNCTION ' not an image, return 0
IF _PIXELSIZE(i) = 4 THEN ' 4 bytes per pixel?
IMG_ColorDepth% = 32 ' yes, 32 bit color image
ELSE ' no, 1 byte per pixel
p = 0 ' reset palette counter
c = 0 ' reset color counter
DO ' begin palette search
IF _PALETTECOLOR(p, i) <> &HFF000000 THEN c = c + 1 ' increment color counter if color found
p = p + 1 ' increment palette counter
LOOP UNTIL p = 256 ' leave when entire palette searched
IF c <= 16 THEN ' 16 colors or less?
IMG_ColorDepth% = 16 ' yes, 16 color image
ELSE ' no, greater than 16
IMG_ColorDepth% = 256 ' 256 color image
END IF
END IF
END FUNCTION
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Posts: 2,171
Threads: 222
Joined: Apr 2022
Reputation:
103
08-16-2024, 09:38 PM
(This post was last modified: 08-16-2024, 09:39 PM by Pete.)
Code: (Select All)
Dim Shared erh As Integer
i = -1
pete = IMG_ColorDepth%(i)
Print pete
handler:
erh = Err
Resume Next
Function IMG_ColorDepth% (i As Long)
'+------------------------------------------------+
'| Returns the color depth of an image passed in. |
'| |
'| i - the image handle |
'| |
'| Returns: 0 : not an image |
'| 32 : 32 bit color image |
'| 256 : 256 color image |
'| 16 : 16 color image (or text only) |
'| |
'| Note: this function will fail if an image |
'| handle value passed in is less than -1 |
'| but does not belong to an actual image. |
'+------------------------------------------------+
Dim c As Integer ' color counter
Dim p As Integer ' palette counter
On Error GoTo handler
If _PixelSize(i) = 4 Then ' 4 bytes per pixel?
If erh Then i = 0: Exit Function
IMG_ColorDepth% = 32 ' yes, 32 bit color image
Else ' no, 1 byte per pixel
p = 0 ' reset palette counter
c = 0 ' reset color counter
Do ' begin palette search
If _PaletteColor(p, i) <> &HFF000000 Then c = c + 1 ' increment color counter if color found
p = p + 1 ' increment palette counter
Loop Until p = 256 ' leave when entire palette searched
If c <= 16 Then ' 16 colors or less?
IMG_ColorDepth% = 16 ' yes, 16 color image
Else ' no, greater than 16
IMG_ColorDepth% = 256 ' 256 color image
End If
End If
End Function
So i starts in at -1, triggers the error, exits as 0.
Edit: To turn the call to handler off at some point, just place: ON ERROR GOTO 0 in the program flow.
Pete
Shoot first and shoot people who ask questions, later.
Posts: 1,272
Threads: 119
Joined: Apr 2022
Reputation:
100
08-16-2024, 09:43 PM
(This post was last modified: 08-16-2024, 09:45 PM by TerryRitchie.)
(08-16-2024, 09:38 PM)Pete Wrote: Code: (Select All)
Dim Shared erh As Integer
i = -1
pete = IMG_ColorDepth%(i)
Print pete
handler:
erh = Err
Resume Next
Function IMG_ColorDepth% (i As Long)
'+------------------------------------------------+
'| Returns the color depth of an image passed in. |
'| |
'| i - the image handle |
'| |
'| Returns: 0 : not an image |
'| 32 : 32 bit color image |
'| 256 : 256 color image |
'| 16 : 16 color image (or text only) |
'| |
'| Note: this function will fail if an image |
'| handle value passed in is less than -1 |
'| but does not belong to an actual image. |
'+------------------------------------------------+
Dim c As Integer ' color counter
Dim p As Integer ' palette counter
On Error GoTo handler
If _PixelSize(i) = 4 Then ' 4 bytes per pixel?
If erh Then i = 0: Exit Function
IMG_ColorDepth% = 32 ' yes, 32 bit color image
Else ' no, 1 byte per pixel
p = 0 ' reset palette counter
c = 0 ' reset color counter
Do ' begin palette search
If _PaletteColor(p, i) <> &HFF000000 Then c = c + 1 ' increment color counter if color found
p = p + 1 ' increment palette counter
Loop Until p = 256 ' leave when entire palette searched
If c <= 16 Then ' 16 colors or less?
IMG_ColorDepth% = 16 ' yes, 16 color image
Else ' no, greater than 16
IMG_ColorDepth% = 256 ' 256 color image
End If
End If
End Function
So i starts in at -1, triggers the error, exits as 0.
Edit: To turn the call to handler off at some point, just place: ON ERROR GOTO 0 in the program flow.
Pete Oh I completely understand how to implement this like you showed. The problem is the function above is a .BM library file.
My code would error out when:
'$INCLUDE:'.\lib\image\LIB_IMG_Contrast.BM'
'$INCLUDE:'.\lib\image\LIB_IMG_ColorDepth.BM'
The code outside of the function in the second .BM file will trigger an error. I could create an accompanying .BI file that contains the code outside. I'll experiment with that.
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Posts: 2,171
Threads: 222
Joined: Apr 2022
Reputation:
103
I don't work with include files, so maybe I'm missing something. Don't you have a main file, and then load the libraries? Error handlers go in the main and the main just needs to be structured so the flow never directly enters the handler routine. Actually that sounds like what you are thinking about, creating a main as another separate bi. Yes, that should work.
Pete
Shoot first and shoot people who ask questions, later.
Posts: 1,272
Threads: 119
Joined: Apr 2022
Reputation:
100
08-16-2024, 10:00 PM
(This post was last modified: 08-16-2024, 10:03 PM by TerryRitchie.)
Ok, that seems to have worked. Here is the main code:
Code: (Select All)
'$INCLUDE:'.\lib\image\lib_img_colordepth.bi' IMG_ColorDepth function
Image& = _NEWIMAGE(640, 480, 32) ' valid image
PRINT IMG_ColorDepth(Image&) ' valid image
PRINT IMG_ColorDepth(-30) ' invalid image
'$INCLUDE:'.\lib\image\lib_img_colordepth.bm' IMG_ColorDepth function
Here is the .BI library file:
Code: (Select All)
'LIB_IMG_ColorDepth.BI
DIM SHARED ColorDepthError AS INTEGER
COLORDEPTH_BIFILE:
IF ERR THEN
ColorDepthError = ERR
RESUME NEXT
END IF
And here is the .BM library file.
Code: (Select All)
'LIB_IMG_ColorDepth.BM
FUNCTION IMG_ColorDepth% (i AS LONG)
'+------------------------------------------------+
'| Returns the color depth of an image passed in. |
'| |
'| i - the image handle |
'| |
'| Returns: 0 : not an image |
'| 32 : 32 bit color image |
'| 256 : 256 color image |
'| 16 : 16 color image (or text only) |
'| |
'| Note: this function will fail if an image |
'| handle value passed in is less than -1 |
'| but does not belong to an actual image. |
'+------------------------------------------------+
DIM c AS INTEGER ' color counter
DIM p AS INTEGER ' palette counter
IF i > -2 THEN EXIT FUNCTION ' not an image, return 0
ON ERROR GOTO COLORDEPTH_BIFILE ' use error handler in .BI file
IF _PIXELSIZE(i) = 4 THEN ' 4 bytes per pixel?
IF ColorDepthError THEN ' did _PIXELSIZE generate an error?
ColorDepthError = 0 ' yes, reset error flag
IMG_ColorDepth% = 0 ' return 0 (not an image)
ON ERROR GOTO 0 ' remove ON ERROR redirection
EXIT FUNCTION ' leave function
END IF
IMG_ColorDepth% = 32 ' yes, 32 bit color image
ELSE ' no, 1 byte per pixel
p = 0 ' reset palette counter
c = 0 ' reset color counter
DO ' begin palette search
IF _PALETTECOLOR(p, i) <> &HFF000000 THEN c = c + 1 ' increment color counter if color found
p = p + 1 ' increment palette counter
LOOP UNTIL p = 256 ' leave when entire palette searched
IF c <= 16 THEN ' 16 colors or less?
IMG_ColorDepth% = 16 ' yes, 16 color image
ELSE ' no, greater than 16
IMG_ColorDepth% = 256 ' 256 color image
END IF
END IF
ON ERROR GOTO 0 ' remove ON ERROR redirection
END FUNCTION
New to QB64pe? Visit the QB64 tutorial to get started.
QB64 Tutorial
Posts: 2,171
Threads: 222
Joined: Apr 2022
Reputation:
103
Good that it works that way!
So I would place it in the main, but would this work with INCLUDE files?
MAIN
Code: (Select All)
DIM SHARED ColorDepthError AS INTEGER
'$INCLUDE:'.\lib\image\lib_img_colordepth.bi' IMG_ColorDepth function
Image& = _NEWIMAGE(640, 480, 32) ' valid image
PRINT IMG_ColorDepth(Image&) ' valid image
PRINT IMG_ColorDepth(-30) ' invalid image
'$INCLUDE:'.\lib\image\lib_img_colordepth.bm' IMG_ColorDepth function
END
COLORDEPTH_BIFILE:
ColorDepthError = ERR
RESUME NEXT
Shoot first and shoot people who ask questions, later.
Posts: 2,696
Threads: 327
Joined: Apr 2022
Reputation:
217
(08-16-2024, 10:19 PM)Pete Wrote: Good that it works that way!
So I would place it in the main, but would this work with INCLUDE files?
MAIN
Code: (Select All)
DIM SHARED ColorDepthError AS INTEGER
'$INCLUDE:'.\lib\image\lib_img_colordepth.bi' IMG_ColorDepth function
Image& = _NEWIMAGE(640, 480, 32) ' valid image
PRINT IMG_ColorDepth(Image&) ' valid image
PRINT IMG_ColorDepth(-30) ' invalid image
'$INCLUDE:'.\lib\image\lib_img_colordepth.bm' IMG_ColorDepth function
END
COLORDEPTH_BIFILE:
ColorDepthError = ERR
RESUME NEXT
I don't think so. You've got code and labels AFTER your subs, which QB64 doesn't like.
Code: (Select All)
DIM SHARED ColorDepthError AS INTEGER
'$INCLUDE:'.\lib\image\lib_img_colordepth.bi' IMG_ColorDepth function
Image& = _NEWIMAGE(640, 480, 32) ' valid image
PRINT IMG_ColorDepth(Image&) ' valid image
PRINT IMG_ColorDepth(-30) ' invalid image
COLORDEPTH_BIFILE:
ColorDepthError = ERR
RESUME NEXT
'$INCLUDE:'.\lib\image\lib_img_colordepth.bm' IMG_ColorDepth function
END
The above should work though, I'd think without any issue.
|
