Fuente/ Codesnippets | | | | |  |
KompilierenMarcaSeparaciónGemerkt/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 | Hab algunos Sachen mejorado, como: Flackern beseitigt, automatische Bildrestaurierung y Echtzeitscrollen.
KompilierenMarcaSeparación {$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 | Hier el XPSE-Code traducido después de XProfan:
KompilierenMarcaSeparación $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
Saludo
Roland
@IF: Hier es wirklich völlig unverständlich, por qué einerseits links neben el Posting una große vacío Fläche es y dafür en el Gegenzug el Listing ständig después de rechts a scrollen es, en una bißchen qué a erfassen. Meiner unmaßgeblichen Meinung después de debería el Einrücken el Postings zugunsten besserer Lesbarkeit ersatzlos gestrichen voluntad! |
| | | | 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 ▲ |
| | |
| |
RGH | Und el Ganze deutlich kürzer:
KompilierenMarcaSeparación $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 ▲ |
| | |
| |
Frank
Abbing |
Nur a Information: Von ":=" para Wertzuweisungen innerhalb XProfan bin Yo abgekommen, dass einfache Gleichheitszeichen para Zuweisungen y doppeltes Gleichheitszeichen para Vergleiche nutze Yo heute sólo todavía.
Hab simplemente sólo deinen Code übernommen y luego erweitert. Yo benutze sólo una Gleichzeichen para Vergleiche y Zuweisungen. Su Arbeiten es ineffizient.  |
| | | | | | |
| | | RGH
@IF: Hier es wirklich völlig unverständlich, por qué einerseits links neben el Posting una große vacío Fläche es y dafür en el Gegenzug el Listing ständig después de rechts a scrollen es, en una bißchen qué a erfassen.
Code "Separieren" para Code-Vollbild, mehr kann Yo _im Moment_ no bieten. |
| | | | | | |
| | 
Jörg
Sellmeyer | | ¿Por qué no simplemente todos Beiträge schön links ausgerichtet untereinander? Dieses links/rechts macht la página muy unruhig. Yo komm me antes como beim Tennis. |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ...  | 15.12.2008 ▲ |
| | |
|
Zum QuelltextThemeninformationenDieses Thema ha 4 subscriber: |
|
(1.131)
Deutsch
English
Français
Español
Italia