Questa è la quarta pagina della rubrica dedicata alla programmazione Visual Basic.

Attendere il caricamento completo...

Vai alla prima pagina; Vai alla seconda pagina; Vai alla terza pagina

INSERISCI NEI PREFERITI - http://www.visualbasic.subito.cc - INSERISCI NEI PREFERITI

Una maschera per form [o una form in maschera]

Un esempio al momento giusto!

    

    Abbiamo già visto come sia possibile creare delle form con effetti di trasparenza. Molti di voi avranno tuttavia notato molte applicazioni che hanno delle skin oppure una grafica super arrotondata che sembra non avere nessuno spigolo. 

    Ammesso e concesso che sia "obbligatorio" creare dei programmi con delle grafiche "strepitose" credo che sia importante conoscere come creare questi graficismi.

    Utilizzerò di seguito alcune API di cui riporto le dichiarazioni: 

Public Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Alcune delle quali coloro che hanno letto le tips precedenti già conoscono.

L'obiettivo di questo esempio è quello di generare una form utilizzando una bitmap con effetti di trasparenza, vediamo le immagini che utilizzerò nell'esempio:

Questa immagine è contenuta in un file dal nome: Pinguino.jpg [attenzione ai nomi perché verranno utilizzati di seguito].

Questa immagine è contenuta in un file dal nome: mask.bmp 

Quindi occorrono due immagini, una vera e propria che sarà l'immagine visualizzata al posto della finestra, l'altra non meno importante è la maschera. La maschera è fondamentale, in quanto è quella passata alla funzione CreaRegione che vedremo subito.

Prima di tutto occorre spendere due parole su questi due file. Prima create il primo file salvatelo in formato jpeg. Attenzione non create troppi spigoli, e createlo di una dimensione adatta alla finestra da realizzare.

Successivamente, create l'immagine utilizzata per maschera, ricavatela dalla prima riempiendo tutta l'immagine iniziale con il colore nero (#000000).

A questo punto continuiamo con la descrizione del codice:

Function CreaRegione(pictureArrivo As PictureBox, Optional longColoreTrasparente As Long) As Long
Dim longR As Long
Dim longLarghezza As Long
Dim longInizio As Long
Dim longAltezza As Long
Dim longRegioneF As Long
Dim longRegione As Long
Dim Riga As Long
Dim Colonna As Long
If longColoreTrasparente& < 1 Then
longColoreTrasparente& = GetPixel(pictureArrivo.hDC, 0, 0)
End If
longAltezza& = pictureArrivo.Height / Screen.TwipsPerPixelY
longLarghezza& = pictureArrivo.Width / Screen.TwipsPerPixelX
longRegioneF& = CreateRectRgn(0, 0, 0, 0)
For Riga& = 0 To longAltezza& - 1
Colonna& = 0
Do While Colonna& < longLarghezza&
Do While Colonna& < longLarghezza& And GetPixel(pictureArrivo.hDC, Colonna&, Riga&) = longColoreTrasparente&
Colonna& = Colonna& + 1
Loop
If Colonna& < longLarghezza& Then
longInizio& = Colonna&
Do While Colonna& < longLarghezza& And GetPixel(pictureArrivo.hDC, Colonna&, Riga&) <> longColoreTrasparente&
Colonna& = Colonna& + 1
Loop
If Colonna& > longLarghezza& Then Colonna& = longLarghezza&
longRegione& = CreateRectRgn(longInizio&, Riga&, Colonna&, Riga& + 1)
longR& = CombineRgn(longRegioneF&, longRegioneF&, longRegione&, RGN_OR)
DeleteObject (longRegione&)
End If
Loop
Next
CreaRegione = longRegioneF&
End Function

Questa funzione in pratica scompone l'immagine utilizzata come maschera creando delle regioni create con l'API: CreateRectRgn ed infine raggruppa tutte le regioni con l'API: CombineRgn.

Sub ApplicaMaschera()
On Error Resume Next ' In case of error
' This is also part of Dos's Dos-Shape example. To update if the skin is changed
Dim longR As Long
lngRegion& = CreaRegione(Maschera)
longR& = SetWindowRgn(Me.hWnd, lngRegion&, True)
End Sub
Private Sub CaricaImmagine()
On Local Error Resume Next
Me.Picture = LoadPicture(App.Path + "\pinguino.jpg") ' Attenzione! inserire qui il nme del file dell'immagine
Me.Maschera.Picture = LoadPicture(App.Path + "\mask.bmp") 'Attenzione! inserire qui il nome del file della maschera
Me.Sposta.Height = frmPrincipale.Height
Me.Sposta.Width = frmPrincipale.Width
Call ApplicaMaschera
End Sub

Vediamo infine come lanciare la funzione che crea la finestra:

Private Sub Form_Load()
Call CaricaImmagine
Sposta.Top = 0
Sposta.Left = 0
Sposta.BackStyle = 0
End Sub

Ecco fatto.

Il risultato? questo:

 

Una form in Maschera 45,9Kb

Scarica

 

Una raccomandazione, non fatevi prendere la mano da questo graficismo. Infatti le operazioni che questo algoritmo compie sono molte, quindi, con immagini molto grandi e complesse la generazione del form è molto lenta. Ai vostri utenti piacerà senz'altro la nuova veste grafica della vostra applicazione, ma si scocceranno presto se per aprirla saranno costretti ad aspettare troppo.

Buon divertimento.

 

 

EURO CHE PASSIONE...

Molti di voi mi hanno scritto per avere informazioni su come modificare la funzione di CONVERSIONE NUMERI IN LETTERE, scritta un bel po' di tempo fa per utilizzare numeri decimali. Si, perché l' EURO ci dovrà abituare all'utilizzo dei decimali. 

Certo che fare adesso un macro per la conversione delle cifre in un numero scritto in lettere sarebbe stato meglio, visto che non capiterà tanto spesso di scrivere assegni, bollettini, fatture (solo una idea del suo utilizzo) di cifre di miliardi di euro.

Ma ecco la modifica da apportare:

Innanzi tutto un po' di teoria:
Il cambio è 1936.27

dato una cifra in lire per ottenere quella in euro è sufficiente dividere la
prima per il valore del cambio. Per quanto riguarda i decimali basta
arrotondare alla seconda cifra, così:
...
87,335 = 87,34
87,334 = 87,33
...

Ma veniamo al dunque, la funzione per convertire la cifra in lettere rimane
la stessa, è sufficiente intervenire a monte.
La normativa stabilisce che le cifre in lettere devono essere scritte così:
prendiamo 13500 lire =  sessantanove/98
cioè impone di scrivere i decimali dopo la barra
Tutto questo lo si può fare così:

Public Function LireEuro(lire As Double) As String
Dim Eurodec As Double
cambio = 1936.27
Dim Euroint As Double
Euroint = Fix(lire / cambio)
Eurodec = lire / cambio - Euroint
If Eurodec > 0.995 Then
Eurodec = 0
Euroint = Euroint + 1
Else
Eurodec = Format(Eurodec, "#.##")
End If
LireEuro = eliminadoppie(NumLettere(Euroint)) & "/" & Right(Str(Eurodec), 2)
End Function


Naturalmente dovete usare questa funzione contestualmente a quelle da me pubblicate  presenti nelle varie forme.

EUROCONVERTITORE

Ecco un nuovo articolo dedicato all'euro e alle problematiche per la conversione lire-euro e viceversa. Ma un problema più grosso sono costretti a risolverlo i commercianti, soprattutto per la non tanto splendida (secondo il mio modesto parere) idea di far circolare contemporaneamente lire ed euro per 2 mesi di tempo.  Infatti, loro spesso, almeno per ora, sono costretti a ricevere lire e restituire il resto in Euro. Ecco che quindi colgo l'occasione per pubblicare questo programma, gentilmente inviato da Erminio Ricciardi, un appassionato lettore di questo sito :) Mi raccomando seguite il suo esempio e speditemi i vostri programmi o semplici routine che ritenete essere di utilità per tutti. 

Vediamo alcune immagini del programma:

Come potete vedere, esprimendo una cifra da pagare in lire è possibile visualizzare il resto in Euro visualizzando anche il numero delle banconote e delle monete corrispondenti.

E naturalmente vediamo alcune riflessioni del sorgente:

Iniziamo a sottolineare il corretto utilizzo dell'evento GotFocus che permette di aggiornare i diversi textbox appena il puntatore si sposta su uno di essi.

Ecco tutto il codice inserito nel form principale, per maggiore comprensione riporto la lista degli oggetti textbox associati ai diversi utilizzi:

text1: 'pagato in lire; text2: 'pagato in euro; text3: 'importo da pagare in euro; text4: 'importo da pagare in lire

Ripercorrere tutto l'algoritmo potrà sembrare complesso, ma vi assicuro che grazie alla pulizia del codice risulta in realtà semplice.

Dim tot As Single
Dim lire As Single
Dim euro As Single
Dim restoxx As Single


Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
If restoxx > 0 Then
vedi = restoxx
Resto.Show (1)
End If
End Sub


Private Sub Form_Unload(Cancel As Integer)
lire = 0
euro = 0
End Sub

Private Sub Form_Load()
tot = 0
lire = 0
euro = 0
Call totale
End Sub

Private Sub Text1_GotFocus() 'pagato in lire
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub
Private Sub Text2_GotFocus() 'pagato in euro
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)
End Sub
Private Sub Text3_GotFocus() 'importo da pagare in euro
Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)
End Sub
Private Sub Text4_GotFocus() 'importo da pagare in lire
Text4.SelStart = 0
Text4.SelLength = Len(Text4.Text)
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 44
If KeyAscii = 13 Then Text3.SetFocus
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then KeyAscii = 44
If KeyAscii = 13 Then Text4.SetFocus
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text2.SetFocus
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then Text1.SetFocus
End Sub

Private Sub Text1_LostFocus()
If Not IsNumeric(Text1.Text) Then Text1.Text = 0
Text1.Text = Format(Text1.Text, "##,##0")
lire = Text1.Text / 1936.27
lire = Math.Round(lire, 2)
Label7.Caption = Format(lire, "##,##0.00")
Call totale
End Sub

Private Sub Text2_LostFocus()
If Not IsNumeric(Text2.Text) Then Text2.Text = 0
Text2.Text = Format(Text2.Text, "##,##0.00")
euro = Text2.Text
Label8.Caption = Format(euro, "##,##0.00")
Call totale
End Sub

Private Sub Text3_LostFocus()
If Not IsNumeric(Text3.Text) Then Text3.Text = 0
Text3.Text = Format(Text3.Text, "##,##0.00")
tot = Text3.Text
Text4.Text = Format(Text3.Text * 1936.27, "##,##0")
Call totale
End Sub

Private Sub Text4_LostFocus()
If Not IsNumeric(Text4.Text) Then Text4.Text = 0
Text4.Text = Format(Text4.Text, "##,##0")
Text3.Text = Format(Text4.Text / 1936.27, "##,##0.00")
tot = Text3.Text
Call totale
End Sub

Private Sub totale()
Dim subt As Single

restoxx = 0
subt = lire + euro
Label10.Caption = Format(subt, "##,##0.00")
restoxx = subt - tot
Label12.Caption = Format(restoxx, "##,##0.00")
Label12.ForeColor = IIf(restoxx < 0, vbRed, vbBlack)
If restoxx < 0 Then Label12.Caption = "mancano " + Label12.Caption
End Sub

Naturalmente non vorrei tediarvi con l'arduo compito del copia ed incolla e quindi ecco il file di archivio zip contenente i files necessari:

Euroconvertitore 65Kb

Scarica

A voi il compito di studiarlo e completarlo come meglio credete.

Ricordo che questo codice mi è stato spedito da Erminio Ricciardi e di nuovo SPEDITE, SPEDITE, SPEDITE ...  i vostri programmi, routines.

INSERISCI NEI PREFERITI - http://www.visualbasic.subito.cc - INSERISCI NEI PREFERITI

Continua...
(la sezione successiva è in elaborazione)

(Aggiornato al 30/05/2004 )