473,559 Members | 2,982 Online
Bytes | Software Development & Data Engineering Community
+ Post

Home Posts Topics Members FAQ

Virtual listbox (need to handle more than 32767 lines) How to get it to work ?

Hello All,

I'm trying to get a "Virtual Listbox" to work. I've currently got a form,
and used CreateWindowExA to create a ListBox with the LBS_OWNERDRAWFI XED and
LBS_NODATA flags on it. I've allso subclassed the window and do see all
kinds of WS_??? messages coming by.

But now I'm stuck :-\

I've got *no* idea what to do next, and all my searching on the web leads me
to examples that are, as far as I can see, incomplete in regard to using it
under classic VB (They're targetted at the .NET environment).

I have, to test if the whole actually worked, changed the ListBox back to a
normal one, and that went o.k (all items, added with a SendMAessage using
LB_ADDSTRING where shown).

So, can somebody please tell me how to continue ? :-)

Regards,
Rudy Wieser

Jul 17 '05 #1
6 7856
I believe Bryan has a virtual listbox demo at www.mvps.org/vbvision/

--

Randy Birch
MVP Visual Basic
http://www.mvps.org/vbnet/
Please respond only to the newsgroups so all can benefit.
"R.Wieser" <rw************ ***@xs4all.nl> wrote in message
news:3f******** *************@d reader5.news.xs 4all.nl...
: Hello All,
:
: I'm trying to get a "Virtual Listbox" to work. I've currently got a
form,
: and used CreateWindowExA to create a ListBox with the LBS_OWNERDRAWFI XED
and
: LBS_NODATA flags on it. I've allso subclassed the window and do see all
: kinds of WS_??? messages coming by.
:
: But now I'm stuck :-\
:
: I've got *no* idea what to do next, and all my searching on the web leads
me
: to examples that are, as far as I can see, incomplete in regard to using
it
: under classic VB (They're targetted at the .NET environment).
:
: I have, to test if the whole actually worked, changed the ListBox back to
a
: normal one, and that went o.k (all items, added with a SendMAessage using
: LB_ADDSTRING where shown).
:
: So, can somebody please tell me how to continue ? :-)
:
: Regards,
: Rudy Wieser
:
:
:
Jul 17 '05 #2
On Mon, 8 Dec 2003 23:19:00 +0100, "R.Wieser"
<rw************ ***@xs4all.nl> wrote:
Hello All,

I'm trying to get a "Virtual Listbox" to work. I've currently got a form,
and used CreateWindowExA to create a ListBox with the LBS_OWNERDRAWFI XED and
LBS_NODATA flags on it. I've allso subclassed the window and do see all
kinds of WS_??? messages coming by.


<snip>

One of the first things I did when I moved from VB4 to VB5 was to
build a UserControl that fronts a small ListBox and a VScrollBar
(the VScrollBar needs 'scaling' to allow values above 32766)

I simply RaiseEvent for each line of data to display, and shove it in
the small Listbox
- it could be made a little more efficient
- but I and others have been using it for years
Jul 17 '05 #3
J French <er*****@nowher e.com> schreef in berichtnieuws
3f************* *@news.btclick. com...
On Mon, 8 Dec 2003 23:19:00 +0100, "R.Wieser"
<rw************ ***@xs4all.nl> wrote:


Hello J. ,
Hello All,

I'm trying to get a "Virtual Listbox" to work. I've currently got a form,and used CreateWindowExA to create a ListBox with the LBS_OWNERDRAWFI XED andLBS_NODATA flags on it. I've allso subclassed the window and do see all
kinds of WS_??? messages coming by.


<snip>

One of the first things I did when I moved from VB4 to VB5 was to
build a UserControl that fronts a small ListBox and a VScrollBar
(the VScrollBar needs 'scaling' to allow values above 32766)

I simply RaiseEvent for each line of data to display, and shove it in
the small Listbox
- it could be made a little more efficient
- but I and others have been using it for years


Maybe that's what I should do afterall ... Although the Virtual Listbox
seems to do about the same, it seems to require I handle all the displaying
of the actual data myself :-( It should have been nice if it would have
just asked me for the data, and would than display it.

Do you have any (pointer to an) example handy, preferrable in, the by you
mentioned, "classic" VB ?

Regards,
Rudy Wieser

Jul 17 '05 #4
On Tue, 9 Dec 2003 16:19:20 +0100, "R.Wieser"
<rw************ ***@xs4all.nl> wrote:

<snip>

Maybe that's what I should do afterall ... Although the Virtual Listbox
seems to do about the same, it seems to require I handle all the displaying
of the actual data myself :-( It should have been nice if it would have
just asked me for the data, and would than display it.

Do you have any (pointer to an) example handy, preferrable in, the by you
mentioned, "classic" VB ?


Here is my little 'monster'
- it is slightly inefficient, but I've never bothered with that

VERSION 5.00
Begin VB.UserControl Epl
BackStyle = 0 'Transparent
ClientHeight = 3840
ClientLeft = 0
ClientTop = 0
ClientWidth = 3930
KeyPreview = -1 'True
ScaleHeight = 3840
ScaleWidth = 3930
ToolboxBitmap = "ePL.ctx":0 000
Begin VB.VScrollBar VScroll
Height = 2175
Left = 3240
TabIndex = 1
Top = 0
Width = 250
End
Begin VB.ListBox List1
Height = 2205
ItemData = "ePL.ctx":0 182
Left = 0
List = "ePL.ctx":0 189
TabIndex = 0
Top = 0
Width = 3255
End
End
Attribute VB_Name = "Epl"
Attribute VB_GlobalNameSp ace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredI d = False
Attribute VB_Exposed = False
Option Explicit: DefObj A-Z
' Properties : Current
' MaxRec
'
' 16/3/99 JF - version 2.00 - converted to Longs
' 1/4/99 JF - .Refill() added
' 2/4/99 JF - Refresh now performs a complete recalc/resize
' Tabs Added, Scrollbar only if large list
' 30/4/99 JF - Prevent asking for Recs over MaxRec
' Added Horiz Option - Bodge for now
' 28/10/99 JF - LinesInBox added
' 11/10/00 JF - List1.Clear moved
' THIS VERSION MOVED TO C:\DEV\AMACC
' Lock Window Update tested - no real use
' Failed experiment with Timer
' 20/07/01 JF - RightButtonPrev iew added - reduce flicker
' RefreshOffFlag added, Setup Added
' 7/12/03 JF - SetFixedTabs (bad parameter - Variant)

' --- Properties --
' MaxRec&
' Current&
' Setup(MaxRec&, Current&) - Does both at the same time
' DisableFlag - stops refresh via callbacks
' RefreshOffFlag - disables screen activity
' HorizOffset - Offset for Line Display - in Chars
' HorizWidth - List Width in Chars
' Enabled
' Font
' BackColor
' ForeColor
' LinesOnPage% - Get - No of Lines (may be less than LinesInBox)
' LinesInBox - Get and Set
' LineRec( LineNo )

' --- Calls ---
' Refresh
' ReDraw - Like Refill but uses internal info
' Refill( Rec& ) - Rec = 0 Refills all Rec <> 0 then
refreshes Rec
' TabsOff - Sets Tabs to every 8 Chars (Default)
' SetFixedTabs(In terval) - Interval is Chars
' SetTabWidths(T& ()) - T$(0) is No of items, T(1) - T(N) tab pos
in chars

' --- Public Events ---
Public Event GetData(Rec&, DispLine$)
Public Event Selected(Rec&)
Public Event RightButtonSele cted(Rec&)
Public Event LeftButtonSelec ted(Rec&)
Public Event RightButtonPrev iew(NewRec&, HandledFlag As Boolean)
Public Event DoubleClick()
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event EscapeKey()
Public Event CurrentChanged( Rec&)
Public Event UserFormatLine( Rec&, Raw$, DispLine$)
Public Event MouseOver()

' --- Internal ---
Private Declare Function LockWindowUpdat e Lib "user32" _
(ByVal hwndLock As Long) As Long
Private Declare Function UpdateWindow Lib "user32" _
(ByVal hWnd As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessag eA"
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam
As Any) As Long
Private Declare Function SendMessageBynu m Lib "user32" Alias
"SendMessag eA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam
As Long, ByVal lParam As Long) As Long
Private Declare Function SendMessageBySt ring Lib "user32" Alias
"SendMessag eA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam
As Long, ByVal lParam As String) As Long

Private Const LB_ADDSTRING = &H180
Private Const LB_INSERTSTRING = &H181
Private Const LB_DELETESTRING = &H182
Private Const LB_SELITEMRANGE EX = &H183
Private Const LB_RESETCONTENT = &H184
Private Const LB_SETSEL = &H185
Private Const LB_SETCURSEL = &H186
Private Const LB_GETSEL = &H187
Private Const LB_GETCURSEL = &H188
Private Const LB_GETTEXT = &H189
Private Const LB_GETTEXTLEN = &H18A
Private Const LB_GETCOUNT = &H18B
Private Const LB_SELECTSTRING = &H18C
Private Const LB_DIR = &H18D
Private Const LB_GETTOPINDEX = &H18E
Private Const LB_FINDSTRING = &H18F
Private Const LB_GETSELCOUNT = &H190
Private Const LB_GETSELITEMS = &H191
Private Const LB_SETTABSTOPS = &H192
Private Const LB_GETHORIZONTA LEXTENT = &H193
Private Const LB_SETHORIZONTA LEXTENT = &H194
Private Const LB_SETCOLUMNWID TH = &H195
Private Const LB_ADDFILE = &H196
Private Const LB_SETTOPINDEX = &H197
Private Const LB_GETITEMRECT = &H198
Private Const LB_GETITEMDATA = &H199
Private Const LB_SETITEMDATA = &H19A
Private Const LB_SELITEMRANGE = &H19B
Private Const LB_SETANCHORIND EX = &H19C
Private Const LB_GETANCHORIND EX = &H19D
Private Const LB_SETCARETINDE X = &H19E
Private Const LB_GETCARETINDE X = &H19F
Private Const LB_SETITEMHEIGH T = &H1A0
Private Const LB_GETITEMHEIGH T = &H1A1
Private Const LB_FINDSTRINGEX ACT = &H1A2
Private Const LB_SETLOCALE = &H1A5
Private Const LB_GETLOCALE = &H1A6
Private Const LB_SETCOUNT = &H1A7
Private Const LB_MSGMAX = &H1A8

Private Const LB_INITSTORAGE = &H1A8
Private Const LB_ITEMFROMPOIN T = &H1A9

Private Const WM_SETREDRAW = &HB
Private mNewListIndex%, mTopRec&, mListBoxLines!, mMaxRec&
Private mWithScrollWidt h%, mNoScrollWidth%
Private mListLineHeight !, mRealListBoxLin es!
Private mVSB_Min&, mVSB_Max&, mVSB_Value&, mVSB_Factor#
Private mInRoutineFlag As Boolean
Private mInVSBChangeFla g As Boolean
Private mDisableFlag As Boolean
Private mHorizOffset As Integer
Private mLine$()
Private mInitializedFla g As Boolean
Private mRefreshOffFlag As Boolean

'
=============== =============== =============== =============== =============== ====
'
' Public Properties Specific to This Control
'
'
############### ############### ############### ############### ############### ####
'
'
'
Public Sub Setup(MaxRec&, Current&)
Dim H As Boolean

H = mRefreshOffFlag
mRefreshOffFlag = True
If List1.ListCount = 0 Then List1.AddItem "" ' very first time in
Me.MaxRec = MaxRec
mRefreshOffFlag = H
Me.Current = Current

End Sub
'
############### ############### ############### ############### ############### ####
'
' Get/Set the Number of Items in the Pick List
'
Public Property Let MaxRec(Value&)
mMaxRec = Value
Call m_EplSetVsbMax
End Property
Public Property Get MaxRec() As Long
MaxRec = mMaxRec
End Property

'
############### ############### ############### ############### ############### ####
'
' Get/Set the Current (Active) Record in the Pick List
'
Public Property Get Current() As Long
Current = mTopRec + List1.ListIndex
End Property

Public Property Let Current(Value As Long)
Dim Rec&, V&, Q&

V = Value
If V < 1 Or V > mMaxRec Then
MsgBox ("Invalid Epl.Current =" + Str$(V))
If V < 1 Then V = 1
If V > MaxRec Then V = MaxRec
End If
Rec = V

' --- Simpy a check that there is a ListIndex - Debug
If List1.ListIndex < 0 Then
If List1.ListCount > 0 Then
If mRefreshOffFlag = False Then
MsgBox ("EPL1 - Set Current - NO LIST INDEX")
End If
List1.ListIndex = 0 ' make something selected
End If
End If

mNewListIndex = List1.ListIndex

' handle a move past highest top
If V > mVSB_Max Then
V = mVSB_Max
mNewListIndex = Rec - V
End If

' handle a small move on the same page
Q = V - mVSB_Value
If Q >= 0 And Q < mListBoxLines Then
V = mVSB_Value
End If

V = Rec - mNewListIndex
If V < mVSB_Min Then
V = mVSB_Min
mNewListIndex = Rec - V
End If

mTopRec = 0
Q = mVSB_Value
mVSB_Value = V
Call mVSB_Change
End Property

'
############### ############### ############### ############### ############### ####
'
'
Public Property Get RefreshOffFlag( ) As Boolean
RefreshOffFlag = mRefreshOffFlag
End Property

Public Property Let RefreshOffFlag( Value As Boolean)
mRefreshOffFlag = Value
End Property
'
############### ############### ############### ############### ############### ####
'
' Get/Set the Disable Flag - Goes not Callback GetData
'
Public Property Get DisableFlag() As Boolean
DisableFlag = mDisableFlag
End Property

Public Property Let DisableFlag(Val ue As Boolean)
mDisableFlag = Value
End Property
'
############### ############### ############### ############### ############### ####
'
'
Public Property Get HorizOffset() As Integer
HorizOffset = mHorizOffset
End Property
Public Property Let HorizOffset(Val ue As Integer)
Dim L9%

If Value < 0 Then _
Value = 0
If mHorizOffset <> Value Then
mHorizOffset = Value
For L9 = 0 To List1.ListCount - 1
List1.List(L9) = LF_FormatLine(m TopRec + L9, mLine$(L9))
Next
End If
End Property
'
############### ############### ############### ############### ############### ####
'
'
Public Property Get HorizWidth() As Integer
Dim Q%
If VScroll.Visible Then _
Q = VScroll.Width
HorizWidth = (List1.Width - Q) \ TextWidth("X")
End Property

'
############### ############### ############### ############### ############### ####
'
'
Public Property Get LinesOnPage() As Long
LinesOnPage = Int(mListBoxLin es)
End Property

'
############### ############### ############### ############### ############### ####
'
'
Public Property Get LinesInBox() As Long
LinesInBox = Int(mRealListBo xLines)
End Property
'
############### ############### ############### ############### ############### ####
'
'
Public Property Let LinesInBox(Valu e&)

Dim N%

N% = TextHeight("X") / 3

While mRealListBoxLin es < Value
Height = Height + N%
DoEvents
Wend
N = N / 2
While mRealListBoxLin es > Value
Height = Height - N
DoEvents
Wend
MaxRec = MaxRec ' Force Recalc and Current to 1

End Property

'
############### ############### ############### ############### ############### ####
'
'
Public Property Get LineRec(LineNo As Long) As Long
LineRec = mTopRec + LineNo - 1
If LineRec > mMaxRec Then _
LineRec = 0
End Property

'
=============== =============== =============== =============== =============== ====
'
' VB ONLINE RECOMMENDED FUNCTIONS
'
'
############### ############### ############### ############### ############### ####
'
' This is recommended by VB Book Online
'
' Select: Tools, Proceedure Attributes
' Enabled, Advanced - set Proc ID to Enabled
'
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_User MemId = -514
Enabled = UserControl.Ena bled
End Property

Public Property Let Enabled(ByVal Value As Boolean)
UserControl.Ena bled = Value
PropertyChanged "Enabled"
End Property
'
############### ############### ############### ############### ############### ####
'
' This is recommended by VB Book Online
'
Public Sub Refresh()
Dim H&
List1.Refresh
VScroll.Refresh
H = Current
Call UserControl_Res ize
If H > 0 And H <= mMaxRec Then _
Current = H
End Sub

'
############### ############### ############### ############### ############### ####
'
'
'
Sub SetFixedTabs(In terval%)
Dim Q&(1)
Q(0) = Interval * 2 ' Every N Chars
Call SendMessage(Lis t1.hWnd, LB_SETTABSTOPS, 1, Q&(0))
List1.Refresh
End Sub

'
############### ############### ############### ############### ############### ####
'
'
'
Sub TabsOff()
Dim Q&(1)
Q(0) = 32 ' Every 8 Chars
Call SendMessage(Lis t1.hWnd, LB_SETTABSTOPS, 1, Q&(0))
List1.Refresh
End Sub

'
############### ############### ############### ############### ############### ####
'
' TabWidth(0) = Number of Tabs
' TabWidth(1 to n) = Width of Each Field in Bytes
'
Sub SetTabWidths(Ta bWidth() As Long)
Dim Max&, L9%
If TabWidth(0) < 1 Or TabWidth(0) > UBound(TabWidth ) Then
MsgBox ("EPL.OCX - Bad TabWidth(0) in TabSetWidths")
End If
Max = TabWidth(0)
ReDim Q&(Max + 1)
For L9 = 1 To Max
Q(L9) TabWidth(L9) * 4 ' 4 Dialog Units Per Char
Q(L9) = Q(L9 - 1) + Q(L9)
Next
Call SendMessage(Lis t1.hWnd, LB_SETTABSTOPS, Max, Q&(1))
End Sub

'
=============== =============== =============== =============== =============== ====
'
' Appearance Properties
'
'
############### ############### ############### ############### ############### ####
'
' Explicitly Setting Colors Appears to be ESSENTIAL
' Otherwise it takes the Container's Colours
'
Private Sub UserControl_Ini tialize()
ForeColor = vbWindowText
BackColor = vbWindowBackgro und
' ---
mNewListIndex = 0
VScroll.Min = 0
VScroll.Max = 32000
mVSB_Min = 1
mVSB_Factor = 1
mMaxRec = 0
mTopRec = 0
If List1.ListCount = 1 Then _
List1.ListIndex = 0

End Sub
'
############### ############### ############### ############### ############### ####
'
' Refill the Box - 0 refills all
'
Public Sub Refill(Rec&)
Dim S$, LineIndex&
If Rec < 1 Then
mTopRec = 0
Call VScroll_Change
GoTo QUIT
End If
LineIndex = Rec& - mTopRec
If (LineIndex < 0) _
Or (LineIndex > List1.ListCount - 1) _
Or (Rec > mMaxRec) Then
GoTo QUIT
End If
Call LS_GetData(Rec& , mLine(LineIndex ))
List1.List(Line Index) = LF_FormatLine(R ec&, mLine$(LineInde x))
QUIT:
End Sub

'
############### ############### ############### ############### ############### ####
'
' ReDraws the lines - Like Refill but uses internal data
'
Public Sub ReDraw()
Dim L9%

For L9 = 0 To List1.ListCount - 1
List1.List(L9) = LF_FormatLine(m TopRec + L9, mLine$(L9))
Next
End Sub
'
############### ############### ############### ############### ############### ####
'
'
'
Public Property Get Font() As StdFont
Set Font = UserControl.Fon t
End Property

Public Property Set Font(F As StdFont)
Set UserControl.Fon t = F
Set List1.Font = F
PropertyChanged "Font"
Call UserControl_Res ize
End Property
'
############### ############### ############### ############### ############### ####
'
'
'
Public Property Get BackColor() As OLE_COLOR
BackColor = UserControl.Bac kColor
End Property

Public Property Let BackColor(Q As OLE_COLOR)
UserControl.Bac kColor = Q
List1.BackColor = Q
PropertyChanged "BackColor"
Call Refresh
End Property
Public Property Get ForeColor() As OLE_COLOR
ForeColor = UserControl.For eColor
End Property

Public Property Let ForeColor(Q As OLE_COLOR)
UserControl.For eColor = Q
List1.ForeColor = Q
PropertyChanged "ForeColor"
Call Refresh
End Property
'
############### ############### ############### ############### ############### ####
'
'
'
Private Sub UserControl_Rea dProperties(Pro pBag As PropertyBag)

mInitializedFla g = True
Set Font = PropBag.ReadPro perty("Font", Ambient.Font)
ForeColor = PropBag.ReadPro perty("ForeColo r", vbWindowText)
BackColor = PropBag.ReadPro perty("BackColo r", vbWindowBackgro und)
End Sub
Private Sub UserControl_Wri teProperties(Pr opBag As PropertyBag)
Call PropBag.WritePr operty("Font", Font, Ambient.Font)
Call PropBag.WritePr operty("ForeCol or", ForeColor, vbWindowText)
Call PropBag.WritePr operty("BackCol or", BackColor,
vbWindowBackgro und)
End Sub
'
=============== =============== =============== =============== =============== ====
'
' MAIN ROUTINES FOLLOW
'
'
############### ############### ############### ############### ############### ####
'
'
'
Private Sub List1_MouseMove (Button As Integer, Shift As Integer, X As
Single, Y As Single)
RaiseEvent MouseOver
End Sub
'
############### ############### ############### ############### ############### ####
'
'
'
Private Sub m_EplSetVsbMax( )
Call UserControl_Res ize
' --- and refresh the listbox
mNewListIndex = 0
mVSB_Value = 0
mTopRec = 0
Call mVSB_Change
End Sub

'
############### ############### ############### ############### ############### ####
'
'
'
Private Sub UserControl_Res ize()

Dim H&

H = Current

Set List1.Font = UserControl.Fon t
List1.Top = 0
VScroll.Top = 0
If Width > 250 Then
VScroll.Width = 250
Else
VScroll.Width = Width \ 2
End If

mWithScrollWidt h = ScaleWidth - VScroll.Width
mNoScrollWidth% = ScaleWidth

List1.Width = ScaleWidth - VScroll.Width
List1.Height = ScaleHeight
VScroll.Height = List1.Height
List1.Left = 0
VScroll.Left = ScaleWidth - VScroll.Width

' all this finds the number of lines in the ListBox
mListLineHeight = TextHeight("XXX ")
mRealListBoxLin es = List1.Height \ mListLineHeight
mListBoxLines = mRealListBoxLin es

' --- this resets mRealListboxLin es
If mListBoxLines > mMaxRec Then _
mListBoxLines = mMaxRec

' --- we need to reset the VSB max
Call LS_DoVsbCalcs

If H > 1 Then _
If H <= MaxRec Then _
Current = H

' --- If in Design Mode - And Control is Initialized
If mInitializedFla g Then
If Ambient.UserMod e = False Then
List1.Clear
List1.AddItem "EPL ISS Easy Pick List"
List1.ListIndex = 0
End If
End If
End Sub
'
############### ############### ############### ############### ############### ####
'
'
'
Private Sub LS_DoVsbCalcs()
Dim Q&

If mListBoxLines >= mMaxRec Then
List1.Width = mNoScrollWidth
VScroll.Visible = False
Else
List1.Width = mWithScrollWidt h
VScroll.Visible = True
End If

mVSB_Min = 1
mVSB_Max = mMaxRec - mListBoxLines + 1

mVSB_Factor = mVSB_Max / 32000
Q = 32000 / mVSB_Max
If Q < 1 Then _
Q = 1
VScroll.SmallCh ange = Q
VScroll.LargeCh ange = Q

' --- and refresh the listbox
' mNewListIndex = 0
' mVSB_Value = 0
' mTopRec = 0
' Call mVSB_Change
End Sub

'
############### ############### ############### ############### ############### ####
'
' Trap a Right Mouse Click
'
Private Sub List1_MouseDown (Button As Integer, Shift As Integer, X As
Single, Y As Single)
Dim V#, Item%, HandledFlag As Boolean

V# = Y / List1.Height ' %age of total height
V# = mRealListBoxLin es * V# ' convert to line
Item = Int(V# + 0.1)
List1.SetFocus
If Item < mListBoxLines Then
If Button = vbRightButton Then
RaiseEvent RightButtonPrev iew(mTopRec + Item, HandledFlag)
If HandledFlag Then Exit Sub
End If
mNewListIndex = Item
Call mVSB_Change
If Button = vbRightButton Then
RaiseEvent RightButtonSele cted(Current) ' Current is a
property
Else
RaiseEvent LeftButtonSelec ted(Current)
End If
End If
' End If
End Sub
'
############### ############### ############### ############### ############### ####
'
'
'
Private Sub UserControl_Key Down(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode , Shift)
If KeyCode Then _
Call OverrideKeyHand ler(KeyCode, Shift)
End Sub

'
############### ############### ############### ############### ############### ####
'
'
'
Private Sub OverrideKeyHand ler(KeyCode%, Shift%)

Dim lMove%, vMove%, Q&

mNewListIndex = List1.ListIndex

Select Case KeyCode
Case vbKeyUp, vbKeyLeft: lMove = -1
Case vbKeyDown, vbKeyRight: lMove = 1
Case vbKeyHome: mVSB_Value = mVSB_Min: mNewListIndex = 0
Case vbKeyEnd: mVSB_Value = mVSB_Max: mNewListIndex =
mListBoxLines - 1
Case vbKeyPageUp: vMove = -mListBoxLines
Case vbKeyPageDown: vMove = mListBoxLines
Case vbKeyEscape: RaiseEvent EscapeKey: GoTo QUIT
Case vbKeyReturn: Call List1_DblClick: GoTo QUIT
Case Else: GoTo QUIT
End Select
' moves within the list box
If lMove Then
Q = mNewListIndex + lMove
If Q >= mListBoxLines Then
lMove = 0
vMove = 1
End If
If Q < 0 Then
lMove = 0
vMove = -1
End If
mNewListIndex = mNewListIndex + lMove
End If

' --- VSB Moves
If vMove Then
Q = mVSB_Value + vMove
mVSB_Value = Us_MinMax(Q, mVSB_Min, mVSB_Max)
End If

' --- Call the mover even though
' we only moved within the box
' as we need to set the VScroll Bar & may refresh box
' also we need to set List1.ListIndex

Call mVSB_Change

KeyCode = 0

QUIT:

End Sub
'
############### ############### ############### ############### ############### ####
'
' This is triggered by : 1) A Click
' 2) Any Change in List1.ListIndex
'
Private Sub List1_Click()
If mInRoutineFlag = False Then
mNewListIndex = List1.ListIndex
Call mVSB_Change
End If
End Sub

'
############### ############### ############### ############### ############### ####
'
'
'
Private Sub List1_DblClick( )
RaiseEvent Selected(Curren t) ' Current is a property
End Sub

'############## ############### ############### ############### ############### ##########
'
' This is the MAIN routine for triggering any moves
'
Private Sub mVSB_Change()
Dim Q%, H%
mInVSBChangeFla g = True ' Suppress a later recalc of
mVSB_Value

mVSB_Value = Us_MinMax(mVSB_ Value, mVSB_Min, mVSB_Max)
Q = mVSB_Value / mVSB_Factor ' Q may be Zero
H = VScroll.Value
VScroll.Value = Q ' this may NOT trigger VScroll_Change
If H = VScroll.Value Then
Call VScroll_Change
End If

mInVSBChangeFla g = False
End Sub

'
############### ############### ############### ############### ############### ############### ##
'
' This is called ONLY by all VScroll Bar Moves
' - Changing: VScroll.Value triggers this
'
' Enter with : mNewListIndex ( if List1.ListIndex is to change )
' mInVSBChangeFla g ( suppress recalc of mVSB_Value )
'
Private Sub VScroll_Change( )
Dim Q&

mInRoutineFlag = True ' prevent List1.Click launching calls

If mInVSBChangeFla g = False Then
Q = VScroll.Value * mVSB_Factor
mVSB_Value = Us_MinMax(Q, mVSB_Min, mVSB_Max)
End If
With List1

While mTopRec <> mVSB_Value
mTopRec = mVSB_Value
Call m_EplFillListBo x
Wend
If .ListCount > 0 Then ' Set position in list
' Trap For Resize - 2/4/99 JF
If mNewListIndex >= .ListCount Then _
mNewListIndex = .ListCount - 1
' Set Position in List
.ListIndex = mNewListIndex
End If
End With
mInRoutineFlag = False

Static LastCurrent&
If LastCurrent <> Current Then
LastCurrent = Current
RaiseEvent CurrentChanged( Current)
End If
End Sub
'
############### ############### ############### ############### ############### ############### ##
'
'
'
'
Private Sub m_EplFillListBo x()
Dim S$, Q&, Count%

If mRefreshOffFlag Then Exit Sub ' Disabled Screen

'LockWindowUpda te List1.hWnd
'LockWindowUpda te UserControl.hwn d
' ---
ReDim mLine$(mRealLis tBoxLines)

With List1
.Clear
While .ListCount < mListBoxLines
Q& = mTopRec + .ListCount ' ie: 0 to mListBoxLines -
1
Call LS_GetData(Q&, mLine$(Count))
.AddItem LF_FormatLine(Q &, mLine$(Count))
Count = Count + 1

Wend
End With

' ---
'LockWindowUpda te 0
'LockWindowUpda te 0
'UpdateWindow List1.hWnd
End Sub
'
############### ############### ############### ############### ############### ############### ##
'
'
'
'
Private Sub VScroll_GotFocu s()
List1.SetFocus
End Sub
'
############### ############### ############### ############### ############### ############### ##
'
'
'
'
Private Sub LS_GetData(Q&, S$)
If Q& > 0 Then
If Q& <= mMaxRec Then
If mDisableFlag = False Then
RaiseEvent GetData(Q&, S$)
End If
End If
End If
End Sub
'
############### ############### ############### ############### ############### ############### ##
'
'
'
'
Private Function LF_FormatLine$( Rec&, Raw$)
Dim S$
S$ = Raw$
RaiseEvent UserFormatLine( Rec&, Raw$, S$)
LF_FormatLine = Mid$(S$, mHorizOffset + 1)
End Function
Public Sub LocalTerminate( )
' Local Terminate From US_Severe
End Sub

'Call SendMessageBynu m(List1.hwnd, WM_SETREDRAW, False, 0)
'Call SendMessageBynu m(List1.hwnd, LB_RESETCONTENT , 0, 0)
'Call SendMessageBySt ring(List1.hwnd , LB_ADDSTRING, 0, S$)
'Call SendMessageBynu m(List1.hwnd, LB_SETCURSEL, mNewListIndex, 0)
'Call SendMessageBynu m(List1.hwnd, WM_SETREDRAW, True, 0)

Jul 17 '05 #5
J French <er*****@nowher e.com> schreef in berichtnieuws
3f************* *@news.btclick. com...

Hello J,
On Tue, 9 Dec 2003 16:19:20 +0100, "R.Wieser"
<rw************ ***@xs4all.nl> wrote:


<snip>
Do you have any (pointer to an) example handy, preferrable in, the by you
mentioned, "classic" VB ?


Here is my little 'monster'
- it is slightly inefficient, but I've never bothered with that


Thanks. I think I can use it :-)

Regards,
Rudy Wieser

Jul 17 '05 #6
On Wed, 10 Dec 2003 22:48:18 +0100, "R.Wieser"
<rw************ ***@xs4all.nl> wrote:

<snip>
Here is my little 'monster'
- it is slightly inefficient, but I've never bothered with that


Thanks. I think I can use it :-)


Just don't OCX it .... Please .... there are enough OCXes
Jul 17 '05 #7

This thread has been closed and replies have been disabled. Please start a new discussion.

Similar topics

28
5182
by: Jon Davis | last post by:
If I have a class with a virtual method, and a child class that overrides the virtual method, and then I create an instance of the child class AS A base class... BaseClass bc = new ChildClass(); .... and then call the virtual method, why is it that the base class's method is called instead of the overridden method? How do I fix this if I...
4
8129
by: Sharon | last post by:
I have a ListBox on my form and wand to do auto scrolling, I can do that by: myListBox.ClearSelected(); OutputListBox.SelectedIndex = myListBox.Items.Count - 1; But it causes to unselect all selected items, so I wish do that by moving the vertical scroll bar, imbedded in the ListBox. But I couldn’t find a way to get the ListBox vertical...
7
2586
by: GTi | last post by:
In Win32 I have a function that opens several Dialogs and put the window handle in a listbox (together with a string): HWND hWnd = CreateDialogParam(...) LB_SETITEMDATA, index, (LPARAM)hWnd); In this way when users select a different item in the listbox I just hides the old window handle, and show the new window with...
8
3373
by: nick | last post by:
I have a problem and I've been using a cheezy work around and was wondering if anyone else out there has a better solution. The problem: Let's say I have a web application appA. Locally, I set it up as C:\domains\appA. Locally, my IIS root points to C:\domains. I don't point it to C:\domains\appA since if I have an appB under C:\domains I...
8
1877
by: tshad | last post by:
I have a string that I read from my database: 1|8|5620|541 These are all values in my ListBox. I want to select each of these items (4 of them - but could be many more). At the moment I am doing the following: Dim a() As String Dim j As Integer a = JobCategoriesSelected.Split("|") ' Where JobCategoriesSelected is set to...
2
8877
by: Paul_Madden via DotNetMonster.com | last post by:
I am handling the Listbox DrawItem event to enable the listbox strings to be displayed in different colours for easy reading. Have set ScrollAlwaysVisible and HorizontalScrollbar to true. I Anchor the listbox T, L, R, B on the parent form The string items held within the listbox are quite big, much longer than could be displayed within...
0
2668
by: LostInMd | last post by:
Hi All, I've got an owner drawn listBox where I draw and measure the items that I add to the listBox. For example, I have a listBox that can only display 10 characters on each horizontal line. The majority of my items contain much more than 10 characters and thus the reason for my use of owner drawn listBoxes - I do not want to use a...
7
2898
by: Christopher Pisz | last post by:
My problem is my derived class is getting called twice instead of the base and then the derived. I thought this was the purpose for virtuals and dynamic casting :/ I want my base class to have its method called and then the derived class have its method called. What am I not understanding? Int the following code, my Event Tester class is...
1
1566
by: Derek =?utf-8?Q?Kuli=C5=84ski?= / takeda | last post by:
Hi, I have a problem, I hope someone will help me. I'm writing a small emulator, and as I'm working on it I want to see its internal memory the memory is from 0000 - FFFF (WORD) so that's 65536 bytes. I'm thinking to put 16 of them in one line, so that would make 4096 lines. Adding the elements takes a lot of time, I read that anything...
0
7629
marktang
by: marktang | last post by:
ONU (Optical Network Unit) is one of the key components for providing high-speed Internet services. Its primary function is to act as an endpoint device located at the user's premises. However, people are often confused as to whether an ONU can Work As a Router. In this blog post, we’ll explore What is ONU, What Is Router, ONU & Router’s main...
0
7550
by: Hystou | last post by:
Most computers default to English, but sometimes we require a different language, especially when relocating. Forgot to request a specific language before your computer shipped? No problem! You can effortlessly switch the default language on Windows 10 without reinstalling. I'll walk you through it. First, let's disable language...
0
7836
Oralloy
by: Oralloy | last post by:
Hello folks, I am unable to find appropriate documentation on the type promotion of bit-fields when using the generalised comparison operator "<=>". The problem is that using the GNU compilers, it seems that the internal comparison operator "<=>" tries to promote arguments from unsigned to signed. This is as boiled down as I can make it. ...
1
7593
by: Hystou | last post by:
Overview: Windows 11 and 10 have less user interface control over operating system update behaviour than previous versions of Windows. In Windows 11 and 10, there is no way to turn off the Windows Update option using the Control Panel or Settings app; it automatically checks for updates and installs any it finds, whether you like it or not. For...
0
6184
agi2029
by: agi2029 | last post by:
Let's talk about the concept of autonomous AI software engineers and no-code agents. These AIs are designed to manage the entire lifecycle of a software development project—planning, coding, testing, and deployment—without human intervention. Imagine an AI that can take a project description, break it down, write the code, debug it, and then...
1
5455
isladogs
by: isladogs | last post by:
The next Access Europe User Group meeting will be on Wednesday 1 May 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM). In this session, we are pleased to welcome a new presenter, Adolph Dupré who will be discussing some powerful techniques for using class modules. He will explain when you may want to use classes...
0
5172
by: conductexam | last post by:
I have .net C# application in which I am extracting data from word file and save it in database particularly. To store word all data as it is I am converting the whole word file firstly in HTML and then checking html paragraph one by one. At the time of converting from word file to html my equations which are in the word document file was convert...
0
3603
by: TSSRALBI | last post by:
Hello I'm a network technician in training and I need your help. I am currently learning how to create and manage the different types of VPNs and I have a question about LAN-to-LAN VPNs. The last exercise I practiced was to create a LAN-to-LAN VPN between two Pfsense firewalls, by using IPSEC protocols. I succeeded, with both firewalls in...
0
3579
by: adsilva | last post by:
A Windows Forms form does not have the event Unload, like VB6. What one acts like?

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.