XProfan

//rundll32.exe appwiz.cpl,NewLinkHere %1
 {$cleq}
seterrorlevel -1
declare apptitle$
apptitle$:="TrayClockPro V1"
 $U thread.pcu = thread.

if par$(1)=="-about"

    messagebox "Programmiert von:	iF (if@mxii.com)
    Weil es einfach ätzt nie das Datum auf Anhieb zu sehen.",apptitle$,4096
    end

endif

if par$(1)=="-cal"

    declare MonthCal&,dlg&
    Def CreateMonthCal(7) Control("SysMonthCal32","",&(7),%(2),%(3),%(4),%(5),&(1),%(6),%hinstance)
    windowstyle 1+2+4+8+16
    dlg&:=createwindow(%desktop,"Kalender",100,100,743,500)
    //windowtitle "Kalender"
    //Window 100,100 - 640,480
    MonthCal& = CreateMonthCal(dlg&,"",0,0,width(dlg&),height(dlg&),$50000004)
    thread.start 2

    whilenot %key==2

        waitinput

    wend

    thread.stop 2
    end

endif

if val(substr$($winver,1,"."))<5

    shell Add$(Add$("EXPLORER.EXE ",Chr$(34)),Add$("https://www.amazon.com/exec/obidos/ASIN/B00005MOTE/103-3689356-1416660",Chr$(34)))
    messagebox apptitle$+" benötigt WindowsXP und kann auf diesem System nicht ausgeführt werden.",apptitle$,4096
    end

endif

declare h&,p&,t&,wh&,hh&,col&,ex%,tbn&,tbx&,tby&,tbxx&,tbyy&,whi&,tme$,mk%,runtasksh&,desktoph&,thdl&,sbutt&,i&,pipe&
declare parr$[512],cx%
declare parrn$[512],cx%
clear parr$[]
clear parrn$[]
DEF SetWindowLong(3) ! "user32","SetWindowLongA"
DEF GetWindowLong(2) ! "user32","GetWindowLongA"
DEF mevent(5) !"USER32","mouse_event"
 $U file.pcu = f
 $U pipe.pcu = pipe.

if pipe.is(apptitle$)

    messagebox apptitle$+" läuft bereits.",apptitle$,4096
    end

endif

pipe&:=pipe.create(apptitle$)
#include mouse.inc
whi&:=rgb(255,255,255)
//get desktoph
desktoph&:=external("user32","FindWindowExA",0,0,"progman",0)
//get sbutt&
h&:=external("user32","FindWindowExA",0,0,"Shell_TrayWnd",0)
h&:=external("user32","FindWindowExA",h&,0,"Button",0)
sbutt&:=h&
//get runtasksh
h&:=external("user32","FindWindowExA",0,0,"Shell_TrayWnd",0)
h&:=external("user32","FindWindowExA",h&,0,"ReBarWindow32",0)
h&:=external("user32","FindWindowExA",h&,0,"MSTaskSwWClass",0)
runtasksh&:=h&
//get clockclassh
h&:=external("user32","FindWindowExA",0,0,"Shell_TrayWnd",0);thdl&:=h&;gettbpos h&
h&:=external("user32","FindWindowExA",h&,0,"TrayNotifyWnd",0);tbn&:=h&
h&:=external("user32","FindWindowExA",h&,0,"TrayClockWClass",0)
wh&:=width(h&);hh&:=height(h&)
case wh&>99 : notnormaltbmsg 1
case tbxx&<>%maxx : notnormaltbmsg 1
case tbyy&<>%maxy : notnormaltbmsg 1
case tbx&<>0 : notnormaltbmsg 1
windowstyle 80+512
window 0,0 - 0,0wh&,hh&
external("user32","SetParent",%hwnd,h&)
mcls 100,hh&
startpaint h&;copybmptomem 0,0 - 1,hh& > 0,0;endpaint
setwindowpos %hwnd = 0,0 - wh&,hh&;0
thread.do 1

whilenot ex%

    thread.start 1,9;waitinput;thread.stop 1
    mk%:=%mousekey

    if mk%==1

        setmenuitem 0
        createmenu
        appendmenu 800,"About"
        separator
        appendmenu 700,"Kalender"
        separator
        subpopup "Einblenden/Ausblenden"

        if external("user32","IsWindowVisible",desktoph&)

            appendmenu 101,"Desktopsymbole ausblenden"

        else

            appendmenu 101,"Desktopsymbole einblenden"

        endif

        if external("user32","IsWindowVisible",runtasksh&)

            appendmenu 102,"Ausgeführte Anwendungen ausblenden"

        else

            appendmenu 102,"Ausgeführte Anwendungen einblenden"

        endif

        if external("user32","IsWindowVisible",sbutt&)

            appendmenu 103,"Start-Knopf ausblenden"

        else

            appendmenu 103,"Start-Knopf einblenden"

        endif

        endsub
        separator
        subpopup "Programmstart"
        clearlist
        chdir fgetdir.desktop()
        addfiles "*.*"
        clear parr$[]
        clear parrn$[]
        cx%:=0
        for i&:=0 to %getcount do begin

        if mid$(listboxitem$(i&),1,1)<>"["

            if upper$(right$(listboxitem$(i&),4))==".LNK"

                parr$[cx%]:=listboxitem$(i&)
                parrn$[cx%]:=del$(listboxitem$(i&),len(listboxitem$(i&))-3,4)

            else

                parr$[cx%]:=listboxitem$(i&)
                parrn$[cx%]:=listboxitem$(i&)

            endif

            cx%+

        endif

        end
        for i&:=0 to cx%-1 do begin
        appendmenu 1000+i&,parrn$[i&]
        end
        endsub
        separator
        appendmenu 100,"Beenden"
        trackmenu %mousex,%mousey

        if %menuitem==100

            ex%:=1

        elseif %menuitem==101

            if external("user32","IsWindowVisible",desktoph&)

                showwindow.desktop 0

            else

                showwindow.desktop 1

            endif

        elseif %menuitem==102

            if external("user32","IsWindowVisible",runtasksh&)

                showwindow (runtasksh&,0)

            else

                showwindow (runtasksh&,1)

            endif

        elseif %menuitem==103

            if external("user32","IsWindowVisible",sbutt&)

                showwindow (sbutt&,0)

            else

                showwindow (sbutt&,1)

            endif

        elseif (%menuitem>999) and (%menuitem<1600)

            shell "rundll32.exe url.dll,FileProtocolHandler "+parr$[%menuitem-1000]

        elseif (%menuitem==800)

            shell par$(0)+" -about"

        elseif (%menuitem==700)

            shell par$(0)+" -cal"

        endif

        setmenuitem 0

    endif

    if mk%==2

        showwindow (%hwnd,0)
        mevent(8,0,0,0,0);mevent(16,0,0,0,0)//rklick
        wt 3000
        showwindow (%hwnd,1)

    endif

wend

app.exit
end

proc wt

    parameters i&
    i&:=i&10

    whileloop 10

        settimer i&;waitinput;killtimer

    wend

endproc

proc app.exit

    pipe.close pipe&
    showwindow (%hwnd,0)
    showwindow (tbn&,0)//redraw trayicnz+clock
    showwindow (tbn&,1)
    end

endproc

proc gettbpos

    parameters h&
    declare mem#;Dim mem#,44;Clear mem#;Long mem#,0=44
    external("user32","GetWindowPlacement",h&,mem#)
    tbx&:=Long(mem#,28)
    tby&:=Long(mem#,32)
    tbxx&:=Long(mem#,36)
    tbyy&:=Long(mem#,40)
    Dispose mem#

endproc

proc notnormaltbmsg

    parameters exit%
    showwindow (%Hwnd,0)
    messagebox "Die Taskbar wurde bewegt und/oder ist nicht in der qNormalpositionq.
    Diese kleine Anwendung ist nur für qnormaleq Taskbars gedacht.
    "+apptitle$+" wird beendet.",apptitle$,4096
    case exit% : app.exit

endproc

proc thread.do

    parameters n&

    if n&==1

        if (height(h&)<>hh&)

            notnormaltbmsg 0
            ex%:=1
            sendmessage (%hwnd,16,0,0)

        endif

        if (width(h&)<>wh&)

            ifnot ex%

                notnormaltbmsg 0
                ex%:=1
                sendmessage (%hwnd,16,0,0)

            endif

        endif

        if tme$<>time$(0)

            tme$:=time$(0)
            disp

        endif

    elseif n&==2

        setwindowpos monthcal&= 0,0 - width(dlg&),height(dlg&);0

    endif

endproc

proc disp

    startpaint -1
    copysizedbmp 0,0 - 1,hh& > 1,0 - 99,hh&;0
    textcolor whi&,-1
    usefont "Tahoma",13,0,0,0,0
    drawtext (wh&/2-14)+3,4,tme$
    usefont "Tahoma",11,0,0,0,0
    drawtext (wh&/2-17)+2,16,del$(date$(0),7,2)
    endpaint
    mcopybmp 1,0 - wh&,hh& > 0,0;0

endproc

proc showwindow.taskbar

    parameters m%
    showwindow(external("user32","FindWindowExA",0,0,"Shell_TrayWnd",0),m%)

endproc

proc showwindow.desktop

    parameters m%
    showwindow(external("user32","FindWindowExA",0,0,"progman",0),m%)

endproc