English
Source / code snippets

Anzeigegröße Bildgröße Proportional Verify converting

 

Michael
Dell
are CX > MaxX and/or CY > MaxY then becomes Proportional
on Monitorgröße umgerechnet! (XProfan10)

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

Demo:
Declare Gl_CX&,Gl_CY&

Proc ChkDat

    Parameters CD_dName$
    CD_dName$ = Upper $(CD_dName$)
    Casenote 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   ex 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)      are %BmpX > %MaxX and/or %BmpY > %MaxY then Proportional
        on Monitorgröße converting!
        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&
Text Color RGB(255,255,255),0
Window Style $F0
Window 0,0-%MaxX,%MaxY
ShowCursor 0
Cls 0
Text Color RGB(255,255,255),0
ClearList
AddFiles *"*.BMP"
AddFiles *"*.GIF"
AddFiles *"*.JPG"
AddFiles *"*.PNG"   ex 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
goes with Create("hSizedPic",...) plainer but one sees here pointed goes.
 
Salu Michael...

Hab zwar krumme Fieß awer dofir e' ecklich Gsicht! 
08/04/08  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

7.376 Views

Untitledvor 0 min.
Michael Hettner05/02/22
Jörg Sellmeyer05/28/20
GDL09/12/15
Dieter Zornow11/18/11
More...

Themeninformationen

this Topic has 1 subscriber:

Michael Dell (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie