MSFLEXGRID EDITAVEL

NILTON.VIANNA 16/08/2009 12:31:03
#319965

Ola amigos
Estou tentando usar o MsfrexGrid, é seguinte já tenho o modo busca,
Gostaria de editar, pois quando inserir continuar digitando novas linhas
Ex:
Quantidade Produto Unitário Soma
01 Monitor 50,00 50,00

[ô] Meu Projeto

Na célula produto entra minha busca de produto tudo Ok.
Mais ai incluir ele desabilita e não consigo nova linha.

Option Explicit
Dim RS As New ADODB.Recordset
Public Key As Integer
[ô]---------declarações do sistema-------------------------------------
Private ArquivoDados As String [ô] Arquivo com os dadaos do grid
Const NovaLinha As String = [Ô]>[Ô] [ô] Indica uma nova linha
Private ControlVisible As Boolean [ô] Se o controle esta visivel ou nao
Private LastRow As Long [ô] Ultima linha em que se editou
Private LastCol As Long [ô] ultima coluna em que se editou

Private Sub cmdSalir_Click()
Unload Me
End Sub

Private Sub Form_Load()
[ô]Dim i As Long
[ô]Dim caminho As String
[ô]caminho = App.path
[ô]ArquivoDados = caminho & IIf(Right$(caminho, 1) = [Ô][Ô], [Ô][Ô], [Ô][Ô]) & [Ô]Boletim.txt[Ô]
OcultarControles
CabecalhoGrid
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
[ô] gravar dados do grid
If (MsgBox([Ô]Deseja Gravar Alterações no arquivo ? [Ô], vbYesNo, [Ô]Gravar dados no Arquivo.[Ô]) = vbYes) Then
[ô][ô]GravarDados
End If
End Sub
Private Sub Form_Resize()
[ô] Reajustar o tamanho do grid ao formulario
If WindowState <> vbMinimized Then
FG1.Move 0, 180, ScaleWidth, ScaleHeight
End If
End Sub
Private Sub FG1_Click()
[ô] Quando clicar uma vez
[ô] atribui o valor selecionado
AtribuiValorCelula
End Sub
Private Sub FG1_DblClick()
[ô]editar ao clicar duas vezes
LastRow = FG1.Row
LastCol = FG1.Col
OcultarControles
ExibirCelula
End Sub
Private Sub FG1_KeyDown(KeyCode As Integer, Shift As Integer)
[ô] Editar ao pressionar F2
If KeyCode = vbKeyF2 Then
ExibirCelula
ElseIf KeyCode = vbKeyDelete Then
[ô] Excluir linhas selecionadas
ExcluirLinhas
End If
End Sub
Private Sub FG1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
[ô] Editar ao teclar ENTER
Case vbKeyReturn
KeyAscii = 0
ExibirCelula
[ô] Cancelar ao pressionar ESC
Case vbKeyEscape
KeyAscii = 0
AtribuiValorCelula
[ô] Editar ao pressinar qualquer tecla
Case 32 To 255
ExibirCelula
With txtProduto
If .Visible Then
.Text = Chr$(KeyAscii)
.SelStart = Len(.Text) + 1
End If
End With
End Select
End Sub
Private Sub FG1_Scroll()
[ô] Ver se a coluna esta visivel
[ô] entao ocultar os controles
[ô]
If FG1.ColIsVisible(LastCol) = False Then
OcultarControles
Exit Sub
End If
If FG1.RowIsVisible(LastRow) = False Then
OcultarControles
Exit Sub
End If
[ô] ver se estava visivel antes de ocultar
[ô] e posicionar na mesma celula
If ControlVisible Then
ExibirCelula
End If
End Sub
Private Sub ExibirCelula()
Static OK As Boolean
[ô]
[ô] Se for celula fixa , sair
If FG1.Col <= FG1.FixedCols - 1 Or FG1.Row <= FG1.FixedRows - 1 Then
Exit Sub
End If
[ô]
If OK Then Exit Sub
OK = True
[ô]
OcultarControles
[ô]
LastRow = FG1.Row
LastCol = FG1.Col
[ô]
[ô] Nova Celula
With FG1
If .TextMatrix(LastRow, 0) = NovaLinha Then
.Rows = .Rows + 1
.TextMatrix(LastRow, 0) = LastRow
.TextMatrix(.Rows - 1, 0) = NovaLinha
End If
End With
[ô]
Select Case LastCol
Case Else

txtProduto.Move FG1.CellLeft - Screen.TwipsPerPixelX, FG1.CellTop + 180 - Screen.TwipsPerPixelY, FG1.CellWidth + Screen.TwipsPerPixelX * 2, FG1.CellHeight + Screen.TwipsPerPixelY * 2
txtProduto.Text = FG1.Text
If Len(FG1.Text) = 0 Then
If LastRow > 1 Then
txtProduto.Text = FG1.TextMatrix(LastRow - 1, LastCol)
End If
End If
txtProduto.Visible = True
If txtProduto.Visible Then
txtProduto.ZOrder
txtProduto.SetFocus
End If
End Select
[ô]
ControlVisible = True
[ô]
OK = False
End Sub
Private Sub ProximaCelula()
If FG1.Col < FG1.Cols - 1 Then
FG1.Col = FG1.Col + 1
Else
FG1.Col = 1
If FG1.Row < FG1.Rows - 1 Then
FG1.Row = FG1.Row + 1
End If
End If
End Sub

Private Sub txtProduto_GotFocus()
With txtProduto
[ô] Posiciona o cursor no fim do texto
.SelStart = Len(.Text)
End With
End Sub
Private Sub txtProduto_KeyPress(KeyAscii As Integer)
[ô] ao pressionar ENTER aceitar a entrada de dados
If KeyAscii = vbKeyReturn Then
KeyAscii = 0

If LastCol = 1 Then
If IsNumeric(txtProduto.Text) Then
If Val(txtProduto.Text) > 99999 Or Val(txtProduto.Text) < 0 Then
MsgBox [Ô]Atenção Informe valores de 1 a 99999 ![Ô], vbInformation, [Ô] Quantidade Incorreta[Ô]
Exit Sub
End If
End If
End If

If LastCol = 2 Then
[ô]MOSTRA O NOME DO PRODUTO
FrmProPedidos.Show 1
If IsNumeric(txtProduto.Text) Then
MsgBox [Ô]Informe o Nome do Produto ! [Ô], vbInformation, [Ô] Produto Invalido[Ô]
Exit Sub
End If
End If

If LastCol = 3 Then
If IsNumeric(txtProduto.Text) Then
txtProduto = Format(txtProduto.Text, [Ô]###,###,##0.00[Ô])
Exit Sub
End If
End If

AtribuiValorCelula
ProximaCelula
[ô] ESC, cancela a edição
ElseIf KeyAscii = vbKeyEscape Then
KeyAscii = 0

txtProduto.Visible = False
ControlVisible = False
End If
End Sub

Private Sub AtribuiValorCelula()
Dim Texto As String
[ô]
OcultarControles
ControlVisible = False
[ô]
[ô] atribuir o texto anterior a celula
Select Case LastCol
Case 4 To 7
[ô]notas menores que 5 muda cor fonte para vermelho, demais azul
Texto = txtProduto.Text
FG1.TextMatrix(LastRow, LastCol) = Texto
If Val(FG1.Text) < 5 Then
[ô][ô] FG1.CellForeColor = &HFFF4DD
Else
[ô][ô] FG1.CellForeColor = &HFFF4DD
End If
Case Else
Texto = txtProduto.Text
FG1.TextMatrix(LastRow, LastCol) = Texto
End Select
End Sub
Private Sub CabecalhoGrid()
[ô] configuar o grid
Dim i As Long
[ô]
With FG1
.GridLines = flexGridFlat
.FixedRows = 1
.FixedCols = 1
.ScrollBars = flexScrollBarBoth
.AllowUserResizing = flexResizeColumns
.Cols = 5 [ô] Número de colunas(incluindo o cabecalho)
.Rows = 2 [ô] Número de linhas(com cabecalho)
.ColWidth(0) = 285 [ô] Largura da coluna 0

.TextArray(1) = [Ô]Quantidade[Ô]
.ColWidth(1) = 1000
.TextArray(2) = [Ô]Produto[Ô]
.ColWidth(2) = 4500
.TextArray(3) = [Ô]Unitário[Ô]
.ColWidth(3) = 1300
.TextArray(4) = [Ô]Soma R$:[Ô]
.ColWidth(4) = 1300

[ô] Mostrar os números nas colunas
For i = 1 To .Rows - 1
.TextMatrix(i, 0) = i
Next
[ô]
[ô] Indica uma nova linha
[ô] atribui a primeira linha do grid
.TextMatrix(.Rows - 1, 0) = NovaLinha
End With
End Sub
Private Sub ExcluirLinhas()
[ô] Excluir linhas selecionadas
Dim i As Long
Dim j As Long
Dim k As Long
Dim n As Long
[ô]
[ô] Não excluir se for a ultima linha
If FG1.RowSel = FG1.Rows - 1 Then
Beep
Exit Sub
End If
If FG1.Row = FG1.Rows - 1 Then
Beep
Exit Sub
End If
[ô]
[ô] Exclui sempre da linha maior par menor
i = FG1.Row
j = FG1.RowSel
If i < j Then
k = i
i = j
j = k
End If
For n = i To j Step -1
FG1.RemoveItem n
Next
LastRow = FG1.Rows - 1
LastCol = 1
FG1.Col = LastCol
FG1.Row = LastRow
FG1.RowSel = LastRow
FG1.ColSel = LastCol
End Sub
Private Sub OcultarControles()
[ô] Ocultar o controle textbox
txtProduto.Visible = False
End Sub

Public Sub MostraDadosProduto()
Dim rsPaciente As New ADODB.Recordset
Dim SQL As String
Dim ProdutoID As Long
ProdutoID = Val(txtProdutoID.Text)

On Error Resume Next
SQL = [Ô]SELECT Produto, Unitario, Item From CadProduto Where ProdutoID=[Ô] & ProdutoID
rsPaciente.Open SQL, CnSql, adOpenForwardOnly, adLockReadOnly
txtProduto = rsPaciente(0)
txtUnitario = rsPaciente(1)
txtItem = rsPaciente(2)

If Val(rsPaciente(2)) <= 0 Then
MsgBox Me.txtProduto & [Ô] Produto não esta disponível no estoque ![Ô], vbMagenta, [Ô] Sisnews Informações[Ô]
End If

rsPaciente.Close
End Sub

Private Sub cmdIncluir_Click()
[ô]If Len(txtNome.Text) < 3 Then
[ô]MsgBox [Ô]Informe o nome do Cliente ! [Ô], vbExclamation, [Ô] Sisnews Sistemas [Ô]
[ô]txtNome.SetFocus
[ô]End If
txtProduto.Move FG1.CellLeft - Screen.TwipsPerPixelX, FG1.CellTop + 180 - Screen.TwipsPerPixelY, FG1.CellWidth + Screen.TwipsPerPixelX * 2, FG1.CellHeight + Screen.TwipsPerPixelY * 2
If (Key = 1) Then
Key = 1
Else
Key = Key + 1
End If
FG1.Rows = Key + 1
FG1.TextMatrix(Key, 2) = txtProduto.Text
FG1.TextMatrix(Key, 3) = txtUnitario.Text
End Sub

[ô][ô] Grato