XProfan

Français

Gemerkt/Separiert von http://xprofan.com/thread.core?t=5812
 {$cleq}
const appTitle=PicScrollDlg
const scrollBarsWidth=20
long hPic=create(hPic,-1,pic2.jpg)
casenot hPic : err(pic not loaded)
long hPic.szX=bmpx,hPic.szY=bmpy
windowstyle 2 | 8 | 16 | 512
long hDlg=createwindow(hwnd,appTitle,100,100,540,380)
long hDlg.hScrollY=create(vScroll,hDlg,,width(hDlg)-scrollBarsWidth,0,scrollBarsWidth,height(hDlg)-scrollBarsWidth)
long hDlg.hScrollX=create(hScroll,hDlg,,0,height(hDlg)-scrollBarsWidth,width(hDlg)-scrollBarsWidth,scrollBarsWidth)
long hBlindStatic=create(text,hDlg,,width(hDlg)-scrollBarsWidth,height(hDlg)-scrollBarsWidth,scrollBarsWidth,scrollBarsWidth)
usermessages wm_close

do {

    hPic.Paint(hPic,hDlg,hDlg.hScrollX,hDlg.hScrollY,hPic.szX,hPic.szY)
    invalidaterect(hBlindStatic,0,0)
    updatewindow(hBlindStatic)
    waitinput
    case umessage==wm_close:break

}

deleteobject hpic
destroywindow(hDlg)
end

err(string s){

    messagebox(s,appTitle,4096)
    end

}

hPic.Paint(long hPic,hDlg,hScrlX,hScrlY,picSzX,picSzY){

    long x=0-getScrollPos(hScrlX)/100*(picSzX-width(hDlg)+scrollBarsWidth)
    long y=0-getScrollPos(hScrlY)/100*(picSzY-height(hDlg)+scrollBarsWidth)
    startpaint hDlg
    drawpic hPic,x,y;0
    endpaint
    invalidaterect(hScrlX,0,0)
    updatewindow(hScrlX)
    invalidaterect(hScrly,0,0)
    updatewindow(hScrlys2>)

}

pic2.jpg

86 kB

Hochgeladen:

25.09.2007

Downloadcounter:

Download

picscrolldlg.exe

741 kB

Hochgeladen:

25.09.2007

Downloadcounter:

Download

picscrolldlg.prf

2 kB

Hochgeladen:

25.09.2007

Downloadcounter:

Download

25.09.2007 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Frank
Abbing

Hab quelques Sachen verbessert, comment: Flackern beseitigt, automatische Bildrestaurierung et Echtzeitscrollen.
Kompilieren Marque Séparation

 {$cleq}
Const appTitle=PicScrollDlg
Const scrollBarsWidth=20
long hPic=create(hPic,-1,background.bmp)     Bildnamen anpassen
long hPic.szX=bmpx,hPic.szY=bmpy
windowstyle 2 | 8 | 16 | 512
long hDlg=createwindow(hwnd,appTitle,100,100,540,380)
long hDlg.hScrollY=create(vScroll,hDlg,,width(hDlg)-scrollBarsWidth,0,scrollBarsWidth,height(hDlg)-scrollBarsWidth)
long hDlg.hScrollX=create(hScroll,hDlg,,0,height(hDlg)-scrollBarsWidth,width(hDlg)-scrollBarsWidth,scrollBarsWidth)
long hBlindStatic=create(text,hDlg,,width(hDlg)-scrollBarsWidth,height(hDlg)-scrollBarsWidth,scrollBarsWidth,scrollBarsWidth)
SubClass hDlg.hScrollX, 1
SubClass hDlg.hScrollY, 1
SubClass hDlg, 1
usermessages wm_close

While 1

    hPic.Paint(hPic,hDlg,hDlg.hScrollX,hDlg.hScrollY,hPic.szX,hPic.szY)
    invalidaterect(hBlindStatic,0,0)
    updatewindow(hBlindStatic)
    waitinput
    case umessage==wm_close:break

EndWhile

deleteobject hpic
destroywindow(hDlg)
end

Proc hPic.Paint

    Parameters hPic2&,hDlg&,hScrlX&,hScrlY&,picSzX&,picSzY&
    long x=0-getScrollPos(hScrlX&)/100*(picSzX&-width(hDlg&)+scrollBarsWidth)
    long y=0-getScrollPos(hScrlY&)/100*(picSzY&-height(hDlg&)+scrollBarsWidth)
    startpaint hDlg&
    CopyPic hPic2&, 0,0 - (width(hDlg&)-scrollBarsWidth)-x,(height(hDlg&)-scrollBarsWidth)-y > x,y; 0
    endpaint
    invalidaterect(hScrlX&,0,0)
    updatewindow(hScrlX&)
    invalidaterect(hScrly&,0,0)
    updatewindow(hScrly&)

EndProc

SubClassProc

    If ((%sMessage=SBM_GETRANGE) or (%sMessage=WM_PAINT))

        hPic.Paint(hPic,hDlg,hDlg.hScrollX,hDlg.hScrollY,hPic.szX,hPic.szY)
        invalidaterect(hBlindStatic,0,0)
        updatewindow(hBlindStatic)

    EndIf

ENDPROC

10.12.2008 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

RGH

ici qui XPSE-Code traduit pour XProfan:
Kompilieren Marque Séparation

 $H Windows.ph
 $H Messages.ph
def $appTitle "PicScrollDlg"
def &scrollBarsWidth 20
var hPic& = create("hPic", -1, "hintergrund.bmp") Bildnamen anpassen
var hPic.szX& = %bmpx
var hPic.szY& = %bmpy
windowstyle 2 | 8 | 16 | 512
var hDlg& = create("window", %hwnd, $appTitle, 100, 100, 540, 380)
var hDlg.hScrollY& =
create("vScroll", hDlg&, "", width(hDlg&) - &scrollBarsWidth, 0,
&scrollBarsWidth, height(hDlg&) - &scrollBarsWidth)
var hDlg.hScrollX& =
create("hScroll", hDlg&, "", 0, height(hDlg&) - &scrollBarsWidth,
width(hDlg&) - &scrollBarsWidth, &scrollBarsWidth)
var hBlindStatic& =
create("text", hDlg&, "", width(hDlg&) - &scrollBarsWidth, height(hDlg&) - &scrollBarsWidth,
&scrollBarsWidth, &scrollBarsWidth)
SubClass hDlg.hScrollX&, 1
SubClass hDlg.hScrollY&, 1
SubClass hDlg&, 1
usermessages ~wm_close

While 1

    hPic.Paint(hPic&, hDlg&, hDlg.hScrollX&, hDlg.hScrollY&, hPic.szX&, hPic.szY&)
    ~invalidaterect(hBlindStatic&, 0, 0)
    ~updatewindow(hBlindStatic&)
    waitinput
    case %umessage = ~wm_close : break

EndWhile

deleteobject hpic&
destroywindow(hDlg&)
end

Proc hPic.Paint

    Parameters hPic2&,hDlg&,hScrlX&,hScrlY&,picSzX&,picSzY&
    var x& = 0 - getScrollPos(hScrlX&) / 100 * (picSzX& - width(hDlg&) + &scrollBarsWidth)
    var y& = 0 - getScrollPos(hScrlY&) / 100 * (picSzY& - height(hDlg&) + &scrollBarsWidth)
    startpaint hDlg&
    CopyPic hPic2&, 0,0 - (width(hDlg&) - &scrollBarsWidth - x&),
    (height(hDlg&) - &scrollBarsWidth - y&) > x&, y&; 0
    endpaint
    ~invalidaterect(hScrlX&, 0, 0)
    ~updatewindow(hScrlX&)
    ~invalidaterect(hScrly&, 0, 0)
    ~updatewindow(hScrly&)

EndProc

SubClassProc

    If ((%sMessage = ~SBM_GETRANGE) or (%sMessage = ~WM_PAINT))

        hPic.Paint(hPic&, hDlg&, hDlg.hScrollX&, hDlg.hScrollY&, hPic.szX&, hPic.szY&)
        ~invalidaterect(hBlindStatic&, 0, 0)
        ~updatewindow(hBlindStatic&)

    EndIf

./../../function-references/XProfan/endproc/'>ENDPROC

Salut
Roland

@iF: ici ist es wirklich völlig inintelligible, pourquoi einerseits à gauche près de dem Posting une grand le vide Surface ist et pour im Gegenzug cela Listing ständig à droite trop scrollen ist, um légèrement quoi trop erfassen. Meiner unmaßgeblichen attitude pour sollte cela Einrücken qui Postings zugunsten besserer Lesbarkeit ersatzlos gestrichen volonté!

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

11.12.2008 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

RGH

et cela Ganze deutlich kürzer:
Kompilieren Marque Séparation

 $H Messages.ph
def $appTitle "PicScrollDlg"
def &scrollBarsWidth 16
var hPic& = create("hPic", -1, "hintergrund.bmp") Bildnamen anpassen
var hPic.szX& = %bmpx
var hPic.szY& = %bmpy
windowstyle 2 | 8 | 16 | 512
var hDlg& = create("window", 0, $appTitle, 100, 100, 540, 380)
var hDlg.hScrollY& =
create("vScroll", hDlg&, "", width(hDlg&) - &scrollBarsWidth, 0,
&scrollBarsWidth, height(hDlg&) - &scrollBarsWidth)
var hDlg.hScrollX& =
create("hScroll", hDlg&, "", 0, height(hDlg&) - &scrollBarsWidth,
width(hDlg&) - &scrollBarsWidth, &scrollBarsWidth)
SubClass hDlg.hScrollX&, 1
SubClass hDlg.hScrollY&, 1
hPic.Paint(hPic&, hDlg&, hDlg.hScrollX&, hDlg.hScrollY&, hPic.szX&, hPic.szY&)

While 1

    waitinput
    case %key = 2 : break

EndWhile

deleteobject hpic&
destroywindow(hDlg&)
end

Proc hPic.Paint

    Parameters hPic2&,hDlg&,hScrlX&,hScrlY&,picSzX&,picSzY&
    var x& = 0 - getScrollPos(hScrlX&) / 100 * (picSzX& - width(hDlg&) + &scrollBarsWidth)
    var y& = 0 - getScrollPos(hScrlY&) / 100 * (picSzY& - height(hDlg&) + &scrollBarsWidth)
    startpaint hDlg&
    CopyPic hPic2&, 0,0 - (width(hDlg&) - &scrollBarsWidth - x&),
    (height(hDlg&) - &scrollBarsWidth - y&) > x&, y&; 0
    endpaint

EndProc

SubClassProc

    If ((%sMessage = ~SBM_GETRANGE) or (%sMessage = ~WM_PAINT))

        hPic.Paint(hPic&, hDlg&, hDlg.hScrollX&, hDlg.hScrollY&, hPic.szX&, hPic.szY&)

    EndIf

ENDPROC

Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4

11.12.2008 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Frank
Abbing

seulement zur information: de ":=" pour Wertzuweisungen dedans XProfan suis je abgekommen, dass simple Gleichheitszeichen pour Zuweisungen et doppeltes Gleichheitszeichen pour Vergleiche nutze je aujourd'hui seulement encore.

Hab simple seulement deinen Code übernommen et ensuite erweitert. je benutze seulement un Gleichzeichen pour Vergleiche et Zuweisungen. Dein travailler ist ineffizient.

11.12.2008 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

RGH

@iF: ici ist es wirklich völlig inintelligible, pourquoi einerseits à gauche près de dem Posting une grand le vide Surface ist et pour im Gegenzug cela Listing ständig à droite trop scrollen ist, um légèrement quoi trop erfassen.

Code "Separieren" pour Code-Vollbild, plus peux je _im Moment_ pas bieten.

15.12.2008 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Jörg
Sellmeyer

pourquoi pas simple alle Posts joli à gauche ausgerichtet untereinander? cet à gauche/à droite pouvoir qui page très unruhig. je komm mir avant comment beim Tennis.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...