Quelltexte/ Codesnippets | | | | - Seite 1 - |
| Normann Strübli | Hallo,
lange hats gedauert aber hier ist es nun, das erste Customdrawlistviewcontrol für XProfan (Nagut, das erste NUR in Profan geschriebene)
Und das ganze funktioniert natürlich auch mit: Rebar, trackbar, header and toolbar controls,Tooltips und Treeviews.
###################################
Listview-Control CUSTOMDRAW
##################################
Author : Normann Strübli
November 2005
##################################
Customdraw ermöglicht einem gezielt Elemente eines in diesem Beispiel verwendeten
Listviewcontrols zu manipulieren. Der klare Vorteil z.B. gegenüber Ownerdraw ist,
das man sich nicht um das Zeichnen kümmern muss, sondern einfach Nachrichten die
vor dem Zeichnen gesendet werden abfängt und die Parameter entsprechend ändert.
{$cliq}
*** Header
$H Windows.ph
$H Structs.ph
$H Messages.ph
$H Commctrl.ph
*** Includes
Set(FastMode,1)
struct TWindowClass = ~WndClass
struct TMsg = ~Msg
Struct Hd_notify = ~Hd_notify
Struct NMHDR = ~NMHDR
Struct Rect = ~Rect
Struct NMCUSTOMDRAW = nmhdr#(12),dwDrawStage&,hdc&,Rect#(16),dwItemSpec&,uItemState&,lItemlParam&
Struct NMLVCUSTOMDRAW = NMCUSTOMDRAW#(48),clrText&,clrTextBK&,iSubitem%,dwItemType&,clrface&,iIconEffect%,iIconPhase%,iPartId%,iStateId%,rcText#(16),uAlign&
Struct Lv_Item = ~Lv_Item
Struct Lv_Column = ~Lv_Column
Struct NM_Listview = ~NM_Listview
Declare iSelect&
Declare Hd_notify#
Declare NMHDR#
Declare Rect#,MyRect#
Declare NMLVCUSTOMDRAW#
Declare NMCUSTOMDRAW#
Declare Window&
Declare column&,Anzcolumn&,Startcolumn&
Declare BkColor&
Declare lparam1&,lparam2&,lparam3&,lparam4&,lparam5&,sortorder&
declare LVColumnTEXT#
declare LVItemtext#
Declare Lv_Item#
Declare Lv_Column#
Declare NM_Listview#
declare WindowClass#, Msg#
declare AppName$
Declare itemtext$,itemtext#
Declare istring$,pa&,pb&,pc&,pd&
Declare StdFont&,Bigfont&
Declare ListDC&,ListmemDC&
declare Listview&,ListviewID&
ListviewID& = 1010
Dim itemtext#,255
dim LVItemText#,255
dim LVColumnTEXT#,255
Dim Lv_Item#,Lv_Item
Dim Lv_Column#,Lv_Column
Dim NM_Listview#,NM_Listview
Dim Hd_notify#,Hd_notify
Dim NMHDR#,NMHDR
dim NMLVCUSTOMDRAW#,NMLVCUSTOMDRAW
Dim NMCUSTOMDRAW#,NMCUSTOMDRAW
Dim Rect#,Rect
Dim Myrect#,Rect
Definierte Funktionen
Def Hiword(1) And(&(1)>>16,$Ffff)
Def Loword(1) And(&(1),$Ffff)
Def Makelong(2) Or(&(1),&(2)<<16)
~InitCommonControls()
AppName$ = Customdraw Listview
PROC LVINSERTCOLUMN
string LVColumnText#,0 = @$(6) Der Übergebene Text in @$(4)
long Lv_Column#,0 = @&(3) MAsk,Text|Format|Width|Subitem
long Lv_Column#,4 = @&(4) Ausrichtung
long Lv_Column#,8 = @&(5) Width of Column in Pixeln.
Long Lv_Column#,12= LVColumnText# die Adresse aus LVColumntext#
sendmessage(@&(1),~LVM_INSERTCOLUMN,@&(2),Lv_Column#)
ENDPROC -------------------------------------------------------------------------
PROC LVINSERTTEXT
String LVItemText#,0=@$(7) FeldText$
long lv_item#,0 = ~LVIF_IMAGE | ~LVIF_STATE | ~LVIF_TEXT | ~LVIF_PARAM
long lv_item#,4 =@&(3) index of the item (zeile)
long lv_item#,8 =@&(4) index of the subitem (column)
long lv_item#,12=@&(5) item state
long lv_item#,16=@&(6) state Mask of item
long lv_item#,20=LVitemtext# item text Adresse
long lv_item#,24=@&(8) size of text buffer
long lv_item#,28=@&(9) IconNr. aus Imagelist
long lv_item#,32=@&(10) MY_ITEM
sendmessage(@&(1),~LVM_INSERTITEM,@&(4),lv_item#) Insertitem to column
sendmessage(@&(1),~LVM_SETITEMTEXT,@&(3),lv_item#) Settext into Item
ENDPROC --------------------------------------------------------------------------------
proc WindowProc
parameters Window&, Message&, WParam&, LParam&
if Message& = ~WM_Initdialog
endif
If Message& = ~Wm_notify
NMHDR# = Lparam&
NM_Listview# = Lparam&
if NMHDR#.hwndfrom& = listview&
if NMHDR#.code& = ~NM_KILLFOCUS Das Control hat den Focus verloren
elseif NMHDR#.code& = ~NM_SETFOCUS Das Control hat den Focus bekommmen
elseif NMHDR#.code& = ~NM_CLICK Der Anwender hat die linke Maustaste im Control geklickt
iSelect& = SendMessage(listview&,~LVM_GETNEXTITEM,(-1),~LVNI_FOCUSED) STATT 0 SPÄTER -1 -BUG IN PROFAN !!!!
if iSelect& = -1 Keine Items enthalten
endif
elseif NMHDR#.code& = ~NM_DBLCLK Der Anwender hat die linke Maustaste im Control doppel-geklickt
MessageBox(Doppelklick mit der linken Maustaste,Meldung,64)
elseif NMHDR#.code& = ~NM_OUTOFMEMORY Das Control konnte die Aktion Aufgrund zu wenig Speicher nicht ausführen
elseif NMHDR#.code& = ~NM_RCLICK Der Anwender hat die rechte Maustaste im Control geklickt.
MessageBox(Klick mit der rechten Maustaste,Meldung,64)
elseif NMHDR#.code& = ~NM_RDBLCLK Der Anwender hat die rechte Maustaste im Control doppel-geklickt.
elseif NMHDR#.code& = ~NM_RETURN Der Anwender hat die ENTER-Taste im Control gedrückt
MessageBox(Return gedrückt,Meldung,64)
elseif NMHDR#.code& = ~NM_CUSTOMDRAW Wird vom Listview gesendet um das Elterfenter über Zeichenoperationen zu informieren
NMLVCUSTOMDRAW# = lparam& Siehe http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/listview/structures/nmlvcustomdraw.asp
NMCUSTOMDRAW# = lparam& Siehe http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/custdraw/structures/nmcustomdraw.asp
if NMCUSTOMDRAW#.dwDrawStage& = ~CDDS_PREPAINT
Return ~CDRF_NOTIFYITEMDRAW
elseif NMCUSTOMDRAW#.dwDrawStage& = ~CDDS_ITEMPREPAINT
Return ~CDRF_NOTIFYSUBITEMDRAW Diese Zeile bewirkt das eine CDDS_SUBITEM NAchricht verschickt wird wenn ein
Subitem gezeichnet wird.
Wird diese Zeile entfernt können nur ganze Zeilen verarbeitet werden.
if NMCUSTOMDRAW#.dwItemSpec& = 2 Zeile 2
NMLVCUSTOMDRAW#.clrText& = RGB(0,200,0) Textfarbe
NMLVCUSTOMDRAW#.clrTextBk& = RGB(0,0,200) Hintergrundfarbe
Return ~CDRF_NEWFONT Aktualisieren...
else
NMLVCUSTOMDRAW#.clrText& = RGB(200,0,0)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(0,200,200)
Return ~CDRF_NEWFONT
endif
elseif NMCUSTOMDRAW#.dwDrawStage& = ~CDDS_SUBITEM | ~CDDS_ITEMPREPAINT Selbsterklärend :-)
if NMLVCUSTOMDRAW#.iSubItem% = 0
NMLVCUSTOMDRAW#.clrText& = RGB(255,255,255)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(220,55,23)
Return ~CDRF_NEWFONT
elseif NMLVCUSTOMDRAW#.iSubItem% = 1
NMLVCUSTOMDRAW#.clrText& = RGB(255,255,255)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(220,0,220)
Return ~CDRF_NEWFONT
elseif NMLVCUSTOMDRAW#.iSubItem% = 2
NMLVCUSTOMDRAW#.clrText& = RGB(255,0,0)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(20,150,220)
Return ~CDRF_NEWFONT
elseif NMLVCUSTOMDRAW#.iSubItem% = 3
NMLVCUSTOMDRAW#.clrText& = RGB(255,255,255)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(20,200,20)
Return ~CDRF_NEWFONT
elseif NMLVCUSTOMDRAW#.iSubItem% = 4
NMLVCUSTOMDRAW#.clrText& = RGB(0,0,0)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(220,150,20)
~SelectObject(NMCUSTOMDRAW#.hdc&,Bigfont&) Ein anderer Font
Return ~CDRF_NEWFONT
endif
else
RETURN ~cdrf_dodefault
endif
elseif NMHDR#.code& = ~LVN_COLUMNCLICK Das Control hat den Focus bekommmen
Endif
endif
endif
if Message& = ~wm_Destroy
CloseProc
END
endif
return ~DefWindowProc(Window&, Message&, WParam&, LParam&)
endproc
proc WinMain
declare Window&, Message&
dim WindowClass#,TWindowClass
dim Msg#,TMsg
with WindowClass#
.style& = 0
.lpfnWndProc& = ProcAddr(WindowProc,4)
.cbClsExtra& = 0
.cbWndExtra& = 0
.hInstance& = %HInstance
.hIcon& = ~LoadIcon(0,~idi_Information)
.hCursor& = ~LoadCursor(0, ~idc_Arrow)
.hbrBackground& = ~GetStockObject(~white_Brush)
.lpszMenuName& = Addr(AppName$)
.lpszClassName& = Addr(AppName$)
endwith
if ~RegisterClass(WindowClass#) = 0
~MessageBox(0,Fenster konnte nicht registriert werden!,Fehler,0)
end
endif
Window& = ~CreateWindowEx(
0,
Addr(AppName$),
Addr(AppName$),
~ws_OverlappedWindow,
~cw_UseDefault,
~cw_UseDefault,
540,
500,
0,
0,
%HInstance,
0)
~ShowWindow(Window&, ~sw_ShowNormal)
~UpdateWindow(Window&)
stdfont& = @CREATE(FONT,Arial,12,0,0,0,0)
Bigfont& = @CREATE(FONT,Arial,14,0,1,0,0)
Listview&=Control(SysListView32,,~WS_CHILD | ~WS_VISIBLE | ~LVS_REPORT,0,0,520,420,window&,ListviewID&,%Hinstance)
ListDC& = ~GETDC(Listview&)
ListmemDC& = ~CreatecompatibleDC(ListDC&)
sendmessage(Listview&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_GRIDLINES | ~LVS_EX_FULLROWSELECT | ~LVS_EX_SUBITEMIMAGES) EX_LVSTIL+Checkbox<BR>
~Setprop(Listview&,OldCallback,~Setwindowlong(Listview&,~Gwl_wndproc, Procaddr(Listviewcallback,4))) Listview Subclassing
Ein paar Spalten hinzufügen
LVINSERTCOLUMN ListView&,0,$000F,~LVCFMT_LEFT,100,Splate 1
LVINSERTCOLUMN ListView&,1,$000F,~LVCFMT_LEFT,100,Spalte 2
LVINSERTCOLUMN ListView&,2,$000F,~LVCFMT_LEFT,100,Spalte 3
LVINSERTCOLUMN ListView&,3,$000F,~LVCFMT_LEFT,100,Spalte 4
LVINSERTCOLUMN ListView&,4,$000F,~LVCFMT_RIGHT,100,Spalte 5
$000F = ~LVCF_FMT | ~LVCF_SUBITEM | ~LVCF_TEXT | LVCF_WIDTH
Und ein paar Zeilen
LVINSERTTEXT listview&,$0003,0,0,0,0,0. Zeile 1.Spalte,0,0,0
LVINSERTTEXT listview&,$0003,0,1,0,0,0. Zeile 2.Spalte,0,0,0
LVINSERTTEXT listview&,$0003,0,2,0,0,0. Zeile 3.Spalte,0,0,0
LVINSERTTEXT listview&,$0003,0,3,0,0,0. Zeile 3.Spalte,0,0,0
LVINSERTTEXT listview&,$0003,0,4,0,0,0. Zeile 4.Spalte,0,0,0
Whileloop 50 Ein paar Zeilen hinzufügen
Itemtext$ = &loop + .Zeile
LVINSERTTEXT listview&,$0003,&loop,0,0,0,Itemtext$ + 1. Spalte ,0,0,0
LVINSERTTEXT listview&,$0003,&loop,1,0,0,Itemtext$ + 2. Spalte ,0,0,0
LVINSERTTEXT listview&,$0003,&loop,2,0,0,Itemtext$ + 3. Spalte ,0,0,0
LVINSERTTEXT listview&,$0003,&loop,3,0,0,Itemtext$ + 4. Spalte ,0,0,0
LVINSERTTEXT listview&,$0003,&loop,4,0,0,Itemtext$ + 5. Spalte ,0,0,0
Endwhile
while ~GetMessage(Msg#, 0, 0, 0) > 0
~TranslateMessage(Msg#)
~DispatchMessage(Msg#)
endwhile
end
endproc
WinMain
Proc Listviewcallback
Parameters Wnd&, Msg&, Wparam&, Lparam&
If Msg& = ~Wm_notify
NMHDR# = Lparam&
If (NMHDR#.code& = ~Hdn_begintrackw) OR (NMHDR#.code& = ~Hdn_DIVIDERDBLCLICKw) Die HDN_BeginTrack Botschaft abfangen und löschen!
Hd_notify# = Lparam&
if Hd_notify#.iButton& = 0 Wenn Spalte 0
Return 1
Endif
Endif
Endif
Return ~Callwindowproc(~Getprop(Wnd&,OldCallback),Wnd&, Msg&,Wparam&,Lparam&)
Endproc
Prozeduren
Proc Closeproc
DeleteObject stdfont&
DeleteObject bigfont&
dispose LVColumnTEXT#
dispose Lv_Column#
dispose lv_item#
dispose LVITEMTEXT#
dispose NM_Listview#
dispose ItemText#
dispose HD_Notify#
dispose NMHDR#
dispose RECT#
dispose MyRect#
Dispose WindowClass#
Dispose MSG#
Dispose NMCUSTOMDRAW#
Dispose NMLVCUSTOMDRAW#
~PostQuitMessage(0)
End
Endproc
|
| | | | |
| | « Dieser Beitrag wurde als Lösung gekennzeichnet. » | | Jörg Sellmeyer | Schick isses ja aber da beschränk ich mich ja doch lieber auf das xprofane Aussehen, wenn ich mir den Codewust da so ansehe... Trotzdem repariert.
'###################################
'Listview-Control CUSTOMDRAW
'##################################
'Author : Normann Strübli
'November 2005
'##################################
'Customdraw ermöglicht einem gezielt Elemente eines in diesem Beispiel verwendeten
'Listviewcontrols zu manipulieren. Der klare Vorteil z.B. gegenüber Ownerdraw ist,
'das man sich nicht um das Zeichnen kümmern muss, sondern einfach Nachrichten die
'vor dem Zeichnen gesendet werden abfängt und die Parameter entsprechend ändert.
' {$cliq}
'*** Header
$H Windows.ph
$H Structs.ph
$H Messages.ph
$H Commctrl.ph
'*** Includes
$I Profalt.inc
Set("FastMode",1)
struct TWindowClass = ~WndClass
struct TMsg = ~Msg
Struct Hd_notify = ~Hd_notify
Struct NMHDR = ~NMHDR
Struct Rect = ~Rect
Struct NMCUSTOMDRAW = nmhdr#(12),dwDrawStage&,hdc&,Rect#(16),dwItemSpec&,uItemState&,lItemlParam&
Struct NMLVCUSTOMDRAW = NMCUSTOMDRAW#(48),clrText&,clrTextBK&,iSubitem%,dwItemType&,clrface&,iIconEffect%,iIconPhase%,iPartId%,iStateId%,rcText#(16),uAlign&
Struct Lv_Item = ~Lv_Item
Struct Lv_Column = ~Lv_Column
Struct NM_Listview = ~NM_Listview
Declare iSelect&
Declare Hd_notify#
Declare NMHDR#
Declare Rect#,MyRect#
Declare NMLVCUSTOMDRAW#
Declare NMCUSTOMDRAW#
Declare Window&
Declare column&,Anzcolumn&,Startcolumn&
Declare BkColor&
Declare lparam1&,lparam2&,lparam3&,lparam4&,lparam5&,sortorder&
declare LVColumnTEXT#
declare LVItemtext#
Declare Lv_Item#
Declare Lv_Column#
Declare NM_Listview#
declare WindowClass#, Msg#
declare AppName$
Declare itemtext$,itemtext#
Declare istring$,pa&,pb&,pc&,pd&
Declare StdFont&,Bigfont&
Declare ListDC&,ListmemDC&
declare Listview&,ListviewID&
ListviewID& = 1010
Dim itemtext#,255
dim LVItemText#,255
dim LVColumnTEXT#,255
Dim Lv_Item#,Lv_Item
Dim Lv_Column#,Lv_Column
Dim NM_Listview#,NM_Listview
Dim Hd_notify#,Hd_notify
Dim NMHDR#,NMHDR
dim NMLVCUSTOMDRAW#,NMLVCUSTOMDRAW
Dim NMCUSTOMDRAW#,NMCUSTOMDRAW
Dim Rect#,Rect
Dim Myrect#,Rect
'Definierte Funktionen
Def Hiword(1) And(&(1)>>16,$Ffff)
Def Loword(1) And(&(1),$Ffff)
Def Makelong(2) Or(&(1),&(2)<<16)
~InitCommonControls()
AppName$ = "Customdraw Listview"
PROC LVINSERTCOLUMN
string LVColumnText#,0 = @$(6)'Der Übergebene Text in @$(4)
long Lv_Column#,0 = @&(3)'MAsk,Text|Format|Width|Subitem
long Lv_Column#,4 = @&(4)'Ausrichtung
long Lv_Column#,8 = @&(5)'Width of Column in Pixeln.
Long Lv_Column#,12= LVColumnText#'die Adresse aus LVColumntext#
sendmessage(@&(1),~LVM_INSERTCOLUMN,@&(2),Lv_Column#)
ENDPROC -------------------------------------------------------------------------
PROC LVINSERTTEXT
String LVItemText#,0=@$(7)'FeldText$
long lv_item#,0 = ~LVIF_IMAGE | ~LVIF_STATE | ~LVIF_TEXT | ~LVIF_PARAM
long lv_item#,4 =@&(3)'index of the item (zeile)
long lv_item#,8 =@&(4)'index of the subitem (column)
long lv_item#,12=@&(5)'item state
long lv_item#,16=@&(6)'state Mask of item
long lv_item#,20=LVitemtext#'item text Adresse
long lv_item#,24=@&(8)'size of text buffer
long lv_item#,28=@&(9)'IconNr. aus Imagelist
long lv_item#,32=@&(10)'MY_ITEM
sendmessage(@&(1),~LVM_INSERTITEM,@&(4),lv_item#)'Insertitem to column
sendmessage(@&(1),~LVM_SETITEMTEXT,@&(3),lv_item#)'Settext into Item
ENDPROC'--------------------------------------------------------------------------------
proc WindowProc
parameters Window&, Message&, WParam&, LParam&
if Message& = ~WM_Initdialog
endif
If Message& = ~Wm_notify
NMHDR# = Lparam&
NM_Listview# = Lparam&
if NMHDR#.hwndfrom& = listview&
if NMHDR#.code& = ~NM_KILLFOCUS'Das Control hat den Focus verloren
elseif NMHDR#.code& = ~NM_SETFOCUS'Das Control hat den Focus bekommmen
elseif NMHDR#.code& = ~NM_CLICK'Der Anwender hat die linke Maustaste im Control geklickt
iSelect& = SendMessage(listview&,~LVM_GETNEXTITEM,(-1),~LVNI_FOCUSED)'STATT 0 SPÄTER -1 -BUG IN PROFAN !!!!
if iSelect& = -1'Keine Items enthalten
endif
elseif NMHDR#.code& = ~NM_DBLCLK'Der Anwender hat die linke Maustaste im Control doppel-geklickt
MessageBox("Doppelklick mit der linken Maustaste","Meldung",64)
elseif NMHDR#.code& = ~NM_OUTOFMEMORY'Das Control konnte die Aktion Aufgrund zu wenig Speicher nicht ausführen
elseif NMHDR#.code& = ~NM_RCLICK'Der Anwender hat die rechte Maustaste im Control geklickt.
MessageBox("Klick mit der rechten Maustaste","Meldung",64)
elseif NMHDR#.code& = ~NM_RDBLCLK'Der Anwender hat die rechte Maustaste im Control doppel-geklickt.
elseif NMHDR#.code& = ~NM_RETURN'Der Anwender hat die ENTER-Taste im Control gedrückt
MessageBox("Return gedrückt","Meldung",64)
elseif NMHDR#.code& = ~NM_CUSTOMDRAW'Wird vom Listview gesendet um das Elterfenter über Zeichenoperationen zu informieren
NMLVCUSTOMDRAW# = lparam&'Siehe https://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/listview/structures/nmlvcustomdraw.asp
NMCUSTOMDRAW# = lparam&'Siehe https://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/commctls/custdraw/structures/nmcustomdraw.asp
if NMCUSTOMDRAW#.dwDrawStage& = ~CDDS_PREPAINT
Return ~CDRF_NOTIFYITEMDRAW
elseif NMCUSTOMDRAW#.dwDrawStage& = ~CDDS_ITEMPREPAINT
Return ~CDRF_NOTIFYSUBITEMDRAW'Diese Zeile bewirkt das eine CDDS_SUBITEM NAchricht verschickt wird wenn ein
'Subitem gezeichnet wird.
'Wird diese Zeile entfernt können nur ganze Zeilen verarbeitet werden.
if NMCUSTOMDRAW#.dwItemSpec& = 2'Zeile 2
NMLVCUSTOMDRAW#.clrText& = RGB(0,200,0)'Textfarbe
NMLVCUSTOMDRAW#.clrTextBk& = RGB(0,0,200)'Hintergrundfarbe
Return ~CDRF_NEWFONT'Aktualisieren...
else
NMLVCUSTOMDRAW#.clrText& = RGB(200,0,0)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(0,200,200)
Return ~CDRF_NEWFONT
endif
elseif NMCUSTOMDRAW#.dwDrawStage& = ~CDDS_SUBITEM | ~CDDS_ITEMPREPAINT' Selbsterklärend :-)
if NMLVCUSTOMDRAW#.iSubItem% = 0
NMLVCUSTOMDRAW#.clrText& = RGB(255,255,255)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(220,55,23)
Return ~CDRF_NEWFONT
elseif NMLVCUSTOMDRAW#.iSubItem% = 1
NMLVCUSTOMDRAW#.clrText& = RGB(255,255,255)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(220,0,220)
Return ~CDRF_NEWFONT
elseif NMLVCUSTOMDRAW#.iSubItem% = 2
NMLVCUSTOMDRAW#.clrText& = RGB(255,0,0)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(20,150,220)
Return ~CDRF_NEWFONT
elseif NMLVCUSTOMDRAW#.iSubItem% = 3
NMLVCUSTOMDRAW#.clrText& = RGB(255,255,255)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(20,200,20)
Return ~CDRF_NEWFONT
elseif NMLVCUSTOMDRAW#.iSubItem% = 4
NMLVCUSTOMDRAW#.clrText& = RGB(0,0,0)
NMLVCUSTOMDRAW#.clrTextBk& = RGB(220,150,20)
~SelectObject(NMCUSTOMDRAW#.hdc&,Bigfont&)'Ein anderer Font
Return ~CDRF_NEWFONT
endif
else
RETURN ~cdrf_dodefault
endif
elseif NMHDR#.code& = ~LVN_COLUMNCLICK'Das Control hat den Focus bekommmen
Endif
endif
endif
if Message& = ~wm_Destroy
CloseProc
END
endif
return ~DefWindowProc(Window&, Message&, WParam&, LParam&)
endproc
proc WinMain
declare Window&, Message&
dim WindowClass#,TWindowClass
dim Msg#,TMsg
with WindowClass#
.style& = 0
.lpfnWndProc& = ProcAddr("WindowProc",4)
.cbClsExtra& = 0
.cbWndExtra& = 0
.hInstance& = %HInstance
.hIcon& = ~LoadIcon(0,~idi_Information)
.hCursor& = ~LoadCursor(0, ~idc_Arrow)
.hbrBackground& = ~GetStockObject(~white_Brush)
.lpszMenuName& = Addr(AppName$)
.lpszClassName& = Addr(AppName$)
endwith
if ~RegisterClass(WindowClass#) = 0
~MessageBox("0,Fenster konnte nicht registriert werden!","Fehler",0)
end
endif
Window& = ~CreateWindowEx(\
0,\
Addr(AppName$),\
Addr(AppName$),\
~ws_OverlappedWindow,\
~cw_UseDefault,\
~cw_UseDefault,\
540,\
500,\
0,\
0,\
%HInstance,\
0)
~ShowWindow(Window&, ~sw_ShowNormal)
~UpdateWindow(Window&)
stdfont& = @CREATE("FONT","Arial",12,0,0,0,0)
Bigfont& = @CREATE("FONT","Arial",14,0,1,0,0)
Listview&=Control("SysListView32","",~WS_CHILD | ~WS_VISIBLE | ~LVS_REPORT,0,0,520,420,window&,ListviewID&,%Hinstance)
ListDC& = ~GETDC(Listview&)
ListmemDC& = ~CreatecompatibleDC(ListDC&)
sendmessage(Listview&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_GRIDLINES | ~LVS_EX_FULLROWSELECT | ~LVS_EX_SUBITEMIMAGES)' EX_LVSTIL+Checkbox<BR>
~Setprop(Listview&,"OldCallback",~Setwindowlong(Listview&,~Gwl_wndproc, Procaddr("Listviewcallback",4)))'Listview Subclassing
'Ein paar Spalten hinzufügen
LVINSERTCOLUMN ListView&,0,$000F,~LVCFMT_LEFT,100,"Spalte 1"
LVINSERTCOLUMN ListView&,1,$000F,~LVCFMT_LEFT,100,"Spalte 2"
LVINSERTCOLUMN ListView&,2,$000F,~LVCFMT_LEFT,100,"Spalte 3"
LVINSERTCOLUMN ListView&,3,$000F,~LVCFMT_LEFT,100,"Spalte 4"
LVINSERTCOLUMN ListView&,4,$000F,~LVCFMT_RIGHT,100,"Spalte 5"
' $000F = ~LVCF_FMT | ~LVCF_SUBITEM | ~LVCF_TEXT | LVCF_WIDTH
'Und ein paar Zeilen
LVINSERTTEXT listview&,$0003,0,0,0,0,"0. Zeile 1.Spalte",0,0,0
LVINSERTTEXT listview&,$0003,0,1,0,0,"0. Zeile 2.Spalte",0,0,0
LVINSERTTEXT listview&,$0003,0,2,0,0,"0. Zeile 3.Spalte",0,0,0
LVINSERTTEXT listview&,$0003,0,3,0,0,"0. Zeile 3.Spalte",0,0,0
LVINSERTTEXT listview&,$0003,0,4,0,0,"0. Zeile 4.Spalte",0,0,0
Whileloop 50'Ein paar Zeilen hinzufügen
Itemtext$ = &loop + .Zeile
LVINSERTTEXT listview&,$0003,&loop,0,0,0,Itemtext$ + "1. Spalte ",0,0,0
LVINSERTTEXT listview&,$0003,&loop,1,0,0,Itemtext$ + "2. Spalte ",0,0,0
LVINSERTTEXT listview&,$0003,&loop,2,0,0,Itemtext$ + "3. Spalte ",0,0,0
LVINSERTTEXT listview&,$0003,&loop,3,0,0,Itemtext$ + "4. Spalte ",0,0,0
LVINSERTTEXT listview&,$0003,&loop,4,0,0,Itemtext$ + "5. Spalte ",0,0,0
Endwhile
while ~GetMessage(Msg#, 0, 0, 0) > 0
~TranslateMessage(Msg#)
~DispatchMessage(Msg#)
endwhile
end
endproc
WinMain
Proc Listviewcallback
Parameters Wnd&, Msg&, Wparam&, Lparam&
If Msg& = ~Wm_notify
NMHDR# = Lparam&
If (NMHDR#.code& = ~Hdn_begintrackw) OR (NMHDR#.code& = ~Hdn_DIVIDERDBLCLICKw)'Die HDN_BeginTrack Botschaft abfangen und löschen!
Hd_notify# = Lparam&
if Hd_notify#.iButton& = 0'Wenn Spalte 0
Return 1
Endif
Endif
Endif
Return ~Callwindowproc(~Getprop(Wnd&,"OldCallback"),Wnd&, Msg&,Wparam&,Lparam&)
Endproc
'Prozeduren
Proc Closeproc
DeleteObject stdfont&
DeleteObject bigfont&
dispose LVColumnTEXT#
dispose Lv_Column#
dispose lv_item#
dispose LVITEMTEXT#
dispose NM_Listview#
dispose ItemText#
dispose HD_Notify#
dispose NMHDR#
dispose RECT#
dispose MyRect#
Dispose WindowClass#
Dispose MSG#
Dispose NMCUSTOMDRAW#
Dispose NMLVCUSTOMDRAW#
~PostQuitMessage(0)
End
Endproc
|
| | | | | |
|
Zum QuelltextThemenoptionen | 6.113 Betrachtungen |
ThemeninformationenDieses Thema hat 2 Teilnehmer: |