Français
Source/ Codesnippets

poutre Listview

 
- page 1 -



Thomas
Freier
Brauchte je pour une Statistikanzeige. ici avec Pascals Listview et XProfan 11
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&=Créer(ImageList, 222,20,33,0)
................................................... En-tête-Image
declare x&,y&
x&=CreateBitmap(122,20,1,1,0)
MCLS 222,20
Début de peinture -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(Ajouter, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Couleur du texte RGB(05,0,0),GetSysColor(15)
UseFont Arial,15,0,0,0,0
DrawText 0, 3,   Jahrgang
y&=SelectObject(%hdc,x&)
ImageList(Ajouter, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Couleur du texte RGB(05,0,0),GetSysColor(15)
UseFont Arial,15,0,0,0,0
DrawText 0, 3,   somme
y&=SelectObject(%hdc,x&)
ImageList(Ajouter, 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
Couleur du texte 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(Ajouter, 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
Couleur du texte RGB(255,255,255),RGB(255,0,0)
UseFont Arial,15,0,0,0,0
DrawText 0, 3,   Frauen
y&=SelectObject(%hdc,x&)
ImageList(Ajouter, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
Cls GetSysColor(15)
Couleur du texte 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(Ajouter, icolist&,y&,0)
x&=SelectObject(%hdc,y&)
EndPaint
 $H ListView.ph

Proc new_Item

    Set(Decimals,0)
    Paramètres 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
    Début de peinture -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(Ajouter, icolist&,y&,0)
    x&=SelectObject(%hdc,y&)
    EndPaint
    Lv#.Mask&   =~LVIF_IMAGE
    Lv#.Image&  =GetCount(icolist&)-1
    LvSetItem(Lv1&)

ENDPROC

---------------------------------------------------------------------------------Funktionen
------Spalte insérer
def LvInsertColumn(2) sendmessage( &(1),~LVM_INSERTCOLUMN,%(2),Lvc# )
------Kombination aus LVM_SETITEMTEXT et LVM_INSERTITEM, weil zum Anlegen des Items
------et zum mettons qui SubItem-Textes verschiedene Messages nötig sommes
def LvInsertItem(1) si(Lv#.SubItem&,sendmessage(&(1),~LVM_SETITEMTEXT,Lv#.Item&,Lv#),sendmessage(&(1),~LVM_INSERTITEM,0,Lv#))
------Eigenschaften eines Items mettons (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&=Créer(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,  toujours un 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,l'an,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

tandis que 1

    waitinput

endwhile

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

465 kB
Hochgeladen:06.03.2009
Downloadcounter250
Download
8 kB
Hochgeladen:06.03.2009
Downloadcounter401
Download
 
Gruß Thomas
Windows XP SP2, XProfan X2
06.03.2009  
 



« cette Beitrag wurde comme Solution gekennzeichnet. »


p.specht

REANIMIERT:
 $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&=Créer("ImageList", 222,20,33,0)
'................................................... En-tête-Image
declare x&,y&
x&=CreateBitmap(122,20,1,1,0)
MCLS 222,20
Début de peinture -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)
Couleur du texte 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)
Couleur du texte 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
Couleur du texte 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
Couleur du texte 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)
Couleur du texte 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("Décimal",0)
    Paramètres 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
    Début de peinture -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

'---------------------------------------------------------------------------------Funktionen
'------Spalte insérer
def LvInsertColumn(2) sendmessage( &(1),~LVM_INSERTCOLUMN,%(2),Lvc# )
'------Kombination aus LVM_SETITEMTEXT et LVM_INSERTITEM, weil zum Anlegen des Items
'------et zum mettons qui SubItem-Textes verschiedene Messages nötig sommes
def LvInsertItem(1) si(Lv#.SubItem&,sendmessage(&(1),~LVM_SETITEMTEXT,Lv#.Item&,Lv#),sendmessage(&(1),~LVM_INSERTITEM,0,Lv#))
'------Eigenschaften eines Items mettons (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&=Créer("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)
Faible Lvc#,Lvc
clear Lvc#
Lvc#.Mask&    = ~LVCF_TEXT | ~LVCF_IMAGE | ~LVCF_WIDTH
Lvc#.Text&    =Lvc#+32
'1. Column ausblenden, là toujours un 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,l'an,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

tandis que 1

    waitinput

endwhile

destroywindow(Lv1&)
DeleteObject IcoList&
DeleteObject Font&
dispose Lv#
FIN
 
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 dans mon INCLUDE-Verzeichnis pas.

P.S.:
Glücklicherweise gibt es ici une très grand recueil de Headerdateien.

et... Wow, cela sieht vraie super aus...
 
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.
12.10.2018  
 



Zum Quelltext


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

7.470 Views

Untitledvor 0 min.
H.Brill10.10.2024
Hans Neff24.01.2023
p.specht15.12.2020
RudiB.23.04.2020
plus...

Themeninformationen



Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.


d'accordDatenschutzerklärung
je voudrais keinen Cookie