Utilizzare
il designer DataReport di Visual Basic 6 (terza parte)
a cura di Amedeo Fantini
(requisiti: conoscenza generica di VB)
Nel periodo trascorso dalla stesura della seconda
parte ad oggi (sono passati circa quattro anni) ho totalmente cambiato
il mio approccio mentale verso l'oggetto in questione, ritenendolo semplicemente
un tool per il trasferimento di "informazioni su supporto cartaceo" e non
più un tool per la creazione di stampe.
Tra le due affermazioni sembrerebbe non esserci alcuna differenza, ma da come
ho sempre inteso ed utilizzato le stampe in altri ambienti, pretendevo di
agire anche qui nello stesso modo. Per me "generare una stampa" (sono cresciuto
con CLIPPER e IMBS/38) ha sempre significato creare un programma che durante
il suo flusso inviava dati alla periferica di output "quando necessario e
solo il necessario".
E quindi ho preso in mano il DataReport convinto di modellarlo a mio
piacere. Non ne sono uscito sconfitto, ma ho radicalmente cambiato il modo
di concepire una stampa (quantomeno con il DR).
Quindi, oggi, lo ritengo una comoda interfaccia per riportare su carta quello
che ho già completamente preparato da un'altra parte. Se fossimo a scuola
(..magari..) corrisponderebbe all'incirca all'azione della ricopia in bella
del tema.
Ovviamente, come già esposto in precedenza (prima
parte , seconda
parte ) ci sono punti nei quali intervenire e modificare alcune cose,
ma sostanzialmente si tratta di un'operazione di puro trasferimento dati.
In pratica il lavoro va fatto prima, e non durante.
Nella parte che seguirà ho ritenuto pertanto di riportare, oltre a quanto già "promesso" nell'articolo precedente, anche alcuni procedimenti (trucchi?) e soluzioni con le quali impiego il DR, considerando con questo di esaurire l'argomento.
Mi rimane solo un piccolo cruccio: non sono riuscito a rendere dinamiche
le immagini. Ci ho provato con tutte le forze, ma da quanto ne ho dedotto
si dovrebbe intervenire troppo a basso livello, il che corrisponderebbe ad
una soluzione non ufficiale.
L'unica annotazione che mi sento di fare è che sembra che il DR, prima
di generare la stampa vera e propria, utilizzi un'area temporanea di lavoro
(che non si capisce dove sia e come sia possibile raggiungerla), la quale
solo al termine viene riportata su stampante. E' solo in questo momento che
assegna, alle immagini presenti sulla pagina, l'ultima presente in memoria.
Desidero tanto che qualcuno mi smentisca, e non sapete quanto!!
Impostare la stampante di default
Come già esposto in precedenza (prima
parte, paragrafo "proprietà metodi ed eventi") il DR si appoggia
esclusivamente sulla stampante di default creando non pochi problemi quando
questa deve essere impostata in modo trasparente.
Per risolvere la questione utilizzo da diverso tempo alcune funzioni che lo
consentono. Riporto il codice di seguito per coloro che non ne fossero a conoscenza
invitando ad estenderlo in una classe che lo completi e lo estenda al meglio
(come del resto ho fatto io).
Option Explicit
Private Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long
Private Declare Function WriteProfileString Lib "kernel32" _
Alias "WriteProfileStringA" _
(ByVal lpszSection As String, _
ByVal lpszKeyName As String, _
ByVal lpszString As String) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lparam As String) As Long
Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer
Private Declare Function OpenPrinter Lib "winspool.drv" _
Alias "OpenPrinterA" _
(ByVal pPrinterName As String, _
phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib "winspool.drv" _
Alias "SetPrinterA" _
(ByVal hPrinter As Long, _
ByVal Level As Long, _
pPrinter As Any, _
ByVal Command As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" _
Alias "GetPrinterA" _
(ByVal hPrinter As Long, _
ByVal Level As Long, _
pPrinter As Any, _
ByVal cbBuf As Long, _
pcbNeeded As Long) As Long
Private Declare Function lstrcpy Lib "kernel32" _
Alias "lstrcpyA" _
(ByVal lpString1 As String, _
ByVal lpString2 As Any) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long
Private Const HWND_BROADCAST = &HFFFF
Private Const WM_WININICHANGE = &H1A
Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_ACCESS_ADMINISTER = &H4
Private Const PRINTER_ACCESS_USE = &H8
Private Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or _
PRINTER_ACCESS_USE)
Private Const PRINTER_ATTRIBUTE_DEFAULT = 4
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmLogPixels As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
dmICMMethod As Long ' // Windows 95 only
dmICMIntent As Long ' // Windows 95 only
dmMediaType As Long ' // Windows 95 only
dmDitherType As Long ' // Windows 95 only
dmReserved1 As Long ' // Windows 95 only
dmReserved2 As Long ' // Windows 95 only
End Type
Private Type PRINTER_INFO_5
pPrinterName As String
pPortName As String
Attributes As Long
DeviceNotSelectedTimeout As Long
TransmissionRetryTimeout As Long
End Type
Private Type PRINTER_DEFAULTS
pDatatype As Long
pDevMode As Long
DesiredAccess As Long
End Type
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
'****************************************************************
' FUNZIONE PUBBLICA DA RICHIAMARE
' Imposta la stampante predefinita in Windows 95/98/NT/2000/XP
'****************************************************************
Public Sub OSSetDefaultPrinter(PrinterName As String)
Dim osinfo As OSVERSIONINFO
If Len(PrinterName) = 0 Then Exit Sub
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
Call GetVersionExA(osinfo)
If osinfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
Win95SetDefaultPrinter PrinterName
Else
'Suppone che le versioni successive a win95 usino il sistema di NT
WinNTSetDefaultPrinter PrinterName
End If
End Sub
'*******************************************************************
' Copia un indirizzo LPSTR su una stringa
'*******************************************************************
Private Function PtrCtoVbString(Add As Long) As String
'Assume un buffer di 512 byte
Dim sTemp As String * 512
'Copia i dati della stringa in base all'indirizzo
Call lstrcpy(sTemp, Add)
'Se la stringa non è null-terminated assumo che sia vuota
If (InStr(1, sTemp, Chr$(0)) = 0) Then
PtrCtoVbString = vbNullString
Else
'Toglie il chr$(0) dalla fine della stringa
PtrCtoVbString = Left$(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If
End Function
'**********************************************************************************
'Routine ausiliaria per la scrittura della stampante default su WIN.INI versione NT
'**********************************************************************************
Private Sub SetDefaultPrinter(PrinterName As String, _
DriverName As String, _
PrinterPort As String)
Dim DeviceLine As String
DeviceLine = PrinterName + "," + DriverName + "," + PrinterPort
'Inserisce le nuove impostazioni per la stampante nella sezione [WINDOWS]
'del WIN.INI per loa voce DEVICE=xxxxxx
Call WriteProfileString("windows", "Device", DeviceLine)
'Manda a tutte le applicazioni un messaggio che indica di rileggere WIN.INI
Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
End Sub
'**********************************************************************************
' Imposta la stampante su w95
'**********************************************************************************
Private Sub Win95SetDefaultPrinter(PrinterName As String)
Dim Handle As Long
Dim pd As PRINTER_DEFAULTS
Dim X As Long
Dim need As Long
Dim pi5 As PRINTER_INFO_5 ' struttura PRINTER_INFO
Dim LastError As Long
Dim t() As Long
'Inizializza i dati della struttura PRINTER_DEFAULTS
pd.pDatatype = 0&
pd.DesiredAccess = PRINTER_ALL_ACCESS Or pd.DesiredAccess
'Ottiene un handle alla stampante
X = OpenPrinter(PrinterName, Handle, pd)
'Ignora l'errore in caso di fallimento
If X = False Then Exit Sub
'Chiamata a GetPrinter con Level=5 (PRINTER_INFO_5) per determinare quanti byte
'servono per il buffer
Call GetPrinter(Handle, 5, ByVal 0&, 0, need)
'Inutile controllare qui Err.LastDllError: dovrebbe esserci stato un errore
'122 - ERROR_INSUFFICIENT_BUFFER, quindi ridimensiono t per contenere i byte
'necessari
ReDim t((need \ 4))
'Adesso posso chiamare GetPrinter per ottenere le informazioni sotto forma di una
'struttura PRINTER_INFO_5
X = GetPrinter(Handle, 5, t(0), need, need)
'Ignora l'errore in caso di fallimento
If X = False Then Exit Sub
'Converte in stringa i primi 2 puntatori
pi5.pPrinterName = PtrCtoVbString(t(0))
pi5.pPortName = PtrCtoVbString(t(1))
'Gli altri sono semplici Long
pi5.Attributes = t(2)
pi5.DeviceNotSelectedTimeout = t(3)
pi5.TransmissionRetryTimeout = t(4)
'Flag che imposta la stampante default
pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT
'Imposta la stampante come default
X = SetPrinter(Handle, 5, pi5, 0)
'Ignora l'errore in caso di fallimento
If X = False Then Exit Sub
'Chiude l'handle
ClosePrinter Handle
End Sub
'**********************************************************************************
' recupera
'**********************************************************************************
Private Sub GetDriverAndPort(Buffer As String, _
DriverName As String, _
PrinterPort As String)
Dim iDriver As Long
Dim iPort As Long
DriverName = vbNullString
PrinterPort = vbNullString
'Il nome del driver è il primo della lista seperata da ","
iDriver = InStr(Buffer, ",")
If iDriver > 0 Then
DriverName = Left$(Buffer, iDriver - 1)
'Il nome della porta è il secondo dopo il nome del driver
iPort = InStr(iDriver + 1, Buffer, ",")
If iPort > 0 Then
PrinterPort = Mid$(Buffer, iDriver + 1, iPort - iDriver - 1)
End If
End If
End Sub
'**********************************************************
' Imposta la stampante predefinita sotto WinNT
'**********************************************************
Private Sub WinNTSetDefaultPrinter(PrinterName As String)
Dim Buffer As String
Dim DeviceName As String
Dim DriverName As String
Dim PrinterPort As String
'Recupera le informazioni sulla stampante richiesta da WIN.INI
Buffer = Space$(1024)
Call GetProfileString("PrinterPorts", PrinterName, vbNullString, Buffer, Len(Buffer))
'Ottiene dal buffer il nome del driver e della porta
GetDriverAndPort Buffer, DriverName, PrinterPort
If Len(DriverName) > 0 And Len(PrinterPort) > 0 Then
SetDefaultPrinter PrinterName, DriverName, PrinterPort
End If
End Sub
Ancora sull'oggetto stdDataFormat
Come già esposto in precedenza la rigidezza del DR non consente di
accedere alle proprietà di un controllo posto all'interno di una sezione durante
la sua elaborazione; ne consegue che, essendo indisponibili le azioni che
si effettuano normalmente sui controlli (impostazioni di proprietà, font,
altro..), spesso si getta la spugna senza cercare d'aggirare l'ostacolo utilizzando
quel poco che il DR, in associazione ad altri componenti, ci consente
di fare.
Ovviamente non è che con due righe di codice si risolvono i problemi e pertanto bisogna sporcare un po' il nostro report. Dal mio punto di vista ritengo possa essere un compromesso tutto sommato accettabile perché con quello che abbiamo (il DR) ricercare anche la purezza del codice, o della soluzione, è un po' come cercare di incastonare delle gemme con un cucchiaio!!
Mi ricollego perciò ad un quesito apparso nella mailing list di Visual-Basic.it, il quale aveva come oggetto la richiesta di alternare il colore di stampa di una riga in funzione di situazioni variabili, per ricordare come l'associazione dell'oggetto stdDataFormat ad un controllo rptTextBox consenta di ottenere facilmente delle soluzioni a prima vista impossibili.
Nell'esempio che segue si ottiene la stampa di un report dove il colore
del testo rispecchia il suo contenuto.
L'immagine che invece riporto corrisponde alla finestra del nostro DR sulla
quale ho inserito tre controlli rptTextBox impostando per ognuno il
colore del font desiderato.
Vorrei far notare che questa disposizione non è corretta perché la sezione stampata sarebbe molto più alta della riga stessa. Nel caso reale i controlli andranno posizionati l'uno sopra all'altro e la sezione dimensionata con un'altezza minore (se lo avessi fatto non sarebbe stato graficamente chiaro per chi sta leggendo).
Di seguito il codice da inserire nel DataReport. L'associazione ai dati deve avvenire prima dell'attivazione della stampa stessa e la proprietà DataField deve essere associata ad un campo del recordset.
Option Explicit
Dim WithEvents sdfRosso As StdDataFormat
Dim WithEvents sdfBlu As StdDataFormat
Dim WithEvents sdfNero As StdDataFormat
Private Sub DataReport_Initialize()
Set sdfRosso = New StdDataFormat
Set sdfBlu = New StdDataFormat
Set sdfNero = New StdDataFormat
With Me
With .Sections("Section1").Controls
.Item("txtRosso").DataField = "Field"
.Item("txtBlu").DataField = "Field"
.Item("txtNero").DataField = "Field"
.Item("txtRosso").Top = 0
.Item("txtBlu").Top = 0
.Item("txtNero").Top = 0
Set .Item("txtRosso").DataFormat = sdfRosso
Set .Item("txtBlu").DataFormat = sdfBlu
Set .Item("txtNero").DataFormat = sdfNero
End With
End With
End Sub
Private Sub sdfRosso_Format(ByVal DataValue As StdFormat.StdDataValue)
If UCase(DataValue) <> "ROSSO" Then
DataValue = ""
End If
End Sub
Private Sub sdfBlu_Format(ByVal DataValue As StdFormat.StdDataValue)
If UCase(DataValue) <> "BLU" Then
DataValue = ""
End If
End Sub
Private Sub sdfNero_Format(ByVal DataValue As StdFormat.StdDataValue)
If UCase(DataValue) <> "NERO" Then
DataValue = ""
End If
End Sub
In pratica ecco cosa succede: ogni qualvolta scatta l'evento associato al controllo rptTextBox (vedi seconda parte paragrafo "Intervenire durante l'esecuzione della stampa") occorre semplicemente "sbiancare" i valori che non si desiderano e quindi solo quello che corrisponderà al colore sarà stampato (o meglio il DR li stampa tutti ma il BackGround del controllo è trasparente...)
La proprietà CanGrow
MSDN: "Restituisce o imposta un valore che determina se le dimensioni del
controllo possono aumentare in senso verticale quando il testo restituito
non rientra nelle dimensioni impostate per il controllo".
Pippo (programmatore): "Però, comoda! Così se il testo non ci sta tutto
sulla riga il DR me lo estende e non me lo taglia…"
Questa è un'ipotetica riflessione che potrebbe aiutare a comprendere il perché
la proprietà è spesso sottovalutata (perché limitarsi al solo testo?), mentre
invece, se utilizzata a dovere, consente di ottenere risultati a prima vista
impensabili. Di certo all'interno di un sistema poco dinamico come il DR
è l'unica che va controcorrente, e quindi in grado d'influenzare costantemente
il layout finale.
Estendiamo perciò la valutazione fatta dal nostro programmatore (Pippo) e
proviamo a dargli anche un altro compito oltre a quello ovvio "dell'allargare
il controllo se il testo non ci sta". Sappiamo ad esempio che l'altezza di
una sezione del DR è statica, o meglio: è possibile variarla solo prima
che il DR inizi il suo processo, dopodiché questa rimane fissa. La
proprietà in questione è l'unica che può obbligare la sezione ad espandersi
per poi ritornare alla dimensione iniziale.
Pertanto si può decidere (ad esempio) di modificare l'altezza di una sezione
con criteri di valutazione più generici e non strettamente legati alla singola
riga da stampare.
Alcune considerazioni:
- la proprietà CanGrow è applicabile ai controlli rptLabel, rptTextBox e rptFunction; se desideriamo interagire con essa possiamo solo utilizzare su questi ultimi due dal momento che sono i soli a supportare l'associazione con l'oggetto stdDataFormat.
- l'espansione del controllo avviene solo in verticale, ossia verso il basso, mentre la dimensione orizzontale rimane invariata. L'azione influenza tutti i controlli che occupano lo spazio sottostante a quello che si espande, e ne provoca lo spostamento in blocco.
Ipotizziamo ora di voler stampare una lista di importi e, al variare di una condizione verificabile solo durante il processo di stampa, inserire dei subtotali. Come esempio ho preso la tabella products del database NorthWind ed ho ipotizzato di stampare un subtotale quando la somma della Quantità in stock supera un valore passato da una selezione esterna.
Questo è il codice da inserire nel DataReport
Option Explicit
Public SkipQTA As Long
Dim WithEvents sdfSubTotal As StdDataFormat
Dim QtaSKIP As Long
Private Sub DataReport_Initialize()
Set sdfSubTotal = New StdDataFormat
With Me
With .Sections("Section1")
With .Controls
.Item("txtName").DataField = "ProductName"
.Item("txtCategoryID").DataField = "CategoryName"
.Item("txtQta").DataField = "UnitsInStock"
.Item("txtSubTotal").DataField = "UnitsInStock"
.Item("txtSubTotal").Height = 0
Set .Item("txtSubTotal").DataFormat = sdfSubTotal
End With
'Altezza della sezione
.Height = .Controls("txtName").Height
End With
End With
End Sub
Private Sub sdfSubTotal_Format(ByVal DataValue As StdFormat.StdDataValue)
QtaSKIP = QtaSKIP + CLng(DataValue)
If QtaSKIP >= SkipQTA Then
DataValue = "Totale : " & CStr(QtaSKIP)
QtaSKIP = 0
Else
DataValue = ""
End If
End Sub
Il codice da prendere in esame è quello contenuto nell'evento Format
dove effettuiamo il test; valorizzando il contenuto del parametro DataValue,
obblighiamo il controllo stesso ad espandersi per stampare il subtotale.
Quello che ho ottenuto, passando il valore "123", è riportato di seguito.
Non sempre però ci capita d'inserire del testo sulla pagina; a volte possiamo avere la necessità di mettervi semplicemente dello spazio. Ad esempio quando il nostro utente desidera aggiungere a mano delle note in corrispondenza di una determinata voce, oppure ci servono delle righe vuote, dopo l'ultima stampata, per spostare la sezione "Report Footer".
Dobbiamo perciò dimensionare il controllo adibito a "spaziatore" con una larghezza pari ad un singolo carattere, ad esempio la lettera "X", ed impostargli il colore di primo piano sul bianco. Così facendo otteniamo che il numero delle righe è pari al numero delle "X" concatenate, ed il colore bianco indica al DR di non stampare il contenuto.
Creare manualmente le gerarchie
Ho riportato in precedenza (prima
parte paragrafo "L'associazione ai dati") come il DataReport non
sia in grado di processare recordset gerarchici allo stesso livello: i recordset
secondari non possono mai essere paralleli ma sempre ricorsivi.
Provo a rappresentarlo graficamente:
Fig.1
- RS1 (Section1)
- RS2 (Section2)
- RS3 (Section3)
- RS2 (Section2)
Questa sequenza è corretta
Fig.2
- RS1 - (Section1)
- RS2 (Section2)
- RS3 (Section(?))
- RS2 (Section2)
Questa sequenza non è assolutamente possibile da processare perché RS2 e RS3 sono allo stesso livello (fisicamente RS2 e RS3 sono due campi di RS1 di tipo RecordSet)
Ricapitoliamo ora come il DR tratta i recordset gerarchici (Fig.1):
- per ogni riga di RS1 si attiva Section2 se RS2 contiene righe
- per ogni riga di RS2 si attiva Section3 se RS3 contiene righe
- ... e così via.
Una situazione facilmente rappresentabile è quella nella quale RS1
contiene un fornitore, RS2 l'elenco degli ordini a lui associati e
RS3 l'elenco degli articoli presenti in ogni singolo ordine.
E fin qui nessun problema, perché la sintassi del comando SHAPE ci
consente agevolmente di ricrearla.
Ma il mio utente vuole stampare l'elenco degli ordini e, solo dopo l'ultimo
ordine, l'elenco riepilogativo di tutti gli articoli presenti negli ordini
sopraelencati. Esaminando la struttura del comando SHAPE,
sulla quale non mi dilungo, e di come sia possibile creare tramite SQL
la gerarchia di relazione, questa soluzione non è ipotizzabile perché il recordset
contenente l'elenco riepilogativo degli articoli potrebbe anche essere creato,
ma verrebbe stampato per ogni riga di ordine.
Armandosi di pazienza si potrebbe anche costruire uno SHAPE che risolve
il problema, perché ordini ed articoli sono quantomeno in relazione fra loro.
Ma allora faccio io l'utente incontentabile: voglio una stampa che mi elenchi
tutti i clienti di una zona seguito da un elenco di articoli di una determinata
categoria, ed infine i numeri telefonici delle compagnie di spedizione che
posso chiamare.
In pratica in un unico foglio tre sezioni senza nessun legame.
Vi prospetto alcune soluzioni:
- una pistola (per voi o per l'utente);
- convincerlo che tre stampe sono meglio di una;
- armarsi di colla e forbici e da tre fogli ricavarne uno;
- chiamare Mandrake.
Bene, fine dell'angolo dell'umorismo.
Ragionando su quanto finora esposto, il prospetto richiesto sarebbe realizzabile
inserendo i dati della sezione successiva solo sull'ultima riga della sezione
precedente, così che la stampa della Sezione2 verrebbe eseguita solo
al termine della Sezione1.
Ma come abbiamo visto nella sintassi del comando SHAPE non è che possiamo
dire all'SQL di recuperare righe dal database a sentimento (ora si…ora
no) e soprattutto senza che le tabelle coinvolte siano in qualche modo relazionate
tra loro.
Quindi l'unica soluzione percorribile rimane quella di crearsi una gerarchia
manualmente, con la quale possiamo decidere quando e cosa mettervi dentro.
Per fare questo ci serve una direttiva poco documentata del comando SHAPE:
la parola chiave NEW che ci consente di creare una struttura personalizzata.
Questo che segue è un esempio del suo utilizzo.
SHAPE APPEND
NEW adInteger AS Field1,
NEW adVarChar(10) AS Field2,
(( SHAPE APPEND
NEW adInteger AS chField1,
NEW adVarChar(10) AS chField2)
RELATE Field1 TO ChField1) AS MyRecordset
Ora che sappiamo come fare non resta che mettere in pratica il tutto. L'esempio
che segue servirà solo per illustrare come si procede nella creazione e nel
popolamento del recordset.
Nell'allegato troverete invece anche la soluzione alla prima richiesta del
nostro utente. La seconda richiesta invece la lascio a voi.
Il nostro report avrà pertanto la seguente struttura:
- Sezione1 (Grp1H) - intestazione
- Sezione2 (Grp2H) - primo dettaglio
- Sezione3 (Dett) - secondo dettaglio che sarà stampato solo al termine del precedente.
Per creare il recordset dobbiamo specificare nella connessione il provider MsDataShape e come sorgente dati "NONE" perché non serve assolutamente un database dal momento che stiamo creando una struttura personalizzata.
Connection.Open "Data Provider=NONE; Provider=MSDataShape"
Bisogna porre particolare attenzione quando si crea il recordset perché per poterlo riempire a piacere occorre che sia abilitato alla modifica.
RsMAIN.Open Origine, ConnessioneAttiva, adOpenStatic
Ecco il comando che crea il recordset necessario all'esempio:
SQLString = "SHAPE APPEND " & _
" NEW adVarChar(10) AS L1, " & _
" NEW adVarChar(30) AS Row1, " & _
" ((SHAPE APPEND " & _
" NEW adVarChar(10) AS L1, " & _
" NEW adVarChar(1) AS L2, " & _
" NEW adVarChar(15) AS Row2, " & _
" ((SHAPE APPEND " & _
" NEW adVarChar(1) AS L2, " & _
" NEW adVarChar(15) AS Row3 " & _
" ) RELATE L2 TO L2 " & _
" ) AS Rs2 " & _
" ) RELATE L1 TO L1 " & _
" ) AS Rs1"
Per legare i livelli ho inserito dei campi chiave L1 e L2 che
hanno il compito di indicare al DR quando eseguire la sezione figlia.
Ovviamente solo sull'ultima riga della Sezione2 ho inserito il valore
di legame con la Sezione3.
Una volta creata la struttura avremo un recordset il quale avrà all'interno
un campo chiamato "Rs2" di tipo RecordSet che, a sua volta,
avrà un campo chiamato "Rs3" anche lui di tipo RecordSet.
Dim strConnString As String
Dim cnConn As ADODB.Connection
Dim SQLString As String
Dim pRsMAIN As ADODB.Recordset
Dim pRs2 As ADODB.Recordset
Dim pRs3 As ADODB.Recordset
strConnString = "Data Provider=NONE; Provider=MSDataShape"
Set cnConn = New ADODB.Connection
cnConn.Open strConnString
SQLString = "SHAPE APPEND " & _
" NEW adVarChar(10) AS L1, " & _
" NEW adVarChar(30) AS Row1, " & _
" ((SHAPE APPEND " & _
" NEW adVarChar(10) AS L1, " & _
" NEW adVarChar(1) AS L2, " & _
" NEW adVarChar(15) AS Row2, " & _
" ((SHAPE APPEND " & _
" NEW adVarChar(1) AS L2, " & _
" NEW adVarChar(15) AS Row3 " & _
" ) RELATE L2 TO L2 " & _
" ) AS Rs2 " & _
" ) RELATE L1 TO L1 " & _
" ) AS Rs1"
Set pRsMAIN = New ADODB.Recordset
pRsMAIN.LockType = adLockOptimistic
pRsMAIN.Open SQLString, cnConn, adOpenStatic
With pRsMAIN
.AddNew
.Fields("L1").Value = "CODICE"
.Fields("Row1").Value = "S1-RIGA1"
.Update
'Istanza del recordset figlio
Set pRs2 = .Fields("Rs1").Value
With pRs2
.AddNew
.Fields("L1").Value = "CODICE"
.Fields("L2").Value = "0"
.Fields("Row2").Value = "S2-RIGA1"
.Update
.AddNew
.Fields("L1").Value = "CODICE"
.Fields("L2").Value = "0"
.Fields("Row2").Value = "S2-RIGA2"
.Update
.AddNew
.Fields("L1").Value = "CODICE"
.Fields("L2").Value = "1"
.Fields("Row2").Value = "S2-RIGA3"
.Update
'Istanza del recordset figlio
Set pRs3 = .Fields("Rs2").Value
With pRs3
.AddNew
.Fields("L2").Value = "1"
.Fields("Row3").Value = "S3-RIGA1"
.Update
.AddNew
.Fields("L2").Value = "1"
.Fields("Row3").Value = "S3-RIGA2"
.Update
End With
End With
End With
'Attiva il DataReport
Set DataR.DataSource = pRsMAIN
DataR.Show vbModal
pRsMAIN.Close
pRs2.Close
pRs3.Close
cnConn.Close
Set pRsMAIN = Nothing
Set pRs2 = Nothing
Set pRs3 = Nothing
Set cnConn = Nothing
E questo è quello che si ottiene.
Riporto anche il risultato dell'esempio relativo alla stampa degli ordini per evidenziare come, tramite l'impiego della proprietà CanGrow, ho inserito una intestazione sulla sezione relativa agli articoli.
API e Subclassing
Tempo fa mi hanno chiesto di visualizzare la finestra di anteprima impostando
automaticamente l'ingrandimento al 50%.
Dopo alcuni tentativi, assodato che non c'è una proprietà che lo consente,
ho avviato SPY++ ed ho individuato l'handle del controllo listbox
con l'intenzione di mandargli un messaggio (tramite l'API SendMessage)
per selezionare uno degli elementi della lista. Detto e fatto.
Ma poi mi è venuta la tentazione di aggiungere anche un pulsante in più alla
toolbar per poterlo utilizzare a piacere.
Insomma, gira e rigira ci sono ricascato.
Mi ero ripromesso di non farlo, ma non ce l'ho fatta. Beninteso: non che non
sia permesso o non corretto fare ricorso alle API per aggirare alcuni
limiti, ma dentro di me non mi sembrava una sfida ad armi pari (forse sono
un po' suonato).
Quindi per chi non si fa scrupoli, riporto di seguito alcune parti di codice
con il quale si può facilmente estendere il DR.
Innanzitutto occorre determinare l'handle della toolbar presente
nella finestra del DataReport e, per questo, ci affidiamo alle API.
Esaminando il codice riportato si può vedere come la finestra stessa sia composta
da quattro finestre figlie: quella che ci interessa è l'ultima.
Una volta individuata siamo in grado di determinare l'indirizzo di ogni elemento
presente sulla sua superficie, quindi i due pulsanti e la combo per lo "zoom".
Ecco quindi il codice per determinare l'handle della toolbar
Private Const GW_CHILD = 5
Private Declare _
Function GetWindow _
Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Dim DRHwnd As Long
Dim lToolbar As Long
Dim btnExportHwnd As Long
Dim btnPrintHWnd As Long
Dim lblHWnd As Long
Dim cboZoomHWnd As Long
'Determina l'handle della toolbar
DRHwnd = DataReport1.hWnd
DRHwnd = GetWindow(DRHwnd, GW_CHILD)
DRHwnd = GetWindow(DRHwnd, GW_CHILD)
lToolbar = GetWindow(DRHwnd, GW_CHILD)
'Pulsante PRINT
btnPrintHWnd = GetWindow(lToolbar, GW_CHILD)
'Pulsante EXPORT
btnExportHWnd = GetWindow(btnPrintHWnd, GW_HWNDNEXT)
'Label della combo di ZOOM
lblHWnd = GetWindow(btnExportHwnd, GW_HWNDNEXT)
'ComboBox ZOOM
cboZoomHWnd = GetWindow(lblHWnd, GW_HWNDNEXT)
Ora che abbiamo ottenuto l'indirizzo dei singoli elementi che compongono la nostra toolbar, siamo in grado d'intervenire a piacere: ad esempio potrebbe tornarci utile nasconderne o disabilitarne uno.
Private Declare _
Function ShowWindow _
Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare _
Function EnableWindow _
Lib "user32" (ByVal hWnd As Long, ByVal fEnable As Long) As Long
'Nasconde il pulsante PRINT
ShowWindow btnPrintHWnd, False
'Disabilita il pulsante EXPORT
EnableWindow btnExportHWnd, False
'Disabilita il combo box ZOOM
EnableWindow cboZoomHWnd, False
Oppure impostare automaticamente il fattore di "zoom" ad un determinato valore.
Ecco il codice per selezionare un valore nella combo dello Zoom:
Private Declare Function SendMessage _
Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const CB_SELECTSTRING As Long = &H14D
'Seleziona lo ZOOM al 150%
SendMessage cboZoomHWnd, CB_SELECTSTRING, -1, ByVal "150%"
Ma il massimo lo si ottiene aggiungendo un pulsante in più a quelli già esistenti, utilissimo per estendere le funzionalità dell'anteprima. Comodissima e ultramoderna potrebbe essere l'esportazione in formato PDF:
Private Declare Function CreateWindowEx Lib "user32" _
Alias "CreateWindowExA" _
(ByVal dwExStyle As Long, _
ByVal lpClassName As String, _
ByVal lpWindowName As String, _
ByVal dwStyle As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hWndParent As Long, _
ByVal hMenu As Long, _
ByVal hInstance As Long, _
lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Const WS_CHILD = &H40000000
Private Const WS_VISIBLE = &H10000000
Private Const WM_GETFONT = &H31
Private Const WM_SETFONT = &H30
Dim btnWindow As Long
Dim Font As Long
btnWindow = CreateWindowEx(0, "BUTTON", "Hello", WS_CHILD Or WS_VISIBLE, 300, 3, 80, 20, _
lToolbar, 0, App.hInstance, 0)
Font = SendMessage(lToolbar, WM_GETFONT, 0, 0)
SendMessage btnWindow, WM_SETFONT, Font, 0
Meglio ancora se mettiamo sul pulsante un'immagine esplicativa:
Private Const BS_ICON = &H40&
Private Const BS_BITMAP = &H80&
Private Declare _
Function LoadImage _
Lib "user32" _
Alias "LoadImageA" _
(ByVal hInst As Long, _
ByVal lpsz As String, _
ByVal un1 As Long, _
ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal un2 As Long) As Long
Dim btnWindow1 As Long
Dim btnWindow2 As Long
Dim Font As Long
Dim Img As Long
btnWindow1 = CreateWindowEx(0, "BUTTON", "Hello", WS_CHILD Or WS_VISIBLE Or BS_BITMAP, _
200, 3, 24, 24, lToolbar, 0, App.hInstance, 0)
btnWindow2 = CreateWindowEx(0, "BUTTON", "Hello", WS_CHILD Or WS_VISIBLE Or BS_ICON, _
250, 3, 24, 24, lToolbar, 0, App.hInstance, 0)
Img = LoadImage(0, "immagine.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
SendMessage btnWindow1, BM_SETIMAGE, IMAGE_BITMAP, ByVal Img
Img = LoadImage(0, "immagine.ico", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)
SendMessage btnWindow2, BM_SETIMAGE, IMAGE_ICON, ByVal Img
Questo è il risultato che possiamo ottenere.
Ovviamente tutto questo sarebbe praticamente inutile senza che poi si possano
intercettare gli eventi dei pulsanti, e qui dobbiamo per forza rivolgersi
al SubClassing.
Il codice seguente permette di intercettare gli eventi di un bottone presente
sulla ToolBar:
' .........Module1.bas..........
Public Declare Function SetWindowLong Lib "user32.dll" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nindex As Long, _
ByVal dwnewlong As Long) As Long
Public Declare Function CallWindowProc Lib "user32.dll" _
Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
lParam As Long) As Long
Public Const WM_LBUTTONUP = &H202
Public Const GWL_WNDPROC = (-4)
Public myOldhWndProc As Long
Public Sub SubclassButton(phWnd As Long)
myOldhWndProc = SetWindowLong(phWnd, GWL_WNDPROC, AddressOf MyWindowProc)
End Sub
Public Function MyWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, lParam As Long) As Long
If uMsg = WM_LBUTTONUP Then
Beep
End If
MyWindowProc = CallWindowProc(myOldhWndProc, hWnd, uMsg, wParam, lParam)
End Function
Ed ecco il codice per attivare il subclassing di uno dei bottoni inseriti:
SubclassButton btnWindow1
Conclusione
Spero con questo articolo di aver dimostrato definitivamente come, nonostante
gli estremi limiti del DataReport, sia possibile piegare questo strumento
ad esigenze avanzate che apparirebbero irrealizzabili ad un primo esame.
Invito pertanto coloro che hanno esigenze di stampa all'interno dei propri
applicativi, a non sottovalutare l'oggetto in questione perché, a differenza
di altri prodotti, consente un controllo totale via codice e permette, con
un po' di creatività, di ottenere dei risultati professionali.
Il codice di esempio a corredo di questo articolo è scaricabile dall'Area
Download.
aggiunto su richiesta: l'esempio di subclassing
In merito a quest'articolo, per ciascuna delle sue parti, potete scrivere
all'autore Amedeo Fantini.