Jump to content

Dan's misc. Scripts


Recommended Posts

Hi, here ill post some of my scripts, which are less or more useful. 

To begin with, here is an HTML unescape script. It converts the %20%5D%5B chars into readable text.

It tries to detect if the 2 chars after % are valid, but not for every case.  

 

#include <GuiEdit.au3>
#include <Misc.au3>
#include <ButtonConstants.au3>
#include <EditConstants.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>

Local $x, $y, $hf, $file
Local $tmpclip = ""
Global $aFont
Dim $aFont[8]
Global $f_Italic, $f_Strikethru, $f_Underline

#Region ### START Koda GUI section ### Form=
$Form1 = GUICreate("Unescape tool", 620, 470, -1, -1, BitOR($GUI_SS_DEFAULT_GUI, $WS_SIZEBOX, $WS_THICKFRAME), $WS_EX_ACCEPTFILES)
Global $Edit1 = GUICtrlCreateEdit("", 1, 47, 305, 419)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKBOTTOM)
Global $Edit2 = GUICtrlCreateEdit("", 311, 47, 305, 419)
GUICtrlSetResizing(-1, $GUI_DOCKBORDERS)
$Button1 = GUICtrlCreateButton("Open", 1, 1, 53, 44)
GUICtrlSetResizing(-1, $GUI_DOCKALL)
$Button2 = GUICtrlCreateButton("Unescape", 215, 1, 91, 44)
GUICtrlSetResizing(-1, $GUI_DOCKALL)
$Button3 = GUICtrlCreateButton("Save", 311, 1, 53, 44)
GUICtrlSetResizing(-1, $GUI_DOCKALL)
$Button4 = GUICtrlCreateButton("Clear", 56, 1, 53, 44)
GUICtrlSetResizing(-1, $GUI_DOCKALL)
$Button5 = GUICtrlCreateButton("Paste", 155, 1, 53, 44)
GUICtrlSetResizing(-1, $GUI_DOCKALL)
GUISetState(@SW_SHOW)
$ButtonFont = GUICtrlCreateButton("Font", 111, 1, 43, 21)
GUICtrlSetResizing(-1, $GUI_DOCKALL)
#EndRegion ### END Koda GUI section ###

_GUICtrlEdit_SetLimitText($Edit1, 256000)
_GUICtrlEdit_SetLimitText($Edit2, 256000)

SetInitFont()

$fn = @ScriptDir

While 1
    $nMsg = GUIGetMsg()
    Switch $nMsg
        Case $GUI_EVENT_CLOSE
            Exit
        Case $Button1
            $fn = FileOpenDialog("Open a text file", $fn, "All (*.*)", $FD_PROMPTOVERWRITE)
            If $fn <> "" Then
                FOP($fn)
            EndIf
        Case $Button2
            Unescape(GUICtrlRead($Edit1))
        Case $Button3
            $fn = FileSaveDialog("Save as a text file", $fn, "All (*.*)")
            If $fn <> "" Then
                FSA($fn)
            EndIf
        Case $Button4
            GUICtrlSetData($Edit1, "")
            GUICtrlSetData($Edit2, "")
        Case $Button5
            $tmpclip = ClipGet()
            If @error = 0 Then GUICtrlSetData($Edit1, $tmpclip & @CRLF, 1)
            $tmpclip = ""
        Case $ButtonFont
            $aFont = _ChooseFont($aFont[2], $aFont[3], $aFont[5], $aFont[4], $f_Italic, $f_Underline, $f_Strikethru, $Form1)
            If $aFont <> -1 Then
                GUICtrlSetFont($Edit1, $aFont[3], $aFont[4], $aFont[1], $aFont[2])
                GUICtrlSetColor($Edit1, $aFont[7])
                GUICtrlSetFont($Edit2, $aFont[3], $aFont[4], $aFont[1], $aFont[2])
                GUICtrlSetColor($Edit2, $aFont[7])
                $f_Italic = BitAND($aFont[1], 2)
                $f_Underline = BitAND($aFont[1], 4)
                $f_Strikethru = BitAND($aFont[1], 8)
            EndIf
    EndSwitch
WEnd


Func FOP($fn)            ;FileOpen
    $hf = FileOpen($fn, 0)
    $file = FileRead($hf)
    FileClose($fn)
    GUICtrlSetData($Edit1, $file)
    Unescape($file)
    $file = ""
EndFunc   ;==>FOP

Func Unescape($txt)

    Local $y = 1, $quit = 0, $dn, $SR
    Local $rp = ""
    Do
        $y = StringInStr($txt, "%", 0, 1, $y)            ;Get the start position of the first %
        If $y > 0 Then
            $rp = StringMid($txt, $y, 3)                ;Get the string to be replaced e.g. %20 or %5D
            $SR = StringRight($rp, 2)                   ;Remove the % from the $RP
            $dn = Dec($SR)
            If @error = 0 Then                          ;Check if it is a valid binary (hex) number.
                If $SR = 25 Then $y = $y + 1
                $txt = StringReplace($txt, $rp, Chr($dn), 0, 0)                ;Replace all occurences of eg %20 with Chr(32)  Hex(20)=Dec 32
            Else
                $y = $y + 1                             ;If not, increase the search start position
            EndIf
        EndIf
    Until $y = 0

    _GUICtrlEdit_BeginUpdate($Edit2)
    GUICtrlSetData($Edit2, "")
    GUICtrlSetData($Edit2, $txt, 1)
    _GUICtrlEdit_EndUpdate($Edit2)
    $txt = ""
EndFunc   ;==>Unescape

Func FSA($fn)                ;FileSave
    $hf = FileOpen($fn, 2)
    FileWrite($hf, GUICtrlRead($Edit2))
    FileClose($fn)
EndFunc   ;==>FSA

Func CW($txt, $crlf = 1)  ;For debugging
    Local $nl = ""
    If $crlf = 1 Then $nl = @CRLF
    ConsoleWrite($txt & $nl)
EndFunc   ;==>CW

Func SetInitFont()
    ;Default font definition
    $aFont[1] = "0"
    $aFont[2] = "Terminal"
    $aFont[3] = "9"
    $aFont[4] = "400"
    $aFont[7] = "0"

    $f_Italic = BitAND($aFont[1], 2)
    $f_Underline = BitAND($aFont[1], 4)
    $f_Strikethru = BitAND($aFont[1], 8)
    GUICtrlSetFont($Edit1, $aFont[3], $aFont[4], $aFont[1], $aFont[2], 0)
    GUICtrlSetColor($Edit1, $aFont[7])
    GUICtrlSetFont($Edit2, $aFont[3], $aFont[4], $aFont[1], $aFont[2], 0)
    GUICtrlSetColor($Edit2, $aFont[7])
EndFunc   ;==>SetInitFont

The Gui has two edit boxes.

You can Load a Text file or paste a text from the clipboard into the left box.

Loading something will automatically convert it, while pasting will not. The result is displayed in the right box, which is resizeable.

The text from the right box can be saved, if needed.

Optionally the font for both boxes can be changed (same for both), but not saved.

Edited by Dan_555
Link to post
Share on other sites
  • 2 weeks later...

With autoit, it is easy to write some small tools, just like this one.

It is a Scratchpad or Notepad which does not have any saving abilities.

Therefore  you can copy and paste into it and discard the changes without ever being asked, if you want to save them.

#NoTrayIcon
#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_Outfile=Simple_Scratchbook.exe
#AutoIt3Wrapper_Outfile_x64=Simple_Scratchbook_x64.exe
#AutoIt3Wrapper_Compression=4
#AutoIt3Wrapper_UseX64=y
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
#include <ButtonConstants.au3>
#include <EditConstants.au3>
#include <GuiEdit.au3>
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <Misc.au3>


Global $closecounter = 0, $TimeHandle=TimerInit(), $TimeDiff=TimerDiff($TimeHandle)
Global $formTitle="Simple Scratchbook"

#Region ### START Koda GUI section ### Form=
$Form1 = GUICreate($formTitle, 616, 440, 208, 165, BitOR($GUI_SS_DEFAULT_GUI, $WS_MAXIMIZEBOX, $WS_SIZEBOX, $WS_THICKFRAME, $WS_TABSTOP))
$Edit1 = GUICtrlCreateEdit("", 3, 30, 610, 406, -1, 0)
GUICtrlSetData(-1, "")
GUICtrlSetResizing(-1, $GUI_DOCKTOP)
$ButtonCLS = GUICtrlCreateButton("Clear", 2, 0, 33, 21)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKHEIGHT)
$ButtonCLSPASTE = GUICtrlCreateButton("Clear and Paste", 110, 0, 86, 21)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKHEIGHT)
$ButtonPaste = GUICtrlCreateButton("Paste", 45, 0, 54, 21)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKHEIGHT)
$ButtonCopy = GUICtrlCreateButton("Copy", 210, 0, 49, 21)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKHEIGHT)
$ButtonCopyALL = GUICtrlCreateButton("CopyAll", 262, 0, 54, 21)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKHEIGHT)
$ButtonUndo = GUICtrlCreateButton("Undo", 325, 0, 40, 21)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKHEIGHT)
$ButtonFont = GUICtrlCreateButton("Font", 365, 0, 40, 21)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKHEIGHT)
$CheckLock = GUICtrlCreateCheckbox("Read only", 474, 0, 65, 16)
GUICtrlSetResizing(-1, $GUI_DOCKLEFT + $GUI_DOCKTOP + $GUI_DOCKWIDTH + $GUI_DOCKHEIGHT)
GUISetState(@SW_SHOW)
#EndRegion ### END Koda GUI section ###

GUISetState(@SW_SHOW)

While 1
    If $closecounter = 1 And TimerDiff($TimeHandle) > 1000 Then
        $closecounter = 0
        WinSetTitle ($Form1,"",$formTitle)
    EndIf
    $nMsg = GUIGetMsg()
    Switch $nMsg
        Case $GUI_EVENT_CLOSE
            If $closecounter = 1 Then
                If TimerDiff($TimeHandle) <= 1000 Then
                    Exit
                EndIf
            EndIf
            If $closecounter = 0 Then
                $closecounter = 1
                $TimeHandle = TimerInit()
                WinSetTitle ($Form1,"","Doubleclick to close")
            EndIf

        Case $ButtonCLS
            ControlSetText("", "", $Edit1, "")
        Case $ButtonCLSPASTE
            ControlSetText("", "", $Edit1, "")
            Local $clp = ClipGet()
            ControlSetText("", "", $Edit1, $clp)
        Case $ButtonPaste
            ;Local $clp = ClipGet()
            ControlFocus($Form1, "", $Edit1)
            Send("^v")
        Case $ButtonCopy
            ControlFocus($Form1, "", $Edit1)
            Send("^c")
        Case $ButtonCopyALL
            ClipPut(_GUICtrlEdit_GetText($Edit1))
        Case $ButtonUndo
            ;ControlFocus($Form1,"",$Edit1)
            ;Send("^z")
            _GUICtrlEdit_Undo($Edit1)
        Case $CheckLock
            If _IsChecked($CheckLock) = 1 Then
                GUICtrlSetStyle($Edit1, BitOR($ES_WANTRETURN, $WS_VSCROLL, $WS_HSCROLL, $ES_AUTOVSCROLL, $ES_AUTOHSCROLL, $ES_READONLY))
            Else
                GUICtrlSetStyle($Edit1, BitOR($ES_WANTRETURN, $WS_VSCROLL, $WS_HSCROLL, $ES_AUTOVSCROLL, $ES_AUTOHSCROLL))
            EndIf
        Case $ButtonFont
            $aFont = _ChooseFont("", "", "", "", "", "", "", $Form1)
            If $aFont <> -1 Then
                GUICtrlSetFont($Edit1, $aFont[3], $aFont[4], $aFont[1], $aFont[2])
                GUICtrlSetColor($Edit1, $aFont[7])
            EndIf
    EndSwitch
WEnd


Func _IsChecked($idControlID)
    Return BitAND(GUICtrlRead($idControlID), $GUI_CHECKED) = $GUI_CHECKED
EndFunc   ;==>_IsChecked

Useful if you need to reuse text a lot.

Or, do you need to compare a text code side by side ?

 

Anyway, this app does not save anything.

You can change the Font and you have copy, paste, clear, celar and paste, copy all and undo buttons.

Have fun.

Edited by Dan_555
Link to post
Share on other sites

I'm using "Ideal" to program in blitz basic language.

Ideal was not updated for a long time, and while it works perfectly, it has one bug.

While the is bug nothing serious, the built in error checking wants to report it, so a Message box is occasionally showing up, which can be clicked away.

Lately i wrote a script, which is clicking it away, automatically:

#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_Outfile=CloseIdealErrorWindow.exe
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
#include <Timers.au3>
#include <Misc.au3>

Global $pid

Opt("TrayAutoPause", 0)
Opt("TrayMenuMode", 3)
opt("TrayOnEventMode",1)

Local $idExit = TrayCreateItem("Exit")

TrayItemSetOnEvent ($idExit, "ExitIt" )

If FileExists(@ScriptDir & "\" & "Ideal.exe") Then $pid=ShellExecute("ideal.exe")

If _Singleton("CloseIdealErrorWindow", 1) = 0 Then Exit

TraySetToolTip("IDeal.exe helper tool")

While ProcessExists($pid)
    If WinExists("IDEal - Error Handler") Then
        WinActivate("IDEal - Error Handler")
        ControlClick("IDEal - Error Handler", "", 2, "Left")
        sleep (60)
        WinActivate("IDEal")
    EndIf
    Sleep(100)
WEnd

Func ExitIt()
    exit
EndFunc

Edit (1.1.2021): This should be used as a launcher for the Ideal.exe. 

Edited by Dan_555
Updated script, now exits when ideal.exe is closed
Link to post
Share on other sites

I'm not sure what you have asked, but if you want to save and load the font for the next time, then you can do it like this:

 

#include <GUIConstantsEx.au3>
#include <GuiEdit.au3>
#include <WindowsConstants.au3>
#include <Misc.au3>

Global $aFont, $bFont
Dim $aFont[8]    ;Font array definition
Dim $bFont[8]
Global $f_Italic, $f_Strikethru, $f_Underline

Global $snip_inidir = @ScriptDir, $snip_inifile = ""

If FileExists($snip_inidir) Then
    If StringRight($snip_inidir, 1) <> "\" Then $snip_inidir = $snip_inidir & "\"
EndIf

$snip_inifile = $snip_inidir & "editfontcfg.ini"


Global $Form1 = GUICreate("Fonttest", 307, 200, -1, -1, BitOR($GUI_SS_DEFAULT_GUI, $WS_MAXIMIZEBOX, $WS_SIZEBOX, $WS_THICKFRAME, $WS_TABSTOP))
Global  $ButtonFont = GUICtrlCreateButton("Font", 3, 2, 40, 17)
GUICtrlSetTip(-1, "Change the font of the edit field.")
Global $hEdit = GUICtrlCreateEdit("", 2, 20, 302, 176, BitOR($ES_WANTRETURN, $WS_VSCROLL, $WS_HSCROLL, $ES_AUTOVSCROLL, $ES_AUTOHSCROLL))

_GUICtrlEdit_SetLimitText($hEdit, 8765432)


GUISetState(@SW_SHOW)
GetIniFont($hEdit)

While 1
    $nMsg = GUIGetMsg()
    Switch $nMsg
        Case $GUI_EVENT_CLOSE
            Exit
        Case $ButtonFont
            SetFont($hEdit, $Form1, 1)
    EndSwitch

WEnd

Func SetFont($id, $formId, $nr = 0)
    For $x = 0 To 7
        $bFont[$x] = $aFont[$x]
    Next
    $aFont = _ChooseFont($aFont[2], $aFont[3], $aFont[5], $aFont[4], $f_Italic, $f_Underline, $f_Strikethru, $formId)
    If $aFont <> -1 Then
        ;  GUICtrlSetFont ( controlID, size [, weight [, attribute [, fontname [, quality]]]] )
        GUICtrlSetFont($id, $aFont[3], $aFont[4], $aFont[1], $aFont[2], 0)
        GUICtrlSetColor($id, $aFont[5])
        $f_Italic = BitAND($aFont[1], 2)
        $f_Underline = BitAND($aFont[1], 4)
        $f_Strikethru = BitAND($aFont[1], 8)
        SetIniFont($nr)
        ;ConsoleWrite(@CRLF & $aFont[3] & @CRLF & $aFont[4] & @CRLF & $aFont[1] & @CRLF & $aFont[2] & @CRLF & $aFont[5])
    Else
        Dim $aFont[8]            ;Font array definition
        For $x = 0 To 7
            $aFont[$x] = $bFont[$x]
        Next
    EndIf
EndFunc   ;==>SetFont

Func GetIniFont($id, $nr = 0)
    ;Default font definition
    $aFont[1] = IniRead($snip_inifile, "font", $nr & "1", "0")
    $aFont[2] = IniRead($snip_inifile, "font", $nr & "2", "Arial")
    $aFont[3] = IniRead($snip_inifile, "font", $nr & "3", "8")
    $aFont[4] = IniRead($snip_inifile, "font", $nr & "4", "400")
    $aFont[7] = IniRead($snip_inifile, "font", $nr & "7", "0")

    $f_Italic = BitAND($aFont[1], 2)
    $f_Underline = BitAND($aFont[1], 4)
    $f_Strikethru = BitAND($aFont[1], 8)
    GUICtrlSetFont($id, $aFont[3], $aFont[4], $aFont[1], $aFont[2], 0)
    GUICtrlSetColor($id, $aFont[7])
EndFunc   ;==>GetIniFont

Func SetIniFont($nr = 0)
    IniWrite($snip_inifile, "font", $nr & "1", $aFont[1])
    IniWrite($snip_inifile, "font", $nr & "2", $aFont[2])
    IniWrite($snip_inifile, "font", $nr & "3", $aFont[3])
    IniWrite($snip_inifile, "font", $nr & "4", $aFont[4])
    IniWrite($snip_inifile, "font", $nr & "7", $aFont[7])
EndFunc   ;==>SetIniFont

You can save the font for many different edit boxes, by changing the $nr.

(Save and later reuse some of the favorite fonts)

 

And the above code as an Include.

Include this file if you want an easy way to Set fonts for Edit boxes.

#include <Misc.au3>
Global $a_Font, $a_Fontc
Dim $a_Font[8]    ;Font array definition
Dim $a_Fontc[8]
Global $f_Italic, $f_Strikethru, $f_Underline
Global $f_inifile

; Remember to set the $f_inifile to the ini filename !
; $f_inifile="test.ini"!

Func SetFont($id, $h_gui, $nr = 0)
    for $x=0 to 7
    $a_Fontc[$x]=$a_Font[$x]
    Next
    $a_Font = _ChooseFont($a_Font[2], $a_Font[3], $a_Font[5], $a_Font[4], $f_Italic, $f_Underline, $f_Strikethru, $h_gui)
    If $a_Font <> -1 Then
        ;  GUICtrlSetFont ( controlID, size [, weight [, attribute [, fontname [, quality]]]] )
        GUICtrlSetFont($id, $a_Font[3], $a_Font[4], $a_Font[1], $a_Font[2], 0)
        GUICtrlSetColor($id, $a_Font[5])
        $f_Italic = BitAND($a_Font[1], 2)
        $f_Underline = BitAND($a_Font[1], 4)
        $f_Strikethru = BitAND($a_Font[1], 8)
        SaveIniFont($nr)
        ;ConsoleWrite(@CRLF & $a_Font[3] & @CRLF & $a_Font[4] & @CRLF & $a_Font[1] & @CRLF & $a_Font[2] & @CRLF & $a_Font[5])
    Else
        Dim $a_Font[8]    ;Font array definition
            for $x=0 to 7
            $a_Font[$x]=$a_Fontc[$x]
    Next
    EndIf
EndFunc   ;==>SetFont

Func GetIniFont($id, $nr = 0)
    ;Default font definition
    $a_Font[1] = IniRead($f_inifile, "font", $nr & "1", "0")
    $a_Font[2] = IniRead($f_inifile, "font", $nr & "2", "Arial")
    $a_Font[3] = IniRead($f_inifile, "font", $nr & "3", "8")
    $a_Font[4] = IniRead($f_inifile, "font", $nr & "4", "400")
    $a_Font[7] = IniRead($f_inifile, "font", $nr & "7", "0")

    $f_Italic = BitAND($a_Font[1], 2)
    $f_Underline = BitAND($a_Font[1], 4)
    $f_Strikethru = BitAND($a_Font[1], 8)
    GUICtrlSetFont($id, $a_Font[3], $a_Font[4], $a_Font[1], $a_Font[2], 0)
    GUICtrlSetColor($id, $a_Font[7])
EndFunc   ;==>GetIniFont

Func SaveIniFont($nr = 0)
    IniWrite($f_inifile, "font", $nr & "1", $a_Font[1])
    IniWrite($f_inifile, "font", $nr & "2", $a_Font[2])
    IniWrite($f_inifile, "font", $nr & "3", $a_Font[3])
    IniWrite($f_inifile, "font", $nr & "4", $a_Font[4])
    IniWrite($f_inifile, "font", $nr & "7", $a_Font[7])
EndFunc   ;==>SetIniFont

$f_inifile should be set to a desired ini filename in the main program !

You can have multiple edit fields with different fonts. 

Use $nr with a number to Get/Set different font options. 

Edited by Dan_555
Link to post
Share on other sites
On 9/9/2020 at 1:27 AM, Dan_555 said:

Lately i wrote a script, which is clicking it away, automatically:

Slight nitpick, you can use TrayOnEvent instead of making your own Sleep function which checks for tray messages :)

EasyCodeIt - A cross-platform AutoIt implementation - Fund the development! (GitHub will double your donations for a limited time)

DcodingTheWeb Forum - Follow for updates and Join for discussion

Link to post
Share on other sites
  • 1 month later...

I was toying around with GDI+, and got the idea to simplify the usage of it.

Here is the result: 

(p.s. example 01 contains flashing colors)

#include <GDIPlus.au3>
#include <GUIConstantsEx.au3>
#include <Timers.au3>
#include <String.au3>

Global $txtinfo[7]                    ;Array which holds the font settings
Global $guiQuit = 0


Global $hGUI = GUICreate("GDI+ test, click on x to continue", 400, 300)        ; Create GUI
GUISetState(@SW_SHOW)

$iMsgBoxAnswer = MsgBox(270388, "Flashing Colors", "One of the examples contains flashing Colors" & @CRLF & "Do you want to continue ?", 15)
If $iMsgBoxAnswer = 7 Then Exit ;No

Initialize()    ;Initialize GDI and Fonts

Example0()        ;Simple example program
Example1()
Example2()
Example3()

CleanUp()        ;Stop Gdi and free the ressources

;~ Func Template()
;~  $guiQuit = 0            ;Always reset the $guiQuit to 0
;~
;~  While Delay(40) = 0
;~  ;   If Delay(500) = 1 Then ExitLoop 2      ;Alternative: Frame limiter - Exit the "for" and "while" loops when the close button (x) has been pressed.
;~  WEnd
;~ EndFunc


Func Example0()
    $guiQuit = 0            ;Always reset the $guiQuit to 0
    Local $x = 0, $y = 1
    While Delay(40) = 0
        CLS("FFFFFF")
        If $y = 1 Then
            $x = $x + 2
            If $x > 370 Then $y = -$y
        Else
            $x = $x - 2
            If $x <= 0 Then $y = -$y
        EndIf
        Print("Test 01", 0, 0)
        Print("Hi", $x, 100)
    WEnd
EndFunc   ;==>Example0

Func Example1()
    $guiQuit = 0            ;Always reset the $guiQuit to 0
    Local $flip = -1            ;Flip colors

    While $guiQuit = 0

        For $x = 0 To 10

            $flip = -$flip
            If $flip = 1 Then
                CLS("FF0000")                    ;Clear the screen(window) in color red
            Else
                CLS("00FF00")                    ; -       ||                   -  Green
            EndIf


            Color("000000")                        ;Set font drawing color
            Font("Arial", 12 + ($x * 2))        ;Set a font (can be used outside the loop, too)
            Local $px = 40, $py = 110            ;Text coordinates
            Local $txt = "Hello world qg 1iIlL0Oo"        ;Text to draw/print

            outline($txt, $px, $py)                ;Output the text with an outline effect

            Color("000000")                        ;Set font drawing color
            Font("Arial", 10)                    ;Set a font (can be used outside the loop, too)
            Print("Font test", 0, 0)               ;Print a normal text on screen

            ; Loop until the user exits.

            If Delay(500) = 1 Then ExitLoop 2      ;Frame limiter - Exit the "for" and "while" loops when the close button (x) has been pressed.
        Next
    WEnd
EndFunc   ;==>Example1

Func Example2()
    $guiQuit = 0            ;Always reset the $guiQuit to 0
    Local $spaces = _StringRepeat(" ", 35)
    Local $txt = $spaces & "Hi, this is a simple text scrolling test in Autoit3 with GDI+" & $spaces
    Local $x = 0

    Font("Arial", 32)
    Color("000000")

    While Delay(80) = 0
        CLS("0000FF")
        $x = $x + 1
        If $x >= StringLen($txt) Then $x = 0
        Print(StringMid($txt, $x, 40), 0, 100)

    WEnd
EndFunc   ;==>Example2

Func Example3()
    $guiQuit = 0            ;Always reset the $guiQuit to 0
    Local $spaces = _StringRepeat(" ", 15)
    Local $txt = $spaces & "And last example is an Outline text scrolling test in Autoit3 with GDI+, enjoy !" & $spaces
    Local $x = 0

    Font("Arial", 82)

    While Delay(60) = 0
        CLS("00cFcF")
        $x = $x + 1
        If $x >= StringLen($txt) Then $x = 0
        Color("ffffff")                        ;Define the Outline color, here
        outline(StringMid($txt, $x, 40), 0, 100)

    WEnd
EndFunc   ;==>Example3


Func Delay($nr)
    ; #include <Timers.au3>
    Local $varTS = _Timer_Init()
    While _Timer_Diff($varTS) < $nr
        If GUIGetMsg() = $GUI_EVENT_CLOSE Then               ;Check for the events.
            $guiQuit = 1
            ExitLoop                                        ;Stops the delaying loop
        EndIf
        Sleep(10)
    WEnd
    If $guiQuit = 1 Then Return 1
    Return 0
EndFunc   ;==>Delay

Func CleanUp()
    ; Clean up resources
    _GDIPlus_FontDispose($txtinfo[4])
    _GDIPlus_FontFamilyDispose($txtinfo[3])
    _GDIPlus_StringFormatDispose($txtinfo[2])
    _GDIPlus_BrushDispose($txtinfo[1])
    _GDIPlus_GraphicsDispose($txtinfo[0])
    _GDIPlus_Shutdown()
EndFunc   ;==>CleanUp

Func Initialize()
    _GDIPlus_Startup()                                                ;Startup GDI
    $txtinfo[0] = _GDIPlus_GraphicsCreateFromHWND($hGUI)            ;Create a Graphic object using the gui window
    $txtinfo[2] = _GDIPlus_StringFormatCreate()                        ;Create a string object
    Color("000000")                                                    ;Setup a default Brush/drawing color
    Font("Arial", 10)                                                ;Setup a default font
EndFunc   ;==>Initialize

Func outline($txt, $x, $y)
    For $lx = -1 To 1
        For $ly = -1 To 1
            Print($txt, $x + $lx, $y + $ly)
        Next
    Next
    Color("00FFFF")
    Print($txt, $x, $y)
EndFunc   ;==>outline

Func CLS($Rgb)
    _GDIPlus_GraphicsClear($txtinfo[0], "0xFF" & $Rgb)
EndFunc   ;==>CLS

Func Color($cstr = "000000", $cAlpha = "FF")
    $txtinfo[1] = _GDIPlus_BrushCreateSolid("0x" & $cAlpha & $cstr)
EndFunc   ;==>Color

Func Print($txt, $x, $y)
    $txtinfo[5] = _GDIPlus_RectFCreate($x, $y) ;, StringLen($txt)*$txtinfo[6], $txtinfo[6]*2)
    _GDIPlus_GraphicsDrawStringEx($txtinfo[0], $txt, $txtinfo[4], $txtinfo[5], $txtinfo[2], $txtinfo[1])
EndFunc   ;==>Print

Func Font($name, $size, $style = 2)
    ;Style numbers=
    ;0 - Normal weight or thickness of the typeface
    ;1 - Bold typeface
    ;2 - Italic typeface
    ;4 - Underline
    ;8 - Strikethrough

    $txtinfo[3] = _GDIPlus_FontFamilyCreate($name)
    $txtinfo[4] = _GDIPlus_FontCreate($txtinfo[3], $size, $style)
    $txtinfo[6] = $size
EndFunc   ;==>Font

This is all non double buffered, so a flickering may/will occur.

After the Gui has been created, (The gui needs to have the handle passed into the $hGui variable), use

Initialize() - to startup the GDI+ and to setup default color and font.

At the end of the script, use

CleanUp() - To free the resources used by the script. 

 

The available commands are:

CLS  ("000000")  -   Clears the screen in a color. The color is in RGB - Hex format.

Font(Name,Size) - Sets the font to use. The font name should be passed in double quotes, e.g.  "Arial" or "Terminal" ... etc. 

Color ("000000") - Sets the brush color in RGB - Hex format. Optionally, the alpha value "00"-"FF" can be set up, but it is predefined as "FF". 

Print ("Text",x,y) - Draws the text on the Gui window.

Delay(Milliseconds) - Wrapped-up the Sleep function to act as a delay. It sets the global $guiQuit variable to 1 if the x button was pressed.  See the examples on how it can be used. 

 

And the last one is only a helper function:

Outline ("text",x,y) - Draws a Text with borders. 

Enjoy.

Edited by Dan_555
Link to post
Share on other sites
  • 1 month later...

Hi, 

this is the "continuation" of the Script from my last post. It is a Script which should make it easy to write some Ascii/Text based games.


There are few new commands (description is in the sourcecode).

 

Save the code as

Ascii Game Framework (GDIP_AsciiGamework_include.au3)

;V 1.00
;Ascii Game Framework - include, written by Dan_555
;Use this to easily program some Ascii-Games
;
;Initialize(Height,Width,"windowname")  to startup the GDI+ and to setup default color and font.Defaults to 400x300 window
;CleanUp()                              To free the resources used by the script.
;
;The available commands are:
;
;CLS  ("000000")            Clears the screen in a color. The color is in RGB - Hex format.
;Font(Name,Size,[style])    Sets the font to use. The font name should be passed in double quotes, e.g.  "Arial" or "Terminal" ... etc.
;                           Read the function for the style explanation (bold, italic etc)
;Color ("000000")           Sets the brush color in RGB - Hex format. Optionally, the alpha value "00"-"FF" can be set up, but it is predefined as "FF".
;Print ("Text",x,y)         Draws the text on the Gui window.
;Delay(Milliseconds,[flip]) Wrapped-up the Sleep function to act as a delay.
;                           It sets the global $guiQuit variable to 1 if the x button was pressed.  See the examples on how it can be used.
;                           set flip to 0 if you want to use the Flip() function on your own
;KeyDown("Keyname")         Returns 1 if keyname e.g. "up" was pressed
;                           Available key names: Up,Down,Left,Right,Space,Ctrl,Alt,Shift,Enter,Lmouse,Rmouse,Mmouse,LShift,RShift,ESC
;Flip()                     Draws the buffer to the window (flips the backbuffer so that it becomes visible) use this at the end of the game loop.
;GetMouseCoords()           Used by the Delay function to set up the mouse coordinates into MouseX,MouseY,MouseGx,MouseGy variables.
;                           Use this only if you want to use a custom Delay function, set it at the beginning of the loop.
;
;And the last one is only a helper function:
;Outline ("text",x,y,[oc],[tc])                 Draws a Text with borders. oc= outline color, tc= text color in rgb format e.g. "ff2d13"
;
;Available Global variables:
;
;$gdip_GraphicX, $gdip_GraphicY                 Current Drawing size
;$mouseX, $mouseY, $mouseGX, $mouseGY           Mouse Coordinates x,y=Window based (-1,-1 if outside window) GX,GY= Displays coordinates past the Graphic area.
;                                               negative coordinates to the up and to the left side
;$h_GameGui                                     Game Window/gui handle
;$guiQuit                                       Used by the Delay Function to end the app.
;$h_User32DLL                                   Handle to the User32.dll (opened with Initialize, and closed with CleanUp functions)

#include <GDIPlus.au3>
#include <GUIConstantsEx.au3>
#include <Timers.au3>
#include <String.au3>
#include <Misc.au3>

#include <WinAPISys.au3>
#include <WindowsConstants.au3>
#include <Constants.au3>

Opt("GUICloseOnESC",0)

Global $a_txt_info[7]                       ;Array which holds the font settings
Global $guiQuit = 0                         ;check if x is pressed and set to 1 to quit (used by the delay function)
Global $v_GuiInitializeLock = 0
Global $gdip_backbuffer, $gdip_bitmap       ;Backbuffer and frontbuffer handles
Global $gdip_GraphicX, $gdip_GraphicY       ;Graphics Width and Height
Global $mouseX, $mouseY, $mouseGX, $mouseGY ;Mouse Coordinates x,y=Window based GX,GY= Uses the coordinate outside window
Global $h_GameGui                ;Game gui handle
Global $h_User32DLL            ;Keypress DLL (User32) handle

Func Delay($nr, $flip = 1)
    ; #include <Timers.au3>
    Local $varTS = _Timer_Init()
    While _Timer_Diff($varTS) < $nr
        If GUIGetMsg() = $GUI_EVENT_CLOSE Then               ;Check for the events.
            $guiQuit = 1
            ExitLoop                                        ;Stops the delaying loop
        EndIf
        Sleep(10)
    WEnd
    If $flip = 1 Then _GDIPlus_GraphicsDrawImageRect($a_txt_info[0], $gdip_bitmap, 0, 0, $gdip_GraphicX, $gdip_GraphicY) ;Draw the backbuffer to the screen
    GetMouseCoords()
    If $guiQuit = 1 Then Return 1
    Return 0
EndFunc   ;==>Delay

Func KeyDown($key = "")
    ;Available keys:
    ;Arrow Up,Down,Left,Right,Space,Ctrl,Alt,Shift,Enter,Lmouse,Rmouse,Mmouse,LShift,RShift,ESC
    If WinActive($h_GameGui) Then
        $key = StringLower($key)
        Switch $key
            Case "up"
                If _IsPressed("26") Then Return 1
            Case "down"
                If _IsPressed("28") Then Return 1
            Case "left"
                If _IsPressed("25") Then Return 1
            Case "right"
                If _IsPressed("27") Then Return 1
            Case "space"
                If _IsPressed("20") Then Return 1
            Case "ctrl"
                If _IsPressed("11") Then Return 1
            Case "alt"
                If _IsPressed("12") Then Return 1
            Case "shift"
                If _IsPressed("10") Then Return 1
            Case "enter"
                If _IsPressed("0D") Then Return 1
            Case "lmouse"
                If _IsPressed("01") Then Return 1
            Case "rmouse"
                If _IsPressed("02") Then Return 1
            Case "mmouse"
                If _IsPressed("04") Then Return 1
            Case "lshift"
                If _IsPressed("A0") Then Return 1
            Case "rshift"
                If _IsPressed("A1") Then Return 1
            Case "lctrl"
                If _IsPressed("A2") Then Return 1
            Case "rctrl"
                If _IsPressed("A3") Then Return 1
            Case "esc"
                If _IsPressed("1B") Then Return 1
        EndSwitch
    EndIf
    Return 0
EndFunc   ;==>KeyDown

Func CleanUp()
    If $v_GuiInitializeLock = 1 Then
        ; Clean up resources
        _GDIPlus_GraphicsDispose($gdip_backbuffer) ;Free the backbuffer
        _GDIPlus_FontDispose($a_txt_info[4])
        _GDIPlus_FontFamilyDispose($a_txt_info[3])
        _GDIPlus_StringFormatDispose($a_txt_info[2])
        _GDIPlus_BrushDispose($a_txt_info[1])
        _GDIPlus_GraphicsDispose($a_txt_info[0])
        _GDIPlus_Shutdown()
        DllClose($h_User32DLL)
    Else
        MsgBox(270384, "Cleanup Error", "Game GDI init was either not started" & @CRLF & "or allready cleaned up.", 10)
    EndIf
EndFunc   ;==>CleanUp

Func Initialize($x = 400, $y = 300, $gamename = "GDI+ test, click on x to continue")
    If $v_GuiInitializeLock = 0 Then
        If $x <= 0 Then $x = 400
        If $y <= 0 Then $y = 300
        $gdip_GraphicX = $x-1
        $gdip_GraphicY = $y-1

        $h_GameGui = _GUICreate($gamename, $gdip_GraphicX, $gdip_GraphicY)  ; Create GUI
        GUISetState(@SW_SHOW)
        $h_User32DLL = DllOpen("user32.dll")
        _GDIPlus_Startup()                                            ;Startup GDI
        $a_txt_info[0] = _GDIPlus_GraphicsCreateFromHWND($h_GameGui)        ;Create a Graphic object using the gui window
        $a_txt_info[2] = _GDIPlus_StringFormatCreate()                    ;Create a string object
        Color("000000")                                                ;Setup a default Brush/drawing color
        Font("Arial", 10)                                            ;Setup a default font
        $gdip_bitmap = _GDIPlus_BitmapCreateFromGraphics($gdip_GraphicX, $gdip_GraphicY, $a_txt_info[0])    ;Create bitmap object
        $gdip_backbuffer = _GDIPlus_ImageGetGraphicsContext($gdip_bitmap)     ;Create backbuffer
        $v_GuiInitializeLock = 1
    Else
        MsgBox(270384, "Initialize Error", "Game GDI was allready initialized", 10)
    EndIf

EndFunc   ;==>Initialize

Func outline($txt, $x, $y, $oc = "000000", $tc = "FFFFFF")
    ;$oc = Outline color
    ;$tc = Textcolor
    Local $oldcolor = StringMid($a_txt_info[1], 3, 6)
    Color($oc)
    For $lx = -1 To 1
        For $ly = -1 To 1
            Print($txt, $x + $lx, $y + $ly)
        Next
    Next
    Color($tc)
    Print($txt, $x, $y)
    Color($oldcolor)
EndFunc   ;==>outline

Func CLS($Rgb)
    _GDIPlus_GraphicsClear($gdip_backbuffer, "0xFF" & $Rgb)
EndFunc   ;==>CLS

Func Color($cstr = "000000", $cAlpha = "FF")
    _GDIPlus_BrushDispose($a_txt_info[1])
    $a_txt_info[1] = _GDIPlus_BrushCreateSolid("0x" & $cAlpha & $cstr)
EndFunc   ;==>Color

Func Print($txt, $x, $y)
    $a_txt_info[5] = _GDIPlus_RectFCreate($x, $y) ;, StringLen($txt)*$a_txt_info[6], $a_txt_info[6]*2)
    _GDIPlus_GraphicsDrawStringEx($gdip_backbuffer, $txt, $a_txt_info[4], $a_txt_info[5], $a_txt_info[2], $a_txt_info[1])
EndFunc   ;==>Print

Func Flip()                ;Draw the backbuffer to the screen, in case you want to use your own delay/sleep functions
    _GDIPlus_GraphicsDrawImageRect($a_txt_info[0], $gdip_bitmap, 0, 0, $gdip_GraphicX, $gdip_GraphicY) ;Draw the backbuffer to the screen
EndFunc   ;==>Flip

Func Font($name, $size, $style = 2)
    ;Style numbers=
    ;0 - Normal weight or thickness of the typeface
    ;1 - Bold typeface
    ;2 - Italic typeface
    ;4 - Underline
    ;8 - Strikethrough

    $a_txt_info[3] = _GDIPlus_FontFamilyCreate($name)
    $a_txt_info[4] = _GDIPlus_FontCreate($a_txt_info[3], $size, $style)
    $a_txt_info[6] = $size
EndFunc   ;==>Font

Func GetMouseCoords()        ;Call the function once in the main loop to get the mouse coordinates
    Local $a = GUIGetCursorInfo()
    If @error = 0 Then
        $mouseX = $a[0]
        $mouseY = $a[1]
        $mouseGX = $mouseX
        $mouseGY = $mouseY

        If ($mouseX < 0 Or $mouseX > $gdip_GraphicX) Or ($mouseY < 0 Or $mouseY > $gdip_GraphicY) Then
            $mouseX = -1
            $mouseY = -1
        EndIf
    Else
        ;If error return -2
        $mouseX = -2
        $mouseY = -2
        $mouseGX = -2
        $mouseGY = -2
    EndIf

EndFunc   ;==>GetMouseCoords

Func _WinSetClientPos($sTitle, $sText, $w, $h, $l = Default, $t = Default)
    ;Function code example from mat : https://www.autoitscript.com/forum/topic/154224-_winsetclientpos/
    Local Const $iDefStyle = BitOR($WS_MINIMIZEBOX, $WS_CAPTION, $WS_POPUP, $WS_SYSMENU)
    Local Const $iDefExStyle = $WS_EX_WINDOWEDGE

    Local $hWnd = WinGetHandle($sTitle, $sText)
    If @error Then Return SetError(1, 0, 0)

    Local $x = $l, $y = $t

    If IsKeyword($l) = $KEYWORD_DEFAULT Then $x = 100
    If IsKeyword($t) = $KEYWORD_DEFAULT Then $y = 100

    Local $iStyle = _WinAPI_GetWindowLong($hWnd, $GWL_STYLE)
    Local $iExStyle = _WinAPI_GetWindowLong($hWnd, $GWL_EXSTYLE)

    If $iStyle = -1 Then $iStyle = $iDefStyle
    If $iExStyle = -1 Then $iExStyle = $iDefExStyle

    Local $rect = DllStructCreate($tagRECT)
    DllStructSetData($rect, "left", $x)
    DllStructSetData($rect, "right", $x + $w)
    DllStructSetData($rect, "top", $y)
    DllStructSetData($rect, "bottom", $y + $h)

    If Not BitAND($iStyle, BitOR(BitAND($WS_CAPTION, BitNOT($WS_BORDER)), $WS_POPUP)) Then
        _WinAPI_AdjustWindowRectEx($rect, BitOR($iStyle, $WS_CAPTION), $iExStyle, False)
    Else
        _WinAPI_AdjustWindowRectEx($rect, $iStyle, $iExStyle, False)
    EndIf

    $w = DllStructGetData($rect, "right") - DllStructGetData($rect, "left")
    $h = DllStructGetData($rect, "bottom") - DllStructGetData($rect, "top")

    If BitAND($iStyle, $WS_VSCROLL) Then
        $w += _WinAPI_GetSystemMetrics($SM_CXVSCROLL)
    EndIf

    If BitAND($iStyle, $WS_HSCROLL) Then
        $h += _WinAPI_GetSystemMetrics($SM_CYHSCROLL)
    EndIf

    If IsKeyword($l) = $KEYWORD_DEFAULT Then
        $x = (@DesktopWidth - $w) / 2
    Else
        $x = DllStructGetData($rect, "left")
    EndIf

    If IsKeyword($t) = $KEYWORD_DEFAULT Then
        $y = (@DesktopHeight - $h) / 2
    Else
        $y = DllStructGetData($rect, "top")
    EndIf

    Return WinMove($hWnd, "", $x, $y, $w, $h)
Endfunc   ;==>_WinSetClientPos

Func _GUICreate($sTitle, $w, $h, $x = -1, $y = -1, $iStyle = -1, $iExStyle = -1, $hParent = 0)
    ;Function Code:mat (Autoit-Forum)
    Local $hRet = GUICreate($sTitle, $w, $h, $x, $y, $iStyle, $iExStyle, $hParent)

    If $x = -1 Then $x = Default
    If $y = -1 Then $y = Default

    _WinSetClientPos($hRet, "", $w, $h, $x, $y)

    Return $hRet
EndFunc   ;==>_GUICreate


;~ ;;Startup and en ding
;~ Initialize()    ;Initialize GDI and Fonts

;GameDemoTemplate()         ;Game Loop

;~ CleanUp()        ;Stop Gdi and free the ressources


;~ Func GameDemoTemplate()
;~  $guiQuit = 0            ;Always reset the $guiQuit to 0
;~
;~  While Delay(40) = 0
;~  ;   If Delay(500) = 1 Then ExitLoop 2      ;Alternative: Frame limiter - Exit the "for" and "while" loops when the close button (x) has been pressed.
;~  WEnd
;~ EndFunc

And here is an example Game:

#include "GDIP_AsciiGamework_include.au3"

;;Startup and ending
Initialize(380, 335)   ;Initialize GDI and Fonts

GameDemoTemplate()            ;Game Loop

CleanUp()        ;Stop Gdi and free the ressources


Func GameDemoTemplate()
    $guiQuit = 0         ;Always reset the $guiQuit to 0

    Global $fontsize = 15
    Font("Arial", $fontsize)
    Global $cm = 0, $Score = 0, $GameOver = 0
    Global $gx = 25
    Global $gy = 20
    Global $a_gamefield[$gx + 1][$gy + 1]
    Global $v_GameName, $v_GameLVLstring
    Local $tmpx, $tmpf = 1
    Global $px, $py, $gbox, $gdot, $plock = 0

    ; Level Description:
    ;O = Player, # = Wall, $ % = Score, X=Exit

    $v_GameName = "Test_map"
    MakeLvlString("#########################")
    MakeLvlString("#$%#     $      $      X#")
    MakeLvlString("# $#   ##### ############")
    MakeLvlString("#$ # $    %#            #")
    MakeLvlString("# $###################  #")
    MakeLvlString("#       #               #")
    MakeLvlString("######  #  #######  #####")
    MakeLvlString("# $    ###   #$     # $ #")
    MakeLvlString("#            ####   #  $#")
    MakeLvlString("#### #########      # ###")
    MakeLvlString("#    ##%$$ #        # $ #")
    MakeLvlString("#  ###$             ### #")
    MakeLvlString("#  # ######### ######   #")
    MakeLvlString("#  ###       #          #")
    MakeLvlString("#        ######## ####  #")
    MakeLvlString("# # #### #$$         ####")
    MakeLvlString("#   #$O  #   #  #  #  $ #")
    MakeLvlString("#  ########### ###### ###")
    MakeLvlString("#     $ %#$$$$ #$$$%$$$ #")
    MakeLvlString("#########################")
    MapString2Array()

    While Delay(40, 0) = 0
        ;   If Delay(500) = 1 Then ExitLoop 2      ;Alternative: Frame limiter - Exit the "for" and "while" loops when the close button (x) has been pressed.

        CLS("000000")

        If $GameOver = 0 Then
            PlayGame()
            DrawGame()
        Else
            DrawGame()
            Color("FF3030")
            If $tmpf = 1 Then
                $tmpx = $tmpx + 5
                If $tmpx > 130 Then $tmpf = 0
            Else
                $tmpx = $tmpx - 5
                If $tmpx < -100 Then $tmpf = 1
            EndIf
            Outline("Game Over", $gdip_GraphicX / 2 - (5 * $fontsize) + $tmpx, $gdip_GraphicY / 2 - (3 * $fontsize), "FFFF00","AF4F00")
        EndIf
        Flip()
    WEnd
EndFunc   ;==>GameDemoTemplate

Func PlayGame()
    Local $newpos = ""
    $cm = 0
    Select
        Case KeyDown("up")
            If CheckMove($px, $py - 1) > 0 Then
                $a_gamefield[$px][$py] = " "
                $py = $py - 1
                $a_gamefield[$px][$py] = "O"
            EndIf
        Case KeyDown("down")
            If CheckMove($px, $py + 1) > 0 Then
                $a_gamefield[$px][$py] = " "
                $py = $py + 1
                $a_gamefield[$px][$py] = "O"
            EndIf
        Case KeyDown("left")
            If CheckMove($px - 1, $py) > 0 Then
                $a_gamefield[$px][$py] = " "
                $px = $px - 1
                $a_gamefield[$px][$py] = "O"
            EndIf
        Case KeyDown("right")
            If CheckMove($px + 1, $py) > 0 Then
                $a_gamefield[$px][$py] = " "
                $px = $px + 1
                $a_gamefield[$px][$py] = "O"
            EndIf
    EndSelect
    If $cm = 2 Then $Score = $Score + 2
    If $cm = 4 Then $Score = $Score + 10
    If $cm = 3 Then $GameOver = 1
EndFunc   ;==>PlayGame

Func CheckMove($x, $y)
    $cm = 0
    If ($x >= 0 And $x <= $gx - 1) And ($y >= 0 And $y <= $gy - 1) Then
        If $a_gamefield[$x][$y] = " " Then $cm = 1
        If $a_gamefield[$x][$y] = "$" Then $cm = 2
        If $a_gamefield[$x][$y] = "X" Then $cm = 3
        If $a_gamefield[$x][$y] = "%" Then $cm = 4
    EndIf
    Return $cm
EndFunc   ;==>CheckMove


Func DrawGame()
    WinSetTitle($h_GameGui, "", $v_GameName & " " & $mouseX & "/" & $mouseY & "  " & $mouseGX & "/" & $mouseGY)
    Local $tmp = ""
    For $y = 1 To $gy
        For $x = 1 To $gx
            $tmp = $a_gamefield[$x - 1][$y - 1]
            If $tmp = "X" Then
                Color("00FF000")
            ElseIf $tmp = "O" Then
                Color("3030FF")
            ElseIf $tmp = "$" Then
                Color("FFFF00")
            ElseIf $tmp = "%" Then
                Color("FF5F00")
            Else
                Color("FFFFFF")
            EndIf
            Print($tmp, ($x - 1) * $fontsize, ($y - 1) * $fontsize)
        Next
    Next
    Color("FF00FF")
    Print("Score: " & $Score, 0, 21 * $fontsize)
EndFunc   ;==>DrawGame

Func MakeLvlString($txt)
    $v_GameLVLstring = $v_GameLVLstring & $txt
EndFunc   ;==>MakeLvlString

Func MapString2Array()
    Local $tmp
    $plock = 0          ;lock player when found
    $px = 0              ;Player X position
    $py = 0              ;Player Y Position

    WinSetTitle($h_GameGui, "", $v_GameName)
    For $y = 0 To $gy
        For $x = 1 To $gx
            $tmp = StringUpper(StringMid($v_GameLVLstring, $x + ($y * $gx), 1))
            $a_gamefield[$x - 1][$y] = $tmp
            If $tmp = "O" And $plock = 0 Then
                $plock = 1
                $px = $x - 1
                $py = $y
            EndIf
        Next
    Next
EndFunc   ;==>MapString2Array

Func CW($txt)
    ConsoleWrite($txt & @CRLF)
EndFunc   ;==>CW

 

Edited by Dan_555
Removed one X from the Gamemap.
Link to post
Share on other sites

Hi, this is my version of the Peg Solitaire Game in Autoit

It was inspired by the http://www.mathematische-basteleien.de/solitaire.htm game (which is, by the look, almost identical).

It has the Standard Board and additionally 14 different Board setups. The Game starts with randomly selected  challenge.

It has an Undo and Edit functions. 

Image1.jpg.6689a4b8e765c686cf88436336962285.jpg

;This game was inspired by the http://www.mathematische-basteleien.de/solitaire.htm
#include <ButtonConstants.au3>
#include <GUIConstantsEx.au3>
#include <StaticConstants.au3>
#include <WindowsConstants.au3>
#include <GuiConstants.au3>

Global $Appname = "Peg Solitaire", $Appname01 = $Appname

$Form1 = GUICreate($Appname, 510, 416, 255, 271)
$Group1 = GUICtrlCreateGroup("Presets", 383, 2, 124, 413)

Dim $Button[14]
Dim $GameType[17][2]

$GameType[00][0] = ""
$GameType[01][0] = "Standard"
$GameType[02][0] = "Pyramid 16"
$GameType[03][0] = "Pyramid 9"
$GameType[04][0] = "Mirror"
$GameType[05][0] = "Greek Cross"
$GameType[06][0] = "Latin Cross"
$GameType[07][0] = "Ship"
$GameType[08][0] = "Submarine"
$GameType[09][0] = "Y-Pentomino"
$GameType[10][0] = "T-Pentomino"
$GameType[11][0] = "V-Pentomino"
$GameType[12][0] = "P-Pentomino"
$GameType[13][0] = "L-Pentomino"
$GameType[14][0] = "O-Pentomino"
$GameType[15][0] = "Pasted Level"

$GameType[00][1] = "000000000000000000000000000000000"
$GameType[01][1] = "111111111111111101111111111111111"
$GameType[02][1] = "000010001110001111101111111000000"
$GameType[03][1] = "000010001110001111100000000000000"
$GameType[04][1] = "000000001110000111000011100010000"
$GameType[05][1] = "000010000100001111100001000010000"
$GameType[06][1] = "000000000100000111000001000010000"
$GameType[07][1] = "000000001100001111000000000000000"
$GameType[08][1] = "000000000100001111100000000000000"
$GameType[09][1] = "000000000100000011000000100001000"
$GameType[10][1] = "000000000000000111000001000010000"
$GameType[11][1] = "000000000000000011100001000010000"
$GameType[12][1] = "000000000110000011000001000000000"
$GameType[13][1] = "000000000100000010000001100000000"
$GameType[14][1] = "000000000000000011000001100000000"
$GameType[15][1] = "000000000000000000000000000000000"

$Button[00] = GUICtrlCreateButton("Standard", 391, 25, 108, 22)
For $x = 1 To 13
    $Button[$x] = GUICtrlCreateButton($GameType[$x + 1][0], 391, 50 + (26 * $x), 108, 22)
Next

GUICtrlCreateGroup("", -99, -99, 1, 1)
$Group2 = GUICtrlCreateGroup("Edit", 4, 2, 132, 44)
$B_Edit = GUICtrlCreateButton("Off", 6, 15, 32, 22)
GUICtrlSetFont(-1, 10, 800, 0, "Arial")
GUICtrlSetTip(-1, "On : Edit levels (Click to toggle)" & @CRLF & "Off: Play the Game" & @CRLF & "Resets the Undo !")
$B_Cls = GUICtrlCreateButton("Cls", 38, 15, 32, 22)
$B_UsePasted = GUICtrlCreateButton("Use Pasted", 70, 15, 64, 22)
GUICtrlSetTip(-1, "Play the Game from the 'Level Data' input box.")
GUICtrlCreateGroup("", -99, -99, 1, 1)
GUICtrlCreateLabel("Level Data:", 18, 50, 55, 20)
$i_Numbers = GUICtrlCreateInput("", 75, 48, 210, 20, $ES_Number)
GUICtrlSetLimit($i_Numbers, 33)
$Label1 = GUICtrlCreateLabel("Peg Solitaire", 138, 0, 245, 45)
GUICtrlSetFont(-1, 30, 800, 0, "Arial")
$Group3 = GUICtrlCreateGroup("Game", 3, 65, 377, 350)
GUICtrlCreateGroup("", -99, -99, 1, 1)
$b_Undo = GUICtrlCreateButton("Undo", 339, 49, 41, 19)

Local $x, $y, $ox = -1, $oy = -1, $cx, $cy
Local $edit = -1
GUICtrlSetState($B_Cls, $GUI_DISABLE)

Dim $GameField[8][8]
Dim $UndoBuffer[200]
$UndoBuffer[0] = 0

For $y = 1 To 7
    For $x = 1 To 7
        If $y = 1 Or $y = 2 Or $y = 6 Or $y = 7 Then
            $tmptxt = " "
            If $x >= 3 And $x <= 5 Then
                $GameField[$x][$y] = GUICtrlCreateButton($tmptxt, (-30) + ($x * 48), 26 + ($y * 48), 48, 48)
                GUICtrlSetFont(-1, 30, 800, 0, "Arial")
            Else
                $GameField[$x][$y] = -1
            EndIf
        Else
            $GameField[$x][$y] = GUICtrlCreateButton($tmptxt, (-30) + ($x * 48), 26 + ($y * 48), 48, 48)
            GUICtrlSetFont(-1, 30, 800, 0, "Arial")
        EndIf
    Next
Next

BoardSetup(Random(1, 14))

GUISetState(@SW_SHOW)

While 1
    $nMsg = GUIGetMsg()
    Switch $nMsg
        Case $GUI_EVENT_CLOSE
            Exit
        Case $b_Undo            
            if $ox > -1 Then
                ChangeSquare($ox, $oy, "o")
                $ox=-1
                $oy=-1
            EndIf
            Undo()
            WinSetTitle($Form1, "", $Appname01)
        Case $B_UsePasted
            $tmptxt = GUICtrlRead($i_Numbers)
            $GameType[15][1] = $tmptxt
            BoardSetup(15)

        Case $B_Cls
            $ox = -1
            $oy = -1
            BoardSetup()
        Case $B_Edit
            $edit = -$edit
            If $ox > -1 Then
                ChangeSquare($ox, $oy, "o")
                $ox = -1
                $oy = -1
            EndIf
            OnOff(($edit < 0) ? 0 : 1)
            $Appname01 = $Appname & "  - Playing: Edited board."
            WinSetTitle($Form1, "", $Appname01)
            $UndoBuffer[0] = 0
        Case Else
            If $nMsg > 0 Then
                ;Check Game type Buttons:
                For $x = 0 To 13
                    If $nMsg = $Button[$x] Then
                        BoardSetup($x + 1)
                        $ox = -1
                        $oy = -1
                        $UndoBuffer[0] = 0
                    EndIf
                Next

                ;Check Board buttons:
                For $btny = 1 To 7
                    For $btnx = 1 To 7
                        If $nMsg = $GameField[$btnx][$btny] Then
                            $tmp = GUICtrlRead($GameField[$btnx][$btny])

                            If $edit = -1 Then                                    ;Game play code:
                                If $tmp = " " Then
                                    If Jump($btnx, $btny, $ox, $oy) = 1 Then    ;Successful jump
                                        $ox = -1
                                        $oy = -1
                                    EndIf
                                    $tmptxt = GetBoard()
                                    GUICtrlSetData($i_Numbers, $tmptxt)
                                    If StringFind($tmptxt, "1") = 1 Then WinSetTitle($Form1, "", $Appname & " : *** Well Done ***")
                                ElseIf $tmp == "o" Then
                                    If $ox = -1 Then
                                        $ox = $btnx
                                        $oy = $btny
                                        ChangeSquare($ox, $oy, "O")
                                    Else
                                        ChangeSquare($ox, $oy, "o")
                                        $ox = $btnx
                                        $oy = $btny
                                        ChangeSquare($ox, $oy, "O")
                                    EndIf
                                EndIf

                            Else                                                ;Edit board:
                                If $tmp = " " Then
                                    ChangeSquare($btnx, $btny, "o")
                                ElseIf $tmp = "o" Then
                                    ChangeSquare($btnx, $btny, " ")
                                EndIf
                                $tmptxt = GetBoard()
                                GUICtrlSetData($i_Numbers, $tmptxt)
                                WinSetTitle($Form1, "", $Appname01)
                            EndIf
                        EndIf
                    Next
                Next
            EndIf
    EndSwitch
WEnd

Func UndoAdd()
    If $UndoBuffer[0] < 998 Then
        $UndoBuffer[0] = $UndoBuffer[0] + 1
        $tmptxt = GetBoard()
        $UndoBuffer[$UndoBuffer[0]] = $tmptxt
    EndIf
EndFunc   ;==>UndoAdd

Func Undo()
    If $UndoBuffer[0] >= 1 Then
        $tmptxt = $UndoBuffer[$UndoBuffer[0]]
        $UndoBuffer[0] = $UndoBuffer[0] - 1
        $GameType[16][1] = $tmptxt
        BoardSetup(16)
    EndIf
EndFunc   ;==>Undo

Func StringFind($txt, $s)
    Local $nr = 0
    For $x = 1 To StringLen($txt)
        If StringMid($txt, $x, 1) == $s Then $nr = $nr + 1
    Next
    Return $nr
EndFunc   ;==>StringFind

Func OnOff($x)
    Local $tmp = "on"
    If $x = 0 Then
        $tmp = "off"
        GUICtrlSetState($B_Cls, $GUI_DISABLE)
    Else
        GUICtrlSetState($B_Cls, $GUI_ENABLE)
    EndIf
    GUICtrlSetData($B_Edit, $tmp)
EndFunc   ;==>OnOff

Func Jump($x, $y, $ox, $oy)
    Local $tmpx = Abs($ox - $x)
    Local $tmpy = Abs($oy - $y)
    Local $dir = 0

    If $tmpx = 0 And $tmpy = 2 Then
        $dir = ($oy - $y) > 0 ? $y + 1 : $y - 1
        If GUICtrlRead($GameField[$x][$dir]) == "o" Then
            UndoAdd()
            ChangeSquare($x, $y, "o")
            ChangeSquare($x, $dir, " ")
            ChangeSquare($ox, $oy, " ")
            Return 1
        EndIf
    ElseIf $tmpy = 0 And $tmpx = 2 Then
        $dir = ($ox - $x) > 0 ? $x + 1 : $x - 1
        If GUICtrlRead($GameField[$dir][$y]) == "o" Then
            UndoAdd()
            ChangeSquare($x, $y, "o")
            ChangeSquare($dir, $y, " ")
            ChangeSquare($ox, $oy, " ")
            Return 1
        EndIf
    EndIf
    Return 0
EndFunc   ;==>Jump

Func ChangeSquare($x, $y, $txt)
    GUICtrlSetData($GameField[$x][$y], $txt)
EndFunc   ;==>ChangeSquare

Func BoardSetup($a = 0)
    Local $w = 0, $x, $y, $z
    Local $tmptxt = "", $tmptxt1 = ""
    If $a < 16 Then
        $Appname01 = $Appname & "  - Playing: " & $GameType[$a][0]
        WinSetTitle($Form1, "", $Appname01)
        $UndoBuffer[0] = 0
    EndIf
    For $y = 1 To 7
        For $x = 1 To 7
            $z = 0
            $tmptxt = " "
            If $y = 1 Or $y = 2 Or $y = 6 Or $y = 7 Then
                If $x >= 3 And $x <= 5 Then $z = 1
            Else
                $z = 1
            EndIf
            If $z = 1 Then
                $w = $w + 1
                $tmptxt1 = StringMid($GameType[$a][1], $w, 1)
                $tmptxt = ($tmptxt1 = "1") ? "o" : " "
                ChangeSquare($x, $y, $tmptxt)
            EndIf
        Next
    Next
    GUICtrlSetData($i_Numbers, GetBoard())
EndFunc   ;==>BoardSetup

Func GetBoard()
    Local $tmptxt = ""
    For $y = 1 To 7
        For $x = 1 To 7
            $z = 0
            If $y = 1 Or $y = 2 Or $y = 6 Or $y = 7 Then
                If $x >= 3 And $x <= 5 Then $z = 1
            Else
                $z = 1
            EndIf
            If $z = 1 Then
                $tmptxt = $tmptxt & _Txt2num(GUICtrlRead($GameField[$x][$y]))
            EndIf
        Next
    Next
    Return $tmptxt
EndFunc   ;==>GetBoard

Func _Txt2num($txt)
    If $txt = " " Then Return "0"
    If $txt = "o" Then Return "1"
EndFunc   ;==>_Txt2num

Func CW($txt, $crlf = 1)
    Local $nl = ""
    If $crlf = 1 Then $nl = @CRLF
    ConsoleWrite($txt & $nl)
EndFunc   ;==>CW

Have Fun !

Edited by Dan_555
Minor Bugfix #3
Link to post
Share on other sites

Thanks.

At first i wanted to use numbers for the levels, and for that i'v converted some functions from blitzbasic to autoit.

But i decided to leave it as it is. 

 

In other (older ?) basic languages, when speaking of binary, it means the numbers in the binary format "0100101".

But AutoIt has a different meaning for it.

So here are the converted functions which manipulate the individual bits of one variable:

$y=2
$x=Bit_Set($y,1)
CW($y & " = " & _NumberToBinary($y) & " :")
CW ($x & " = " & _NumberToBinary($x))
CW("")

$y=3
$x=Bit_Clear($y,1)
CW($y & " = " & _NumberToBinary($y) & " :")
CW ($x & " = " & _NumberToBinary($x))
CW("")

$y=3
$x=Bit_Toggle($y,2)
CW($y & " = " & _NumberToBinary($y) & " :")
CW($x & " = " & _NumberToBinary($x))
CW("")

$y=2
$x=Bit_Toggle($y,1)
CW($y & " = " & _NumberToBinary($y) & " :")
CW($x & " = " & _NumberToBinary($x))

CW("")
CW("Reading out 183, should display 10110111")
For $x=8 to 1 step -1
CW(Bit_Read(183,$x),0)
Next

CW("")

Func Bit_Set($x, $bit)                ;Set a bit to 1
    ;x = variable
    ;bit = bit number to set (reminder: bit #1 is the rightmost bit: %101001110[1] <- )
    Return BitOR($x, BitShift(1, -($bit - 1)))
EndFunc   ;==>Bit_Set

Func Bit_Clear($x, $bit)               ;Set a bit to 0
    ;x = variable
    ;bit = bit number to unset (reminder: bit #1 is the rightmost bit: %101001110[1] <- )
    Return BitAND($x, (BitXOR($x, BitShift(1, -($bit - 1)))))
EndFunc   ;==>Bit_Clear

Func Bit_Toggle($x, $bit)           ;Flip a bit (1 becomes 0 or 0 becomes 1)
    Return BitXOR($x, (BitShift(1, -($bit - 1))))
EndFunc   ;==>Bit_Toggle

Func Bit_Read($x, $bit)               ;Reads a bit state of a variable
    ;Return the bit state (0 or 1) rightmost bit being 1st
    Return ((BitAND(($x), (BitShift(1, -($bit - 1))))) <> 0) ? 1 : 0
EndFunc   ;==>Bit_Read

Func CW($txt, $crlf = 1)
    Local $nl = ""
    If $crlf = 1 Then $nl = @CRLF
    ConsoleWrite($txt & $nl)
EndFunc   ;==>CW


; =================================================================================================
; Func _NumberToBinary($iNumber)
;
; Converts a 32-bit signed # to a binary bit string. (Limitation due to AutoIT functionality)
;   NOTE: range for 32-bit signed values is -2147483648 to 2147483647!
;       Anything outside the range will return an empty string!
;
; $iNumber = # to convert, obviously
;
; Returns:
;   Success: Binary bit string
;   Failure: "" and @error set
;
; Author: Ascend4nt, with help from picaxe (Changing 'If BitAND/Else' to just one line)
;   See it @ http://www.autoitscript.com/forum/index.php?showtopic=90056
; =================================================================================================

Func _NumberToBinary($iNumber)
    Local $sBinString = ""
    ; Maximum 32-bit # range is -2147483648 to 2147483647
    If $iNumber < -2147483648 Or $iNumber > 2147483647 Then Return SetError(1, 0, "")

    ; Convert to a 32-bit unsigned integer. We can't work on signed #'s
    $iUnsignedNumber = BitAND($iNumber, 0x7FFFFFFF)

    ; Cycle through each bit, shifting to the right until 0
    Do
        $sBinString = BitAND($iUnsignedNumber, 1) & $sBinString
        $iUnsignedNumber = BitShift($iUnsignedNumber, 1)
    Until Not $iUnsignedNumber

    ; Was it a negative #? Put the sign bit on top, and pad the bits that aren't set
    $sBinString = StringRight("000000000000000000000000000000" & $sBinString, 31)
    If $iNumber < 0 Then Return '1' & $sBinString
    Return '0' & $sBinString
EndFunc   ;==>_NumberToBinary

All functions use the same syntax: (Variable,bit number).

Where the rightmost bit is the number 1, going to left up to 31/32 (of which Autoit supports, i think). 

Bit_Clear sets a bit to 0

Bit_Read reads out a bit, returns either 1 or 0

Bit_Set sets a bit to 1

Bit_Toggle flips a bit. 1 becomes 0, and 0 becomes 1.

And there is a _NumberToBinary function which i'v found here on the forums (see the code for the credits/link).

 

Have fun.

Edited by Dan_555
Link to post
Share on other sites

This script is a font explorer (charmap) type thingy. 

You can copy the numbers into the input box, if you want to use it later. You'll need to use the ChrW() with them. 

#include <ButtonConstants.au3>
#include <GUIConstantsEx.au3>
#include <Misc.au3>

Dim $array[10][10]    ;Button array

Local $z = 0        ;Counter
Global $bs = 44      ;Button Size
Global $font

$gs = $bs

If $gs <= 16 Then $gs = 22

Global $hgui = GUICreate("My GUI", 55 + (10 * $gs), 25 + (10 * $gs)) ; will create a dialog box that when displayed is centered

$btnc = GUICtrlCreateButton("C",5,1,25,15)
GUICtrlSetTip (-1, "Sets the starting point to 0")
$btnp = GUICtrlCreateButton("+", 5, 20, 40, 40)
$btnm = GUICtrlCreateButton("-", 5, 60, 40, 40)
$btnp1 = GUICtrlCreateButton("++", 5, 110, 40, 40)
$btnm1 = GUICtrlCreateButton("--", 5, 150, 40, 40)
$btnF = GUICtrlCreateButton("Font", 5, 210, 40, 40)
$inp = GUICtrlCreateInput("", 50, 0, 219, 20)

;Add buttons
For $y = 0 To 9
    For $x = 0 To 9
        $array[$x][$y] = GUICtrlCreateButton(" ", 50 + ($x * $bs), 20 + ($y * $bs), $bs, $bs, $BS_BITMAP)
    Next
Next

SetFont()
ChrFont(0)

GUISetState(@SW_SHOW)

; Loop until the user exits.
While 1
    WinSetTitle($hgui, "", "Starting from # " & $z & " | Using font: " & $font)
    $nmsg = GUIGetMsg()
    Switch $nmsg
        Case $GUI_EVENT_CLOSE
            ExitLoop
        Case $btnc
            $z=0
            ChrFont($z)
        Case $btnp
            $z = $z + 100
            ChrFont($z)
        Case $btnm
            $z = $z - 100
            If $z < 0 Then $z = 0
            ChrFont($z)
        Case $btnp1
            $z = $z + 1000
            ChrFont($z)
        Case $btnm1
            $z = $z - 1000
            If $z < 0 Then $z = 0
            ChrFont($z)
        Case $btnF
            SelFont()
            SetFont($font)
        Case Else
            If $nmsg > 0 Then
                Local $tmpz = $z - 1
                For $y = 0 To 9          ;Process buttons
                    For $x = 0 To 9
                        $tmpz = $tmpz + 1
                        If $nmsg = $array[$x][$y] Then
                            Local $txt = GUICtrlRead($inp)
                            GUICtrlSetData($inp, $txt & $tmpz & "; ")
                        EndIf
                    Next
                Next
            EndIf
    EndSwitch
WEnd

Func SelFont()                      ;Select a font
    Local $aF = _ChooseFont($font)
    If @error <> 0 Then                 ;AutoIt help states to check if the @error is not 0 
        $font = "System2"
    Else        
            $font = $aF[2]
    EndIf

EndFunc   ;==>SelFont

Func SetFont($fontname = "System2")     ;Assign font to the buttons
    If $fontname = "" Then $fontname = "System2"
    $font = $fontname
    For $y = 0 To 9
        For $x = 0 To 9
            GUICtrlSetFont($array[$x][$y], 30, 400, 0, $font)
        Next
    Next
EndFunc   ;==>SetFont

Func ChrFont($z)                        ;Write text on the buttons with ChrW
    For $y = 0 To 9
        For $x = 0 To 9
            GUICtrlSetData($array[$x][$y], ChrW($z))
            GUICtrlSetTip($array[$x][$y], $z, "Font Number")
            $z = $z + 1
        Next
    Next
EndFunc   ;==>ChrFont

 

Edited by Dan_555
Modified the SelFont function, removed the array check by replacing @error > 0 with @error <> 0
Link to post
Share on other sites

Square Time ! (word play on hammer time ?!! 😉 )

Following the last 2 scripts, which contained an array of buttons, here comes a Game, with an Array of Buttons ! 

I'v just uploaded an Nonogram game, called Aut-o-gram here.

Have fun !

Edited by Dan_555
Link to post
Share on other sites

BTW, I'v updated the Aut-o-Gram Game with Undo function and easier Levels.

.....

 

Here is my Alternative input box function.

It uses an edit box to display the text, and is therefore expandable.

The script has a simple demo,which displays some keywords while typing.

And i modified my helper function of console write  (CW) to display a message box if compiled, or to write to console if running from SCITE.

#include <WindowsConstants.au3>
#include <guiconstantsEx.au3>
#include <GuiEdit.au3>
#include <ButtonConstants.au3>


;Needed for the demo:
#include <Array.au3>
#include <String.au3>

CW(InputGui("Test input", "Please enter a search term:" & @CRLF & "Available terms:" & @CRLF & @CRLF, 280, 230, 1) & @CRLF)


Func InputGui($titletxt = "", $TextMSG = "", $w = 300, $h = 120, $needreturn = 0)
    ;Modified source from https://www.autoitscript.com/forum/topic/90035-check-for-valid-file-name-while-entering-text/
    ;by dan_555
    ;Cancel or X will always return an empty string and the @error will be set to 1

    ;$needreturn :  If set, the button will react to the enter key. else the user needs to click on Ok or Cancel/X to exit the input box
    ;               1 set the default button to OK, 2 set the default button to Cancel

    Local $okdef = -1, $canceldef = -1
    If $needreturn = 1 Then $okdef = $BS_DEFPUSHBUTTON
    If $needreturn = 2 Then $canceldef = $BS_DEFPUSHBUTTON

    If $w < 85 Then $w = 85
    If $h < 85 Then $h = 85

    Local $MyGui = GUICreate($titletxt, $w, $h, -1, -1, $WS_POPUP + $WS_CAPTION)
    Local $Edit = GUICtrlCreateEdit($TextMSG, 4, 4, $w - 8, $h - 55, BitOR($ES_AUTOVSCROLL, $ES_READONLY, $WS_VSCROLL))
    Local $input = GUICtrlCreateInput("", 4, $h - 50, $w - 8, 20, $ES_WANTRETURN)
    Local $buttonOK = GUICtrlCreateButton("OK", 4, $h - 25, 35, 20, $okdef = -1)
    Local $buttonCA = GUICtrlCreateButton("Cancel", $w - 45, $h - 25, 40, 20, $canceldef)
    GUISetState(@SW_SHOW)

    Local $final, $tmp, $itxt, $itxtold, $Err = 0
    Local $WinPos

    While 1
        $WinPos = WinGetPos($MyGui)
        $msg = GUIGetMsg()
        Select
            Case $msg = $GUI_EVENT_CLOSE Or $msg = $buttonCA
                $Err = 1
                ExitLoop
            Case $msg = $buttonOK
                ExitLoop
        EndSelect
        $itxt = GUICtrlRead($input)

        ; ************ Demo ***************
        ;Updating the Text 'on the fly'
        If $itxt <> $itxtold Then                ;Do something if the new text in the input box is different than the old
            $itxtold = $itxt
            $tmp = ReadArray($itxt)                ;Get the new text data from the ReadArray function

            _GUICtrlEdit_BeginUpdate($Edit)            ;Update the Edit box with the new data
            GUICtrlSetData($Edit, "", 1)
            GUICtrlSetData($Edit, $TextMSG & $tmp)
            _GUICtrlEdit_EndUpdate($Edit)
        EndIf

        ; *********** End of Demo  *********

        Sleep(10)
    WEnd
    If $Err = 0 Then                        ;If ok button was clicked
        $final = GUICtrlRead($input)
        GUIDelete($MyGui)
        Return $final
    Else                                    ;X or Cancel was pressed
        GUIDelete($MyGui)
        SetError(1)
        Return ""
    EndIf
EndFunc   ;==>InputGui

Func ReadArray($text)        ;Demo function
    Local $array = _StringBetween(",1,11,111,2,22,222,3,33,333,4,44,444,5,55,555,6,66,666,7,77,777,8,88,888,9,99,999,Assembler,Ambition,Basic,BLitz Basic,Blue Moon,Bingo,Circle,Circular,day,night,sleep,dream,lucid dream,test,", ",", ",")
    _ArrayInsert($array, 0, UBound($array) - 1)     ;Insert the number of items at the 0 position of the array
    Local $list = ""
    Local $x, $y
    For $x = 1 To $array[0]
        For $y = StringLen($text) To 1 Step -1
            If StringLeft($array[$x], $y) = $text Then
                $list = $list & $array[$x] & @CRLF
                ExitLoop
            EndIf
        Next
    Next
    Return $list
EndFunc   ;==>ReadArray


Func CW($txt, $crlf = 1)                        ;Console write - If run from Scite it will write into console, else it displays a Message box !
    Local $tmp
    If StringInStr($CmdLineRaw, "/ErrorStdOut") Then
        If $crlf = 1 Then $tmp = @CRLF
        ConsoleWrite($txt & $tmp)
    Else
        MsgBox(0, "Output: ", $txt)
    EndIf
EndFunc   ;==>CW

Have fun.

Edited by Dan_555
Link to post
Share on other sites
  • 1 month later...

BF*, the programming language with a silly name, is now visualized in AutoIt. 

First, here is the console only version, which executes faster than the Gui-version 😭

#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_Icon=bf.ico
#AutoIt3Wrapper_Change2CUI=y
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****

Func InputConsole()
    If @Compiled = 1 Then
        CW( @crlf & "enter single char>", 0)
        Do
            Local $inp = ConsoleRead()
        Until $inp <> ""
        if StringLen($inp)>1 Then $inp=StringLeft($inp,1)
        ;CW("GOT: (" & $inp & ")")
    Else
        $inp = InputBox("BF-Console", "Please enter a single char")
        If @error <> 0 Then
            Exit
        EndIf
    EndIf
    Return $inp
EndFunc   ;==>InputConsole

CW("Autoit BrainF* Console version" & @crlf)

Const $filetype = "BF (*.b;*.bf)|Text (*.txt;*.ini)|All Files (*.*)"
$tmpfile = FileOpenDialog("Open ABF script", @ScriptDir, $filetype)
$p = FileRead($tmpfile)
CW("Loaded: " & $tmpfile)

Global $ERROR = ""
Global $datastack = 1000
Global $d[$datastack] ; Data stack
Global $b[31] ; bracket stack

Local $dp = 1     ; Data pointer
Local $ip = 1     ; instruction pointer
Local $bp = 1     ; bracket pointer
Local $bc = 0     ; Bracket matching
Local $be = 0      ; Bracket Ending
Local $e = StringLen($p)      ;The length of the code
$ERROR = ""

While 1
    Local $a = StringMid($p, $ip, 1)
    Select
        Case $a = ">"
            $dp = $dp + 1
            If $dp > $datastack - 1 Then     ;$dp = 1
                CW("Emergency loop out >")
                ExitLoop
            EndIf
        Case $a = "<"
            $dp = $dp - 1
            If $dp < 0 Then             ;$dp = $datastack - 1
                CW("Emergency loop out <")
                ExitLoop
            EndIf
        Case $a = "+"
            $d[$dp] = Mod($d[$dp] + 1, 256)
            ;If $d[$dp] > 255 Then $d[$dp] = 0
        Case $a = "-"
            $d[$dp] = Mod($d[$dp] + 255, 256)
            ;$d[$dp] = $d[$dp] - 1
            ;If $d[$dp] < 0 Then $d[$dp] = 0
        Case $a = "."
            If $d[$dp] = 13  Then ;Or $d[$dp] = 10
                CW(@CRLF)
            Else
                CW(Chr($d[$dp]), 0)
            EndIf
        Case $a = ","
            Local $inp = InputConsole()

            If $inp <> "" Then
                $d[$dp] = Asc($inp)
            Else
                Exit
            EndIf
        Case $a = "["
            Local $bc = 1          ; bracket counter
            For $x = $ip + 1 To $e
                If StringMid($p, $x, 1) = "[" Then $bc = $bc + 1
                If StringMid($p, $x, 1) = "]" Then $bc = $bc - 1
                If $bc = 0 Then     ; bc will be 0 once all the subnests have been counted over
                    $b[$bp] = $ip
                    $be = $x
                    $x = $e
                EndIf
                If $bc = 0 And $d[$dp] = 0 Then
                    $ip = $be
                    $bp = $bp - 1
                EndIf
            Next
            $bp = $bp + 1
        Case $a = "]"
            $bp = $bp - 1
            If $d[$dp] <> 0 Then $ip = $b[$bp] - 1
    EndSelect

    $ip = $ip + 1
    If $ip > $e Then ExitLoop

WEnd




if @compiled=1 Then
cw("THE END - Press CTRL C or STRG C to stop")
While 1
    Sleep (10)
WEnd
Else
    CW("The END")
EndIf

Func CW($txt, $crlf = 1)
    Local $nl = ""
    If $crlf = 1 Then $nl = @CRLF
    ConsoleWrite($txt & $nl)
EndFunc   ;==>CW

The console version works from the Scite and in the console.

When ran under dos it accepts input through the stdio, and when ran from Scite it uses the Message Box to get the input.

The interpreter code is from Rosettacode.org

 

The Gui-Visualiser looks like this:

AutoBF.png.834c577db25484ea9efc5b33fef9c653.png

The attached 7z archive contains the source code and compiled versions (32,64 bit) of the visualiser, 32 bit console version, custom icon and

few bf test apps.

AutoBF.7z

Edited by Dan_555
Link to post
Share on other sites

Today i accidentally closed the Whatsapp on the PC, so i tried to find a way to disable the X button.

Google pointed out few threads from this forum, and so i have used the code to make a workable script.

Here is the result:

#Region ;**** Directives created by AutoIt3Wrapper_GUI ****
#AutoIt3Wrapper_Icon=WhatsAppClose.ico
#EndRegion ;**** Directives created by AutoIt3Wrapper_GUI ****
;Dan_555
;Modified version of https://www.autoitscript.com/forum/topic/124227-hide-close-button-in-an-external-application/?tab=comments#comment-862731
;#NoTrayIcon
#include <GUIConstantsEx.au3>
#include <WindowsConstants.au3>
#include <Misc.au3>
#include <GuiButton.au3>

If _Singleton("WhatAppXBypass") = 0 Then Exit

Opt("GUICloseOnESC", 0)
Opt("TrayAutoPause", 0)

Global $iLast_X = 0
Global $iLast_Y = 0
Global $iLast_W = 0
Global $iLast_h = 0
Global $aExtApp_Pos
Global $hGUI, $hPic, $hExtApp

Local $quit = 0
Do
    $iLast_X = -110
    $iLast_Y = -110
    $iLast_W = 0
    $iLast_h = 0
    WinActivate("WhatsApp")
    If WinActive("WhatsApp") <> 0 Then
        $hExtApp = WinGetHandle("WhatsApp")
        $hPidExpApp = WinGetProcess($hExtApp)
        ;ConsoleWrite($hPidExpApp & @CRLF)
        $hGUI = GUICreate("My [X]", 41, 29, -100, -100, $WS_POPUP, $WS_EX_TOOLWINDOW, $hExtApp );BitOr($WS_EX_TOOLWINDOW,$WS_EX_TOPMOST))
        $hPic = GUICtrlCreateLabel("", 0, 0, 41, 29)
        GUICtrlSetBkColor($hPic, "0x00BFA5")
        GUICtrlSetTip (-1,"X is disabled" & @crlf & "Close the whatsapp from the taskbar")
        GUISetState()
        BypassClosing()
    EndIf
    Sleep(60)
Until $quit = 1


Func BypassClosing()
    Local $quit = 0

    Do
        Switch GUIGetMsg()
            Case $GUI_EVENT_CLOSE
                Exit
            Case $hPic
                WinSetState($hExtApp, "", @SW_MINIMIZE)
        EndSwitch
        Local $PEX = ProcessExists($hPidExpApp)
        If $PEX = $hPidExpApp Then
            $aExtApp_Pos = WinGetPos($hExtApp)
            If @error = 0 Then
                If ($aExtApp_Pos[0] <> $iLast_X) Or ($aExtApp_Pos[1] <> $iLast_Y) Or ($aExtApp_Pos[2] <> $iLast_W) Or ($aExtApp_Pos[3] <> $iLast_h) Then
                    $iLast_X = $aExtApp_Pos[0]
                    $iLast_Y = $aExtApp_Pos[1]
                    $iLast_W = $aExtApp_Pos[2]
                    $iLast_h = $aExtApp_Pos[3]
                    WinMove($hGUI, '', $aExtApp_Pos[0] + $aExtApp_Pos[2] - 41, $aExtApp_Pos[1])
                EndIf
            Else
                $quit = 1
            EndIf
        Else
            $quit = 1
        EndIf
    Until $quit = 1
    ConsoleWrite("quit" & @CRLF)
    GUICtrlDelete($hPic)
    GUIDelete($hGUI)
EndFunc   ;==>BypassClosing

The script will wait until WhatsApp is started, then it will cover the X with a small square/rectangular gui.

 Clicking on the covered area will minimize whatsapp.

Closing and restarting, moving and resizing whatsapp works fine (so far).

Attached is the custom icon (taken from the whatsapp.exe)

WhatsAppClose.ico

Edited by Dan_555
Update: Removed the topmost flag and added the whastapp handle to the gui. Positioned the initial gui window outside (top side) desktop window.
Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    No registered users viewing this page.

×
×
  • Create New...