(318)  Login

English
Source / code snippets

beam List view

 
- Page 1 -



Thomas
Freier
needed I for a Statistikanzeige. here with Pascals List and XProfan 11
CompileMarkSeparation
Def GetSysColor(1) !USER32,GetSysColor
Def CreateBitmap(5) !GDI32,CreateBitmap
Def SelectObject(2) !GDI32,SelectObject
window 30,30-616,300
Cls GetSysColor(15)
declare IcoList&
icolist&=Create(ImageList, 222,20,33,0)
................................................... Header-Image
declare x&,y&
x&=CreateBitmap(122,20,1,1,0)
MCls 222,20
StartPaint -1
Cls GetSysColor(15)
USEP 2,2,RGB(255,255,255)
UseBrush 1,RGB(255,255,255)
Rectangle 0,0-0,0
y&=SelectObject(%hdc,x&)
ImageList(Add, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Text Color RGB(05,0,0),GetSysColor(15)
UseFont Arial,15,0,0,0,0
DrawText 0, 3,   Jahrgang
y&=SelectObject(%hdc,x&)
ImageList(Add, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Text Color RGB(05,0,0),GetSysColor(15)
UseFont Arial,15,0,0,0,0
DrawText 0, 3,   amount
y&=SelectObject(%hdc,x&)
ImageList(Add, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls RGB(255,255,255)
USEP 2,2,RGB(0,0,255)
UseBrush 1,RGB(0,0,255)
Rectangle 0,0-122,20
Text Color RGB(255,255,255),RGB(0,0,255)
UseFont Arial,15,0,0,0,0
DrawText 0, 3,   men
y&=SelectObject(%hdc,x&)
ImageList(Add, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls RGB(255,255,255)
USEP 2,2,RGB(255,0,0)
UseBrush 1,RGB(255,0,0)
Rectangle 0,0-122,20
Text Color RGB(255,255,255),RGB(255,0,0)
UseFont Arial,15,0,0,0,0
DrawText 0, 3,   women
y&=SelectObject(%hdc,x&)
ImageList(Add, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Text Color RGB(05,05,0),GetSysColor(15)
UseFont Arial,15,0,0,0,0
DrawText 90, 1, 50
DrawText 186, 1, 100
USEP 0,1,RGB(5,0,0)
Line 14,1 - 14,20
Line 34,1 - 34,20
Line 54,1 - 54,20
Line 74,1 - 74,20
Line 94,14 - 94,20
Line 114,1 - 114,20
Line 134,1 - 134,20
Line 154,1 - 154,20
Line 174,1 - 174,20
Line 194,14 - 194,20
y&=SelectObject(%hdc,x&)
ImageList(Add, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
EndPaint
 $H ListView.ph

Proc new_Item

    Set(Decimals,0)
    Parameters Item%,c2%,c4%,c5%
    Lv#.Mask&   =~LVIF_TEXT | ~LVIF_PARAM | ~LVIF_STATE
    Lv#.Image&   =3
    Lv#.Item&    =Item%
    Lv#.SubItem& =0
    Lv#.Text$    =
    LvInsertItem(Lv1&)
    Lv#.SubItem& =1
    Lv#.Text$    = st$(c2%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =2
    Lv#.Text$    = st$(c4% + c5%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =3
    Lv#.Text$    = st$(c4%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =4
    Lv#.Text$    = st$(c5%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =5
    Lv#.Text$    =
    LvInsertItem(Lv1&)
    MCls 222,20
    StartPaint -1
    Cls RGB(255,255,255)
    USEP 2,2,RGB(0,0,255)
    UseBrush 1,RGB(0,0,255)
    Rectangle 5,4 -(c4%*2),20
    USEP 2,2,RGB(255,0,0)
    UseBrush 1,RGB(255,0,0)
    Rectangle (c4%*2),4 - ((c4%*2)+(c5%*2)),20
    y&=SelectObject(%hdc,x&)
    ImageList(Add, icolist&,y&,0)
    x&=SelectObject(%hdc,y&)
    EndPaint
    Lv#.Mask&   =~LVIF_IMAGE
    Lv#.Image&  =GetCount(icolist&)-1
    LvSetItem(Lv1&)

Endproc

---------------------------------------------------------------------------------functions
------slot insert
def LvInsertColumn(2) sendmessage( &(1),~LVM_INSERTCOLUMN,%(2),Lvc# )
------combination from LVM_SETITEMTEXT and LVM_INSERTITEM, because to that lay out the Items
------and to that settle the SubItem-Texts different Messages necessary are
def LvInsertItem(1) if(Lv#.SubItem&,sendmessage(&(1),~LVM_SETITEMTEXT,Lv#.Item&,Lv#),sendmessage(&(1),~LVM_INSERTITEM,0,Lv#))
------properties one Items settle (in example SubItem-Icon)
def LvSetItem(1) sendmessage( &(1),~LVM_SETITEM,0,Lv# )
declare Lvc#,Lv#,Lv1&
Lv1&=control(SysListView32,,$54010009,20,20,570,200,%hwnd,1,%hinstance,$200)
sendmessage(Lv1&,~LVM_SETIMAGELIST,1,IcoList&)
sendmessage(Lv1&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_GRIDLINES | ~LVS_EX_SUBITEMIMAGES)
declare Font&,Header&
Font&=Create(Font,Arial,15,0,0,0,0)
Header&=sendmessage(Lv1&,~LVM_GETHEADER,0,0)
setfont Header&,Font&
setdialogfont Font&
struct Lvc=Mask&,Fmt&,Cx&,Text&,TextMax&,SubItem&,Image&,Order&,Text$(200)
dim Lvc#,Lvc
clear Lvc#
Lvc#.Mask&    = ~LVCF_TEXT | ~LVCF_IMAGE | ~LVCF_WIDTH
Lvc#.Text&    =Lvc#+32
1. Column Hide, there always one Iconplatz present
Lvc#.Cx&   =0
Lvc#.Image&=0
Lvc#.Text$ =blind
LvInsertColumn(Lv1&,0)
2. Column
Lvc#.Cx&   =80
Lvc#.Image&=1
Lvc#.Text$ =
LvInsertColumn(Lv1&,1)
3. Column
Lvc#.Cx&   =70
Lvc#.Image&=2
Lvc#.Text$ =
LvInsertColumn(Lv1&,2)
4. Column
Lvc#.Cx&   =64
Lvc#.Image&=3
Lvc#.Text$ =
LvInsertColumn(Lv1&,3)
5. Column
Lvc#.Cx&   =64
Lvc#.Image&=4
Lvc#.Text$ =
LvInsertColumn(Lv1&,4)
6. Column
Lvc#.Cx&   =220
Lvc#.Image&=5
Lvc#.Text$ =
LvInsertColumn(Lv1&,5)
dispose Lvc#
-------------------------------------------------Item 1
struct Lvi=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&,Param&,Text$(200)
dim Lv#,Lvi
clear Lv#
Lv#.Text&   =(Lv#+36)
Lv#.TextMax&=200
..Item-Nr,year,men,women
new_item 0, 2000, 60, 1
-------------------------------------------------Item 2
new_item 1, 1999, 40, 4
-------------------------------------------------Item 3
new_item 2, 1998, 74, 10
-------------------------------------------------Item 4
new_item 3, 1997, 104, 2

while 1

    waitinput

endwhile

destroywindow(Lv1&)
DeleteObject IcoList&
DeleteObject Font&
dispose Lv#

465 kB
Hochgeladen:03/06/09
Downloadcounter: 216
Download
8 kB
Hochgeladen:03/06/09
Downloadcounter: 372
Download
 
Gruß Thomas
Windows XP SP2, XProfan X2
03/06/09  ▲
Vollständiges Quote
Absatzweise QuoteZeilenweise Quote
 



« this Posting watts as Solution marked. »


p.specht

REANIMIERT:
CompileMarkSeparation
 $H ListView.ph
' BalkenListview by Thomas suitor, reanimated 2018-10 by p.woodpecker
Def GetSysColor(1) !"USER32","GetSysColor"
Def CreateBitmap(5) !"GDI32","CreateBitmap"
Def SelectObject(2) !"GDI32","SelectObject"
window 30,30-616,300
Cls GetSysColor(15)
declare IcoList&
icolist&=Create("ImageList", 222,20,33,0)
'................................................... Header-Image
declare x&,y&
x&=CreateBitmap(122,20,1,1,0)
MCls 222,20
StartPaint -1
Cls GetSysColor(15)
USEP 2,2,RGB(255,255,255)
UseBrush 1,RGB(255,255,255)
Rectangle 0,0-0,0
y&=SelectObject(%hdc,x&)
ImageList("Add", icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Text Color RGB(05,0,0),GetSysColor(15)
UseFont "Arial",15,0,0,0,0
DrawText 0, 3,"  Jahrgang"
y&=SelectObject(%hdc,x&)
ImageList("Add", icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Text Color RGB(05,0,0),GetSysColor(15)
UseFont "Arial",15,0,0,0,0
DrawText 0, 3,"  Summe"
y&=SelectObject(%hdc,x&)
ImageList("Add", icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls RGB(255,255,255)
USEP 2,2,RGB(0,0,255)
UseBrush 1,RGB(0,0,255)
Rectangle 0,0-122,20
Text Color RGB(255,255,255),RGB(0,0,255)
UseFont "Arial",15,0,0,0,0
DrawText 0, 3,"  Männer"
y&=SelectObject(%hdc,x&)
ImageList("Add", icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls RGB(255,255,255)
USEP 2,2,RGB(255,0,0)
UseBrush 1,RGB(255,0,0)
Rectangle 0,0-122,20
Text Color RGB(255,255,255),RGB(255,0,0)
UseFont "Arial",15,0,0,0,0
DrawText 0, 3,"  Frauen"
y&=SelectObject(%hdc,x&)
ImageList("Add", icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Text Color RGB(05,05,0),GetSysColor(15)
UseFont "Arial",15,0,0,0,0
DrawText 90, 1, 50
DrawText 186, 1, 100
USEP 0,1,RGB(5,0,0)
Line 14,1 - 14,20
Line 34,1 - 34,20
Line 54,1 - 54,20
Line 74,1 - 74,20
Line 94,14 - 94,20
Line 114,1 - 114,20
Line 134,1 - 134,20
Line 154,1 - 154,20
Line 174,1 - 174,20
Line 194,14 - 194,20
y&=SelectObject(%hdc,x&)
ImageList("Add", icolist&,y&,0)
x&=SelectObject(%hdc,y&)
EndPaint

Proc new_Item

    Set("Decimals",0)
    Parameters Item%,c2%,c4%,c5%
    Lv#.Mask&   =~LVIF_TEXT | ~LVIF_PARAM | ~LVIF_STATE
    Lv#.Image&   =3
    Lv#.Item&    =Item%
    Lv#.SubItem& =0
    Lv#.Text$    =""
    LvInsertItem(Lv1&)
    Lv#.SubItem& =1
    Lv#.Text$    = st$(c2%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =2
    Lv#.Text$    = st$(c4% + c5%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =3
    Lv#.Text$    = st$(c4%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =4
    Lv#.Text$    = st$(c5%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =5
    Lv#.Text$    = ""
    LvInsertItem(Lv1&)
    MCls 222,20
    StartPaint -1
    Cls RGB(255,255,255)
    USEP 2,2,RGB(0,0,255)
    UseBrush 1,RGB(0,0,255)
    Rectangle 5,4 -(c4%*2),20
    USEP 2,2,RGB(255,0,0)
    UseBrush 1,RGB(255,0,0)
    Rectangle (c4%*2),4 - ((c4%*2)+(c5%*2)),20
    y&=SelectObject(%hdc,x&)
    ImageList("Add", icolist&,y&,0)
    x&=SelectObject(%hdc,y&)
    EndPaint
    Lv#.Mask&   =~LVIF_IMAGE
    Lv#.Image&  =GetCount(icolist&)-1
    LvSetItem(Lv1&)

Endproc

'---------------------------------------------------------------------------------functions
'------slot insert
def LvInsertColumn(2) sendmessage( &(1),~LVM_INSERTCOLUMN,%(2),Lvc# )
'------combination from LVM_SETITEMTEXT and LVM_INSERTITEM, because to that lay out the Items
'------and to that settle the SubItem-Texts different Messages necessary are
def LvInsertItem(1) if(Lv#.SubItem&,sendmessage(&(1),~LVM_SETITEMTEXT,Lv#.Item&,Lv#),sendmessage(&(1),~LVM_INSERTITEM,0,Lv#))
'------properties one Items settle (z.B. SubItem-Icon)
def LvSetItem(1) sendmessage( &(1),~LVM_SETITEM,0,Lv# )
declare Lvc#,Lv#,Lv1&
Lv1&=control("SysListView32","",$54010009,20,20,570,200,%hwnd,1,%hinstance,$200)
sendmessage(Lv1&,~LVM_SETIMAGELIST,1,IcoList&)
sendmessage(Lv1&,~LVM_SETEXTENDEDLISTVIEWSTYLE,0,~LVS_EX_GRIDLINES | ~LVS_EX_SUBITEMIMAGES)
declare Font&,Header&
Font&=Create("Font","Arial",15,0,0,0,0)
Header&=sendmessage(Lv1&,~LVM_GETHEADER,0,0)
setfont Header&,Font&
setdialogfont Font&
struct Lvc=Mask&,Fmt&,Cx&,Text&,TextMax&,SubItem&,Image&,Order&,Text$(200)
Dim Lvc#,Lvc
clear Lvc#
Lvc#.Mask&    = ~LVCF_TEXT | ~LVCF_IMAGE | ~LVCF_WIDTH
Lvc#.Text&    =Lvc#+32
'1. Column Hide, there always one Iconplatz present
Lvc#.Cx&   =0
Lvc#.Image&=0
Lvc#.Text$ ="Blind"
LvInsertColumn(Lv1&,0)
'2. Column
Lvc#.Cx&   =80
Lvc#.Image&=1
Lvc#.Text$ =""
LvInsertColumn(Lv1&,1)
'3. Column
Lvc#.Cx&   =70
Lvc#.Image&=2
Lvc#.Text$ =""
LvInsertColumn(Lv1&,2)
'4. Column
Lvc#.Cx&   =64
Lvc#.Image&=3
Lvc#.Text$ =""
LvInsertColumn(Lv1&,3)
'5. Column
Lvc#.Cx&   =64
Lvc#.Image&=4
Lvc#.Text$ =""
LvInsertColumn(Lv1&,4)
'6. Column
Lvc#.Cx&   =220
Lvc#.Image&=5
Lvc#.Text$ =""
LvInsertColumn(Lv1&,5)
dispose Lvc#
'-------------------------------------------------Item 1
struct Lvi=Mask&,Item&,SubItem&,State&,StateMask&,Text&,TextMax&,Image&,Param&,Text$(200)
dim Lv#,Lvi
clear Lv#
Lv#.Text&   =(Lv#+36)
Lv#.TextMax&=200
'..Item-Nr,year,men,women
new_item 0, 2000, 60, 1
'-------------------------------------------------Item 2
new_item 1, 1999, 40, 4
'-------------------------------------------------Item 3
new_item 2, 1998, 74, 10
'-------------------------------------------------Item 4
new_item 3, 1997, 104, 2

while 1

    waitinput

endwhile

destroywindow(Lv1&)
DeleteObject IcoList&
DeleteObject Font&
dispose Lv#
END
 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
10/10/18  ▲
 




Michael
W.
ListView.ph

existing in my INCLUDE-directory not.

P.s.:
Glücklicherweise there here a very large collection of Header-Files.

and... Wow, the sees Real class from...
 
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.
10/12/18  ▲
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

6.730 Views

Untitledvor 0 min.
Hans Neff01/24/23
p.specht12/15/20
RudiB.04/23/20
Manfred Barei03/01/19
More...

Themeninformationen

this Topic has 3 subscriber:

Michael W. (1x)
p.specht (1x)
Thomas Freier (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.

all rightDatenschutzerklärung
i want none Cookie