Newsgroup: it.comp.lang.visual-basic
Titolo: Proposta fantascentifica parte II

allora, prendiamo in mano la situazione:
per unanime (?) decisione Carlo ospitera' le creazioni del newsgroup, ok?
[Carlo: ovviamente se non sei disponibile non sei obbligato!  ;-)]
se qualcuno e' contrario che parli ora o taccia per sempre.
aspetto risposte...
Francesco Mapelli (
mape...@tin.it
)
| --> 
http://members.xoom.com/Francesco
  <-- |

Cavoli, ho appena scritto nel primo trehad... Bhe, guardate quello che
ho scritto su...
Ciao
°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
 -----------Federico Emanuele Galli----------
 ----------Visual Basic's Programmer---------
 
 Sideralis Programs (Visual-Basic and Delphi)
 
http://www.geocities.com/colosseum/loge/2151
°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°
                 Trust no ONE.
Per rispondermi via E-Mail togli STOPSPAMMERS.

A proposito... ho scritto due righe di codice per razionalizzare e ampliare
le funzioni delle "form dati" di VB5 (che normalmente non funzionano
benissimo in tutte le situazioni).
Il codice si sostituisce a quello creato in automatico dal wizard e contiene
tutte le istruzioni per l'utilizzo.
Lo allego alla lettera così potete dargli un'occhiata e, se
volete, potete darmi qualche consiglio... non sono un esperto di VB...
Comunque credo che, essendo quelli "gestionali" i programmi più richiesti,
questo codice potrebbe essere utile a qualcuno.
Un saluto a tutti!  :-)
P.S. Spero di non aver scoperto l'acqua calda...  ;-)
Sebastiano Del Gobbo
info - software solutions
inf...@migamma.it
'#######################################################################
'#######################################################################
'##                                                                   ##
'## CODICE PER FORMS CHE GESTISCONO TABELLE DI DATABASES ACCESS (MDB) ##
'## VERSIONE 1.05 del 03/06/98                                        ##
'## Sebastiano Del Gobbo - 
sebast...@usa.net
                       ##
'##                                                                   ##
'#######################################################################
'##                                                                   ##
'## DIFFERENZE RISPETTO ALL'ULTIMA RELEASE:                           ##
'## - Ora il codice è in grado di intercettare la chiusura della form ##
'## e, se questa non è valida, impedire la chiusura e ripristinare    ##
'## gli ultimi dati registrati nella tabella                          ##
'## - Aggiunto il supporto per il tipo di dato "Date" e "Memo" nella  ##
'## ricerca                                                           ##
'##                                                                   ##
'#######################################################################
'#######################################################################
'ISTRUZIONI PER L'UTILIZZO:
'1) Sostituire il codice creato automaticamente dal wizard "Creazione
' guidata forma dati" con quello sottostante
'2) (Opzionale) Togliere il commento nella sub Form_Load() e sostitu-
'ire la parola *nome_database* con il nome del database (compresa la
'estensione .mdb): questa operazione è consigliabile in quanto rende
'la posizione del programma indipendente da quella del database
'3) Aggiungere un pulsante con nome "cmdAnnulla" e caption "A&nnulla"
'4) Aggiungere un pulsante con nome "cmdSalta" e caption "&Salta a..."
'5) Aggiungere un pulsante con nome "cmdTrova" e caption "&Trova..."
'6) Rimuovere il pulsante "Rivisualizza": la sua funzione viene ora
'   svolta dal pulsante "Annulla"
'IMPORTANTE: Il codice di validazione dei dati *deve* essere inserito
'nella funzione FormValido()
'ORDINE (CONSIGLIATO) DEI PULSANTI
'(dall'alto verso il basso o da sinistra a destra)
'Aggiungi
'Elimina
'Aggiorna
'Annulla
'Salta a...
'Trova...
'Chiudi (un po' staccato dagli altri)
Option Explicit
Dim m_intRecordsTotali As Integer
Dim m_blnAggiunge As Boolean
Private Sub cmdAnnulla_Click()
    On Error GoTo MostraErrore
    With datPrimaryRS
        If m_blnAggiunge Then
            .Recordset.CancelUpdate
            m_blnAggiunge = False
        Else
            .UpdateControls
        End If
        datPrimaryRS_Reposition
    End With
    AggiornaPulsanti
    Exit Sub
MostraErrore:
    Beep
    MsgBox Err.Description, vbOKOnly + vbExclamation
End Sub
Private Sub cmdInserisci_Click()
    'Visto che l'operazione di aggiunta, prima di essere
    'effettuata aggiorna il record corrente, controllo
    'che quest'ultimo sia corretto... solo se esiste!
    If m_intRecordsTotali <> 0 Then
        If Not FormValido() Then Exit Sub
    End If
    On Error GoTo MostraErrore
    datPrimaryRS.Recordset.AddNew
    m_blnAggiunge = True
    AggiornaPulsanti
    datPrimaryRS.Caption = datPrimaryRS.Caption & "  (aggiungendo)"
    Exit Sub
MostraErrore:
    Beep
    MsgBox Err.Description, vbOKOnly + vbExclamation
End Sub
Private Sub cmdCancella_Click()
    'Chiedo la conferma
    Dim intConferma As Integer
    intConferma = MsgBox("Sei sicuro di voler cancellare il record?" &
vbCrLf & "Questa operazione è irreversibile!", vbYesNo, "Cancellazione
record")
    If intConferma = vbNo Then Exit Sub
    On Error GoTo MostraErrore
    'Posizione nella tabella e numero di records
    Dim intRecords, intRecord As Integer
    intRecords = datPrimaryRS.Recordset.RecordCount
    intRecord = datPrimaryRS.Recordset.AbsolutePosition + 1
    Debug.Print intRecord, intRecords
    'Operazione di cancellazione
    If intRecords <> 0 Then
        With datPrimaryRS.Recordset
            .Delete
            m_intRecordsTotali = m_intRecordsTotali - 1
            If intRecord <> intRecords Then
                .MoveNext
            Else
                If intRecords <> 1 Then
                    .MovePrevious
                Else
                    datPrimaryRS.Refresh
                End If
            End If
        End With
    End If
    AggiornaPulsanti
    Exit Sub
MostraErrore:
    Beep
    MsgBox Err.Description, vbOKOnly + vbExclamation
    Screen.MousePointer = vbArrow
End Sub
Private Sub cmdRivisualizza_Click()
    'Necessario solo per applicazioni multiutente
    On Error GoTo MostraErrore
    datPrimaryRS.Refresh
    Exit Sub
MostraErrore:
    Beep
    MsgBox Err.Description, vbOKOnly + vbExclamation
End Sub
Private Sub cmdAggiorna_Click()
    'Validazioni a livello del Form
    If Not FormValido() Then Exit Sub
    On Error GoTo MostraErrore
    datPrimaryRS.UpdateRecord
    If m_blnAggiunge Then 'sto confermando l'aggiunta di un record
        m_blnAggiunge = False
        m_intRecordsTotali = m_intRecordsTotali + 1
        datPrimaryRS.Refresh
    End If
    datPrimaryRS.Recordset.Bookmark = datPrimaryRS.Recordset.LastModified
    AggiornaPulsanti
    Exit Sub
MostraErrore:
    Beep
    MsgBox Err.Description, vbOKOnly + vbExclamation
End Sub
Private Sub cmdChiudi_Click()
    Unload Me
End Sub
Private Sub cmdSalta_Click()
    If Not FormValido() Then Exit Sub
    Dim strBookmark, strInput As String
    Dim intNumeroRecord As Integer
    'Cerca il numero del record a cui saltare
    strInput = InputBox("Numero del record (da 1 a " & m_intRecordsTotali &
")", "Salta al record", "1")
    If strInput = "" Then Exit Sub
    intNumeroRecord = Val(strInput)
    If intNumeroRecord < 1 Or intNumeroRecord > m_intRecordsTotali Then
        Beep
        MsgBox "Numero di record non valido", vbOKOnly + vbExclamation
        Exit Sub
    End If
    'Salta al record
    On Error GoTo MostraErrore
    With datPrimaryRS.Recordset
        strBookmark = .Bookmark
        .MoveFirst
        .Move intNumeroRecord - 1
    End With
    Exit Sub
MostraErrore:
    Beep
    MsgBox Err.Description, vbOKOnly + vbExclamation
End Sub
Private Sub cmdTrova_Click()
    If Not FormValido() Then Exit Sub
    Dim strCampo, strValore, strRicerca As String
    Dim fldCampo As Field
    Dim blnEsiste As Boolean
    'Chiede il nome del campo e controlla se esiste
    strCampo = InputBox("Nome del campo nel quale cercare", "Trova...",
"nome campo")
    If strCampo = "" Then Exit Sub
    strCampo = LCase(strCampo)
    blnEsiste = False
    For Each fldCampo In datPrimaryRS.Recordset.Fields
        If LCase(fldCampo.Name) = strCampo Then blnEsiste = True
    Next fldCampo
    If Not blnEsiste Then
        Beep
        MsgBox "Campo non presente nella tabella!" & vbCrLf & vbCrLf,
vbOKOnly + vbExclamation, "Trova..."
        Exit Sub
    End If
    Set fldCampo = datPrimaryRS.Recordset.Fields(strCampo)
    strCampo = "[" & fldCampo.Name & "]"
    'Chiede il valore per cui ricercare
    strValore = InputBox("Valore del campo", "Trova...", "valore campo")
    If strValore = "" Then Exit Sub
    'Aggiustamenti in base al tipo di campo
    Select Case fldCampo.Type
        Case dbBigInt        'Big integer
        Case dbBinary        'Binary
        Case dbBoolean       'Boolean
        Case dbByte          'Byte
        Case dbChar          'Char
            strValore = "'" & strValore & "'"
        Case dbCurrency      'Currency
        Case dbDate          'Date / Time
            strValore = "#" & strValore & "#"
        Case dbDecimal       'Decimal
        Case dbDouble        'Double
        Case dbFloat         'Float
        Case dbGUID          'Guid
        Case dbInteger       'Integer
        Case dbLong          'Long
        Case dbLongBinary    'Long Binary (OLE Object)
        Case dbMemo          'Memo
            strValore = "'" & strValore & "'"
        Case dbNumeric       'Numeric
        Case dbSingle        'Single
        Case dbText          'Text
            strValore = "'" & strValore & "'"
        Case dbTime          'Time
        Case dbTimeStamp     'Time Stamp
        Case dbVarBinary     'VarBinary
    End Select
    'Costruzione della stringa di ricerca
    strRicerca = strCampo & " = " & strValore
    'Prova a trovare il campo
    On Error GoTo MostraErrore
    With datPrimaryRS.Recordset
        .FindFirst strRicerca
        If .NoMatch Then
            Beep
            MsgBox "Il record non è presente nella tabella!", vbOKOnly +
vbExclamation, "Trova..."
            Exit Sub
        End If
    End With
    Exit Sub
MostraErrore:
    Beep
    MsgBox Err.Description, vbOKOnly + vbExclamation
End Sub
Private Sub datPrimaryRS_Reposition()
  Screen.MousePointer = vbDefault
  Dim intRecordAttuale As Integer
  Dim strDataCaption As String
  'Visualizza la posizione del record corrente per dynaset e snapshot
  On Error GoTo MostraErrore
  intRecordAttuale = datPrimaryRS.Recordset.AbsolutePosition + 1
  strDataCaption = "Record: " & intRecordAttuale & " di " &
m_intRecordsTotali
  datPrimaryRS.Caption = strDataCaption
  Exit Sub
MostraErrore:
    Beep
    MsgBox Err.Description, vbOKOnly + vbExclamation
End Sub
Private Sub Form_Activate()
    On Error GoTo MostraErrore
    With datPrimaryRS.Recordset
        .MoveLast
        .MoveFirst
    End With
    m_intRecordsTotali = datPrimaryRS.Recordset.RecordCount
    datPrimaryRS.Refresh
    AggiornaPulsanti
    Exit Sub
MostraErrore:
    If Err.Number <> 3021 Then 'Mostra l'errore solo se ci sono records
nella tabella
        Beep
        MsgBox Err.Description, vbOKOnly + vbExclamation
    End If
    AggiornaPulsanti
End Sub
Private Sub Form_Load()
    'datPrimaryRS.DatabaseName = App.Path() & "\" & strNomeDB
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If m_blnAggiunge Then
        Cancel = True
        Exit Sub
    End If
    'Visto che la chiusura del recordset aggiorna tutti i campi
    'che sono stati editati, prima di permetterla mi assicuro
    'che il record attuale sia valido... se esiste
    If m_intRecordsTotali <> 0 Then
        If Not FormValido() Then
            Cancel = True
            Dim strBookmark As String
            strBookmark = datPrimaryRS.Recordset.Bookmark
            datPrimaryRS.Recordset.Bookmark = strBookmark
            MsgBox "Verrano ripristinati gli ultimi dati registrati." &
vbCrLf & vbCrLf, vbOKOnly + vbInformation, "Chiusura"
            Exit Sub
        End If
    End If
    Screen.MousePointer = vbDefault
End Sub
Public Function FormValido() As Boolean
    Dim strErrMsg As String
    Dim blnErrata As Boolean
    blnErrata = False
    FormValido = True
    'Inserisci qui sotto il codice per validare i dati della form
    'Per fare in modo che l'operazione di aggiornamento non abbia
    'luogo basta settare blnErrata su "True"
    'Per mostrare gli errori, stamparli nella stringa strErrMsg
    If blnErrata Then
        Beep
        strErrMsg = strErrMsg & vbCrLf
        MsgBox strErrMsg, vbOKOnly + vbInformation, Me.Caption & " - Dati
non validi"
        FormValido = False
    End If
End Function
Public Sub AggiornaPulsanti()
    On Error Resume Next
    If m_blnAggiunge Then
        cmdAggiorna.Enabled = True
        cmdAnnulla.Enabled = True
        cmdCancella.Enabled = False
        cmdChiudi.Enabled = False
        cmdInserisci.Enabled = False
        cmdSalta.Enabled = False
        cmdTrova.Enabled = False
        datPrimaryRS.Enabled = False
    Else
        If m_intRecordsTotali = 0 Then
            cmdAggiorna.Enabled = False
            cmdAnnulla.Enabled = False
            cmdCancella.Enabled = False
            cmdSalta.Enabled = False
            cmdTrova.Enabled = False
            datPrimaryRS.Enabled = False
        Else
            cmdAggiorna.Enabled = True
            cmdAnnulla.Enabled = True
            cmdCancella.Enabled = True
            cmdSalta.Enabled = True
            cmdTrova.Enabled = True
            datPrimaryRS.Enabled = True
        End If
        cmdInserisci.Enabled = True
        cmdChiudi.Enabled = True
    End If
End Sub