XProfan

 $I profalt.inc
 $P+
SetErrorLevel 0
'********************** HINWEISE ********************************
'CODE ERZEUGT MIT ROKOS OBJECT CREATOR 3.2
'DATUM  24.06.2003    um  21:33 Uhr
'VERWENDETE PROFANVERSION IST 7.0 ODER HÖHER
Def GetSysColor(1) !"USER32","GetSysColor"
DEF @LoadImage(6) ! "USER32","LoadImageA"
DECLARE ENDE%,x1%,y1%,sicher%,bild&
DECLARE HSCROLL1%,HWSTATUS&,HWSTATUS2&,Bild$
DECLARE VSCROLL1%,Hwscrollrech%,Vscrollrech%

PROC BILDLADEN

    Parameters bild$,x%,y%,hw&
    Declare wfb#,bild&,h&
    Dim wfb#,Add(Len(bild$),1)
    String wfb#,0=bild$
    Let h&=LoadImage(%hinstance,wfb#,0,x%,y%,$50)
    bild&=Control("STATIC","",$05000010E,0,0,x%,y%,hw&,2001,%hinstance)
    SendMessage(bild&,$172,0,h&)
    Dispose wfb#
    return bild&

ENDPROC

PROC LADEN

    PARAMETERS BILD$
    MLoadBMP BILD$'Nur um die X und Y Werte zu ermitteln!
    X1%=%BmpX
    y1%=%BmpY
    destroywindow(bild&)
    BILDLADEN BILD$,X1%,Y1%,hwstatus&
    bild&=@&(0)
    hwstatus2&=@&(0)
    SetScrollRange hscroll1%,0,div(x1%,2)
    SetScrollRange Vscroll1%,0,div(y1%,2)
    SetScrollPos hscroll1%,0
    SetScrollPos vscroll1%,0
    Return bild&

ENDPROC

WINDOWSTYLE 63
WINDOWTITLE "TASTE F12 neues Bild laden"
WINDOW 236,190-501,311
CLS GETSYSCOLOR(15)
USEFONT "MS Sans Serif",13,0,0,0,0
SETDIALOGFONT 1
HSCROLL1% = CREATE("HScroll",%HWND,"HSCROLL1",0002,0260,0490,0016)
VSCROLL1% = CREATE("VScroll",%HWND,"VSCROLL1",0476,0002,0016,0256)
hwstatus&=Control("STATIC","",$54001100,2,2,472,255,%hwnd,2000,%hinstance,512)'Wenn kleinere Profanversion, bitte 512 entfernen!!!
Bild$=""
EnableWindow HSCROLL1%,0
EnableWindow VSCROLL1%,0

WHILENOT ENDE%

    WAITINPUT

    If @EQU(%KEY,2)

        LET ENDE%= 1

    ELSEIF EQU(%SCANKEY,123)

        LET BILD$=@LOADFILE$("ÖFFNE:","*.BMP")

        IF neq$(Bild$,"")

            LADEN Bild$
            bild&=@&(0)

        ELSE

            DestroyWindow(Bild&)
            EnableWindow HSCROLL1%,0
            EnableWindow VSCROLL1%,0

        Endif

    ENDIF

    IF NEQ$(BILD$,"")

        EnableWindow HSCROLL1%,1
        EnableWindow VSCROLL1%,1

        IF GETFOCUS(HSCROLL1%)'HScroll

            hwscrollrech%=getscrollpos(hscroll1%)-getscrollpos(hscroll1%)*2
            setwindowpos hwstatus2&=hwscrollrech%,vscrollrech%-x1%,y1%,0
            REPAINT
            setfocus(%hwnd)

        ELSEIF GETFOCUS(VSCROLL1%)'VScroll

            Vscrollrech%=getscrollpos(Vscroll1%)-getscrollpos(Vscroll1%)*2
            setwindowpos hwstatus2&=hwscrollrech%,Vscrollrech%-x1%,y1%,0
            REPAINT
            setfocus(%hwnd)

        ENDIF

    ENDIF

WEND