XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Video: AVI-Player für Profan 6.x (Animate-Control)
------------------------------------------------------------------------------
Avi-Player für Profan 6.0 32 Bit                     (P)Fairware, Freeware...
Beliebig plazierbarer und in freier Größe darstellbarer mit
Steuerelementen. Play, Stop, Rewind, Trackbar.
In der Proc  CREATE_AVISHOW das gewünschte AVI-File einsetzen.
(c) 1998 Richard Maurukas
angepaßt von Dietmar Horn
------------------------------------------------------------------------------
DEF @CREATETRACKBAR(6) @control(msctls_trackbar32,
@$(2),$50800064,@%(3),@%(4),@%(5),@%(6),@%(1),100, %HInstance)
DEF MakeLong(2) OR(@&(1),MUL(@&(2),$10000))
DEF @CREATEAnimate(6) @control(STATIC,
@$(2),$50880000,@%(3),@%(4),@%(5),@%(6),@%(1),101, %HInstance)
Declare A$,B$,Bilder$,Ende%,e%
Declare Animate1&,AnimStop&,Animgo&,AnimRet&,Frameinfo&,VORZU%
Declare Trackbar1&,TrackPos!,neupos!,MaxFrames&

PROC CREATE_AVISHOW

    PARAMETERS AVIWIND&,AVIX%,AVIY%,AVIBr%,AVIHö%
    declare Animate2&
    Usefont MS Sans Serif,10,0,0,0,0
    setdialogfont 1
    let Animate1& =CreateAnimate(AVIWIND&,,AVIX%,AVIY%,AVIBr%,AVIHö%)
    LET Animate2&=CreateAnimate(AVIWIND&,,AVIX%,add(aviy%,AVIHö%),AVIbr%,55)
    let Trackbar1&=CreateTrackbar(Animate2&,,0,0,AVIBr%,28)
    Let AnimGo&   =Createbutton(Animate2&,>,5,30,20,20)
    let AnimStop& =Createbutton(Animate2&,||,25,30,20,20)
    Let Animret&  =Createbutton(Animate2&,<<,45,30,20,20)
    Let FrameInfo&=Createtext(Animate2&,,70,35,sub(Avibr%,70),20)
    sendmessage(Trackbar1&,$41B,12,0)  TBM_SETTHUMBLENGTH=WM_USER+27
    Hier die AVI mit Pfadangabe einbinden-----
    let A$=SPUREN.AVI
    ------------------------------------------
    Let A$=@ADD$(@ADD$(OPEN ,A$), TYPE AVIVIDEO ALIAS FILM)
    Let B$=@MCISend$(A$)
    @MCISEND$(SET FILM time format frames)
    Let Bilder$=@MCISEND$(STATUS FILM length)
    Settext Frameinfo&,add$(Bilder$, Einzelbilder in der Datei.)
    Let MaxFrames&=val(Bilder$)
    sendmessage(Trackbar1&,$406,1,Makelong(1,maxframes&))
    @MCISend$(add$(WINDOW FILM Handle ,str$(Animate1&)))
    @MCISend$(PUT FILM DESTINATION)

ENDPROC

Window 0,0-640,480
Windowtitle Animatecontrol mit AVI,(c) Richard Maurukas
settruecolor 1
Cls rgb(0,0,75)
CREATE_AVISHOW %Hwnd,0,20,360,280
let ende%=0
let e%=1
declare läuft%
let läuft%=0

Whilenot equ(Ende%,1)

    waitinput
    getmessage

    if and(getfocus(AnimStop&),equ(Läuft%,0))

        @MCISend$(CLOSE FILM)
        let Ende%=1

    elseif Getfocus(Trackbar1&)

        locate 10,0
        let e%= sendmessage(Trackbar1&,$400,0,0)
        @MCISEND$(add$(add$(add$(PlAY FILM from ,str$(e%)), to ),str$(e%)))
        settext Frameinfo&,add$(add$(add$(add$( Bild :,str$(e%)), von ),bilder$),  Bildern.)

    Elseif Getfocus(AnimGO&)

        whilenot or(gt(e%,MaxFrames&),getfocus(Animstop&))

            if equ(läuft%,0)

                @MCISend$(PUT FILM DESTINATION)
                @MCISEND$(add$(add$(add$(PlAY FILM from ,str$(e%)), to ),Bilder$))
                let läuft%=1

            endif

            settext Frameinfo&,add$(add$(add$(add$( Bild :,str$(e%)), von ),bilder$),  Bildern.)
            let e%=val(@MCISEND$(STATUS FILM Position))
            sendmessage(trackbar1&,$405,e%,e%)

            if getfocus(Animstop&)

                let läuft%=0

            endif

        wend

        setfocus(%Hwnd)
        @MCISEND$(STOP FILM)

    Elseif Getfocus(AnimRet&)

        let E%=0
        sendmessage(trackbar1&,$405,-1,0)

    Elseif equ(%Key,2)

        @MCISend$(CLOSE FILM)
        let Ende%=1

    endif

wend

@MCISend$(CLOSE FILM)
destroywindow(Animate1&)
End
------------------------------------