Quelltexte/ Codesnippets | | | | | Nachtrag: Aktueller und besser ist diese Methode: [...]
Flimmerfreie Fensterskalierung mit Anpassung der daraufliegenden Elemente...
wohl ein Problem welches fast alle XProfaner haben. Wenn man sich die fertigen Programme ansieht stellt man immer wieder fest - das nicht umsonst an skalierbaren Fenster gespart wird.
Der gemeine Profaner wird mehr oder weniger dazu bewegt ein nicht-skalierbares Fenster zu erstellen - wobei es dort bei der Erstellung auch erhebliche Qualitätsunterschiede gibt. Immer wieder stelle ich fest, daß Fenster mit einer statischen Größe erstellt werden, wobei nicht beachtet wird das der innere-Bereich je nach Windowseinstellung in der Größe abweichen kann. Dies ist aber ein anderes Thema.
Hier nun mein Vorschlag: Ein Fenster (dlg) welches sich flimmerfrei skalieren lässt - und die daraufliegenden Elemente sich automatisch (und sofort) der neuen Größe anpassen. KompilierenMarkierenSeparieren {$cleq}
seterrorlevel 0
$U thread.pcu = thread.
declare dlg&,dir&,stat&,_dlgw&,_dlgh&,_odlgw&,_odlgh&
decimals 0
dlg&:=createwindow (%desktop,app ,100,100,640,480)
dir&:=createsortedlistbox(dlg&,,0,0,0,0)
stat&:=create(statuswindow,dlg&,Bereit.)
thread.start 1
whilenot (%key==2)
waitinput
wend
thread.stop 1
end
proc thread.do
parameters n&
if n&==1
_dlgw&:=width(dlg&);_dlgh&:=height(dlg&)
if ( ( _odlgw&<>_dlgw& ) or ( _odlgh&<>_dlgh& ) )
_odlgw&:=_dlgw&;_odlgh&:=_dlgh&
_redrw
endif
endif
endproc
proc _redrw
setwindowpos dir&=0,0 - width(dlg&),(height(dlg&)-height(stat&));0
setwindowpos stat&=0,0 - 0,0;0
endproc
Salve, iF |
| | | | |
| | | Mal ne neuere Version mit Popupmenu-Unterstützung. KompilierenMarkierenSeparieren {$cleq}
seterrorlevel 0
$U thread.pcu = thread.
declare dlg&,dir&,stat&,_dlgw&,_dlgh&,_odlgw&,_odlgh&,hMenu&,hwin&
app.init
whilenot (%key==2)
waitinput
if (menuitem(100))
sendmessage(%hwnd,$10,0,0)
setmenuitem 0
elseif (menuitem(998))
enablewindow %hwnd,0
messagebox About,About,4096
enablewindow %hwnd,1
setmenuitem 0
elseif (menuitem(999))
enablewindow %hwnd,0
messagebox Info,Info,4096
enablewindow %hwnd,1
setmenuitem 0
endif
wend
app.kill
end
/* FUNCTIONS */
proc thread.do
parameters n&
if (n&==1)
_dlgw&:=width(dlg&);_dlgh&:=height(dlg&)
if ( ( _odlgw&<>_dlgw& ) or ( _odlgh&<>_dlgh& ) )
_odlgw&:=_dlgw&;_odlgh&:=_dlgh&
_redrw
endif
elseif (n&==2)
insertstring(hwin&,0,time$(0)+.+substr$(time$(1),1,.))
endif
endproc
proc _redrw
setwindowpos %hwnd=0,0 - width(dlg&),%CYMenu;0
setwindowpos hwin&=0,%CYMenu - width(dlg&),(height(dlg&)-height(stat&)-%CYMenu);0
setwindowpos stat&=0,0 - 0,0;0
endproc
proc app.init
proc createpmenu
windowtitle app
windowstyle 80
window 0,0-0,0
showwindow(%Hwnd,0)
popup Programm
appendmenu 100,&Beenden
popup &?
appendmenu 998,&About
Separator
appendmenu 999,&Help
external(USER32,SetParent,%hwnd,dlg&)
endproc
decimals 0
dlg&:=createwindow (%desktop,app ,100,100,640,480)
hwin&:=createlistbox(dlg&,,0,0,0,0)
stat&:=create(statuswindow,dlg&,Bereit.)
createpmenu
thread.start 1
thread.start 2,7
endproc
proc app.kill
thread.stop 2
thread.stop 1
endproc
Vielleicht schaffts ja jemand die PopupMenuunterstützung eleganter einzubetten.
Salve, iF |
| | | | |
| | | Das ganze mal um Faktor Toolbar erweitert: KompilierenMarkierenSeparieren {$cleq}
seterrorlevel 0
$U thread.pcu = thread.
declare dlg&,dir&,stat&,_dlgw&,_dlgh&,_odlgw&,_odlgh&,hMenu&,hwin&,ftps&,ftpp&,ftpm&,_topspc&,hToolbar&,tdlg&
declare fnt1&
app.init
whilenot (%key==2)
waitinput
if (menuitem(100))
sendmessage(%hwnd,$10,0,0)
setmenuitem 0
elseif (menuitem(998))
enablewindow %hwnd,0
messagebox About,About,4096
enablewindow %hwnd,1
setmenuitem 0
elseif (menuitem(999))
enablewindow %hwnd,0
messagebox Info,Info,4096
enablewindow %hwnd,1
setmenuitem 0
elseif (menuitem(2001))
enablewindow %hwnd,0
messagebox Info,Info,4096
enablewindow %hwnd,1
setmenuitem 0
endif
wend
app.kill
end
/* FUNCTIONS */
proc thread.do
parameters n&
if (n&==1)
_dlgw&:=width(dlg&);_dlgh&:=height(dlg&)
if ( ( _odlgw&<>_dlgw& ) or ( _odlgh&<>_dlgh& ) )
_odlgw&:=_dlgw&;_odlgh&:=_dlgh&
_redrw
endif
elseif (n&==2)
insertstring(hwin&,0,time$(0)+.+substr$(time$(1),1,.))
endif
endproc
proc _redrw
setwindowpos %hwnd=0,0 - width(dlg&),(%CYMenu);0
_topspc&:=%winbottom-%wintop+48
setwindowpos tdlg&=0,%CYMenu - %maxx,48;0
setwindowpos htoolbar&=0,0 - width(tdlg&),height(tdlg&);0
if ( (height(dlg&)>150) and (width(dlg&)>150) )
setwindowpos ftpm&=(width(dlg&)-65),((height(dlg&)-height(stat&))-23) - 65,23;0
setwindowpos ftpp&=(width(dlg&)-130),((height(dlg&)-height(stat&))-23) - 65,23;0
else
setwindowpos ftpm&=0,0 - 0,0;0
setwindowpos ftpp&=0,0 - 0,0;0
endif
if (width(dlg&)>150)
setwindowpos ftps&=(width(dlg&)-130),_topspc& - 130,((height(dlg&)-height(stat&)-_topspc&)-height(ftpm&));0
setwindowpos hwin&=0,_topspc& - (width(dlg&)-130),(height(dlg&)-height(stat&)-_topspc&);0
else
setwindowpos ftps&=0,0-0,0;0
setwindowpos hwin&=0,_topspc& - (width(dlg&)),(height(dlg&)-height(stat&)-_topspc&);0
endif
setwindowpos stat&=0,0 - 0,0;0
showwindow (ftpm&,0)
showwindow (ftpp&,0)
showwindow (ftpm&,1)
showwindow (ftpp&,1)
endproc
proc app.init
proc createsubs
proc createpopupmenu
popup Programm
appendmenu 100,&Beenden
popup &?
appendmenu 998,&About
Separator
appendmenu 999,&Help
endproc
proc createtoolbar
hToolbar& = create(TOOLBAR,tdlg&,0,0,0,2000,-1)
Toolbar(separator,hToolBar&)
Toolbar(AddTextButton,hToolBar&,0,2001,Knopf 1,)
Toolbar(AddTextButton,hToolBar&,0,2002,Knopf 2,)
Toolbar(AddTextButton,hToolBar&,0,2003,Knopf 3,)
Toolbar(AddTextButton,hToolBar&,0,2004,Knopf 4,)
Toolbar(AddTextButton,hToolBar&,0,2005,Knopf 5,)
endproc
windowtitle app
windowstyle 80
window 0,0-0,0
createpopupmenu
createtoolbar
external(USER32,SetParent,%hwnd,dlg&)
endproc
decimals 0
fnt1&:=createfont(MS Sans Serif,10,0,0,0,0)
dlg&:=createwindow (%desktop,app ,100,100,640,480)
hwin&:=createlistbox(dlg&,,0,0,0,0)
ftps&:=createlistbox(dlg&,,0,0,0,0)
ftpp&:=createbutton(dlg&,Hinzufügen,0,0,0,0)
ftpm&:=createbutton(dlg&,Bearbeiten,0,0,0,0)
windowstyle 80
tdlg&:=createwindow(dlg&,,0,0,0,0)
external(USER32,SetParent,tdlg&,dlg&)
stat&:=create(statuswindow,dlg&,Bereit.)
setfont hwin&,fnt1&
setfont ftps&,fnt1&
setfont ftpp&,fnt1&
setfont ftpm&,fnt1&
createsubs
thread.start 1
thread.start 2,7
endproc
proc app.kill
thread.stop 2
thread.stop 1
deleteobject fnt1&
endproc
|
| | | | |
|
Zum QuelltextThemenoptionen | 4.725 Betrachtungen |
ThemeninformationenDieses Thema hat 1 Teilnehmer: |