PDA

View Full Version : Please help! My personal QOD:



ReneMiner
18-02-2013, 13:13
Since there was no QOD for a few days now I intended to create one and I wanted to encrypt the whole stuff later by using senseless, wrong-leading variable-names and stuff to let you guess what the program does. But I don't get that far...

I have some problem that occurs since I have Windows 8 on a few different scripts that ran fine on my old system, even with the Displaylist-Tinker!

There's always some If-Without-Endif-Error-Message + scripts crash.

Now I managed to encapsulate and isolate that to a "smaller" script which is postet here.

important comments and how to get it occur are inside - I didn't encrypt this of course but I repeat the most important in advance:

Do not run in Debug-Mode to get it occur at all - stare at window caption instead - the current executed sub gets displayed there.
When program crashes (does just if you went one folder up once) it always shows last scriptline - i counted all if/endif at least 5 times...
I found out which line does the crash (inside Sub Check_Mouse(), last Window-Caption is "Mouse2" )


Is it a Windows8-issue? Does it run on your machines without crash?


' the script is a small file-explorer-control in TBGL-Window
' if runs, check the caption of TBGL-window,
' the current Sub/Function get's displayed there.

' now do the following:
' run this, (without debbuger, then it doesn't occur!)

' click on the first row which gets displayed there
' it'll lead you to the parent-folder mostly then
' do not need to click again but just move the mouse up then
' -- try to point the windows caption for example --

' it crashes here on my system, the Error-Message says
' missing Endif (If without Endif) in the last line of the script
' you can see at windows caption the last status Mouse2 then
' this line is inside Sub Check_Mouse()
' I tried also:"if mY>=0 and mY <= 511 then" ..., instead of "Between" same result


Uses "TBGL", "FILE"

Begin Const
%NO_ITEM = -1

' fonts
%fSmall = 1
%fSymbols

' file-list-types, value is the AscII of related WingDings-Char to display
%ft_myComputer = &H3A
%ft_Volume = &H3B
%ft_Up = &HC7
%ft_SubDir = &H30
%ft_File = &HAB
End Const

Type t_Control ' this is a simple control type for multiple use
X1 As Long ' left
Y1 As Long ' top
X2 As Long ' right
Y2 As Long ' bottom
' txt As String ' unused in this case
' V As Long ' store some common value, unused
First As Long ' first shown element
Count As Long ' number of current shown elements
Extra As Long ' control-specific extra value
' max. number of displayed elements for this one
Slctd As Long ' row inside control that is pointed on, %NO_ITEM if none
End Type

Global XXX As t_Control ' XXX is the used explorer-control
XXX.X1 = 2 ' left
XXX.Y1 = 0 ' top
XXX.X2 = 382 ' right
XXX.Y2 = 511 ' bottom
XXX.Extra = 512 / 16 ' available_height / height_of_a_row
' = max. displayable lines

Type t_Drive
Letter As String ' "C:","D:" etc.
VLabel As String ' volume label
End Type
Global Drive() As t_Drive : ReDim Drive(1) ' holds list of available Drives


Global FileListFile() As String : ReDim FileListFile(1) ' mostly "Filename",
' "Subfolders name"
' "move up"
' "My Computer" etc.

Global FileListType() As Long : ReDim FileListType(1) ' type to the file
' see %ft_CONSTANTS

Global FileListPath As String = APP_ScriptPath ' current path
Global FileListDepth As Long ' example:
' myComputer = always Depth 0
' C:\ = Depth 1
' C:\Windows\ = Depth 2...



Global clWidth As Long = 384 ' prefix window size
Global clHeight As Long = 512

Global hWnd As DWord ' global so can set caption
' from subs and functions

Function TBMain()

Local i As Long

' retrieve initial path-depth
For i = 1 To Len(FileListPath)
If Mid$(FileListPath, i, 1) = "\" Then FileListDepth += 1
Next i

' -- Create and show window
hWnd = TBGL_CreateWindowEx("TBGL script - press ESC to quit", clWidth, clHeight, 32, _
%TBGL_WS_DONTSIZE _
Or %TBGL_WS_WINDOWED _
Or %TBGL_WS_CLOSEBOX)

TBGL_ShowWindow
TBGL_BuildFont TBGL_FontHandle("System", 9), %fSmall
TBGL_BuildFont TBGL_FontHandle("Wingdings", 12), %fSymbols

' -- load the current directory once
Get_FileList()

' -- Resets status of all keys
TBGL_ResetKeyState()
TBGL_UseTexturing FALSE ' will just draw text and boxes...
TBGL_RenderMatrix2D(0, clHeight, clWidth, 0) ' and just 2D

' -- Main loop
While TBGL_IsWindow(hWnd)

TBGL_ClearFrame

Draw_FileList()

TBGL_DrawFrame
Check_Mouse()

' -- ESCAPE key to exit application
If TBGL_GetWindowKeyState(hWnd, %VK_ESCAPE) Then Exit While

Wend

TBGL_DestroyWindow
End Function



Sub Get_DriveList()
Local i As Long
Local lDrv As String
Local lArray() As String

ReDim Drive(1)

TBGL_SetWindowTitle(hWnd,"DRivelist") ' just for debug

For i = 0 To 25 ' check for all letters...
lDrv = Chr$(65 + i) + ":\"
If DIR_Exists(lDrv) Then
Drive(UBound(Drive)).Letter = lDrv
DIR_ListArray(lArray, lDrv, "*", %FILE_VLABEL)
Drive(UBound(Drive)).VLabel = lArray(1)
ReDim Preserve Drive(UBound(Drive) + 1)

ReDim lArray(1)
EndIf
Next i

' somehow this line should be needed, but then it messes the array up...
' If UBound(Drive) > 1 Then ReDim Preserve Drive(UBound(Drive) - 1)

End Sub

Sub Get_FileList()
'read, sort and order files to their types

Local i, lFiles, lDirs As Long
Local sType, lList() As String

ReDim FileListFile(1) : ReDim FileListType(1)

TBGL_SetWindowTitle(hWnd,"Filelist") ' debug state-display

If FileListDepth = 0 Then

' we're top level, so just display all drives

FileListFile(1) = "my computer"
FileListType(1) = %ft_myComputer
Get_DriveList
ReDim Preserve FileListFile(UBound(Drive) + 1)
ReDim Preserve FileListType(UBound(Drive) + 1)
For i = 1 To UBound(Drive)
FileListFile(i + 1) = Drive(i).Letter + " [" + Drive(i).Vlabel + "]"
FileListType(i + 1) = %ft_Volume
Next i

Else
' there's always one level up then
FileListFile(1) =".."
fileListType(1) = %ft_Up

' collect subdirs
lDirs = DIR_ListArray(lList, FileListPath,"*", %FILE_SUBDIR)
If lDirs > 0 Then
ReDim Preserve FileListFile(lDirs + 1)
ReDim Preserve FileListType(lDirs + 1)
For i = 1 To lDirs
FileListFile(i + 1) = lList(i)
FileListType(i + 1) = %ft_SubDir
Next i
EndIf
' collect files
ReDim lList(0)
lFiles = DIR_ListArray(lList, FileListPath,"*.*", %FILE_NORMAL)

If lFiles > 0 Then
ReDim Preserve FileListFile(lFiles + lDirs + 1)
ReDim Preserve FileListType(lFiles + lDirs + 1)
For i = 1 To lFiles
FileListFile(lDirs + i + 1) = lList(i)
sType = Ucase$(FILE_PathSplit(FileListFile(lDirs + i + 1 ), %PATH_EXT ))
FileListType(lDirs + i + 1) = %ft_File
Next i
EndIf

EndIf

XXX.First = 1 ' fresh read list, so Element 1 is displayed in first row
XXX.Count = UBound(FileListFile) ' altogether there are this many in list
XXX.Slctd = %NO_ITEM ' kill old selection since list has changed


End Sub


Sub Draw_FileList()

Local i As Long
Local lStart, lLen, lEnd As Double
TBGL_SetWindowTitle(hWnd,"DRAW")

' calculate top and height of scrollbar
lLen = 16 * XXX.Extra / XXX.Count
lStart = lLen * (XXX.First - 1)
lEnd = lStart + (XXX.Extra + 1) * lLen
' shape it down so it doesnt exceed height of all lines
If lEnd > 16 * XXX.Extra Then lEnd = 16 * XXX.Extra
' draw scrollbar
TBGL_Color 192, 192, 192 ' slider
TBGL_Rect XXX.X2 - 16, XXX.Y1 + lStart, XXX.X2, XXX.Y1 + lEnd
TBGL_Color 128, 128, 128 ' back
TBGL_Rect XXX.X2 - 16, XXX.Y1, XXX.X2, XXX.Y1 + 16 * XXX.Extra


For i = 0 To XXX.Extra - 1
' draw all items in list
If i + XXX.First <= XXX.Count And XXX.First > 0 Then
TBGL_Color 200, 200, 220
TBGL_SetActiveFont %fSymbols
TBGL_PrintFont Chr$(FileListType(i + XXX.First)), XXX.X1, XXX.Y1 + 16 * i + 12
TBGL_SetActiveFont %fSmall
TBGL_PrintFont FileListFile(i + XXX.First), XXX.X1 + 16, XXX.Y1 + 16 * i + 12
EndIf

If i = XXX.Slctd Then
' highlight the selected item
TBGL_Color 128, 64, 96
TBGL_Rect XXX.X1 , XXX.Y1 + i * 16, XXX.X2 - 16, XXX.Y1 + i * 16 + 16
' actual we are drawing underneath the font,
' curios, isn't it?
EndIf

Next i



End Sub

Sub Check_Mouse()

Local i, mW, mY As Long
Static last As Long ' store left mousebutton-state

TBGL_SetWindowTitle(hWnd,"Mouse1a")


mW = TBGL_MouseGetWheelDelta ' store since can read just once per frame

If TBGL_MouseGetLButton Then
Select Case last
Case 0, 3 ' if was not or went up
last = 1 ' it's down
Case Else
last = 2 ' its hold
End Select
Else
Select Case last
Case 1, 2 ' if was down or hold
last = 3 ' its up
Case Else
last = 0 ' its not
End Select
EndIf

TBGL_SetWindowTitle(hWnd,"Mouse1b")

mY = TBGL_MouseGetPosY
' store that to mY for a second so it does NOT CHANGE for sure


TBGL_SetWindowTitle(hWnd,"Mouse2")

' ===========================================================

If Between(mY , XXX.Y1, XXX.Y2) Then
' (.Y1 = 0,.Y2 = 511)
' ===========================================================




TBGL_SetWindowTitle(hWnd,"Mouse3a")

If mW < 0 Then ' mousewheel-action
If XXX.First + XXX.Extra < XXX.Count Then XXX.First += 1
ElseIf mW > 0 Then
If XXX.First > 1 Then XXX.First -= 1
EndIf

TBGL_SetWindowTitle(hWnd,"Mouse3b")

If TBGL_MouseGetPosX < XXX.X2 - 16 Then ' 16=Scrollbar-Width
' the mouse is not over the scroll-bar-area on the right
' so it points somewhere on the text-area
i = mY / 16 ' 16=height of rows
' i = row where mouse points now


' if we're below, limit to the maximum row:
If i >= XXX.Extra Then i = XXX.Extra - 1

If i >= 0 And i < XXX.Count Then
' i is in range of displayed rows
' so selected row for explorer-control is i
XXX.Slctd = i
Else
XXX.Slctd = %NO_ITEM
EndIf

EndIf

If last = 1 Then doSomething() ' on Mouse_down do sub click()

Else
'mouse points ot of range
XXX.Slctd = %NO_ITEM
EndIf


End Sub

Sub doSomething()
' this is just the click-event on explorer-control
'
Local i, lLen As Long

TBGL_SetWindowTitle(hWnd,"Click")

If Between(TBGL_MouseGetPosY, XXX.Y1, XXX.Y2 ) Then

' we are inside list for sure
If TBGL_MouseGetPosX < XXX.X2 - 16 Then ' we're not on scrollbar

If XXX.Slctd < 0 Then Exit Sub ' selected item is outside range

i = XXX.First + XXX.Slctd ' i=index of filelistitem

' now select type of that clicked list-element

Select Case FileListType(i)
Case %ft_Volume
fileListDepth = 1
fileListPath = Drive(i - 1).Letter
' (i-1) is because in this case the first item is "my computer"
' and the second filelist-item is the first Drive()...
Case %ft_Up
' go to parent-folder
If FileListDepth = 1 Then
FileListDepth = 0
Else
For i = Len(FileListPath) - 1 To 1 Step - 1
If Mid$(FileListPath, i, 1) = "\" Then
FileListPath = LEFT$(FileListPath, i)
FileListDepth -= 1
Exit For
EndIf
Next i
EndIf
Case %ft_SubDir
FileListPath = FileListPath + FileListFile(i) + "\"
fileListDepth += 1
End Select
' read in this folder:
Get_FileList

Else
' click on scrollbar
lLen = (16 * XXX.Extra) / XXX.Count
XXX.First = TBGL_MouseGetPosY / lLen

If XXX.First + XXX.Extra > XXX.Count Then
XXX.First = XXX.Count - XXX.Extra
ElseIf XXX.First < 1 Then
XXX.First = 1
EndIf

EndIf

EndIf

End Sub

'------------------------------------------------

EDIT: [OT] Hey, the forum doesn't display anymore if anyone has read this at all. Could at least just show some number... :( ...and Forums front page doesn't tell me if any of my friends were online today...

Petr Schreiber
18-02-2013, 16:31
Hi Rene,

I can confirm the script above produces multiple kinds of issues.

Issue #1
I noticed that when program starts, and I click the scrollbar (gray thing on the right), I get "Subscript out of range in array or matrix on line 248". It is correct, because the line is:


TBGL_PrintFont Chr$(FileListType(i + XXX.First)), XXX.X1, XXX.Y1 + 16 * i + 12


... and the index passed to FileListType is negative, because XXX.First is negative. But that is a problem in algorithm I think.

Issue #2
Start the program, click on any place inside the window, and then move the cursor to window title, you will get "IF without END IF". Here I am not sure about the reason. Maybe it could be some issue in combining single line and multiline IF/ENDIFs, but I am not sure yet.


Petr

ReneMiner
18-02-2013, 16:54
Hi Rene,

Issue #2
Start the program, click on any place inside the window, and then move the cursor to window title, you will get "IF without END IF". Here I am not sure about the reason. Maybe it could be some issue in combining single line and multiline IF/ENDIFs, but I am not sure yet.


Petr

thats what I mean-somehow there is no if without endif. it just occurs if window was clicked before, so the doSomething()-Sub ran through once. But I get this message in other scripts as well, this is just the smallest one which I can post. Same happens in display-list-tinker where it ran perfect in november last year...
I'm gonna check the first issue: but there at least I get the correct Error-description.

EDIT: I don't find where XXX.First gets a negative value from, I already changed the code to make sure it's > 0

but I found something else:

change Lines in Sub Draw_Filelist() to see slider on the scrollbar to this order to see the slider



TBGL_Color 192, 192, 192 ' slider
TBGL_Rect XXX.X2 - 16, XXX.Y1 + lStart, XXX.X2, XXX.Y1 + lEnd
TBGL_Color 128, 128, 128 ' back
TBGL_Rect XXX.X2 - 16, XXX.Y1, XXX.X2, XXX.Y1 + 16 * XXX.Extra


' and the line around 240 reads now:

If i + XXX.First <= XXX.Count And XXX.First > 0 Then




Now the If-Endif occures if mouse moves out to the sides too.


Why does stuff in front always draw to the back ???

Petr Schreiber
18-02-2013, 17:24
Hi Rene,

I found the cause of weird IF/END IF error. When you change line 340 in Check_Mouse() routine from this:


If last = 1 Then doSomething ' on Mouse_down do sub click()


to this:


If last = 1 Then doSomething() ' on Mouse_down do sub click()


or this:


If last = 1 Then
doSomething ' on Mouse_down do sub click()
End If


The error disappears. But it is strange indeed.

During the testing I found and issue which might be the cause of this behavior, see here:
http://www.thinbasic.com/community/project.php?issueid=382


Petr

Petr Schreiber
18-02-2013, 17:29
Why does stuff in front always draw to the back ???

Because the default depth function used is %GL_LESS - it allows to discard fragments of 3D geometry fast. For 2D it is not as suitable, in such a case please use this for draw dependent order with this:


TBGL_DepthFunc(%TBGL_ALWAYS)



Petr

ReneMiner
18-02-2013, 17:54
so then there should be the rule that Sub- and Function-Calls have always to be followed by parens, even if the function doesn't have any arguments to avoid that in the future... Compiler should complain - if parens are omitted - by default.
(Optional it could be possible to disable this or it could be combined with MinVersion-setting for older scripts)

It's - by the way - forcing the reader to recognize that "doSomething" actually is some sub or function.
Thanx for your help again.

ErosOlmi
18-02-2013, 22:17
I'm checking this problem
:oops:

ReneMiner
27-04-2013, 12:15
I add this here because it's about parenthesis too.

I experienced lately the following:

Usually it's valid to call some sub or function without parenthesis. But as you see in this example below it's no good idea to omit parenthesis at all.
This example runs because RGB is also valid with just one parameter, but returns wrong result for "Red". Sometimes - with other Functions as TBGL_Rect or whatever, it throws Error (expected ,) if the first parameter gets calculated somehow as shown in example (DWord Red =...) starting with some parenthesis in calculation.



Uses "Console"

DWord Blue = Rgb 0, 0, (3 + 4) * 30
DWord Test = Rgb 0, 0, 210

PrintL "Blue :" + Str$(Blue)
PrintL "Test :" + Str$(Test)

WaitKey

DWord Green = Rgb 0, (3 + 4) * 30, 0
Test = Rgb 0, 210, 0

PrintL "Green:" + Str$(Green)
PrintL "Test :" + Str$(Test)

WaitKey

DWord Red = Rgb (3 + 4) * 30, 0, 0
Test = Rgb 210, 0, 0

PrintL "Red :" + Str$(Red)
PrintL "Test :" + Str$(Test)

WaitKey

Red = Rgb( (3 + 4) * 30, 0, 0 )
PrintL "re-check"
PrintL "Red :" + Str$(Red)

WaitKey