Console Mouse function

[WayneA]

Example:

Code Select Expand

/* I don't advise using code from this app other than the mouse handling functionality..
This was written only to be an example for practical application of using a mouse in a console app..
The usage of a dictionary was a dirty hack that didnt work out as planned and ReadLine is a similar story.
fun fact, the generated assembly for this app is less than 1kb bigger than the exe
*/
$Include "windows.inc"
AutoDefine "Off"
TypeDef Dictionary Pointer
Type INPUT_RECORD,1
Dim EventType As Word
Dim two_byte_alignment[2] As Char
Union
Dim KeyEvent As KEY_EVENT_RECORD
Dim MouseEvent As MOUSE_EVENT_RECORD
Dim WindowBufferSizeEvent As WINDOW_BUFFER_SIZE_RECORD
Dim MenuEvent As MENU_EVENT_RECORD
Dim FocusEvent As FOCUS_EVENT_RECORD
EndUnion
EndType
Declare Import,ReadConsoleInputA(hConsoleInput As UInt,lpBuffer As Input_Record,nLength As UInt,lpNumberOfEventsRead As UInt ByRef),Int
Dim readFile=NthField(_GetCommandLine()," ",1,True) As String
'Dim readFile=GetStartPath+"Read.a" As String
Dim rFile As BFile
Dim Pos=0 As Int64
Dim LineCount=1,x,y,NeedSpaces,PageCount=0,LastPage=False As Int
Dim PastPages=DictCreate() As Dictionary
_SetConsoleTitle(readFile)
Color 1,7
If OpenFile(rFile,readFile,"R")=0 Then
EnableMouseInput()
Do
If LineCount<25 Then
Locate LineCount,1
If EoF(rFile)=0 Then
NeedSpaces=0
Print ReadLine(rFile,Pos,NeedSpaces)
Locate LineCount,NeedSpaces
Print Space$(81-NeedSpaces)
Else
Print Space$(80)
EndIf
LineCount++
ElseIf LineCount=25 Then
Color 0,1
Locate 25,1
Print "Back",Space$(36),"Quit",Space$(32),"Next",
Color 1,7
Locate 1,1
LineCount++
ElseIf LineCount=26 Then
If GetLastConsoleClick(x,y) Then
If (x>=76 And x<=80) And y=25 And (Pos<Len(rFile)) Then 'Next
LineCount=0
PageCount++
DictAdd(PastPages,Str$(PageCount),Str$(Pos))
ElseIf (x>=1 And x<=5) And y=25 And PageCount>0 Then 'Back
LineCount=1
PageCount--
Pos=Val(DictLookup(PastPages,Str$(PageCount)))
If PageCount=0 Then Pos=0
DebugPrint Str$(Pos)
ElseIf (x>=40 And x<=45) And y=25 Then 'Quit
CloseFile rFile
DictFree PastPages
End
EndIf
'_SetConsoleTitle(Str$(Pos))
EndIf
_Sleep(1)
EndIf
Until False
EndIf

Sub ReadLine(aFile As BFile,Position As UInt64 ByRef,LineLen As Int ByRef),String
Dim LineBuffer=Space$(80) As String
Dim LFPos=0,CRPos=0,LineEndPos=0,TabSpot=0,EoB=81 As Int
Seek aFile,Position
DebugPrint "" 'This is the most benign thing i could put here. If there isnt SOME compilable code here, the damned app wont work.
  'Doesn't seem to matter what. Can be a debug command that will be ignored when not compiled as debug or a function call ect... Compiler bug?
If Len(aFile)-80<=Position Then EoB=(Len(aFile)-Position)-1
If __Read(aFile,LineBuffer,80)=0 Then
LineBuffer[EoB]=0
LFPos=InStr(LineBuffer,"\x0A")
CRPos=InStr(LineBuffer,"\x0D")
If (CRPos>0 And CRPos<LFPos) Then LineEndPos=CRPos
If (LFPos>0 And LFPos<CRPos) Then LineEndPos=LFPos
Do
TabSpot=InStr(LineBuffer,"\x09")
If TabSpot>0 Then LineBuffer[TabSpot-1]=32
Until TabSpot=0
If LineEndPos>0 Then
LineBuffer[LineEndPos]=0
LineLen=Len(LineBuffer)
Position+=LineLen-1
If CRPos>0 Then Position++
If LFPos>0 Then Position++
If Position>Len(aFile) Then Position=Len(aFile)
Seek aFile,Position
Return LineBuffer
Else
LineLen=EoB+1
Position+=EoB
If Position>Len(aFile) Then Position=Len(aFile)-1
Seek aFile,Position
Return LineBuffer
EndIf
Else
MessageBox null,"Error Reading File!","Error"
EndIf
Return ""
EndSub

Sub EnableMouseInput(),Int
Return _SetConsoleMode(_GetStdHandle(STD_INPUT_HANDLE),ENABLE_MOUSE_INPUT)
EndSub

Sub GetLastConsoleClick(x As Int ByRef,y As Int ByRef),Int
Dim input_buffer As INPUT_RECORD
Dim input_read,hConsole As Int
hConsole=_GetStdHandle(STD_INPUT_HANDLE)
If hConsole<>INVALID_HANDLE_VALUE Then
If ReadConsoleInputA(hConsole,input_buffer,1,input_read) Then
If input_read>0 Then
If input_buffer.EventType=MOUSE_EVENTC Then
If input_buffer.MouseEvent.dwButtonState=FROM_LEFT_1ST_BUTTON_PRESSED
x=input_buffer.MouseEvent.dwMousePosition.X+1
y=input_buffer.MouseEvent.dwMousePosition.Y+1
Return True
EndIf
EndIf
EndIf
EndIf
EndIf
Return False
EndSub

Sub NthField(Source As String,Delimiter As Char,fieldNum As Int,Opt quotes=False As Int),Heap
Dim rString As Pointer
Dim pos,field,quote As Int
field=0
rString=AllocHeap(Len(Source)+1)
quote=False
SetType rString,String
If InStr(Source,Chr$(Delimiter))=0 Then Return ""
For pos=0 To Len(Source)-1
If quotes=True And Source[pos]=34 Then
quote=(quote=False)
Else
If Source[pos]=Delimiter And quote=False Then
If field=fieldNum Then Return #rString
field++
#rString=""
Else
#rString+=Source[pos]
EndIf
EndIf
Next pos
Return #rString
EndSub

Just the good stuff:

Code Select Expand

$Include "windows.inc"
Type INPUT_RECORD,1
Dim EventType As Word
Dim two_byte_alignment[2] As Char
Union
Dim KeyEvent As KEY_EVENT_RECORD
Dim MouseEvent As MOUSE_EVENT_RECORD
Dim WindowBufferSizeEvent As WINDOW_BUFFER_SIZE_RECORD
Dim MenuEvent As MENU_EVENT_RECORD
Dim FocusEvent As FOCUS_EVENT_RECORD
EndUnion
EndType
Declare Import,ReadConsoleInputA(hConsoleInput As UInt,lpBuffer As Input_Record,nLength As UInt,lpNumberOfEventsRead As UInt ByRef),Int

Sub GetLastConsoleClick(x As Int ByRef,y As Int ByRef),Int
Dim input_buffer As INPUT_RECORD
Dim input_read,hConsole As Int
hConsole=_GetStdHandle(STD_INPUT_HANDLE)
If hConsole<>INVALID_HANDLE_VALUE Then
If ReadConsoleInputA(hConsole,input_buffer,1,input_read) Then
If input_read>0 Then
If input_buffer.EventType=MOUSE_EVENTC Then
If input_buffer.MouseEvent.dwButtonState=FROM_LEFT_1ST_BUTTON_PRESSED
x=input_buffer.MouseEvent.dwMousePosition.X+1
y=input_buffer.MouseEvent.dwMousePosition.Y+1
Return True
EndIf
EndIf
EndIf
EndIf
EndIf
Return False
EndSub

Sub EnableMouseInput(),Int
Return _SetConsoleMode(_GetStdHandle(STD_INPUT_HANDLE),ENABLE_MOUSE_INPUT)
EndSub