MSFlexGrid Veränderung einer Spaltenbreite

MSFlexGrid Veränderung einer Spaltenbreite

'------------- Anfang Projektdatei Project1.vbp -------------
' Die Komponente 'Microsoft FlexGrid Control 6.0 (SP6) (MSFLXGRD.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm ---------
' Steuerelement: Flexible Tabelle "MSFlexGrid1"

Option Explicit

Private ColWidth() As Integer

Private Sub Form_Load()
Dim x%
ReDim ColWidth(MSFlexGrid1.Cols - 1)

For x = 0 To MSFlexGrid1.Cols - 1
ColWidth(x) = MSFlexGrid1.ColWidth(x)
Next x

GridhWnd = MSFlexGrid1.hWnd
Call Init
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call Terminate
End Sub

Public Sub MSFlexGrid1_ColResize()
Dim x%, Dif&

With MSFlexGrid1
For x = 0 To .Cols - 1
Dif = .ColWidth(x) - ColWidth(x)
If Dif <> 0 Then
Me.Caption = "Spalte " & x & " um " & Dif _
& " Twips geändert"
ColWidth(x) = .ColWidth(x)
Exit For
End If
Next x
End With
End Sub
'---------- Ende Formular "Form1" alias Form1.frm ----------
'--------- Anfang Modul "Module1" alias Module1.bas ---------

Option Explicit

Public Declare Function CallWindowProc Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal _
hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long

Const GWL_WNDPROC = -4
Const WM_LBUTTONUP = &H202

Public GridhWnd&
Dim PrevProc&

Public Sub Init()
PrevProc = SetWindowLong(GridhWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub Terminate()
Dim Result&
Result = SetWindowLong(GridhWnd, GWL_WNDPROC, PrevProc)
End Sub

Function WindowProc(ByVal hWnd&, ByVal uMsg&, ByVal wParam&, ByVal _
lParam&) As Long
WindowProc = CallWindowProc(PrevProc, hWnd, uMsg, wParam, lParam)
If uMsg = WM_LBUTTONUP Then Form1.MSFlexGrid1_ColResize
End Function
'---------- Ende Modul "Module1" alias Module1.bas ----------
'-------------- Ende Projektdatei Project1.vbp --------------