XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Info-über-Dialog anzeigen
Lauffähig ab Profan-Version 5.0
PRFellow-Vorlage
Autor: Thomas Hölzer
Einige interne Funktionen aus Win 9x(teilweise auch NT 4) mit Profan aufrufen
Def RunControl(2) WinExec(Add$(Add$(
RUNDLL32 SHELL32.DLL,Control_RunDLL ,$(1)),.CPL ),$(2),1)
Def FileOpenAs(1) WinExec(Add$(RUNDLL32 SHELL32.DLL,OpenAs_RunDLL ,$(1)),1)
Def FindWindow32(2) !USER32,FindWindowA
Def ShellAbout(4) !SHELL32,ShellAboutA
Def SHClearDocList(2) !SHELL32,SHAddToRecentDocs
Declare ende%,winclass#,titel#,text#,task%,desktop%

Proc ShowTaskBar

    Parameters show%
    Declare htray&
    Dim winclass#,13
    String winclass#,0=Shell_TrayWnd
    Let htray&=FindWindow32(winclass#,0)
    ShowWindow(htray&,show%)
    Dispose winclass#

EndProc

Proc ShowDesktop

    Parameters show%
    Declare desktop&
    Dim winclass#,8
    String winclass#,0=ProgMan
    Let desktop&=FindWindow32(winclass#,0)
    ShowWindow(desktop&,show%)
    Dispose winclass#
    ShowTaskbar show%

EndProc

Proc FormatDriveDlg

    WinExec(RUNDLL32 SHELL32.DLL,SHFormatDrive,1)

EndProc

Proc DiskCopyDlg

    WinExec(RUNDLL32 DISKCOPY.DLL,DiskCopyRunDll,1)

EndProc

Proc FindFileDlg

    ab Profan 6.1 reicht:
    ShellExec(C:,find,1)
    Declare w&
    Dim winclass#,8
    String winclass#,0=ProgMan
    Let w&=FindWindow32(winclass#,0)
    PostMessage(w&,$0100,$72,0)
    PostMessage(w&,$0101,$72,0)
    Dispose winclass#

EndProc

Proc ClearDocMRU

    SHClearDocList(0,0)

EndProc

Proc StartScreenSaver

    SendMessage(%hwnd,$0112,$F140,0)

EndProc

Proc Arbeitsplatz

    WinExec(explorer /n,::{20D04FE0-3AEA-1069-A2D8-08002B30309D},1)

EndProc

Proc Papierkorb

    WinExec(explorer /n,::{645FF040-5081-101B-9F08-00AA002F954E},1)

EndProc

Proc RefreshDesktop

    Declare w&
    Dim winclass#,8
    String winclass#,0=ProgMan
    Let w&=FindWindow32(winclass#,0)
    PostMessage(w&,$0100,$74,0)
    PostMessage(w&,$0101,$74,0)
    Dispose winclass#

EndProc

Cls
PopUp &Datei
AppendMenu 1,&Beenden	Alt+F4
PopUp &Systemsteuerung
AppendMenu 10,&Drucker
AppendMenu 11,&Fonts
AppendMenu 12,&Maus
AppendMenu 13,&Tastatur
AppendMenu 14,&Anzeige
AppendMenu 15,&Bildschirmschoner
AppendMenu 16,&System
AppendMenu 17,&Hardware-Assistent
AppendMenu 18,&Ländereinstellungen
AppendMenu 19,Datum und Uhr&zeit
AppendMenu 20,S&oftware
AppendMenu 21,&Modems
AppendMenu 22,Ma&il und Fax
AppendMenu 23,M&ultimedia
AppendMenu 24,S&ystemklänge
AppendMenu 25,Kenn&wörter
AppendMenu 26,&Joystick
PopUp Di&verses
AppendMenu 40,Diskette &kopieren
AppendMenu 41,Diskette &formatieren
AppendMenu 42,Datei&verknüpfung
AppendMenu 43,Datei &suchen
AppendMenu 44,&Taskleiste aus-/einblEnden
AppendMenu 45,&Über... - Dialog
AppendMenu 46,&Bildschirmschoner starten (falls aktiviert)
AppendMenu 47,&Startmenü aufklappen
AppendMenu 48,Arbeitsplatz öffnen
AppendMenu 49,Papierkorb
AppendMenu 50,Desktop verstecken /zeigen
AppendMenu 51,Desktop-Refresh
AppendMenuBar 100, &?
DrawText 100,100,Einige Systemsteuerungsaufrufe arbeiten nicht mit allen Win-Versionen.
DrawText 100,150,Ein paar interne Funktionen aus Windows 9x mit Profan aufrufen
DrawText 100,200,Bitte über Programm-Menü beenden!

WhileNot ende%

    WaitInput

    If MenuItem(1)

        Let ende%=1

    ElseIf MenuItem(10)

        RunControl(MAIN,Drucker)

    ElseIf MenuItem(11)

        RunControl(MAIN,SchrIftarten)

    ElseIf MenuItem(12)

        RunControl(MAIN,Maus)

    ElseIf MenuItem(13)

        RunControl(MAIN,Tastatur)

    ElseIf MenuItem(14)

        RunControl(DESK,)

    ElseIf MenuItem(15)

        winexec(CONTROL DESK.CPL,,1,1)

    ElseIf MenuItem(16)

        RunControl(SYSDM,)

    ElseIf MenuItem(17)

        RunControl(SYSDM,Hardware)

    ElseIf MenuItem(18)

        RunControl(INTL,)

    ElseIf MenuItem(19)

        RunControl(TIMEDATE,)

    ElseIf MenuItem(20)

        RunControl(APPWIZ,)

    ElseIf MenuItem(21)

        RunControl(MODEM,)

    ElseIf MenuItem(22)

        RunControl(MLCFG32,)

    ElseIf MenuItem(23)

        RunControl(MMSYS,)

    ElseIf MenuItem(24)

        RunControl(MMSYS,Akustische Signale)

    ElseIf MenuItem(25)

        RunControl(PASSWORD,)

    ElseIf MenuItem(26)

        RunControl(JOY,)

    ElseIf MenuItem(40)

        DiskCopyDlg

    ElseIf MenuItem(41)

        FormatDriveDlg

    ElseIf MenuItem(42)

        FileOpenAs(TST)

    ElseIf MenuItem(43)

        FindFileDlg

    ElseIf MenuItem(44)

        ShowTaskbar task%
        Let task%=Not(task%)

    ElseIf MenuItem(45)

        Dim titel#,50
        Dim text#,80
        String titel#,0=Mein Progi#ist meine Lieblingsfirma
        String text#,0=Hier kann z.B. ein eigener Copyright-Hinweis eingesetzt werden!
        ShellAbout(%hwnd,titel#,text#,0)
        Dispose titel#
        Dispose text#

    ElseIf MenuItem(46)

        StartScreenSaver

    ElseIf MenuItem(47)

        PostMessage(%desktop,$0112,$F130,0)

    ElseIf MenuItem(48)

        Arbeitsplatz

    ElseIf MenuItem(49)

        Papierkorb

    ElseIf MenuItem(50)

        ShowDesktop desktop%
        Let desktop%=Not(desktop%)

    ElseIf MenuItem(51)

        RefreshDesktop

    ElseIf MenuItem(100)

        MessageBox(Thomas Hölzer
        webmaster@tehsoft.de,Info,64)

    EndIf

Wend

Wir wollen ja mal nicht so gemein sein ...
ShowDesktop 1
ShowTaskbar 1