msflexgrid

[Mubs]

could anyone help with the following:

I have a program with a flex grid. there are 3 buttons and 2 text box.. the user has to enter between 1-125 in textbox 1 and 0-1023 in text box 2. what ever is defined in text box 2 that amount will be highlighted with colour in the flex grid.. (cells)...I have got this part working but the problem is when i want to delete and remove the coloured cells in flex grid it wont remove the colour in the cells..

(command 1 to create)
(command 3 to remove)

could any1 help.

code:

Dim colourshow(125) As Double, sectors(1023) As Integer


Private Sub Command1_Click( )
Rem create, look for contiguous sectors of right length
i = 0
N = Val(Text2.Text)
inloopb = True
While inloopb
If sectors(i) = 0 Then
Rem one blank found, now for the next N
inloop = True
j = 1
found = False
While inloop
If sectors(i + j) > 0 Then
inloop = False
Else
If j = N Then
found = True
inloop = False
Else
If j < 1023 Then
j = j + 1
Else
MsgBox "Memory full", vbCritical
inloop = False
End If
End If
End If
Wend
If found Then
List1.AddItem Text1.Text
Rem i points to first
For j = 0 To N - 1
sectors(i + j) = Val(Text1.Text)
Next j
Call redisp
inloopb = False
Else
i = i + 1
End If

If i = 1023 Then
MsgBox "Memory full", vbCritical
inloopb = False
Else
i = i + 1
End If
Else
i = i + 1
End If
Wend
End Sub
Private Sub redisp()

For i = 0 To 1023

myrow = Int(i / 16)
mycol = i - myrow * 16
MSf1.Row = myrow
MSf1.Col = mycol + 1
If sectors(i) > 0 Then
MSf1.CellBackCo lor = colourshow(sect ors(i))
Else
MSf1.CellBackCo lor = RGB(0, 0, 0)

End If
Next i
End Sub

Private Sub Command2_Click( )
Rem first check how big file is now
runtot = 0
List2.Clear
For i = 0 To 1023
If sectors(i) = Val(Text1) Then
List2.AddItem Str(i)
runtot = runtot + 1
End If
Next i
If runtot > Val(Text2.Text) Then
Rem file is smaller
Rem use list box to save sectors back to zero
List2.ListIndex = Val(Text2.Text) - 1
While List2.ListIndex < List2.ListCount - 1
List2.ListIndex = List2.ListIndex + 1
whichsector = Val(List2.Text)
sectors(whichse ctor) = 0

Wend
Call redisp
End If
End Sub

Private Sub Command3_Click( )
' if the listbox isn't empty, remove an item ... disable delete button if necessary...
If (Not (List1.ListCoun t = 0)) Then
List1.RemoveIte m (List1.ListCoun t - 1)
End If

End Sub

Private Sub Command4_Click( )
Call redisp
End Sub

Private Sub Command5_Click( )
Timer1.Interval = 10
End Sub


Private Sub Form_Load()
MSf1.Rows = 64
MSf1.Cols = 17
MSf1.ColWidth(0 ) = 400
For i = 1 To 16
MSf1.ColWidth(i ) = 250
Next i
num = 0
Rem now lets have 125 colours in global array
For i = 1 To 5
For j = 1 To 5
For k = 1 To 5
Shape1.FillColo r = RGB(i * 40, j * 40, k * 40)
colourshow(num) = Shape1.FillColo r
num = num + 1
Next k
Next j
Next i

End Sub

Private Sub Text1_Change()
Rem as file number is entered, check if it is in list
If Val(Text1.Text) > 0 Then
hit = False
For i = 0 To List1.ListCount - 1
List1.ListIndex = i
If Val(Text1) = Val(List1.Text) Then

hit = True
End If
Next i
If hit Then
Command2.Enable d = True
Command1.Enable d = False
Command3.Enable d = True
Else
Command1.Enable d = True
Command2.Enable d = False
Command3.Enable d = False
End If
End If
End Sub

Private Sub Timer1_Timer()
Shape2.Left = Shape2.Left + 13
If Shape2.Left >= Label9.Left Then
Timer1.Enabled = False
End If

End Sub

[QVeen72]

Hi,

Before Removing the Item from the ListBox, Do a Search Again through all the Cells, and if anything matches, set the cell back colour to the default..
Something like this :

(AirCode)
[code=vb]
If List1.SelCount =1 Then
Dim i As Integer
Dim N As Single
N = Val(List1.Text )
For i = 1 To Grd.Rows-1
If N = Val(Grd.TextMat rix(i,2)) Then 'Change to whatever Column
'Found and Removing Colour..
Grd.Row = i
Grd.Col = 2
Grd.CellBackCol our = vbWhite ' Change here to your default backcolor
End If
Next
'Remove From List
List1.RemoveIte m List1.ListIndex
End If
[/code]

Regards
Veena

Regards
Veena

[Mubs]

I have tried with the following code but it the colour in the cells still appear and do not set back to default

Private Sub Command3_Click( )
If List1.SelCount = 1 Then
Dim i As Integer
Dim N As Single
N = Val(List1.Text)
For i = 1 To MSf1.Rows - 1
If N = Val(MSf1.TextMa trix(i, 2)) Then 'Change to whatever Column
'Found and Removing Colour..
MSf1.Row = i
MSf1.Col = 2
MSf1.CellBackCo lor = RGB(0, 0, 0) ' Change here to your default backcolor
End If
Next
'Remove From List
List1.RemoveIte m List1.ListIndex
End If
End Sub

[QVeen72]

Hi,

When a Match is found, Keep a BreakPoint and Check..

Regards
Veena

[Mubs]

Hi,

When a Match is found, Keep a BreakPoint and Check..

Regards
Veena

I dont understand what you mean there..

[QVeen72]

Hi,

Match Found means :
If N = Val(MSf1.TextMa trix(i, 2)) Then
Check whether your Checking is being done properly..

Keep Breakpoint at this line:
MSf1.Row = i

and Check..

REgards
Veena

[Mubs]

Hi,

Match Found means :
If N = Val(MSf1.TextMa trix(i, 2)) Then
Check whether your Checking is being done properly..

Keep Breakpoint at this line:
MSf1.Row = i

and Check..

REgards
Veena

it still dont work...it just remove the number from list 1 and not the coloured cells in flex grid

[Mubs]

Hi,

Match Found means :
If N = Val(MSf1.TextMa trix(i, 2)) Then
Check whether your Checking is being done properly..

Keep Breakpoint at this line:
MSf1.Row = i

and Check..

REgards
Veena

I have been advised to tackle this problem with the following
could you suggest anything...

a loop that looks at every element in the sector array

There should be a nested if to see if the value in the array is the same as the value in text2

If the value in sector array is the same, then set the sector array to 0