(276)  Anmelden

Deutsch
Quelltexte/ Codesnippets

Balken Listview

 
- Seite 1 -



Thomas
Freier
Brauchte ich für 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)
................................................... Header-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
Ladeanzahl: 216
Herunterladen
8 kB
Hochgeladen:06.03.2009
Ladeanzahl: 372
Herunterladen
 
Gruß Thomas
Windows XP SP2, XProfan X2
06.03.2009  ▲
Vollständiges Zitat
Absatzweise zitierenZeilenweise zitieren
 



« 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)
'................................................... Header-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 große 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


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

Ungelesen
Abonnieren
Merkliste
Hinweise
Gäste
Löschen
Ständig
Erledigt

6.727 Betrachtungen

Unbenanntvor 0 min.
Hans Neff24.01.2023
p.specht15.12.2020
RudiB.23.04.2020
Manfred Barei01.03.2019
Mehr...

Themeninformationen

Dieses Thema hat 3 Teilnehmer:

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


Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


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