XProfan

Proc gCkSize

    Parameters gCS_CX&,gCS_CY&,gCS_MaxX&,gCS_MaxY&
    Declare gCS_EX&,gCS_EY&
    Clear gCS_EX&,gCS_EY&
    gCS_EX& = gCS_CX&
    gCS_EY& = gCS_CY&

    If (gCS_CY& > gCS_MaxY&)

        gCS_EY& = gCS_MaxY&
        gCS_EX& = (gCS_CX& * (gCS_EY& / gCS_CY&))

    EndIf

    If (gCS_EX& > gCS_MaxX&)

        gCS_EX& = gCS_MaxX&
        gCS_EY& = (gCS_EY& * (gCS_EX& / gCS_CX&))

    EndIf

    Gl_CX& = gCS_EX&
    Gl_CY& = gCS_EY&
    Return 0

EndProc

Declare Gl_CX&,Gl_CY&

Proc ChkDat

    Parameters CD_dName$
    CD_dName$ = Upper$(CD_dName$)
    CaseNot FileExists(CD_dName$): Return 0
    Case InStr(".BMP",CD_dName$) : Return 1
    Case InStr(".GIF",CD_dName$) : Return 1
    Case InStr(".JPG",CD_dName$) : Return 1
    Case InStr(".JPEG",CD_dName$): Return 1
    Case InStr(".PNG",CD_dName$) : Return 1   ab XProfan11
    Return 0

EndProc

Proc DelPHndl

    Parameters DO_PHndl&
    Case DO_PHndl&: DeleteObject DO_PHndl&
    Return 0

EndProc

Proc cPic

    Parameters cP_PHndl&,cP_dNr&
    Declare cP_Name$
    cP_Name$ = ListBoxItem$(cP_dNr&)

    If ChkDat(cP_Name$)

        cP_PHndl&  = DelPHndl(cP_PHndl&)
        cP_PHndl&  = Create("HPic",-1,cP_Name$)
        gCkSize(%BmpX,%BmpY,%MaxX,%MaxY)      Sind %BmpX > %MaxX und/oder %BmpY > %MaxY dann Proportional
        auf Monitorgröße umrechnen!
        DrawSizedPic cP_PHndl&,0,0-Gl_CX&,Gl_CY&;0

    Else

        Return 0

    EndIf

    Return cP_PHndl&

EndProc

Proc gCkSize

    Parameters gCS_CX&,gCS_CY&,gCS_MaxX&,gCS_MaxY&
    Declare gCS_EX&,gCS_EY&
    Clear gCS_EX&,gCS_EY&
    gCS_EX& = gCS_CX&
    gCS_EY& = gCS_CY&

    If (gCS_CY& > gCS_MaxY&)

        gCS_EY& = gCS_MaxY&
        gCS_EX& = (gCS_CX& * (gCS_EY& / gCS_CY&))

    EndIf

    If (gCS_EX& > gCS_MaxX&)

        gCS_EX& = gCS_MaxX&
        gCS_EY& = (gCS_EY& * (gCS_EX& / gCS_CX&))

    EndIf

    Gl_CX& = gCS_EX&
    Gl_CY& = gCS_EY&
    Return 0

EndProc

Declare Gl_PHndl&,Gl_dName$,Gl_PMaxNr&,Gl_Zaehler&
TextColor RGB(255,255,255),0
WindowStyle $F0
Window 0,0-%MaxX,%MaxY
ShowCursor 0
Cls 0
TextColor RGB(255,255,255),0
ClearList
AddFiles *"*.BMP"
AddFiles *"*.GIF"
AddFiles *"*.JPG"
AddFiles *"*.PNG"   ab XProfan11
Gl_PMaxNr& = %GetCount
Case (Gl_PMaxNr& = -1): End
Def CckVGK(1) If((&(1) > Gl_PMaxNr&),0,If((&(1) < 0),Gl_PMaxNr&,&(1)))
Gl_PHndl&   = cPic(Gl_PHndl&,0)
Gl_Zaehler& = 0
Gl_PHndl& = cPic(Gl_PHndl&,Gl_Zaehler&)

While 1: WaitInput : Cls 0

    Case (IsKey(27) | IsKey(69) | IsKey(101) | IsKey(4)): Break

    If (IsKey(34) | IsKey(37) | IsKey(40) | IsKey(2))

        Dec Gl_Zaehler&

    Else

        Inc Gl_Zaehler&

    EndIf

    Gl_Zaehler& = CckVGK(Gl_Zaehler&)
    Gl_PHndl& = cPic(Gl_PHndl&,Gl_Zaehler&)

EndWhile

ShowCursor 1
ClearList
DelPHndl(Gl_PHndl&)
End