LV:Changeing fore-/backcolors in a single cell

[marthar]

Moin!

I have been programming in Turbo-/GFA-Basic quite a while now (starting with Turbo-Basic on the Atari 800 XL back in the 80s, continuing on Atari ST/TT/Falcon and under "MagicMac" on Macinthsh, then reluctantly switching over to GFA-Basic 3.5 for Windows 95 and finally to GB32) and now I stumbled across some kind of problem, I could't resolve myself yet.

In one of my programs, I am using a kind of "spreadsheet"-style ListViews, filled with data gathered from diverse sources, i.e. an oversight over unpaid customer-bills etc. What I would like to do is, mark single cells of the listview to get the immediate attention of the user, if for example a bill is not paid in full. I have no problems, coloring whole lines of the listview, but obviously am unable to mark/colorize single cells instead of the complete line.

Anybody got an idea, how to handle this? I'd appreciate any hints/help, you could provide. I'll attach a short bit of code, building a simple demo-Listview. Pls feel free to use/modify and remail, if that helps.

thanks
Martin

'-------------------------------------------------------------------------------------------
'
' Problem: Coloring single cells in a Listview in a different colour than rest of the line
'
'-------------------------------------------------------------------------------------------

init
Do
Sleep
Exit If Me Is Nothing
Loop

Sub init
Local i%, x%
Local t$, nr$, soll$ , haben$
Local saldo As Double
Local li As ListItem

LoadForm frm1 /* Das ist ja eh immer vorhanden, also nehmen wir das auch gleich
frm1.Caption = "Listview-Test"
Ocx ListView lv1 = 1, 1 /* Wir basteln uns ein Listview-Gerüst

frm1.Width = PixelsToTwipX(500) /* Größe festlegen
frm1.Height = PixelsToTwipY(300)
lv1.Width = TwipsToPixelX(frm1.Width - 300)
lv1.Height = TwipsToPixelY(frm1.Height - 900)

Ocx RichEdit ed = "show selected line here", 1, lv1.Height + 10, lv1.Width, 16
ed.FontName = "Courier New"
ed.FontSize = 9
lv1.View = 3 /* Listenansicht

lv1.ColumnHeaders.Add( , , "Nr").Width = lv1.TextWidth(String$(3, "W")) /* Spalten initialisieren und
lv1.ColumnHeaders.Add( , , "Name").Width = lv1.TextWidth(String$(20, "W")) /* Breite festlegen
lv1.ColumnHeaders.Add( , , "Soll").Width = lv1.TextWidth(String$(6, "W"))
lv1.ColumnHeaders.Add( , , "Haben").Width = lv1.TextWidth(String$(6, "W"))
lv1.ColumnHeaders.Add( , , "Saldo").Width = lv1.TextWidth(String$(6, "W"))

lv1.ColumnHeaders(1).Alignment = 1 /* Spalten ausrichten
lv1.ColumnHeaders(2).Alignment = 0
lv1.ColumnHeaders(3).Alignment = 1
lv1.ColumnHeaders(4).Alignment = 1
lv1.ColumnHeaders(5).Alignment = 1

lv1.FullRowSelect = True /* select whole line
lv1.GridLines = True /* show grid
lv1.HideSelection = False
lv1.FontSize = 9
testdaten:
Data 1,Manfred Muster,100,100
Data 2,Erika Muster, 255.90, 125.00
Data 3,Fritz Fischer, 36.00,0
Data 4,Hans W. Urst, 1522.86,1000.00
Data 5,Hubert Heimlich, 50.00,50.00
Data 6,Gustav Gans,803.40,810
Data 7,Ferdinand Friesengeist,155.00,0

Data -,-,-,-

Restore testdaten
For i% = 1 To 10 /* fill Listview with data
Read nr$, t$, soll$, haben$
Exit If nr$ = "-"
Set li = lv1.AddItem
li.Text = Str$(Val(nr$), 4, 0)
li.SubItems(1) = t$
li.SubItems(2) = Str$(Val(soll$), 7, 2) + " €"
li.SubItems(3) = Str$(Val(haben$), 7, 2) + " €"
saldo = Val(soll$) - Val(haben$)
li.SubItems(4) = Str$(saldo, 7, 2) + " €"

If Odd(i%) /* colour every 2nd line for better readability
li.BackColor = RGB(200, 255, 200)
EndIf
Next i%

' ok, this was the easy part. Up to here, I have no problems, designing my listviews as I wish to.
' But what I really miss, is a possibility to change the appearance of single cells within a line,
' i.e. changing the color of subitem(4) ["Saldo"] to red, if the value within is <>0. Changeging
' the complete line is simple (see below), but how do I set just the color (or fontsize etc.) of cell(x)
' in line(y)??
'
' any suggestions desperately appreciated. From time to time I will look into the forum, but if you
' can help, please send me a piece of explaining code to [e-mail]


End Sub
Sub lv1_ItemClick(Item As ListItem)
Local li As ListItem
Local saldo As Double
Set li = lv1.SelectedItem

saldo = Val(li.SubItems(4))
ed.Text = li.Text + ":" + li.SubItems(1) + " Saldo = " + li.SubItems(4)

If Val(saldo) = 0 /* Example coloring the whole lines
li.ForeColor = RGB(0, 0, 0)
Else If saldo > 0
li.ForeColor = RGB(255, 0, 0)
Else If saldo < 0
li.ForeColor = RGB(0, 150, 0)
EndIf
End Sub

[patrick659]

I am very new in GFA basic, but i try your program.
And after viewing the help file ( doesn't give enougth sample.

But what can i say is just to be able define the cells , because
you got the line but not the column of that row.
And i really cannot help you on this one .

wish you a merry christmas

[649psoft]

The issue here is that the listview object is the most complex win 32 object and you
may know that it can take on completely different views and appearances.

When the original developers stopped with this project they had most of the
features of the report view but the full range of capablity was not implemented,
but this is also true in many other high level languages.

You have done good work in your example but to color a single cell different than
the rest of the line we need to use the API, and you should refer to the Win 32 SDK
from Microsoft.

I have extended and modified your example to color a single cell or column.

To make it complete you should use the form editor since it has better message
subs for redrawing and paint than the OCX hardcoded object.


'-------------------------------------------------------------------------------------------
'
' Problem: Coloring single cells in a Listview in a different colour than rest of the line
'
'-------------------------------------------------------------------------------------------
@initlvitem
init
frm1.AutoRedraw = True

Do
'@lvsetcolumntextcolor 'To do: expand to message notification
Sleep
Exit If Me Is Nothing
Loop

Sub init
Local i%, x%
Local t$, nr$, soll$ , haben$
Local saldo As Double
Local li As ListItem

LoadForm frm1 /* Das ist ja eh immer vorhanden, also nehmen wir das auch gleich
frm1.Caption = "Listview-Test"
Ocx ListView lv1 = 1, 1 /* Wir basteln uns ein Listview-Gerüst

frm1.Width = PixelsToTwipX(500) /* Größe festlegen
frm1.Height = PixelsToTwipY(300)
lv1.Width = TwipsToPixelX(frm1.Width - 300)
lv1.Height = TwipsToPixelY(frm1.Height - 900)

Ocx RichEdit ed = "show selected line here", 1, lv1.Height + 10, lv1.Width, 16
ed.FontName = "Courier New"
ed.FontSize = 9
lv1.View = 3 /* Listenansicht

lv1.ColumnHeaders.Add( , , "Nr").Width = lv1.TextWidth(String$(3, "W")) /* Spalten initialisieren und
lv1.ColumnHeaders.Add( , , "Name").Width = lv1.TextWidth(String$(20, "W")) /* Breite festlegen
lv1.ColumnHeaders.Add( , , "Soll").Width = lv1.TextWidth(String$(6, "W"))
lv1.ColumnHeaders.Add( , , "Haben").Width = lv1.TextWidth(String$(6, "W"))
lv1.ColumnHeaders.Add( , , "Saldo").Width = lv1.TextWidth(String$(6, "W"))

lv1.ColumnHeaders(1).Alignment = 1 /* Spalten ausrichten
lv1.ColumnHeaders(2).Alignment = 0
lv1.ColumnHeaders(3).Alignment = 1
lv1.ColumnHeaders(4).Alignment = 1
lv1.ColumnHeaders(5).Alignment = 1

lv1.FullRowSelect = True /* select whole line
lv1.GridLines = True /* show grid
lv1.HideSelection = False
lv1.FontSize = 9
testdaten:
Data 1,Manfred Muster,100,100
Data 2,Erika Muster, 255.90, 125.00
Data 3,Fritz Fischer, 36.00,0
Data 4,Hans W. Urst, 1522.86,1000.00
Data 5,Hubert Heimlich, 50.00,50.00
Data 6,Gustav Gans,803.40,810
Data 7,Ferdinand Friesengeist,155.00,0

Data -,-,-,-

Restore testdaten
For i% = 1 To 10 /* fill Listview with data
Read nr$, t$, soll$, haben$
Exit If nr$ = "-"
Set li = lv1.AddItem
li.Text = Str$(Val(nr$), 4, 0)
li.SubItems(1) = t$
li.SubItems(2) = Str$(Val(soll$), 7, 2) + " €"
li.SubItems(3) = Str$(Val(haben$), 7, 2) + " €"
saldo = Val(soll$) - Val(haben$)
li.SubItems(4) = Str$(saldo, 7, 2) + " €"

If Odd(i%) /* colour every 2nd line for better readability
li.BackColor = RGB(200, 255, 200)
EndIf
Next i%

' ok, this was the easy part. Up to here, I have no problems, designing my listviews as I wish to.
' But what I really miss, is a possibility to change the appearance of single cells within a line,
' i.e. changing the color of subitem(4) ["Saldo"] to red, if the value within is <>0. Changeging
' the complete line is simple (see below), but how do I set just the color (or fontsize etc.) of cell(x)
' in line(y)??
'
' any suggestions desperately appreciated. From time to time I will look into the forum, but if you
' can help, please send me a piece of explaining code to [e-mail]

End Sub
Sub lv1_ItemClick(Item As ListItem)
Local li As ListItem
Local saldo As Double
Set li = lv1.SelectedItem

saldo = Val(li.SubItems(4))
ed.Text = li.Text + ":" + li.SubItems(1) + " Saldo = " + li.SubItems(4)

If Val(saldo) = 0 /* Example coloring the whole lines
li.ForeColor = RGB(0, 0, 0)
Else If saldo > 0
li.ForeColor = RGB(255, 0, 0)
Else If saldo < 0
li.ForeColor = RGB(0, 150, 0)
EndIf

Set li = Nothing
End Sub
Procedure InitLVItem

'Please see Win32 SDK online help
'Win32 Programmers reference from Microsoft MSDN
'for listview common control documentation

Type LV_ITEM
mask As Long
iItem As Long
iSubItem As Long
STATE As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long
End Type

Global Const LVM_FIRST = &H1000 ' ListView messages
Global Const LVIF_TEXT = &H0001 '*The pszText member is valid or needs to be filled in.
Global Const LVIS_SELECTED = &H0002
Global Const LVM_GETITEMCOUNT = LVM_FIRST + 4
Global Const LVM_SETITEM = LVM_FIRST + 6 '*
Global Const LVM_SETTEXTCOLOR = LVM_FIRST + 36

'rgb buffer accessable from gfa basic
Global CRgb|(3)
Global CRgb%

Global ret As Long
Global ItemText$

'make a copy of a listview item template in memory
Global itema As LV_ITEM
Global ADDRITEM As Int
ADDRITEM = V:itema

Return
Procedure InitLvStateMask(Inum As Int, SubInum As Int)

itema.mask = LVIF_TEXT
itema.iItem = Inum - 1
itema.iSubItem = SubInum
itema.STATE = LVIS_SELECTED
itema.stateMask = LVIS_SELECTED
itema.pszText = V:ItemText$
itema.cchTextMax = 100
itema.iImage = 0
itema.lParam = 0

Return
Procedure LvSetColumnTextColor

Local ColumnToSetSubItemColor = 4
Local lvNumItems As Int 'loop
Local lvNumCols As Int 'loop
Local Icols As Int, Iitems As Int

lvNumItems = SendMessage(lv1.hWnd, LVM_GETITEMCOUNT, 0, 0)
lvNumCols = lv1.ColumnHeaders.Count

For Icols = 0 To lvNumCols
For Iitems = 1 To lvNumItems

'column 4 to red
If Icols = ColumnToSetSubItemColor
CRgb|(0) = 200 'r
CRgb|(1) = 0 'g
CRgb|(2) = 0 'b
Else
CRgb|(0) = 0 'r
CRgb|(1) = 0 'g
CRgb|(2) = 0 'b
EndIf
BMove V:CRgb|(0), V:CRgb%, 3

ItemText$ = lv1.Item(Iitems).SubItems(Icols)

@initlvstatemask(Iitems, Icols)

ret = SendMessage(lv1.hWnd, LVM_SETTEXTCOLOR, 0, CRgb%) 'cell text color
DoEvents
ret = SendMessage(lv1.hWnd, LVM_SETITEM, itema.iItem - 1, ADDRITEM)
DoEvents

Next Iitems
Next Icols

'MsgBox "column 4 is red"

Return
Sub frm1_Close(Cancel?)

'the listview is hardcoded
'so we need to clear it from memory
Try
Set lv1 = Nothing
Catch
EndCatch

Try
Set ed = Nothing
Catch
EndCatch

End

'use Quit if compiled

EndSub
Sub lv1_GotFocus
'@lvsetcolumntextcolor
'DoEvents
EndSub
Sub frm1_Paint
@lvsetcolumntextcolor
DoEvents
EndSub