XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Copyright-Dialog mit Internet- und Mailadresse
cls
######## für Copyright ###########
Code für anklickbaren Text und Cursorhand von Andreas Miethe
H-J. Trog 10/2002 (Freewarecode)
Adressangaben usw. bitte anpassen!
DEF @ASetClassLong(3) ! USER32,SetClassLongA
Parameter : %Handle,-12(HCursor),Cursorhandle
Def @ALoadCursor(2) !USER32,LoadCursorA
Parameter : %Hinstance,Name
Declare StaticCur&
Let StaticCur& = @ALoadCursor(0,32649) wenn WIN98 dann Hand, auch Win Me
DEF HiWord(1) Div&(&(1),$10000)
DEF LoWord(1) And(&(1),$FFFF)
DEF &WM_COMMAND $0111
UserMessages &WM_COMMAND
declare pname1$,version$,programmname$,datum$,eintrag$,email$,subject$,hp$
pname1$=CPSTARTER
programmname$=@add$(Startprogramm für CPicture: ,pname1$)
version$=V. 1.4
datum$=(2001 - 2002)
email$=sumatra@dhjt.de
hp$=http://www.dhjt.de
eintrag$=@add$(email: ,email$)
subject$=@add$(pname1$,version$)

Proc SendMail

    Parameters adress$,subject$
    Let adress$=mailto: ;adress$;?subject=;subject$

    If Lt(ShellExec(adress$,open,1),32)

        Messagebox(Standard Mail-Programm kann nicht gestartet werden!,Fehler,16)

    EndIf

EndProc

proc copyright

    declare mail&,t1&,t2&,t3&,t4&,ende&,e&,font1%
    Font1% = @Create(Font,Arial,12,7,1,1,1)
    SetDialogFont 1
    UseFont ARIAL,14,0,1,0,0
    mail&=@CreateDialog(%hwnd,Copyright,10,50,300,150)
    t1&=@CreateText(mail&,@add$(programmname$,version$),10,10,350,20)
    t2&=@CreateText(mail&,@add$(© H.-J. Trog ,datum$),10,30,200,20)
    t4&=@Control(Static,hp$,$50000100,10,50,200,16,mail&,1003,%Hinstance)
    SetFont t4&,Font1%
    T3& = @Control(Static,eintrag$,$50000100,10,70,200,16,mail&,1003,%Hinstance)
    SetFont t3&,Font1%
    e& = @Control(Button,Zurück,$50000000,185,100,100,20,mail&,1003,%Hinstance)
    @ASetClassLong(t4&,-12,StaticCur&)

    WHILENOT @Equ(ende&,1)

        waitinput

        If %UMessage = &WM_COMMAND

            If &ULParam = T3&

                Static-Control abarbeiten

                If HiWord(&UWParam) = 0Static-Klick

                    sendmail email$,subject$

                Endif

            elseIf &ULParam = T4&

                Static-Control abarbeiten

                If HiWord(&UWParam) = 0Static-Klick

                    ShellExec(hp$,,0)

                Endif

            ElseIf &ULParam = e&

                Button abarbeiten

                If HiWord(&UWParam) = 0 Button-Clicked

                    ende& = 1

                EndIf

            ElseIf &UWParam = 2

                X-abarbeiten
                ende& = 1

            Endif

        endif

    ENDWHILE

    DELETEOBJECT Font1%

endproc

######## Ende copyright