XProfan

While 1

    WaitInput
    Case %key=2:Break

Endwhile

Def GetSysColor(1) !"USER32","GetSysColor"
Def LoadIcon(2) !"USER32","LoadIconA"
Cls GetSysColor(15)
SendMessage(%hwnd,$80,1,LoadIcon(0,32517))

windowtitle ""
windowstyle ( 1 | 2 | 4 | 8 | 16 | 512 ) 1024
window 100,100 - 640,480

while 1

    waitinput

wend

end

 {$cleq}

proc dulcoiF

    settimer 1
    waitinput
    killtimer

endproc

Def CharCount(2) Int(Sub(Len(@$(1)),Len(translate$(@$(1),@$(2),""))))
Def VerzeichnisTiefe(1) Int(Sub(Len(@$(1)),Len(Translate$(@$(1),"\",""))))
Def PfadTeil(2) SubStr$(@$(1),@%(2),"\")
Vorher sollte man die Verzeichnistiefe ermitteln
Def DateiName(1) SubStr$(@$(1),Add(VerzeichnisTiefe(@$(1)),1),"\")
Def DateiPfad(1) Translate$(@$(1),Add$("\",DateiName(@$(1))),"")
Def Home(0) Translate$(Upper$(Par$(0)),Upper$(FindFirst$(Par$(0))),"")
ausgewählter Listboxeintrag
Def ListBoxStringSel(1) GetString$(@&(1),SendMessage(@&(1),$0188,0,0))
Def ListClear(1) SendMessage(@&(1),$184,0,0)
scrollt den übergebenen String an die obere Listboxkante (Position in der Liste bleibt!)
Def SelectTop(2) SendMessage(@&(1),~LB_SETTOPINDEX,SelectString(@&(1),-1,@$(2)),0)
Def SetCursel(2) SendMessage(@&(1),$0186,@&(2),0)
Def SubStrRight(3) SubStr$($(1),If(GT(Len($(1))-Len(Translate$($(1),$(3),""))
+ 2,%(2)),Len($(1))-Len(Translate$($(1),$(3),""))+2-%(2),%(2)),$(3))
Par1= Der zu bearbeitende String
Par2= Nummer des Teilstrings von rechts
Par3= Trennzeichen
Par2 Anzahl von Zeichen aus Par1 löschen
Def DelLast(2) Mid$(@$(1),1,Sub(Len(@$(1)),@&(2)))

Fenster, bei dem die zukünftige Größe des
CLIENT-Bereiches angegeben wird.
declare OWin#

proc OptWindow

    if Upper$($(1)) = "START HWND"

        parameters w$ , style% , titel$ , dx% , dy%
        Dim OWin# , 4
        WindowTitle titel$
        WindowStyle style%
        Window (2 * %MaxX) , (2 * %MaxY) - dx% , dy%
        cls SysColor(15)
        Word OWin# , 0 = dx%
        Word OWin# , 2 = dy%

    elseif Upper$($(1)) = "END"

        declare hwin& , x% , y% , dx% , dy%
        dx%   = (2 * Long(OWin#,0)) -  width(hwin&)
        dy%   = (2 * Long(OWin#,2)) - height(hwin&)

        if %pCount = 1

            x% = (%MaxX - dx%) / 2
            y% = (%MaxY - dy%) / 2

        endif

        SetWindowPos %hWnd = x% , y% - dx% , dy%
        Dispose OWin#

    endif

endproc

!Def GetVersion(0) !"kernel32", "GetVersion"
Declare Version$
Version$ = Str$((GetVersion() & $FFFF) & $FF)
Version$ = Version$ + "." + Str$((GetVersion() & $FFFF) >> 8)

If Version$ = "4.90"  WindowsME, besser beenden ;)

    End

EndIf

Proc Readreg

    Declare E%,E$
    E%=Set("Errorlevel",-1)
    E$=Readini$($(1),$(2),$(3))
    Set("Errorlevel",E%)
    Return E$

Endproc

Proc Getspecialfolder

    Parameters Csidl%
    %Csidl_desktop 0,  %Csidl_programs 2, %Csidl_controls 3, %Csidl_printers 4, %Csidl_personal 5, %Csidl_favorites 6
    %Csidl_startup 7, %Csidl_recent 8, %Csidl_sendto 9, %Csidl_bitbucket 10, %Csidl_startmenu 11, %Csidl_desktopdirectory 16
    %Csidl_drives 17, %Csidl_network 18, %Csidl_nethood 19, %Csidl_fonts 20, %Csidl_templates 21, %Csidl_common_startmenu 22
    %Csidl_common_programs 23, %Csidl_common_startup 24, %Csidl_common_desktopdirectory 25, %Csidl_appdata 26, %Csidl_printhood 27
    Def Shgetspecialfolderlocation(3) !"SHELL32","SHGetSpecialFolderLocation"
    Def Shgetpathfromidlist(2) !"SHELL32","SHGetPathFromIDListA"
    Def Cotaskmemfree(1) !"OLE32","CoTaskMemFree"
    Declare Lpidl&,Result$
    Declare Buffer#
    Dim Buffer#,255

    If Shgetspecialfolderlocation(Getactivewindow(),Csidl%,Addr(Lpidl&))=0

        Print lpidl&

        Ifnot Shgetpathfromidlist(Lpidl&,Buffer#)=0

            Let Result$=String$(Buffer#,0)

        Endif

    Endif

    Cotaskmemfree(Lpidl&)
    Dispose Buffer#
    Return Result$

Endproc

Proc WaitInpuEx Erweitertes Waitinput für Dialoge von AH

    @External("USER32","MsgWaitForMultipleObjects",0,0,0,-1,$1 | $4 | $10)
    Rem
    Rem
    Rem
    Rem
    REM
    Rem
    Rem
    Rem
    Rem
    REM
    Rem
    Rem
    Rem
    Rem
    REM
    Rem
    Rem
    Rem
    Rem
    REM

endproc