-
Apr 24th, 2014, 05:18 AM
#1
Thread Starter
Fanatic Member
A VB6 Recent Files Lister
Here is a VB6 Recent Files lister. You can remove any entries from the list and the programme also checks that the entries have not been deleted or moved.
It is a simple programme which I hope some will find useful. One comment, do not use it from within the IDE or when VB6 is running. VB6 stores the list at startup and re-writes upon completion.
Enjoy - Steve.
Last edited by Steve Grant; May 3rd, 2014 at 02:32 AM.
Reason: Fixes a bug in icon selection
-
May 1st, 2014, 10:25 PM
#2
Member
Re: A VB6 Recent Files Lister
may be some bugs
i can fixed
FrmMain:
Private Sub lstRFiles_Click(Index As Long) 'Swap the icons except for Dashed (Icon 2) entries
If Index <> -1 Then
cmdApply.Enabled = True
If lstRFiles.GetItemIconIndex(Index) = 0 Then
lstRFiles.SetItemIconIndex Index, 1
ElseIf lstRFiles.GetItemIconIndex(Index) = 1 Then
lstRFiles.SetItemIconIndex Index, 0
End If
End If
End Sub
ListBoxEx :
Private Sub DrawItems()
On Error GoTo ErrOut
Dim LastItemVisible As Long
Dim i As Long
Dim TextRect As RECT
Dim hBrush As Long
Dim TopPos As Long
Dim MaxTextWidth As Long
Dim TextW As Long
Dim xLeft As Long
Dim AreaWidth As Long
If Extender.Visible = False Then Exit Sub
'If mCount = 0 Then Exit Sub
TextH = UserControl.TextHeight("羓")
If mIconAlign = AlingLeft Then
If TextH > mIconSize Then
mItemHeight = TextH + 4
Else
mItemHeight = mIconSize + 8
End If
Else
mItemHeight = mIconSize + 16 + TextH + 4
MaxTextWidth = mItemHeight
End If
ItemsVisible = UserControl.ScaleHeight \ mItemHeight
TopPos = mItemHeight * mScrollPos
LastItemVisible = mScrollPos + (UserControl.ScaleHeight \ mItemHeight)
If LastItemVisible > mCount - 1 Then LastItemVisible = mCount - 1
AreaWidth = UserControl.ScaleWidth - IIf(VScroll1.Visible, VScroll1.Width, 0) - 1
If mIconAlign = AlingLeft Then
mSelectionWidth = AreaWidth - 1
xLeft = 1
Else
For i = mScrollPos To LastItemVisible
TextW = UserControl.TextWidth(Item(i).Caption)
If TextW > MaxTextWidth - 16 Then
MaxTextWidth = TextW + 16
End If
Next
If MaxTextWidth > AreaWidth Then MaxTextWidth = AreaWidth
xLeft = (UserControl.ScaleWidth / 2) - (MaxTextWidth / 2) + 0.5
mSelectionWidth = MaxTextWidth
End If
UserControl.AutoRedraw = True
UserControl.Cls
For i = mScrollPos To LastItemVisible
If i = mItemHitText And i = mItemSelected Then
DrawSelection xLeft, (mItemHeight * i) - TopPos + 1, mSelectionWidth, mItemHeight, 150
Else
If i = mItemHitText Then
DrawSelection xLeft, (mItemHeight * i) - TopPos + 1, mSelectionWidth, mItemHeight, 50
End If
If i = mItemSelected Then
DrawSelection xLeft, (mItemHeight * i) - TopPos + 1, mSelectionWidth, mItemHeight, 100
End If
End If
If mIconAlign = AlingLeft Then
ImageList_Draw himl, Item(i).IconIndex, UserControl.hdc, 4, (mItemHeight / 2) - (mIconSize / 2) + (mItemHeight * i) - TopPos, ILD_TRANSPARENT
SetRect TextRect, mIconSize + 8, (mItemHeight * i) - TopPos, mSelectionWidth, (mItemHeight * (i + 1)) - TopPos
DrawText UserControl.hdc, Item(i).Caption, lenw(Item(i).Caption), TextRect, DT_FLAG
Else
ImageList_Draw himl, Item(i).IconIndex, UserControl.hdc, xLeft + (mSelectionWidth / 2) - (mIconSize / 2), (mItemHeight * i) + 8 - TopPos, ILD_TRANSPARENT
SetRect TextRect, xLeft, (mItemHeight * i) - TopPos, xLeft + mSelectionWidth, (mItemHeight * (i + 1)) - TopPos - 8
DrawText UserControl.hdc, Item(i).Caption, lenw(Item(i).Caption), TextRect, DT_SINGLELINE Or DT_WORD_ELLIPSIS Or DT_CENTER Or DT_BOTTOM
End If
Next
UserControl.AutoRedraw = True
UserControl.Line (0, 0)-(UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1), mBorderColor, B
UserControl.AutoRedraw = False
UserControl.Refresh
ErrOut:
End Sub
Private Function lenw(str As String) As Integer
lenw = LenB(StrConv(str, vbFromUnicode))
End Function
-
May 2nd, 2014, 08:14 AM
#3
Thread Starter
Fanatic Member
Re: A VB6 Recent Files Lister
The above would only apply in the event that the listbox was allowed to be empty. It is not.
If no recent files are found then that is put into the listbox as a message with an icon.
Even though the apply button is enabled if you click on the 'No recent files found' message, nothing happens when you push it.
As to the mods you have carried out to Leandro Ascierto's ListboxEX code, I assume this has to do with non-english conversion and I thank you very much for it.
I will update the original post with the update once I have a chance to test it.
Steve.
-
May 2nd, 2014, 07:54 PM
#4
Re: A VB6 Recent Files Lister
Although, it might be a good idea to include that code because what if the list use empty and the user ran the program, the program would crash.
when you quote a post could you please do it via the "Reply With Quote" button or if it multiple post click the "''+" button then "Reply With Quote" button.
If this thread is finished with please mark it "Resolved" by selecting "Mark thread resolved" from the "Thread tools" drop-down menu.
https://get.cryptobrowser.site/30/4111672
-
May 3rd, 2014, 02:19 AM
#5
Thread Starter
Fanatic Member
Re: A VB6 Recent Files Lister
Thank you for your thoughts, however, as explained above, even if the recent files list in the registry is empty, a message to that effect is placed in the listbox to let you the user know. Try it and see if you can break it.
Best,
Steve.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|