XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Aboutbox mit Internetzugang und externem Cursor
Lauffähig ab Profan-Version 6.6
Aboutbox für Profaner(innen)
Andreas Miethe * Bielefeld * Juli 1998
Aboutbox mit Internetdirektzugang und einer Routine
zum Laden und Zuweisen von externen Cursor
***************************************************
 $I Vordefs.INC
 $I Extcur.INC
 $I MakeURL.INC
 $I Knopf.INC
 $I Control.INC
URL.DLL suchen
Declare url$,url&,Aufgerufen&,x%,y%
Let Aufgerufen&=0
Let URL$=@FindFirst$(add$($SysPath,\URL.DLL))
Case equ$(URL$,):Let url&=0
Case neq$(URL$,):Let url&=1
Voreinstellung
showwindow(%hwnd,0)
Windowstyle $74
Declare internet%,dlg%,OK%,Ende%,url%,text4$,Rahmen1%,rahmen2%,Rahmen3%,text1%,text2%,text3%
Declare intertext$,text1$,text2$,text3$,text4$,Text5$
Declare icon%,Farbe&
Declare sch$
Let Intertext$=http://www.ampsoft.de
Let text1$=Programm zur Darstellung einer eigenen Aboutbox mit Internet-Direkt-Zugang
Let text2$=text2$;Bildschirmschonervorschau;chr$(13)
Let text2$=text2$;Vielen Dank an dieser Steller an;chr$(13);Thomas Hölzer auf dessen Quellcode
Let text2$=text2$;die Bildschirmschonervorschau aufgebaut ist
Let text3$=Danksagung an alle Profaner(innen) die Quellcodes veröffentlicht haben !
Let text4$=Der Autor
Let Ende%=0
Let dlg%=CreateWindow(%hwnd,Über...,ACenterx(400),ACentery(310),400,310)
cls RGB(192,192,192)
Let ok%=@Createbutton(DLG%,OK,10,265,100,24)
Let Rahmen1%=@CreateVshape(DLG%,,10,10,100,100)
Let Rahmen2%=@CreateVshapeBlack(DLG%,,250,132,130,90)
Let Rahmen3%=@CreateVshape(DLG%,text2$,10,132,230,90)
Let text1%=@CreateVshape(DLG%,text1$,125,10,255,100)
Let text2%=@CreateTextL(DLG%,text4$,38,111,100,16)
Let text3%=@CreateTextM(DLG%,text3$,250,235,130,80)
Let icon%=@CreateIconA(DLG%,A,195,250,0,0)

If equ(URL&,1)

    Let internet%=@Createtextbutton (DLG%,,10,230,172,16)

Endif

Startpaint dlg%

If equ(URL&,1)

    LET Farbe& = @syscolor(13)

Elseif neq(URL&,1)

    LET Farbe& = @syscolor(17)

Endif

Textcolor farbe&,-1
Usefont Arial,15,0,0,0,1
setdialogfont 1
Drawtext 12,230,http://www.ampsoft.de
Endpaint
Mloadbmp Ich.bmp
Startpaint rahmen1%
APIIntersectClipRect(%HDC,2,2,96,96)
Mcopysizedbmp 0,0-%bmpx,%bmpy > 0,0-96,96;-1
Loadsizedbmp ich.bmp,0,0-96,96;0
Endpaint
Internerdirektverbindung erstellen
URL_Erstellen intertext$
Bildschirmschoner auswählen
wenn da, dann Starfield Simulation sonst der erste Beste
Let sch$=@FindFirst$(Add$($SysPath,Starfield Simulation.scr))

if equ$(sch$,)

    Let sch$=@FindFirst$(Add$($SysPath,*.scr))

endif

ScrPreviewP(sch$,rahmen2%)
Externen Cursor laden und zuweisen
*.CUR oder *.ICO oder *.ANI

If equ(URL&,1)

    Lade_Cursor Hand.cur,internet%

Endif

Setautopaint 0

Whilenot Ende%

    getmessage

    If %wmpaint

        Startpaint rahmen1%
        APIIntersectClipRect(%HDC,2,2,96,96)
        Mcopysizedbmp 0,0-%bmpx,%bmpy > 0,0-96,96;-1
        Endpaint

    Endif

    If equ(URL&,1)

        if equ(%mwnd,internet%)

            ApiSetClassLong(internet%,-12,Hc&)
            Startpaint dlg%
            Textcolor farbe&,-1
            Usefont Arial,15,0,0,0,1
            setdialogfont 1
            Drawtext 12,230,http://www.ampsoft.de
            Endpaint

        Endif

        ifnot equ(%mwnd,internet%)

            Usecursor 0

            If equ(Aufgerufen&,0)

                LET Farbe& = @syscolor(13)

            Elseif equ(Aufgerufen&,1)

                LET Farbe& = @syscolor(2)

            Endif

            Startpaint dlg%
            Setdialogfont 1
            Textcolor farbe&,-1
            Usefont Arial,15,0,0,0,1
            setdialogfont 1
            Drawtext 12,230,http://www.ampsoft.de
            Endpaint

        Endif

    Endif

    if getfocus(ok%)

        Let Ende%=1

    Elseif getfocus(internet%)

        Let aufgerufen&=1
        URL_Aufrufen
        setfocus(text1%)

    endif

endwhile

Ende:
Internerdirektverbindung loeschen
URL_Loeschen
End