Source / code snippets | | | | |  |
CompileMarkSeparationGemerkt/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>)
}
|
 | | | | | | |
| | 
Frank
Abbing | Have some things correct, How: Flackern eliminating, automatic Bildrestaurierung and Echtzeitscrollen.
CompileMarkSeparation {$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
|
| | | | | | |
| | 
RGH | here the XPSE-code translated to XProfan:
CompileMarkSeparation $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
Greeting
Roland
@iF: here's it really completely unverständlich, Why einerseits left next to the Posting a large vain Area is and for in the countermove the Listing constantly to right To scroll is, for a slightly what To erfassen. of my unmaßgeblichen opinion to ought to the Einrücken the Postings zugunsten better Lesbarkeit ersatzlos gestrichen go! |
| | | | 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 | 12/11/08 ▲ |
| | |
| |
RGH | and the whole explicit kürzer:
CompileMarkSeparation $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 | 12/11/08 ▲ |
| | |
| |
Frank
Abbing |
only to information: From ":=" for Wertzuweisungen within XProfan be I abgekommen, that simple Gleichheitszeichen for Zuweisungen and doppeltes Gleichheitszeichen for compare use I today only yet.
Have just your code übernommen and then extended. I use only one Gleichzeichen for compare and Zuweisungen. your works is ineffizient.  |
| | | | | | |
| | | RGH
@iF: here's it really completely unverständlich, Why einerseits left next to the Posting a large vain Area is and for in the countermove the Listing constantly to right To scroll is, for a slightly what To erfassen.
code "Separieren" for code-Vollbild, More can I _im Moment_ not afford. |
| | | | | | |
| | 
Jörg
Sellmeyer | | Why not simply any Posts beautiful left reported among themselves? this left/right power The Page very restless. I komm me to How at tennis. |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ...  | 12/15/08 ▲ |
| | |
|
Zum QuelltextThemeninformationenthis Topic has 4 subscriber: |
|
(1.128)
Deutsch
English
Français
Español
Italia