Suggerimenti codice
Questa sezione è dedicata a programmi perfettamente funzionanti sino al sistema operativo XP. Questi software non sono per vari motivi
compatibili col nuovo sistema operativo Windows Vista oppure sono superati da altri programmi più recenti.
Si è ritenuto di renderli ancora disponibili anche se non viene garantita alcuna implementazione futura sugli stessi.
Elenco tips
Cercare l'eseguibile associato ad una estensione
A volte può essere utile sapere qual'è l'eseguibile, il programma, che è associato ad una determinata estensione. Ci viene incontro la
funzione API FinExecutable.
In un modulo dichiariamo le seguenti costanti e la sottostante funzione:
Private Declare Function FindExecutable Lib "shell32" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal
sResult As String) As Long
A questo punto dalla vostra applicazione richiamate il file che volete aprire come segue:
Private Const MAX_PATH As Long = 260
Private Const ERROR_FILE_NO_ASSOCIATION As Long = 31
Private Const ERROR_FILE_NOT_FOUND As Long = 2
Private Const ERROR_PATH_NOT_FOUND As Long = 3
Private Const ERROR_FILE_SUCCESS As Long = 32 'costante personale
Private Const ERROR_BAD_FORMAT As Long = 11
Public Function CercaExe(nome As String) As String
Dim success As Long
Dim pos As Long
Dim sResult As String
Dim msg As String
sResult = Space$(MAX_PATH)
success = FindExecutable(nome, vbNullString, sResult)
Select Case success
Case ERROR_FILE_NO_ASSOCIATION: msg = "Nessuna associazione"
Case ERROR_FILE_NOT_FOUND: msg = "File non trovato"
Case ERROR_PATH_NOT_FOUND: msg = "Percorso non trovato"
Case ERROR_BAD_FORMAT: msg = "Formato errato"
Case Is >= ERROR_FILE_SUCCESS:
pos = InStr(sResult, Chr$(0))
If pos Then
msg = Left$(sResult, pos - 1)
End If
End Select
CercaExe = msg
End Function
Dim Eseguibile As String
La stringa restituita sarà il percorso dell'eseguibile associato al file che avrete passato come argomento della funzione CercaExe.
Eseguibile = CercaExe("d:\temp\readme.pdf")
Formattazione di numeri
Una funzione commentata per formattare i numeri aggiungendo i separatori delle migliaia anche ai numeri decimali. Questa funzione supera
alcuni limiti della funzione Format di VB. Funzione fornita da Claudio Gucchierato.
Private Function FormattaNumero(ByVal n As Double) As String
Ecco un semplice esempio di utilizzo.
'Questa funzione formatta un numero aggiungendo i separatori delle migliaia anche ai numeri decimali (esempio: 1.000.000,234567)
'Questo codice, contrariamente alla funzione nativa di VB "Format(Numero, "#,##0.##")", non visualizza la virgola finale se il numero non
contiene
'decimali. Inoltre il numero viene sempre formattata nella sua completa lunghezza senza dover utilizzare, come per la funzione "Format", i
relativi "segnaposto" (#)
'NB non è detto che in giro si possa trovar di meglio!
On Error GoTo errore
Dim tmpLong As Long
Dim strNumber As String
Dim LunghParteIntera As Long
Dim strTmp As String
strNumber = CStr(n) 'converto il valore numerico passato come argomento della funzione, in una stringa
tmpLong = Int(n) 'prendo solo la parte intera del valore numerico passato come argomento della funzione
LunghParteIntera = Len(CStr(tmpLong)) 'calcolo la lunghezza della parte intera
strTmp = CStr(tmpLong)
If strTmp = "0" Then
FormattaNumero = strTmp & Right(strNumber, Len(strNumber) - LunghParteIntera)
Else
FormattaNumero = Format(strTmp, "#,#") & Right(strNumber, Len(strNumber) - LunghParteIntera)
End If
Exit Function
errore:
If Err.Number = 6 Then MsgBox "Numero troppo grande!", vbCritical, "Errore di overflow"
End Function
Text1.text= FormattaNumero(12345678.1234)
Nel caso di numero troppo grande (overflow) viene restituito un messaggio di errore.
Utilizzare l'autocompletamento nelle vostre applicazioni
Con il Internet Explorer 5 e versioni successive è disponibile una nuova interessante caratteristica dell'interfaccia denominata
"autocompletamento" (autocomplete).
Tramite l'autocompletamento Windows vi suggerisce, completandoli appunto, i percorsi dei file o gli URL che avete usato di recente. Potete
utilizzare questa caratteristica anche nella vostre applicazioni, attraverso un controllo textbox o un combobox, ma è estendibile a qualunque
altro controllo. L'unica limitazione è che questa funzionalità è disponibile soltanto se avete installato Internet Explorer 5.0 o successiva
(di solito ormai presente su tutti i computer).
Create un nuovo progetto inserendo nel form un TextBox denominato "Text1" e aggiungete un modulo globale.
Il codice del modulo
In un modulo globale .BAS inserite il seguente codice:
Option Explicit
Il codice nel form
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String,
ByVal lpsz2 As String) As Long
Private Declare Function SHAutoComplete Lib "Shlwapi.dll" (ByVal hWndEdit As Long, ByVal dwFlags As Long) As Long
'Costanti di sitema
' Attualmente utilizzate (SHACF_FILESYSTEM | SHACF_URLALL)
Private Const SHACF_DEFAULT As Long = &H0
' Questa costante include il File System e il resto della shell (Desktop\My Computer\Control Panel\)
Private Const SHACF_FILESYSTEM As Long = &H1
' URL presenti nella Cronologia
Private Const SHACF_URLHISTORY As Long = &H2
' URl presenti nella lista degli URL recenti
Private Const SHACF_URLMRU As Long = &H4
' Sia i File System e gli URL presenti nella Cronologia dell'utente
Private Const SHACF_URLALL As Long = (SHACF_URLHISTORY Or SHACF_URLMRU)
Public Function DoAutocomplete(ObjX As Object) As Long
Dim hWndEdit As Long
If TypeOf ObjX Is TextBox Then
' Imposta l'handle del textbox nel quale si digita
hWndEdit = ObjX.hWnd
ElseIf TypeOf ObjX Is ComboBox Then
' Recupera i campi editati scrivendoli nel combo box
hWndEdit = FindWindowEx(ObjX.hWnd, 0, "EDIT", vbNullString)
Else
' Nessun campo editato
DoAutocomplete = 0
Exit Function
End If
' Applica la funzionalità di autocompletamento
DoAutocomplete = SHAutoComplete(hWndEdit, SHACF_DEFAULT)
End Function
Per utilizzare il codice è sufficiente richiamarlo nell'evento Form_Load del form, passandogli come parametro il nome del controllo che si
intende utilizzare ai fini dell'autocompletamento:
DoAutoComplete Text1
Ciò permetterà all'oggetto Text1di avere la funzionalità di autocompletamento.
Conclusione
Potete cambiare facilmente la funzionalità di autocompletamento, modificando SHACF_DEFAULT con la costante SHACF_FILESYSTEM nella funzione
DoAutocomplete.
In tal modo l'autocompletamento sarà ristretto alla sola digitazione dei percorsi dei file sul computer locale, escludendo gli indirizzi
internet.
Prevenire i crash alla chiusura dell'applicazione
Risoluzione del problema spinoso con alcune versioni di ComCtl32.DLL e di VB UserControls
Alcune versioni della versione 6.0 di ComCtl32.DLL causano un arresto alla chiusura del programma quando sono caricati gli stili visivi di XP
in un'applicazione. Ciò accade specialmente quando si usano i controlli utente di VB. Questo articolo prevede due soluzioni al problema.
Problema
Il 40% circa dei miei progetti che supportano ComCtl32 per applicare gli stili visivi di XP ha cominciato improvvisamente ad arrestarsi
quando un'applicazione veniva chiusa. Ciò è stato anche segnalato da molti utenti via mail che lamentavano dei problemi di arresto
apparentemente inspiegabili. Dopo ore di ricerca, si è scoperto quanto segue:
- ComCtl32.DLL era stata aggiornata rispetto alla mia installazione anteriore di XP. La nuova versione era 5.80.2800.1106, precedentemente la versione era 5.80.2600.0.
- L'arresto si verificava soltanto:
- Nei progetti che hanno incluso User Controls di Visual Basic.
- Quando il progetto richiama la ComCtl32.DLL v6.0 (usando un file o una risorsa manifest).
- Nel fare funzionare la versione eseguibile del progetto.
- Aggiungendo finestre di messaggio all'applicazione si è appurato che l'arresto è avvenuto dopo che l'ultima linea del codice di VB era stata eseguita. Senza alcun riguardo alla complessità del progetto, o a quanti form, l'arresto si è presentato soltanto durante l'arresto. GDI e le risorse dell'utente erano regolari.
- Facendo funzionare un programma di debug per l'applicativo si è rilevato che l'arresto era causato da user32.DLL dopo qualche chiamata runtime VB.
Due modi di risolvere il problema
Ci sono due modi di risolvere questo problema. Il primo è una metodo "più corretto", mentre il secondo è frutto di invenzione che può essere applicato generalmente a qualunque tipo di programma che provoca un arresto alla chiusura.
1. La soluzione ufficiale
Microsoft riconosce questo problema nell'articolo knowledge base
KBID 309366 . Purtroppo, la causa del problema non è spiegata e la loro risoluzione suggerita non funziona. Tuttavia, pescando
all'interno dell'articolo si rilevano delle informazioni che danno origine ad una soluzione. Tale soluzione deve usare la chiamata alla
funzione LoadLibrary delle API della Shell32.DLL durante l'inizializzazione evento nel form che contiene il controllo:
Private Declare Sub InitCommonControls Lib "comctl32.dll" ()
Una volta fatto questo, gli arresti non si sono più verificati. Sembra che lo stesso codice possa essere usato direttamente all'interno
propri UserControl, negli eventi _Initialize e _Terminate, avendo ovviamente accesso al codice sorgente del controllo.
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" ( ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" ( ByVal hLibModule As Long) As Long
Private m_hMod As Long
Private Sub Form_Initialize()
m_hMod = LoadLibrary("shell32.dll")
InitCommonControls
End Sub
Private Sub Form_Unload(Cancel As Integer)
FreeLibrary m_hMod
End Sub
2. Ignorare l'errore e procedere
Ignorare l'errore non è la soluzione più elegante, ma può essere facile e questa tecnica può venire utile nella risoluzione degli altri
problemi.
In questo caso non stiamo usufruendo delle risorse, tutto sta terminando e chiudendosi nell'ordine corretto, ma sorge il problema a causa del
tempo di esecuzione di VB, cosa che accade soltanto quando VB pulisce dopo che tutto il codice di esecuzione è terminato.
Così, notando che l'arresto accade soltanto dopo che l'applicativo ha terminato il proprio lavoro, sappiamo che il processo sta chiudere
tutte le istanze aperte. Poiché ogni applicazione funziona in un relativo proprio spazio di memoria, Windows sta cercando di riordinare la
memoria stessa dove l'applicativo ha lasciato traccia. Quindi è questa traccia in memoria che continua ad interferire con le altre
applicazioni, a meno che VB non abbia installato qualcosa nel sistema, cosa che è da considerare come altamente improbabile.
Di conseguenza possiamo risolvere questo problema semplicemente ignorandolo . L'unico problema in questo modo è che l'applicazione continua a
inviare messaggi al sistema e danno origine alla nota finestra che invita a trasmettere le informazioni del Microsoft sul problema:
Fortunatamente, Windows offre un modo per evitare questi avvisi, attraverso il trattamento delle eccezioni strutturato delle API. Mentre
questa api permette di intercettare questi messaggi e mantenere il funzionamento della vostra applicazione, in questo caso non ci
preoccupiamo a tale proposito, poiché tutto il nostro codice ha terminato di funzionare e desideriamo solo arrestare la visualizzazione di
questo messaggio. Fate questo chiamando la funzione API SetErrorMode:
Private Declare Function SetErrorMode Lib "kernel32" ( _
Ciò indirizza Windows a non visualizzare la finestra di messaggio di errore. Ora tutto quello che dobbiamo fare è richiamare questa funzione
attraverso l'ultima linea del codice eseguito dall'applicazione. Notate che potreste richiamare la funzione con la prima linea di codice, ma
in tal caso tutto il UAE realmente connesso con il codice non verrebbe gestito dall'applicazione e ciò comporterebbe una esecuzione in
condizioni non ideali.
ByVal wMode As Long) As Long
Private Const SEM_FAILCRITICALERRORS = &H1
Private Const SEM_NOGPFAULTERRORBOX = &H2
Private Const SEM_NOOPENFILEERRORBOX = &H8000&
...
' Previene tutte le finestre di dialogo e i message box di errore del sistema (UAE):
SetErrorMode SEM_NOGPFAULTERRORBOX
Inoltre è stato aggiunto un certo codice in modo da non fare la chiamata all'IDE, poiché il problema si presenta soltanto negli eseguibili
compilati:
Private Declare Function SetErrorMode Lib "kernel32" ( ByVal wMode As Long) As Long
Determinare dove e quando richiamare questa funzione è cosa specifica per ogni applicazione, tuttavia funzionerà nella maggior parte dei casi
aggiungendo la seguente linea di codice a ciascuna evento _Terminate dei vostri form:
Private Const SEM_NOGPFAULTERRORBOX = &H2&
Private m_bInIDE As Boolean
Public Sub UnloadApp()
If Not InIDE() Then
SetErrorMode SEM_NOGPFAULTERRORBOX
End If
End Sub
Public Property Get InIDE() As Boolean
Debug.Assert (IsInIDE())
InIDE = m_bInIDE
End Property
Private Function IsInIDE() As Boolean
m_bInIDE = True
IsInIDE = m_bInIDE
End Function
Private Sub Form_Terminate()
Se questo non funziona nel vostro applicativo, dovete verificare in quale punto si verifica il problema, in modo da richiamare il codice in
quel punto.
If (Forms.Count = 0) Then
UnloadApp
End If
End Sub
Applicazione dimostrativa
Nell'esempio allegato Project1.exe è un progetto di VB che
contiene un controllo utente vuoto compilato dentro. Quando fate funzionare questo progetto con un file manifest, si genera l'errore in
chiusura. Se ponete un segno di spunta a "Unload Cleanly" tuttavia, il metodo UnloadApp è richiamato in modo da non generare l'errore.
Naturalmente, l'errore nella realtà si genera, ma il sistema non se ne cura più.
Conclusione
Applicando le nuove caratteristiche alle applicazioni più vecchie si possono riscontrare problemi inattesi, poiché non sono state progettate
per il nuovo sistema operativo. Tuttavia, non è sempre pratico aggiornare il codice all'ultima versione ed a volte i lavori di "rappezzo"
sono necessari.
ComCtl32.DLL di Microsoft fornisce un gran numero di caratteristiche eccellenti ma le versioni aggiornate di questa DLL hanno causato
problemi con applicazioni pe esistenti. Questo stato di cose sembra continuare, malgrado la disponibilità di nuovi service packs.
Le soluzioni proposte al problema dei UAE (il famoso errore "Invia a Microsoft...") per le applicazioni di VB che usano gli stili visivi di
XP descritti in questo articolo non sono ideali, ma sono molto facili da applicarsi e comunque sono funzionanti.
Liberamente tradotto da un articolo di Steve McMahon
Aggiungere lo stile XP alla vostra applicazione Visual Basic
Quando fate funzionare un'applicazione Visual Basic su una macchina di XP, noterete che anche se il form ha la barra del titolo in stile XP,
i controlli sul form sono ancora nel vecchio stile Windows. Tuttavia, non è cmplesso adattare un'applicazione ad usare i nuovi stili. In
alcuni casi, potete applicare tale stile alle applicazioni senza codice supplementare!
Il nuovo stile XP
Gli stili visivi di Windows XP sono forniti dalle versioni 6 della ComCtl32.dll o successiva. (già nel vecchio Windows 95 quella libreria
creava l'effetto 3D dei controlli). La differenza sostanziale dalle versioni precedenti di questa DLL, è che la versione 6 non è
redistribuibile, per cui possono utilizzare tale stile solo i sistemi operativi che hanno questa versione installata. Attualmente solo
Windows XP.ComCtl32 non applica lo stile XP ai controlli delle applicazioni per default. Per abilitarlo, occorre accertarsi che la vostra
applicazione richiami la ComCtl32.dll (richiamando la api InitCommonControls della libreria ComCtl32 ed inoltre dovete inserire un file detto
"manifest" come specifica che viene richiamato dalla nuova versione degli stili.
Manifest
I manifest fanno parte delle tecnologie introdotte da Microsoft per tentare di risolvere i conflitti di versioni delle DLL (citati
normalmente come "hell" delle DLL) così comuni nello sviluppo di Windows. Potete avere maggiori informazioni su queste tecnologie e sui
manifest negli articolo tecnico di Windows XP "How To Build and Service Isolated Applications and Side-by-Side Assemblies for Windows XP"
sulla MSDN. Tuttavia, ai fini di questo articolo ciò che dovete sapere è come usare la versione 6 dei common control per realizzare un
documento di XML riconosciuto come manifest da ComCtl32.Il manifest è un documento XML richiesto per utilizzare gli stili visivi di XP, ed
strutturato come segue:
<?xml version="1.0" encoding="UTF-8" standalone="yes" ?>
Si noti che l'attributo nome e la descrizione dell'elemento sono essenzialmente testo libero.
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
version="1.0.0.0"
processorArchitecture="X86"
name="Nome del prodotto"
type="win32" />
<description>Descrizione della tua applicazione</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="X86"
publicKeyToken="6595b64144ccf1df"
language="*" />
</dependentAssembly>
</dependency>
</assembly>
Accertare il collegamento dell' applicazione alla ComCtl32
Se create un manifest, ma la vostra applicazione non richiama la ComCtl32.dll, la stessa non riuscirà a caricare lo stile voluto ( a volte
senza il messaggio di errore). Dovete richiamare almeno la funzione InitCommonControls prima caricare tutti gli elementi grafici e controlli
presenti nella vostra applicazione. Può accadere a volte che non dobbiate fare alcunché perché la vostra applicazione richiami la
ComCtl32.dll (per esempio, se tra le librerie incluse nel progetto ci sono già le Common Control), tuttavia, per essere sicuri che tutto
funzioni è meglio dichiarare InitCommonControls prima della visualizzazione delle qualsiasi form.
Questo è il codice che dovrete implementare all'inizio della vostra applicazione assicurandovi così di richiamare la ComCtl32.dll:
Private Type tagInitCommonControlsEx
Realizzare il Manifest
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControlsEx Lib "comctl32.dll"
(iccex As tagInitCommonControlsEx) As Boolean
Private Const ICC_USEREX_CLASSES = &H200
Public Function InitCommonControlsVB() As Boolean
On Error Resume Next
Dim iccex As tagInitCommonControlsEx
' Ensure CC available:
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_USEREX_CLASSES
End With
InitCommonControlsEx iccex
InitCommonControlsVB = (Err.Number = 0)
On Error Goto 0
End Function
Public Sub Main()
InitCommonControlsVB
'
' Avvia qui la tua applicazione:
'
End Sub
Ci sono due modi per creare e richiamare il manifest: il modo più semplice (ma meno elegante) deve includere il manifesto sul disco per un
eseguibile. Diciamo che la vostra applicazione è denominata TimeSlot.exe . Allora denominerete il file XML manifest come
TimeSlot.exe.manifest
nella stessa cartella dell'eseguibile. TimeSlot.exe caricherà automaticamente lo stile di XP. Se cambiate nome al file manifest prima del
funzionamento dell'applicazione, gli stessi stili non verranno caricati.
Un metodo più completo è quello di compilare il manifest come risorsa nella vostra applicazione. Per fare questo, il manifest deve comparire
come tipo RT_manifest delle risorse (24) con identificatore CREATEPROCESS_MANIFEST_RESOURCE_ID. Per un motivo bizzarro, dovete anche
accertarvi che il file XML risultante sia di lunghezza multipla uniforme di 4 byte. Per esempio, se il vostro file è 597 byte dovete
aggiungere gli spazi del riempimento per comporre un file di 600 byte prima della compilazione. Tale risorsa verrà inglobata utilizzando uno
script del compilatore delle risorse e RC.exe
Alcune note
Gli stili di XP non si applicano durante lo sviluppo, a design time, ma solo esecuzione. Controllate quindi il vostro eseguibile.
I pulsanti di opzione non applicano correttamente lo stile una volta disposti su una struttura, specialmente con VB6. Dovete disporre i
vostri pulsanti di opzione su un controllo picture.
I bordi 3D su PictureBoxes, immagini ed e così via non vengono disegnati nel nuovo stile di XP, perché si tratta di una singola linea fatta
di combinazioni di colore.
Liberamente tradotto da un articolo di Steve McMahon
Ordinare una matrice di numeri
Spesso capita di dover ordinare in ordine crescente i numeri presenti all'interno di una matrice. Proponiamo qui una semplice funzione di
ordinamento.
Ecco la funzione, i cui parametri sono il nome della matrice da ordinare, nonché il valore minimo e il valore massimo all'interno della
matrice: ovvero è possibile ordinare solo un intervallo specifico di numeri della matrice stessa. Solitamente il minimo ed il massimo
coincidono con quelli della matrice stessa.
Public Sub QuickSortVariants(vArray As Variant, inLow As Long, inHi As Long)
Ecco un semplice esempio di utilizzo. Popolo una matrice con dei numeri casuali che faccio poi ordinare con la funzione suddetta.
Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = inLow
tmpHi = inHi
pivot = vArray((inLow + inHi) \ 2)
While (tmpLow <= tmpHi)
While (vArray(tmpLow) < pivot And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend
While (pivot < vArray(tmpHi) And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (inLow < tmpHi) Then QuickSortVariants vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSortVariants vArray, tmpLow, inHi
End Sub
Dim Numeri(1 To 10) As Integer
Al termine visualizzo il risultato in un message box.
Numeri(1) = 10
Numeri(2) = 17
Numeri(3) = 32
Numeri(4) = 8
Numeri(5) = 23
Numeri(6) = 33
Numeri(7) = 11
Numeri(8) = 21
Numeri(9) = 50
Numeri(10) = 16
Call QuickSortVariants(Numeri, LBound(Numeri), UBound(Numeri))
For i = 1 To 10
test = test & Numeri(i) & " "
Next i
MsgBox test
Lanciare un file utilizzando ShellExecute
Molti domandano come aprire un file esterno, associato ad un qualunque programma, da Visual Basic.
In un modulo dichiariamo la seguente funzione:
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile
As String, ByVal lpParameters As_
A questo punto dalla vostra applicazione richiamate il file che volete aprire come segue:
String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Const SW_NORMAL = 1
Dim X As Long
In questo caso si apre direttamente un documento di Word. Con lo stesso sistema potere aprire una pagina Internet o inviare una mail.
X = ShellExecute(hWnd, "Open", "C:\nomecartella\nomefile.doc", vbNullString, vbNullString, SW_NORMAL)
Dim X As Long
Con lo stesso metodo potete anche lanciare un exe, o un file di qualunque estensione.
X = ShellExecute(hWnd, "Open", "http://www.maurorossi.net", vbNullString, vbNullString, SW_NORMAL)
'oppure
Dim X As Long
X = ShellExecute(hWnd, "Open", "mailto:rossimt@sistel.it?subject=Prova&body=Testo da inviare", vbNullString, vbNullString,
SW_NORMAL)
(Il quarto parametro è per gli eventuali comandi della riga di comando, il quinto per la directory di origine, in questo caso sono entrambi
nulle).
Generare una matrice di numeri casuali univoci
Mi è stato chiesto molte volte come generare una sequenza di numeri univoci in un intervallo definito. E' un classico sistema utilizzato per
simulare estrazioni del lotto o per la generazione di calendari di tipo sportivo.
In un modulo dichiariamo la seguente funzione:
Public Function RandomNumbers(Upper As Integer, _
Questa funzione genera una matrice di numeri casuali compresi tra un minimo ed massimo predefiniti. E' stata aggiunta poi la variabile Unique
per decidere se tale matrice deve essere di numeri univoci (True) oppure gli stessi possono essere ripetuti (False). Ecco un esempio di come
richiamare la funzione:
Optional Lower As Integer = 1, _
Optional HowMany As Integer = 1, _
Optional Unique As Boolean = True) As Variant
On Error GoTo LocalError
If HowMany > ((Upper + 1) - (Lower - 1)) Then Exit Function
Dim x As Integer
Dim n As Integer
Dim arrNums() As Variant
Dim colNumbers As New Collection
ReDim arrNums(HowMany - 1)
With colNumbers
'First populate the collection
For x = Lower To Upper
.Add x
Next x
For x = 0 To HowMany - 1
n = RandomNumber(0, colNumbers.Count + 1)
arrNums(x) = colNumbers(n)
If Unique Then
colNumbers.Remove n
End If
Next x
End With
Set colNumbers = Nothing
RandomNumbers = arrNums
Exit Function
LocalError:
'Justin (just in case)
RandomNumbers = ""
End Function
Public Function RandomNumber(Upper As Integer, _
Lower As Integer) As Integer
'Generates a Random Number BETWEEN the LOWER and UPPER values
Randomize
RandomNumber = Int((Upper - Lower + 1) * Rnd + Lower)
End Function
x = RandomNumbers(100, 1, 20, True)
In questo caso si stampa il risultato nella finestra di debug, ma può essere sfruttato in qualunque modo.
For n = LBound(x) To UBound(x)
Debug.Print x(n);
Next n
Salvare immagini i formato JPG utilizzando GDI+
Molto spesso si ha la necessità, anche per motivi di spazio, di salvare le immagini in formato JPG. Questa procedura, senza l'utilizzo di dll
aggiuntive, sfrutta le chiamate alle librerie GDI+, presenti nei sistemi XP o comunque di ultima generazione, per effettuare questa
operazione.
In un modulo dichiariamo la seguente funzione:
Private Type GUID
Per salvare infine l'immagine in formato JPG è sufficiente richiamare la seguente routine (dove Picture1 sarà il controllo picture nel quale
è stata caricata l'immagine e può essere visibile o nascosto):
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type EncoderParameter
GUID As GUID
NumberOfValues As Long
type As Long
Value As Long
End Type
Private Type EncoderParameters
Count As Long
Parameter As EncoderParameter
End Type
Private Declare Function GdiplusStartup Lib "GDIPlus" ( token
As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As
Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" ( ByVal
token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus"
( ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (
ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (
ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID,
encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" ( ByVal
str As Long, id As GUID) As Long
' Salva in JPG
Public Sub SaveJPG( ByVal pict As StdPicture, ByVal filename As String,
Optional ByVal quality As Byte = 80)
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
' Inizializza GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI)
If lRes = 0 Then
' Crea la bitmap GDI+ dall'handle dell'immagine
lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
If lRes = 0 Then
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters
' Inizializza la codifica GUID
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"),
tJpgEncoder
' Inizializza la codifica dei parametri
tParams.Count = 1
With tParams.Parameter ' Qualità
' Imposta la Qualità GUID
CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB3505E7EB}"),
.GUID
.NumberOfValues = 1
.type = 1
.Value = VarPtr(quality)
End With
' Salva l'immagine
lRes = GdipSaveImageToFile( lBitmap, StrPtr(filename), tJpgEncoder,
tParams)
' Elimina la bitmap
GdipDisposeImage lBitmap
End If
' Chiude il processo GDI+
GdiplusShutdown lGDIP
End If
If lRes Then
Err.Raise 5, , "Non posso salvare
l'immagine. Errore GDI+:" & lRes
End If
End Sub
SaveJPG Picture1, "C:\Percorso\Nomefile.jpg", 80
L'ultimo parametro è la qualità dell'immagine, da non confondersi con la compressione che non è parametrizzabile.
Questa procedura si ricorda è valida su sistemi con OS Windows XP o comunque che abbiano installate le liberie GDI+.
Utilizzare TransferDatabase in presenza di password
TransferDatabase è un comando spesso utilizzato sia in VBA di Access che in VB per importare o esportare tabelle da un database all'altro.
Questa semplice procedura presenta delle difficoltà (come riscontrato da Microsoft stessa) se il database di origine è protetto da password.
Per ovviare a tale problema la procedura da eseguire è quella di creare una nuova istanza di Access, aprendo il database interessato e
passandogli la relativa password, per poi eseguire l'operazione voluta.
Nota: se si utilizza da Visual Basic inserire il riferimento a Microsoft Access 9 (o quello installato).
In un modulo dichiariamo la seguente funzione:
Public Function BackupTabelle(DBorigine As String, dbDestinazione As String, dbPassword As String, tabellaOrigine As String,
tabellaDestinazione As String)
Per rilevare l'indice selezionato di una matrice di Option Button sarà sufficiente dichiarare nella nostra routine:
Dim oAcc As Access.Application
Dim td As Integer
Set oAcc = New Access.Application
Set db = oAcc.DBEngine.OpenDatabase(DBorigine, False, False, ";PWD="
& dbPassword)
oAcc.OpenCurrentDatabase DBorigine
oAcc.DoCmd.TransferDatabase acExport, "Microsoft Access",
dbDestinazione, acTable, tabellaOrigine, tabellaDestinazione, False, False
db.Close
Set db = Nothing
End Function
Call BackupTabelle("C:\Percorso\origine.mdb", "C:\Percorso\destinazione.mdb", "password", "Nometabella", "Nometabella")
A questo punto la procedura viene eseguita senza intoppi.
Rilevare l'indice selezionato di una matrice di Option button
Succede molto spesso che si debbano creare dei form con diverse matrici di Option Button o Check Button per dar modo all'utente di
selezionare diverse opzioni all'interno di un proprio programma. Solitamente si rileva tale condizione con un ciclo For... Next. Descriviamo
una semplice routine per evitare di scrivere decine di righe di codice.
In un modulo dichiariamo la seguente funzione:
Public Function CeckOption(Opt As OptionButton) As Long
Per rilevare l'indice selezionato di una matrice di Option Button sarà sufficiente dichiarare nella nostra routine:
Dim c As Long
For c = 0 To Opt.Count
If Opt(c).Value = True
Then CeckOption = c: Exit For
Next c
End Function
Call CeckOption(Opt)
dove Opt sarà il nome della matrice di controlli interessata (Opt(0), Opt(1)....).
Ovviamente con poche modifiche tale routine sarà valida anche per una matrice di Check Button.
Salvare le impostazioni di un programma
Per salvare le impostazioni di una applicazione esistono sostanzialmente tre sistemi:
1) Scrivere tali valori in un file .INI
2) Scrivere in un file di testo (.txt, o qualsiasi estensione)
3) Scrivere nel registro di configurazione di Windows.
Ovviamente il terzo sistema è quello più frequentemente usato da chi programma in VB, anche perchè supportato da alcuni semplici omandi già
inglobati in Visual Basic. Si tratta dei comandi: GetSetting, SaveSetting,DeleteSetting, il cui costrutto è:
GetSetting(appname, section, key[, default]) - legge dal registro
dove appname è il nome del progetto o dell'applicazione (es. "MioProgramma")
SaveSetting(appname, section, key, setting) - scrive nel registro
DeleteSetting(appname, section[, key]) - elimina le voci di registro
section è il nome della sezione (es. "Impostazioni")
key è il nome della chiave (es. "Posizione")
default (opzionale) è il valore predefinito.
Nella guida in linea di Visual Basic potrai trovare gli esempi.
Altro sistema è quello di scrivere file .INI (era molto usato con Windows 3.1).
In questo caso occorre dichiarare in un modulo le relative funzioni delle API di Windows che leggono e scrivono nei file INI:
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName
As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
(queste scrivono in un file .ini personale, mentre se usi GetProfileSting e WriteProfileString leggi e scrivi nel file Win.ini).
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal
lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
lpApplicationName è la sezione del file INI (quelle scritte tra parentesi quadre)
lpKeyName è la chiave (quello che sta davanti al segno =)
lpDefault è l'eventuale valore di default ("" se vuoto)
lpReturnedString è il valore restituito dalla lettura (quello che sta dopo =)
lpFileName è il nome e percorso del file INI (es. App.path &\"miofile.ini")
In scrittura è sufficiente scrivere la funzione nel seguente modo:
i% = WritePrivateProfileString("Impostazioni", "Posizione", "35,42", "Miofile.ini")
(se non si specifica il percorso Miofile.ini viene scritto nella directory C:\WINDOWS)
In lettura occorre convertire il valore integer in string, come nell'esempio:
Dim R1 As String
(30 è la massima lunghezza della stringa - lo puoi decidere tu)
R1 = Space$(31)
num = Trim(Str(n))
i% = GetPrivateProfileString("Impostazioni", "Posizione", "", R1, 30, "Miofile.ini")
R1 = Left$(R1, i%)
R1 = LTrim$(RTrim$(R1))
Ultimo sistema è quello di usare il vecchio metodo Input/Output in un file di testo.
In scrittura:
(suupongo di avere due listbox L1 e L2 e voglio registrare affiancati i valori con loi stesso indice)
Open App.Path + "\lista.dat" For Output As #1
In lettura:
R = 0: S = L1.ListCount - 1
Do While R <= S
L1.ListIndex = R
Write #1, L1, L2
R = R + 1
Loop
Close #1
Open App.Path + "\miofile.dat" For Input As #1
dove A, B sono i valori restituiti, che faccio scrivere separati nelle due listbox L1,L2.
Do While Not EOF(1)
Input #1, A, B
L1.AddItem A
L2.AddItem B
Loop
Close #1
Il problema dell'apice con SQL
Supponiamo di avere un database contenente delle tabelle tra cui una chiamata DIPENDENTI contenente diversi campi. Uno di questi campi si
chiama COGNOME, dove, naturalmente, sono memorizzati i cognomi dei dipendenti di una ditta X. Se eseguiamo una query (utilizzando un Data
Control) utilizzando il seguente metodo:
Dim StringaDaRicercare as String
e nel controllo Text1.Text inseriamo un cognome che ha nel suo contenuto degli apostrofi, ad esempio - D'Alessandro - , otterremo un errore,
in quanto l'apostrofo presente tra la lettera D e la lettera A del cognome viene considerato come parte dell'istruzione della query, e non
come elemento della stringa da ricercare. Per eseguire quindi correttamente la query, bisogna sostituire il singolo apostrofo in un
consecuzione di due apostrofi. Quindi prima di passare una stringa ad una query, possiamo processarla con la seguente funzione, che scansiona
la stringa passatagli come argomento ricercando in essa gli apostrofi, sostituendoli in tal caso con una consecuzione doppia di Chr$(39):
StringaDaRicercare = Text1.Text
Data1.RecordSource = "Select * from Dipendenti where _
Cognome = '" & StringaDaRicercare & "';"
Data1.Refresh
Dim StringaDaRicercare as String
Da richiamare come segue:
Function StringaPerQuery(stringa As String) As String
Dim lun_str As Integer, k0 As Long, k1 As Integer
Dim car As String, strbuff As String
k0 = InStr(stringa, Chr$(39))
If k0 > 0 Then
strbuff = Mid$(stringa, 1, k0 - 1)
lun_str = Len(stringa)
For k1 = k0 To lun_str
car = Mid$(stringa, k1, 1)
If car = Chr$(39) Then car = Chr$(39) & Chr$(39)
strbuff = strbuff & car
Next k1
End If
StringaPerQuery = strbuff
End Function
Dim StringaDaRicercare as String
StringaDaRicercare = StringaPerQuery (Text1.Text) 'chiama la funzione...
Data1.RecordSource = "Select * from Dipendenti where _
Cognome = '" & StringaDaRicercare & "'"
Data1.Refresh
Associare un'estensione ad un programma
Per associare un'estensione di file ad un determinato programma, occorre creare le opportune voci nel registro di configurazione.
Prendiamo ad esempio:
si deve creare in HKEY_CLASSES_ROOT due distinte voci, una ".PIP" e una "File PIPPO"
Public Function Registra (strKey As String, strValueName
As String, strData As String)
Tramite questa semplice funzione sarà possibile registrare la nostra estensione ed associarla al programma voluto nel seguente
modo:
Dim lResult As Long
Dim hKey As Long
lResult = OSRegCreateKey(HKEY_CLASSES_ROOT,
strKey, hKey)
If lResult = ERROR_SUCCESS Then
lResult = OSRegSetValueEx(hKey, strValueName, 0&, REG_SZ, ByVal strData, Len(strData) + 1)
lResult =
OSRegCloseKey(hKey)
End If
End Function
Registra ".PIP", "", "PIPPO File"
La prima riga associa l'eseguibile Pippo.exe ai files .PIP, mentre la seconda associa l'icona per i files .PIP
Registra "PIPPO File\shell\open\command", "", App.Path & "\pippo.exe %1"
Registra "PIPPO File\DefaultIcon", "", App.Path & "\pippo.exe,0"
Per quanto riguarda il lancio automatico da parte della tua applicazione dei file con una determinata estensione (es: .PIP) è necessario che
su Form_Load la nostra applicazione vada a leggere l'eventuale riga di comando:
If Command <> "" Then
'fai eseguire l'operazione voluta
End If
Verificare i duplicati in un combobox
Per verificare di non caricare eventuali nomi duplicati in un combobox:
Function CheckDup(MyValue As Variant, MyCombo As ComboBox) As Boolean
For i = 0 To MyCombo.ListCount - 1
If MyCombo.List(i) = MyValue Then
CheckDup = True
Exit Function
End If
Next i
CheckDup = False
End Function
Verificare se una connessione è in corso
Questo modulo racchiude una semplice funzione per verificare se una connessione ad Internet è in corso oppure no.
Public Declare Function RasEnumConnections Lib "RasApi32.dll"
Alias "RasEnumConnectionsA" (lpRasCon As Any, lpcb As Long,
lpcConnections As Long) As Long
Public Declare Function RasGetConnectStatus Lib "RasApi32.dll"
Alias "RasGetConnectStatusA" (ByVal hRasCon As Long, lpStatus
As Any) As Long
Public Const RAS95_MaxEntryName = 256
Public Const RAS95_MaxDeviceType = 16
Public Const RAS95_MaxDeviceName = 32
Public Type RASCONN95
dwSize As Long
hRasCon As Long
szEntryName(RAS95_MaxEntryName) As Byte
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Public Type RASCONNSTATUS95
dwSize As Long
RasConnState As Long
dwError As Long
szDeviceType(RAS95_MaxDeviceType) As Byte
szDeviceName(RAS95_MaxDeviceName) As Byte
End Type
Public Function IsConnected() As Boolean
Dim TRasCon(255) As RASCONN95
Dim lg As Long
Dim lpcon As Long
Dim RetVal As Long
Dim Tstatus As RASCONNSTATUS95
TRasCon(0).dwSize = 412
lg = 256 * TRasCon(0).dwSize
RetVal = RasEnumConnections(TRasCon(0), lg, lpcon)
If RetVal <> 0 Then
MsgBox "ERROR"
Exit Function
End If
Tstatus.dwSize = 160
RetVal = RasGetConnectStatus(TRasCon(0).hRasCon, Tstatus)
If Tstatus.RasConnState = &H2000 Then
IsConnected = True
Else
IsConnected = False
End If
End Function
Verificare se un file esiste
Molto spesso è necessario verificare se un determinato file è presente o meno nel sistema. Ecco una semplice routine di verifica:
Public Sub VerifyFile(FileName As String)
All'interno del programma sarà poi sufficiente richiamare la funzione dichiarando il file da ricercare:
On Error Resume Next
'Apre lo specifico file
Open FileName For Input As #1
'Gestione dell'eventuale errore
If Err Then
MsgBox ("Il file " & FileName & " non è stato trovato.")
Exit Sub
End If
Close #1
End Sub
Call VerifyFile("MyFile.txt")
Disabilitare il Multitasking in Windows 98
Per disabilitare la combinazione di tasti ALT+TAB (o il corrispondente tasto Win95)occorre dichiarare la seguente funzione e costante:
Private Declare Function SystemParametersInfo Lib "user32" _
Per disabilitare il multitasking è sufficiente dichiarare:
Alias "SystemParametersInfoA" (ByVal uAction As Long, _
ByVal uParam As Long, lpvParam As Any, _
ByVal fuWinIni As Long) As Long
Private Const SPI_SCREENSAVERRUNNING = 97
Dim ret As Integer
Per abilitare nuovamente il multitasking dichiarare:
Dim pOld As Boolean
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, True, pOld, 0)
Dim ret As Integer
Dim pOld As Boolean
ret = SystemParametersInfo(SPI_SCREENSAVERRUNNING, False, pOld, 0)
Aggiungere un collegamento sul desktop in Win 98
E' semplice creare un collegamento del proprio programma sul desktop.Il segreto per creare un collegamento con Visual Basic è in
questadichiarazione del VB4 setup kit
Declare Function fCreateShellLink Lib "STKIT432.DLL" _
Il primo parametro chiede dove piazzare il collegamento (shortcut) relativo alla cartella dei programmi del Menu di Avvio. Il secondo
parametro è il name o il testo che appare con il collegamento. Di seguito viene il percorso del file; il parametro finale supporta ogni
argomento. Pertanto, per piazzare il collegamento sul desktop, inserisci questo codice:
(ByVal lpstrFolderName as String ,ByVal lpstrLinkName as String _
ByVal lpstrLinkPath as String ,ByVal lpstrLinkArgs as String ) As Long
iLong = fCreateShellLink("..\..\Desktop", "Collegamento a Program", "C:\Path\Program.exe","")
Chiamata automatica all'Accesso Remoto in Windows 98
Questa porzione di codice si usa per lanciare la connessione a Internet da una applicazione VB in Windows 98:
Private Sub StartConnection()
dove Nome_Connessione è il nome che avete dato alla vostra connessione all'Accesso remoto.
Dim X
X = Shell("rundll32.exe rnaui.dll,RnaDial " & Nome_Connessione, 1)
DoEvents
SendKeys "{enter}", True
DoEvents
End Sub
Convertire un nome lungo di file in formato DOS
La funzione sottostante converte i nomi di file o do path lunghi in modalità DOS (non più di 8 caratteri):
Declare Function GetShortPathName Lib "KERNEL32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String,
ByVal cchBuffer As Long) As Long
Dove FileName é il path o il nome del file da convertire e ritorna un nome DOS compatibile, pertanto si dichiarerà:
Public Function GetShortFileName(ByVal FileName As String) As String
Dim rc As Long
Dim ShortPath As String
Const PATH_LEN& = 164
ShortPath = String$(PATH_LEN + 1, 0)
rc = GetShortPathName(FileName, ShortPath, PATH_LEN)
GetShortFileName = Left$(ShortPath, rc)
End Function
Dim Lblshort, LongName as string
Lblshort = GetShortFileName(LongName)