(2.665)  Registro

Italia
Fonte/ Codesnippets

Balken Listview

 
- Page 1 -



Thomas
Freier
Brauchte ich per eine Statistikanzeige. Hier mit Pascals Listview und XProfan 11
KompilierenMarkierenSeparieren
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)
................................................... Testata-Image
declare x&,y&
x&=CreateBitmap(122,20,1,1,0)
MCls 222,20
StartPaint -1
Cls GetSysColor(15)
UsePen 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)
TextColor 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)
TextColor 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)
UsePen 2,2,RGB(0,0,255)
UseBrush 1,RGB(0,0,255)
Rectangle 0,0-122,20
TextColor 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)
UsePen 2,2,RGB(255,0,0)
UseBrush 1,RGB(255,0,0)
Rectangle 0,0-122,20
TextColor 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)
TextColor RGB(05,05,0),GetSysColor(15)
UseFont Arial,15,0,0,0,0
DrawText 90, 1, 50
DrawText 186, 1, 100
UsePen 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$    = str$(c2%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =2
    Lv#.Text$    = str$(c4% + c5%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =3
    Lv#.Text$    = str$(c4%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =4
    Lv#.Text$    = str$(c5%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =5
    Lv#.Text$    =
    LvInsertItem(Lv1&)
    MCls 222,20
    StartPaint -1
    Cls RGB(255,255,255)
    UsePen 2,2,RGB(0,0,255)
    UseBrush 1,RGB(0,0,255)
    Rectangle 5,4 -(c4%*2),20
    UsePen 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

---------------------------------------------------------------------------------Funktionen
------Spalte einfügen
def LvInsertColumn(2) sendmessage( &(1),~LVM_INSERTCOLUMN,%(2),Lvc# )
------Kombination aus LVM_SETITEMTEXT und LVM_INSERTITEM, weil zum Anlegen des Items
------und zum Setzen der SubItem-Texte verschiedene Messages nötig sind
def LvInsertItem(1) if(Lv#.SubItem&,sendmessage(&(1),~LVM_SETITEMTEXT,Lv#.Item&,Lv#),sendmessage(&(1),~LVM_INSERTITEM,0,Lv#))
------Eigenschaften eines Items setzen (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 ausblenden, da immer ein Iconplatz vorhanden
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,Jahr,Männer,Frauen
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:06.03.2009
Downloadcounter: 250
Download
8 kB
Hochgeladen:06.03.2009
Downloadcounter: 401
Download
 
Gruß Thomas
Windows XP SP2, XProfan X2
06.03.2009  ▲
Vollständiges Zitat
Absatzweise CitazioneZeilenweise Citazione
 



« Dieser Beitrag wurde als Lösung gekennzeichnet. »


p.specht

REANIMIERT:
KompilierenMarkierenSeparieren
 $H ListView.ph
' BalkenListview by Thomas Freier, reanimated 2018-10 by p.specht
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)
'................................................... Testata-Image
declare x&,y&
x&=CreateBitmap(122,20,1,1,0)
MCls 222,20
StartPaint -1
Cls GetSysColor(15)
UsePen 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)
TextColor 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)
TextColor 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)
UsePen 2,2,RGB(0,0,255)
UseBrush 1,RGB(0,0,255)
Rectangle 0,0-122,20
TextColor 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)
UsePen 2,2,RGB(255,0,0)
UseBrush 1,RGB(255,0,0)
Rectangle 0,0-122,20
TextColor 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)
TextColor RGB(05,05,0),GetSysColor(15)
UseFont "Arial",15,0,0,0,0
DrawText 90, 1, 50
DrawText 186, 1, 100
UsePen 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$    = str$(c2%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =2
    Lv#.Text$    = str$(c4% + c5%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =3
    Lv#.Text$    = str$(c4%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =4
    Lv#.Text$    = str$(c5%)
    LvInsertItem(Lv1&)
    Lv#.SubItem& =5
    Lv#.Text$    = ""
    LvInsertItem(Lv1&)
    MCls 222,20
    StartPaint -1
    Cls RGB(255,255,255)
    UsePen 2,2,RGB(0,0,255)
    UseBrush 1,RGB(0,0,255)
    Rectangle 5,4 -(c4%*2),20
    UsePen 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

'---------------------------------------------------------------------------------Funktionen
'------Spalte einfügen
def LvInsertColumn(2) sendmessage( &(1),~LVM_INSERTCOLUMN,%(2),Lvc# )
'------Kombination aus LVM_SETITEMTEXT und LVM_INSERTITEM, weil zum Anlegen des Items
'------und zum Setzen der SubItem-Texte verschiedene Messages nötig sind
def LvInsertItem(1) if(Lv#.SubItem&,sendmessage(&(1),~LVM_SETITEMTEXT,Lv#.Item&,Lv#),sendmessage(&(1),~LVM_INSERTITEM,0,Lv#))
'------Eigenschaften eines Items setzen (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 ausblenden, da immer ein Iconplatz vorhanden
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,Jahr,Männer,Frauen
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.2018  ▲
 




Michael
W.
ListView.ph

existiert in meinem INCLUDE-Verzeichnis nicht.

P.S.:
Glücklicherweise gibt es hier eine sehr grande Sammlung von Headerdateien.

Und... Wow, das sieht echt Klasse aus...
 
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.
12.10.2018  ▲
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

7.468 Views

Untitledvor 0 min.
H.Brill10.10.2024
Hans Neff24.01.2023
p.specht15.12.2020
RudiB.23.04.2020
Di più...

Themeninformationen

Dieses Thema hat 3 subscriber:

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


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.

einverstandenDatenschutzerklärung
Ich möchte keinen Cookie