|
Scroll # Vedi TelefoniTAB
Option Explicit Dim i As Integer Dim Valore As Long Const mnCTLARRAYHEIGHT = 340 Dim mnFieldTop As Integer Private Sub Command1_Click() STRINGA = InputBox("Inserisci il nominativo da ricercare", "Ricerca", , 3500, 3500) If STRINGA <> "" Then If Inail = False Then Data1.RecordSource = "SELECT * FROM TELEFONI WHERE [nOMINATIVO] LIKE " & Chr(34) & Mid(STRINGA, 1, 1) & "*" & Chr(34) & " order by [Nominativo];" Else Data1.RecordSource = "SELECT * FROM inail WHERE [nOMINATIVO] LIKE " & Chr(34) & Mid(STRINGA, 1, 1) & "*" & Chr(34) & " order by [Nominativo];" End If Data1.Refresh Criterio = "trim(ucase([nominativo])) >= trim(" & Chr(34) & UCase(STRINGA) & Chr(34) & ")" Data1.Recordset.FindFirst Criterio Debug.Print Data1.Recordset.NoMatch Me.Refresh End If End Sub Private Sub Data1_Reposition() Text1.Text = "Record: " & (Data1.Recordset.AbsolutePosition + 1) & _ "/" & Data1.Recordset.RecordCount 'Visualizza la posizione del record corrente per dynaset e snapshot End Sub Private Sub DBGrid1_DblClick() Dim Criterio As String If Not Data1.Recordset.EOF Then Criterio = "[id] = " & Data1.Recordset.Fields("ID") frmTelefoni.Show frmTelefoni.datPrimaryRS.Recordset.FindFirst Criterio frmTelefoni.datPrimaryRS.Recordset.Edit Else frmTelefoni.Show frmTelefoni.datPrimaryRS.Recordset.AddNew End If End Sub Private Sub DBGrid2_DblClick() Dim Criterio As String If Not Data1.Recordset.EOF Then Criterio = "[id] = " & Data1.Recordset.Fields("ID") frmTelefoni.Show frmTelefoni.datPrimaryRS.Recordset.FindFirst Criterio frmTelefoni.datPrimaryRS.Recordset.Edit Else frmTelefoni.Show frmTelefoni.datPrimaryRS.Recordset.AddNew End If End Sub Private Sub DBGrid3_DblClick() Dim Criterio As String Load frmINAIL If Not Data1.Recordset.EOF Then Criterio = "[id] = " & Data1.Recordset.Fields("ID") frmINAIL.datPrimaryRS.Recordset.FindFirst Criterio frmINAIL.datPrimaryRS.Recordset.Edit Else frmINAIL.datPrimaryRS.Recordset.AddNew End If frmINAIL.Show 1 Data1.Refresh End Sub Private Sub DBGrid4_DblClick() Dim Criterio As String Load frmINAIL If Not Data1.Recordset.EOF Then Criterio = "[id] = " & Data1.Recordset.Fields("ID") frmINAIL.datPrimaryRS.Recordset.FindFirst Criterio frmINAIL.datPrimaryRS.Recordset.Edit Else frmINAIL.datPrimaryRS.Recordset.AddNew End If frmINAIL.Show 1 Data1.Refresh End Sub Private Sub Form_Resize() 'Tab3.Visible = False 'Tab4.Visible = False 'Calendar1.Visible = False ChDir App.Path SchermoBLU Inail = False Tab1.Value = 1 Tab1.SetFocus Tab1_AfterUpdate DBGrid1.Visible = True DBGrid2.Visible = True DBGrid3.Visible = False DBGrid4.Visible = False VScroll1.Max = Data1.Recordset.RecordCount ' Imposta il valore massimo. VScroll1.LargeChange = 18 ' Spostamento completo in 5 clic. VScroll1.SmallChange = 5 ' Spostamento completo in 20 clic. 'DBGrid2.Splits.Add 0 'DBGrid2.Splits.Add 1 End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub Private Sub Tab1_AfterUpdate() ChDir App.Path Dim objTabs As Object Dim stLike As String If Inail = False Then If (Tab1.Value = 0) Then Data1.RecordSource = "SELECT * FROM tELEFONI order by [Nominativo]" Data1.Refresh VScroll1.Max = Data1.Recordset.RecordCount ' Imposta il valore massimo. VScroll1.Value = 0 ' RIPORTA A ZERO IL VALORE E QUINDI IL BOTTONE SALE IN ALTO Else stLike = "'" & Chr$(64 + Tab1.Value) & "*'" Data1.RecordSource = "SELECT * FROM TELEFONI WHERE [nOMINATIVO] LIKE " & stLike & " order by [Nominativo] ;" Data1.Refresh VScroll1.Max = Data1.Recordset.RecordCount ' Imposta il valore massimo. VScroll1.Value = 0 ' RIPORTA A ZERO IL VALORE E QUINDI IL BOTTONE SALE IN ALTO End If Else If (Tab1.Value = 0) Then Data1.RecordSource = "SELECT * FROM Inail order by [Nominativo]" Data1.Refresh VScroll1.Max = Data1.Recordset.RecordCount ' Imposta il valore massimo. VScroll1.Value = 0 ' RIPORTA A ZERO IL VALORE E QUINDI IL BOTTONE SALE IN ALTO Else stLike = "'" & Chr$(64 + Tab1.Value) & "*'" Data1.RecordSource = "SELECT * FROM Inail WHERE [nOMINATIVO] LIKE " & stLike & " order by [Nominativo] ;" Data1.Refresh VScroll1.Max = Data1.Recordset.RecordCount ' Imposta il valore massimo. VScroll1.Value = 0 ' RIPORTA A ZERO IL VALORE E QUINDI IL BOTTONE SALE IN ALTO End If End If End Sub Private Sub Tab2_AfterUpdate() Dim objTabs As Object Dim stLike As String On Error Resume Next If Tab2.Value = 15 Then End End If If Tab2.Value = 13 Then Data1.RecordSource = "Select * Form [INAIL] order by [Nominativo]" Data1.Refresh VScroll1.Max = Data1.Recordset.RecordCount ' Imposta il valore massimo. VScroll1.Value = 0 ' RIPORTA A ZERO IL VALORE E QUINDI IL BOTTONE SALE IN ALTO DBGrid1.Visible = False DBGrid2.Visible = False DBGrid3.Visible = True DBGrid4.Visible = True DBGrid3.Refresh DBGrid4.Refresh Inail = True Tab1.Value = 1 Tab1.SetFocus Tab1_AfterUpdate Exit Sub ElseIf Tab2.Value = 14 Then Data1.RecordSource = "Select * Form [Telefoni] order by [Nominativo]" Data1.Refresh VScroll1.Max = Data1.Recordset.RecordCount ' Imposta il valore massimo. VScroll1.Value = 0 ' RIPORTA A ZERO IL VALORE E QUINDI IL BOTTONE SALE IN ALTO DBGrid1.Visible = True DBGrid2.Visible = True DBGrid1.Refresh DBGrid2.Refresh DBGrid3.Visible = False DBGrid4.Visible = False Inail = False Tab1.Value = 1 Tab1.SetFocus Tab1_AfterUpdate VScroll1.Refresh Exit Sub Else If Inail = False Then stLike = "'" & Chr$(64 + 14 + Tab2.Value) & "*'" Data1.RecordSource = "SELECT * FROM TELEFONI WHERE [nOMINATIVO] LIKE " & stLike & " order by [Nominativo];" Data1.Refresh VScroll1.Max = Data1.Recordset.RecordCount VScroll1.Value = 0 ' RIPORTA A ZERO IL VALORE E QUINDI IL BOTTONE SALE IN ALTO VScroll1.Refresh Else stLike = "'" & Chr$(64 + 14 + Tab2.Value) & "*'" Data1.RecordSource = "SELECT * FROM inail WHERE [nOMINATIVO] LIKE " & stLike & " order by [Nominativo];" Data1.Refresh VScroll1.Max = Data1.Recordset.RecordCount VScroll1.Value = 0 ' RIPORTA A ZERO IL VALORE E QUINDI IL BOTTONE SALE IN ALTO VScroll1.Refresh End If End If End Sub Private Sub VScroll1_Change() ' clicca sull'area della barra On Error Resume Next ' e non sul bottone della barra Dim nCurrVal As Integer nCurrVal = VScroll1 If (nCurrVal - Valore) > 0 Then For i = 1 To (nCurrVal - Valore) '18 If Not Data1.Recordset.EOF Then Data1.Recordset.MoveNext End If Next Else For i = 1 To (Valore - nCurrVal) ' 18 ' If Not Data1.Recordset.BOF Then Data1.Recordset.MovePrevious End If Next End If Valore = VScroll1.Value End Sub Private Sub VScroll1_Scroll() On Error Resume Next Dim nCurrVal, quanto As Integer nCurrVal = VScroll1 If (nCurrVal - Valore) > 0 Then quanto = (nCurrVal - Valore) Else quanto = (Valore - nCurrVal) End If If (nCurrVal - Valore) < 0 Then For i = 1 To quanto If Not Data1.Recordset.BOF Then Data1.Recordset.MovePrevious Else Valore = 1 End If Next Else For i = 1 To quanto If Not Data1.Recordset.EOF Then Data1.Recordset.MoveNext Else Valore = Data1.Recordset.RecordCount End If Next End If Valore = VScroll1.Value End Sub |