Newsgroup: it.comp.appl.access
Titolo: Re:(Alex Baraldi) Variazione Dimensione Casella Combinata

Anche se ti capisco, ho impiegato parecchio anch'io a capirla ai tempi,
LEBANS è famoso sia per la sua Bravura che per la Complessità delle
sue soluzioni.....!
Purtroppo non ho molto tempo in questo periodo, pertanto non mi è
realmente possibile darti un supporto più spinto.
Se per te la cosa non è urgente(importante), mandami una Mail tra 2
settimane,
per quel tempo sarò in sede, quindi a casa...... ed avrò più tempo
per dedicarmi ad Access......!
La mail l'ho mandata ma non ricevuto nessuna risposta-commento.
ciao

 ha scritto nel messaggio
news:2vhgssF...@uni-berlin.de...

La mail non l'ho ricevuta(Libero mi riempie di spazzatura ed alcune volte
la casella è piena).
Rimandala e rispiegami il problema perchè non ricordo più.... sono passate
ben più di 2 settimane...!
Ovviamente non garantisco nulla.
Ciao
-- 
@Alex (Alessandro Baraldi)
---------------------------------------------------------------------------
http://www.sitocomune.com/
http://www.mantuanet.it/alessandro.baraldi/
---------------------------------------------------------------------------

 wrote in message
news:cn06lj$3gn$1...@lacerta.tiscalinet.it...

La mail l'ho rispedita. Ma non ho capito se l'hai ricevuta.
Ciao

 Ciao
Giorgio ciao.
Ad oggi non l'ho ricevuta, oppure aveva un'allegato.
Le mail con allegati non le leggo nemmeno.
Non sò che dirti.
Mandala con OGGETTO: ACCESS LISTBOX poi vediamo..!
Ciao
@Alex
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG
Mail spedita (cercala per oggetto), con riassunto delle puntate precedenti.
No allegati.
Ciao

 Ciao
Ma dove l'hai spedita...?
Non è arrivato nulla..!!
ik2...@libero.it
Boh....
Ciao
@ALex


[cut]
L'ho rispedita.
A me, nessuna di quelle spedite a quell'indizizzo č tornata indietro.
Stamattina libero ha qualche problema con la posta.
Non č che hai qualche filtro particolare ?
ciao

 ciao
Magari....!
In realtà libero lo uso via Internet solamente in quanto
non pagherei mai Libero come Provider di Posta.
Questo per dire che non ho nessunissimo filtro, lo dimostrano
le 25/30 Mail Spazzatura al gg che arrivano.
Ribadisco che alle 13.00 non è arrivata la tua mail.
Ciao
@Alex


 wrote in message 
news:de408e0c791e914150...@mygate.mailgate.org...

Neanch'io so cosa dire nel senso che ho testato i miei account di posta, in 
invio e ricezione e la mail che ho mandato a libero l'ho vista dopo 3 
minuti. Quindi escludo problemi nell'invio. Comunque in sostanza la mail 
conteneva la richesta ( se possibile) della soluzione del quesito posto in 
questo newsgroup "Variazione Dimensione Casella Combinata" comparso la prima 
volta giovedì 14 ottobre 2004 alle 10.24. Il Ridimensionamento dell'Item 
Selezionato e della Colonna Visibile.
ciao 

 ciao
L'argomento lo ricordo vagamente, ma poichč da quanto ho capito 
in seguito ai miei suggerimenti non sei riuscito a realizzarlo,
si puň affrontare in 2 modi:
1)Lo faccio io che faccio prima, ma per questo occorre avere le
idee chiare, e gentilmente a prescindere dai post del tempo che fů.
Questa soluzione non mi piace e vorrei evitarla.
2)Potremo approfondire sul NG la tecnica, ma per questo occorre
una preparazione di VBA sufficiente per la comprensione di aiuti
e non di rifacimenti.
Detto questo.... vedi tu.


[cut]
Questo è il codice:
Option Compare Database
Option Explicit
Private Const AdjustForScreen = 70
Private Const SM_CXVSCROLL = 2
Public Const TwipsPerInch = 1440
Private Const LOGPIXELSX = 88        '  Logical pixels/inch in X
Private Const LOGPIXELSY = 90        '  Logical pixels/inch in Y
Private Const HWND_DESKTOP = 0
Private Const DEFAULT_CHARSET = 1
Private Const LF_FACESIZE = 32
Public Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName(1 To LF_FACESIZE) As Byte
End Type
Public Type TEXTMETRIC
    tmHeight As Long
    tmAscent As Long
    tmDescent As Long
    tmInternalLeading As Long
    tmExternalLeading As Long
    tmAveCharWidth As Long
    tmMaxCharWidth As Long
    tmWeight As Long
    tmOverhang As Long
    tmDigitizedAspectX As Long
    tmDigitizedAspectY As Long
    tmFirstChar As Byte
    tmLastChar As Byte
    tmDefaultChar As Byte
    tmBreakChar As Byte
    tmItalic As Byte
    tmUnderlined As Byte
    tmStruckOut As Byte
    tmPitchAndFamily As Byte
    tmCharSet As Byte
End Type
Private Type POINTAPI
    x As Long
    Y As Long
End Type
Private Type Size
    cx As Long
    cy As Long
End Type
Private Type ControlSize
   XMax As Long
   YMax As Long
   YMin As Long
End Type
Private lngLogPixels As POINTAPI
Private Declare Function GetDeviceCaps _
 Lib "gdi32" _
 (ByVal hDC As Long, ByVal nIndex As Long) As Long
Public Declare Function GetSystemMetrics _
 Lib "user32" _
 (ByVal nIndex As Long) As Long
Private Declare Function GetDC _
 Lib "user32" _
 (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC _
 Lib "user32" _
 (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function MulDiv _
 Lib "kernel32" _
 (ByVal nNumber As Long, ByVal nNumerator As Long, _
 ByVal nDenominator As Long) As Long
Private Declare Function CreateFontIndirect _
 Lib "gdi32" Alias "CreateFontIndirectA" _
 (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject _
 Lib "gdi32" _
 (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject _
 Lib "gdi32" _
 (ByVal hObject As Long) As Long
Private Declare Function GetTextMetrics _
 Lib "gdi32" Alias "GetTextMetricsA" _
 (ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long
Private Declare Function GetTextExtentPoint32 _
 Lib "gdi32" Alias "GetTextExtentPoint32A" _
 (ByVal hDC As Long, ByVal lpsz As String, _
 ByVal cbString As Long, lpSize As Size) As Long
Public Function ResizeControl(ctl As Control, _
                               Optional blHeight As Boolean = True, _
                               Optional blWidth As Boolean = True, _
                               Optional maxWidth As Long = 35000, _
                               Optional blFirstColHidden As Boolean = False)
   Dim TwipsPerPixel As POINTAPI
   Dim lngMax() As Long
   Dim lngWidth As Long
   Dim strFont As String
   Dim intWeight As Integer
   Dim fItalic As Boolean
   Dim fUnderline As Boolean
   Dim lngHeight As Long
   Dim intSize As Integer
   Dim strText As String
   Dim intI As Integer
   Dim intCol As Integer
   Dim Scroll As Long
   Dim Sz As ControlSize
   Dim strWidth As String
   Dim blHead As Integer
   With ctl
       intSize = .fontsize
       strFont = .FontName
       intWeight = .FontWeight
       fItalic = .FontItalic
       fUnderline = .FontUnderline
       blHead = .ColumnHeads
   End With
   Call TwipsPixel
   ReDim lngMax(ctl.ColumnCount)
   For intI = 0 To ctl.ListCount + CInt(Not blHead)
      For intCol = 0 To ctl.ColumnCount - 1
         If intCol = 0 And blFirstColHidden Then
            lngMax(intCol) = 0
         Else
            strText = Nz(ctl.Column(intCol, intI), vbNullString)
            If TwipsFromFont(strFont, intSize, _
             intWeight, fItalic, fUnderline, 0, strText, _
             False, lngWidth, lngHeight) Then
                If lngWidth > lngMax(intCol) Then
                    lngMax(intCol) = lngWidth
                End If
            End If
         End If
      Next intCol
   Next intI
   TwipsPerPixel.x = TwipsPerInch / lngLogPixels.x
   Scroll = GetSystemMetrics(SM_CXVSCROLL) * TwipsPerPixel.x
   For intCol = 0 To ctl.ColumnCount - 1
      If intCol = 0 And blFirstColHidden Then
         Sz.XMax = 0
         strWidth = strWidth & "0;"
      Else
         If CInt(lngMax(intCol)) > 0 Then
            Sz.XMax = CInt(Sz.XMax + lngMax(intCol) + 100)
            strWidth = strWidth & CInt(lngMax(intCol) + 100) & ";"
         End If
      End If
   Next
   strWidth = strWidth & "0"
   Sz.XMax = Sz.XMax + AdjustForScreen
   If Sz.XMax > maxWidth Then Sz.XMax = maxWidth
   Sz.YMax = ctl.ListCount * lngHeight * 1.02 + AdjustForScreen
   Sz.YMin = lngHeight '+ AdjustForScreen
   If TypeOf ctl Is ListBox Then
      If blHeight Then ctl.Height = Sz.YMax
      If blWidth Then
         If ctl.ListCount * lngHeight < (ctl.Height) Then Scroll = 0
         ctl.Width = Sz.XMax + Scroll
      End If
   ElseIf TypeOf ctl Is ComboBox Then
      If blHeight Then ctl.Height = Sz.YMin
      If blWidth Then ctl.Width = Sz.XMax + Scroll
      ctl.ListWidth = Sz.XMax + Scroll
   End If
   ctl.ColumnWidths = strWidth
End Function
Private Function TwipsFromFont _
 (ByVal FontName As String, _
 ByVal Size As Long, _
 Optional ByVal Weight As Long = 400, _
 Optional ByVal Italic As Boolean = False, _
 Optional ByVal Underline As Boolean = False, _
 Optional ByVal TotalChars As Long = 0, _
 Optional ByVal Caption As String = "", _
 Optional ByVal UseMaxWidthCount As Long = 0, _
 Optional ByRef Width As Long, _
 Optional ByRef Height As Long) As Boolean
    Dim hDC As Long
    Dim lf As LOGFONT
    Dim tm As TEXTMETRIC
    Dim hFont As Long
    Dim hFontOriginal As Long
    Dim Sz As Size
    Dim lngTextWidth As Long
    Dim lngTextHeight As Long
    On Error Resume Next
    ' Assume failure
    TwipsFromFont = False
    ' Need a DC from which to get information.
    hDC = GetDC(HWND_DESKTOP)
    If hDC = 0 Then
        GoTo Exit3
    End If
    ' Oops, font name is too long.
    ' Get out now.
    If Len(FontName) > LF_FACESIZE - 1 Then
        GoTo Exit3
    End If
    ' Put the face name into the LOGFONT structure.
    Call SetFaceName(lf, FontName)
    ' Set the other characteristics of the font.
    With lf
        .lfHeight = -1 * MulDiv(Size, lngLogPixels.Y, 72)
        .lfWeight = Weight
        .lfItalic = Italic
        .lfUnderline = Underline
        .lfCharSet = DEFAULT_CHARSET
    End With
    ' Create an internal font object.
    hFont = CreateFontIndirect(lf)
    If hFont = 0 Then
        GoTo Exit2
    End If
    ' Select the new font in the DC, and store away the
    ' previous selected font.
    hFontOriginal = SelectObject(hDC, hFont)
    If hFontOriginal = 0 Then
        GoTo Exit1
    End If
    ' Get the text metrics for the font.
    If GetTextMetrics(hDC, tm) = 0 Then
        GoTo ExitHere
    End If
    If TotalChars > 0 Then
        ' If you're working with general characters,
        ' rather than specific text, use the maximum width
        ' for whichever is less, lngChars or lngUseMaxWidth.
        ' If lngUseMaxwidth is 0, this should return 0.
        Width = MulDiv(tm.tmMaxCharWidth * Min(TotalChars,
UseMaxWidthCount), TwipsPerInch, lngLogPixels.x)
        ' If there are characters in lngChars beyond
        ' the characters already "used", add their width
        ' on now.
        If TotalChars > UseMaxWidthCount Then
            Width = Width + MulDiv(tm.tmMaxCharWidth * (TotalChars -
UseMaxWidthCount), TwipsPerInch, lngLogPixels.x)
        End If
        ' Get the height.
        Height = MulDiv((tm.tmHeight + tm.tmExternalLeading), TwipsPerInch,
lngLogPixels.Y)
    Else
        ' If using specific text, get its width and height now.
        If GetTextExtentPoint32(hDC, Caption, Len(Caption), Sz) = 0 Then
            GoTo ExitHere
        End If
        ' Break apart the width and height values.
        lngTextWidth = Sz.cx
        lngTextHeight = Sz.cy
        ' Convert the values into twips.
        Width = MulDiv(lngTextWidth, TwipsPerInch, lngLogPixels.x)
        Height = MulDiv(lngTextHeight + tm.tmExternalLeading, TwipsPerInch,
lngLogPixels.Y)
    End If
    ' Return success.
    TwipsFromFont = True
ExitHere:
    Call SelectObject(hDC, hFontOriginal)
Exit1:
    Call DeleteObject(hFont)
Exit2:
    Call ReleaseDC(HWND_DESKTOP, hDC)
Exit3:
End Function
Public Sub SetFaceName(lf As LOGFONT, strValue As String)
    Dim intLen As Integer
    Dim intI As Integer
    Dim abytTemp() As Byte
    On Error GoTo HandleErrors
    abytTemp = StrConv(strValue, vbFromUnicode)
    intLen = UBound(abytTemp) + 1
    ' Make sure the string isn't too long.
    If intLen > LF_FACESIZE - 1 Then
        intLen = LF_FACESIZE - 1
    End If
    For intI = 1 To intLen
        lf.lfFaceName(intI) = abytTemp(intI - 1)
    Next intI
    ' Tack on a final Chr$(0).
    lf.lfFaceName(intI) = 0
ExitHere:
    Exit Sub
HandleErrors:
    Resume ExitHere
End Sub
Private Function Min(lngX As Long, lngY As Long) As Long
    If lngX < lngY Then
        Min = lngX
    Else
        Min = lngY
    End If
End Function
Private Sub TwipsPixel()
    Dim lngDC As Long
    lngDC = GetDC(HWND_DESKTOP)
    lngLogPixels.x = GetDeviceCaps(lngDC, LOGPIXELSX)
    lngLogPixels.Y = GetDeviceCaps(lngDC, LOGPIXELSY)
End Sub
Quello che desiderei è: es  data la combo1 su tabella1 campo id contatore,
campo testo nomi di località
1 milano
2 caltanissetta
3 bari
4 pordenone
la variazione della dimensine della combo a seconda del contenuto nel campo
località in modo da poterne leggere il contenuto.Mi sarebbe molto utile allo
scorrere dei record in maschera la variazione della dimensione così da
leggere tutto il contenuto del campo, non posso impostarlo fisso al massimo
altrimenti oltre ad un obrobio visivo vado a coprire altri controlli nella
maschera stessa.
Se mi indichi cosa cambiare nel codice penso di riuscire ad implementarlo
nel mio db.
Ciao

 End Function
'//    Tutto il RESTO SERVE.
Ovviamente non l'ho provata, ma riguardando il Codice originario
di Lebans, che modificai qualche anno fà dovrebbe essere giusto.
Ciao
-- 
@Alex (Alessandro Baraldi)



 strText = Nz(ctl.Column(intCol, intI), vbNullString)
            If TwipsFromFont(strFont, intSize, _
             intWeight, fItalic, fUnderline, 0, strText, _
             False, lngWidth, lngHeight) Then
                If lngWidth > lngMax(intCol) Then
                    lngMax(intCol) = lngWidth
                End If
grazie 

 grazie
Prego



Errori di sintassi, errori di compilazione non ce ne sono piů. L'ho posta 
nell' after update della combo e fa il resize della combo stessa.
Si tratta ora di capire come implementarla correttamente, nel senso che fa 
il rezise della combo stessa ma quest'ultima diventa infima ed il contenuto 
illeggibile.
Su quali parametri devo intervenire per avere una dimensione minima ? A me 
serve solo piů grande della dimensione impostata se il contenuto ha un 
numero di caratteri tale da non consentire la lettura completa.
grazie ciao 

 grazie ciao
Questa fà esattamente quello che chiedi, l'ho provata e funziona.
la devi chiamare così:
Call ResizeControl (Me!NomeCombo,Me!NomeCombo.Column(x))
dove x è l'indice della Colonna da visualizzare.
Vedi un pò se può andare....!
Public Function ResizeControl(ctl As Control, strText As String)
   Dim TwipsPerPixel As POINTAPI
   Dim lngWidth As Long
   Dim strFont As String
   Dim intWeight As Integer
   Dim fItalic As Boolean
   Dim fUnderline As Boolean
   Dim lngHeight As Long
   Dim intSize As Integer
   Dim Scroll As Long
   Dim Sz As ControlSize
   Dim strWidth As String
   Dim blHead As Integer
   With ctl
       intSize = .fontsize
       strFont = .FontName
       intWeight = .FontWeight
       fItalic = .FontItalic
       fUnderline = .FontUnderline
       blHead = .ColumnHeads
   End With
   Call TwipsPixel
   Call TwipsFromFont(strFont, intSize, _
             intWeight, fItalic, fUnderline, 0, strText, _
             False, lngWidth, lngHeight)
 
 
   TwipsPerPixel.x = TwipsPerInch / lngLogPixels.x
   Scroll = GetSystemMetrics(SM_CXVSCROLL) * TwipsPerPixel.x
   Sz.XMax = CInt(Sz.XMax + lngWidth + 100)
   strWidth = strWidth & CInt(lngWidth + 100) & ";"
   strWidth = strWidth & "0"
   Sz.XMax = Sz.XMax + AdjustForScreen
   If TypeOf ctl Is ComboBox Then
      ctl.Width = Sz.XMax + Scroll
   End If
End Function
Ciao.


 wrote in message 
news:e7b7ac1c0f5de8caad...@mygate.mailgate.org...

Perfetta.
Ancora 2 curiosità.
1) si può inpostare una dimensione minima del controllo in cm o pixel ?
2) si potrebbe usare anche per una testbox ?
ciao 

 ciao
Buon lavoro.
Ciao


 Certamente, modificando il codice in modo opportuno.
Basta modificare la parte della funzione ResizeControl o bisogna modificare 
anche altre parti ?
ciao
grazie


 Vedi un pň se puň andare....!

Scusate se m'intrometto,
sto cercando di utilizzare la funzione postata da Alessandro ma mi dŕ questo
messaggio:
"Errore di compilazione: tipo definito dall'utente non definito" ed
evidenzia la riga:
Dim TwipsPerPixel As POINTAPI
uso Office 2003.
Cosa posso fare?
Ciao e Grazie
Giuseppe

 Giuseppe
Ciao Giuseppe.
La funzione è ripresa da un Modulo pertanto ovviamente non può andare, in
quanto
lo stesso prevede molte altre cose...!
Scarica dal mio sito questo demo:
Sezione    [Forms]
        Resize List/Combo_Box
Ciao



Grazie
Giuseppe