Quantcast
Channel: VBForums - Visual Basic 6 and Earlier
Viewing all 21178 articles
Browse latest View live

[RESOLVED] UserControl_AsyncReadComplete firing too soon

$
0
0
Anyone got any idea why the UserControl_AsyncReadComplete event would fire before it's finished downloading and buffering the file?

I know someone's going to tell me to use the WinSock control, but I'd rather try and get it going this way if it's possible.

I'm attempting to download a file that's about 110MB, a bit large but not really unreasonable. The UserControl_AsyncReadComplete event always fires after between 45MB and 75MB are downloaded.

Here's the line of code I use to get things started:

Code:

    UserControl.AsyncRead sUrl, vbAsyncTypeByteArray, CLng(Rnd * 2000000000#), vbAsyncReadForceUpdate + vbAsyncReadSynchronousDownload
I just recently added the "vbAsyncReadSynchronousDownload" to see if that would help, but it didn't.

I'm now wondering if I can monitor AsyncProp.BytesMax and maybe restart it if it didn't finish, possibly removing the "vbAsyncReadForceUpdate" on the restart, and also saving my random PropertyName (i.e., the "CLng(Rnd * 2000000000#)").

Has anyone had similar problems, and possibly come up with a fix / work-around (still using UserControl)?

Thanks,
Elroy

[RESOLVED] UC (.ctl) crashing on Windows Server 2008 R2 Standard SP1 (64bit)

$
0
0
There is an excellent User Control (.ctl) at -
http://www.planetsourcecode.com/vb/s...61476&lngWid=1
It is called -
"isButton 3.6.2 the multi style button"

I have widely used this in a program, which runs fine on XP, W7, W8
However my user has just set up a new server yesterday
Windows Server 2008 R2 Standard SP1 (64bit)
(He did not have one before, we previously just used a W7 PC as a pretend server)

My program runs through the Main Sub in a startup bas, and when it gets to the code to Show the main form (it is the first Form we show), the program crashes. I have a debug trace line (writes to a text file), in the very first line of the Form_Load, and even that does not get a chance to run.
If I show a simpler Form instead, that shows fine.

I just re-downloaded the example project from the link above, and tried to run that on the server.
It gives the same crash.

I have never written a User Control, but I love them.
Could some kind sole have a look at that User Control, and help me determine what is causing the crash.

Thanks,
Rob

C1/ComponentOne Activex Scrollbar problems in Application cerated using VB6

$
0
0
Hello,

I have developed a software which runs properly under WinXP, 7, 8, 8.1 but under Win10 there is a serious problem.

What is happening is that where ever I have used VSFlex Grid it does not show the scroll bars that are generally shown in older windows versions.

Has anyone faced such a problem in this forum?

Can someone help me solve this problem like by calling some API to force the components/ActiveX to show scroll bars or something like this.

TIA

Yogi Yang

omit or remove extension?

$
0
0
In a form i have a file list box for the user to choose a file. once they choose a file, I'd like the code to remove the extension on that string.

So if they choose a file named 'MyCar.txt', the code sees it as 'MyCar'.

Any way to remove the extension?

Help: Listview/Flexgrid Image Column

$
0
0
Is there any way to put picture to Listview/Flexgrid column from the database? Or any control can do this?

Trying to get the icon of an applications (.exe)

$
0
0
I'm using the following API

Dim hIcon As Long

hIcon = ExtractAssociatedIcon(Form1.hwnd, FilePath, 1)

Then I use the following to get the actual icon

Dim tmpPic As StdPicture

Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)

Code for HandleToStdPicture

Code:

Private Enum PICTYPES
  PICTYPE_ICON = 3
End Enum

Private Type PICDESC_ICON
  cbSizeOfStruct As Long
  picType As PICTYPES
  hIcon As Long
  hPal As Long
End Type

Private Function HandleToStdPicture(ByVal hImage As Long, ByVal imgType As Long) As IPicture
 ' function creates a stdPicture object from an image handle (bitmap or icon)
 ' pass vbPicTypeBitmap if handle is bitmap or vbPicTypeIcon if it is an icon
 
 Dim lpPictDesc As PICDESC_ICON, aGUID(0 To 3) As Long
   
 With lpPictDesc
  .cbSizeOfStruct = Len(lpPictDesc)
  .picType = imgType
  .hIcon = hImage
  .hPal = 0
 End With
   
 ' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
 aGUID(0) = &H7BF80980
 aGUID(1) = &H101ABF32
 aGUID(2) = &HAA00BB8B
 aGUID(3) = &HAB0C3000
 
 ' create stdPicture
 OleCreatePictureIndirect lpPictDesc, aGUID(0), True, HandleToStdPicture
End Function

OK, when FilePath is the full path and file name to my .exe of the program I am working on I get the correct icon and it is good quality; it looks exactly the same as my exe project's icon shown in the titlebar

Now, if FilePath = "c:\windows\explorer.exe" I also get the correct icon however the quality is poor compared to the same icon shown on the titlebar of Explorer

Note: in the API ExtractAssociatedIcon(Form1.hwnd, FilePath, 1) I use the value of '1' because that is the value that was already there from where I got this API from another application source code I found on the net. This is the index of the icon I want to extract but how do I know for sure that I should always use the index of 1 and if not then how do I determine the correct index number. I want to extract only 16x16 icons

안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소

$
0
0
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소
안전한놀이터추천∮∮≫ 24H-11.COM(코드:BuZz)≪∮∮안전한놀이터주소

(ask) how to create a button that can show and hide a frame in every click

$
0
0
hello there , I'm a newbie here , so let's go to the point as the title I want to ask you all , how to create a button that can show and hide a frame in every single click.. well in websites what I mean is a spoiler button , pls help me with my simple problem :) thx before ~

Delete selected entries from datagrid and access DB

$
0
0
Hi
in my project I have 3 Datagrids all bound to respective access db's for simplicity I will cal the Grid_A,Grid_B and Grid_C I want to be able to delete
selected records. The datagrid contains 23 columns which for each entry some of the columns will contain data in this query I am looking at columns
in pairs 9-10,11-12,13-14, and 15-16 the pair are used to store telephone records column 9 has "Home Number" column 10 has a formatted number
inc. area code like this 0044 01202 123456 and so on.
When the user wants to delete a telephone number for the selected record they click a button the position in the grid,col number and contents are stored in variables array (0 to 3) and all the telephone records and displayed in a listbox clicking the record for delete runs the following code
Code:

VB6
 If bCheckDelete = True Then
          i = 0
          sDelNum = lstNums.ListIndex 'lstNums.List(lstNums.ListIndex)
          lstNums.RemoveItem lstNums.ListIndex  'sDelNum  '  .Items.Remove(ListBox1.SelectedItem)
          Debug.Print strP_Nums(0), strP_Nums(1)
         
          'Now clear datagrid and variable
            For i = 0 To 3
              If sDelNum = i Then
                  With frmTopMain.adoControl.Recordset
                      strP_Nums(sDelNum) = vbNullString
                      iBookMark = .AbsolutePosition
                    .Fields(iColNme) = vbNullString
                    .Fields(iColNum) = vbNullString
                    .Update
                    .Requery
                    If Not .EOF Then .MoveNext Else .MoveFirst
                      .AbsolutePosition = iBookMark
                  End With
              End If
                  iColNme = iColNme + 2
                  iColNum = iColNum + 2
            Next i
           
          i = 0
          'Hide Textboxes and Labels
            For i = 0 To 3
              txtPhone(i).Visible = False
              lblPhone(i).Visible = False
            Next i
        End If

although this deletes the entry it is still in the db
Can you help please

Copy from Excel file

$
0
0
Hi. I want to develop a exam programme on vb6. I want to copy exam questions with pictures from sayfa7 to sayfa6.
But the code didn't work. What is the problem? Thank you.




Code:

Private Sub Command6_Click()
Dim kaynak6 As New excel.Application
Dim kitap6 As New excel.Workbook
Dim sayfa6 As New excel.Worksheet
Dim hedef As New excel.Application
Dim kitap5 As New excel.Workbook
Dim sayfa5 As New excel.Worksheet
Dim kaynak7 As New excel.Application
Dim kitap7 As New excel.Workbook
Dim sayfa7 As New excel.Worksheet
Dim sin As Range


Set kitap5 = hedef.Workbooks.Open(App.Path & "\data\toplu.xlsx")
Set sayfa5 = hedef.Sheets(1)
Set kitap6 = kaynak6.Workbooks.Open(App.Path & "\data\başlık.xlsx")
Set sayfa6 = kaynak6.Sheets(1)
Set kitap7 = kaynak7.Workbooks.Open(App.Path & "\data\sorular.xlsx")
Set sayfa7 = kaynak7.Sheets(1)



Dim sonsatir5 As Integer
Dim sonsatir6 As Integer

Dim index1 As Integer
Dim isim(10000) As String
Dim soyisim(10000) As String
Dim no(10000) As Integer
Dim ogretmen(10000) As String
Dim ders(10000) As String
Dim sinif(10000) As String



Dim a As Integer


On Error Resume Next
sonsatir5 = sayfa5.Cells(sayfa5.Rows.Count, 1).End(xlUp).Row
sayfa6.Cells.UnMerge
sayfa6.Range("a1:j65536") = ""
sayfa6.Cells.Borders(xlDiagonalDown).LineStyle = xlNone
sayfa6.Cells.Borders(xlDiagonalUp).LineStyle = xlNone
sayfa6.Cells.Borders(xlEdgeLeft).LineStyle = xlNone
sayfa6.Cells.Borders(xlEdgeTop).LineStyle = xlNone
sayfa6.Cells.Borders(xlEdgeBottom).LineStyle = xlNone
sayfa6.Cells.Borders(xlEdgeRight).LineStyle = xlNone
sayfa6.Cells.Borders(xlInsideVertical).LineStyle = xlNone
sayfa6.Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
   
a = 0
index1 = 0
z = 0

    For x = 1 To sonsatir5
        isim(index1) = sayfa5.Cells(x, 1)
        soyisim(index1) = sayfa5.Cells(x, 2)
        no(index1) = sayfa5.Cells(x, 3)
        ogretmen(index1) = sayfa5.Cells(x, 5)
        ders(index1) = sayfa5.Cells(x, 6)
        sinif(index1) = sayfa5.Cells(x, 4)
        index1 = index1 + 1
    Next x

sonsatir6 = sonsatir5 * 120



For k = 0 To sonsatir6 - 1 Step 120

sayfa6.Range("c" & k + 5 & ":" & "i" & k + 6).Merge

sayfa6.Cells(k + 2, 1) = "Adı :"
sayfa6.Cells(k + 3, 1) = "Soyadı :"
sayfa6.Cells(k + 5, 1) = "Numarası :"
sayfa6.Cells(k + 6, 1) = "Öğretmen : "
sayfa6.Cells(k + 7, 1) = "Ders :"
sayfa6.Cells(k + 1, 1) = "Sınav Yeri: "
sayfa6.Cells(k + 4, 1) = "Sınıfı :"
sayfa6.Cells(k + 3, 4) = TVali.Text
sayfa6.Cells(k + 4, 4) = TOkul.Text
sayfa6.Cells(k + 2, 4) = "T.C."

sayfa6.Range("A" & k + 1 & ":" & "B" & k + 1).Borders.LineStyle = xlContinuous

sayfa6.Cells(k + 2, 2) = isim(a)
sayfa6.Cells(k + 3, 2) = soyisim(a)
sayfa6.Cells(k + 5, 2) = no(a)
sayfa6.Cells(k + 6, 2) = ogretmen(a)
sayfa6.Cells(k + 7, 2) = ders(a)
sayfa6.Cells(k + 4, 2) = sinif(a)
a = a + 1

Next k

sayfa7.Range("A8:I120").Select
Selection.Copy


sayfa6.Range("A8:I120").Select
ActiveSheet.Paste




kitap6.Save
kitap5.Close
kitap6.Close
kitap7.Close

excel.Application.Quit

MsgBox "tamamdır", vbInformation, "uyarı"

End Sub

[RESOLVED] Sign in Log

$
0
0
In VB6 on WIN 7 Pro How do I grab the password protected sign in and record the date and time?

Thanks

Converting VB6 Change Default Printer Code to VB 2013

$
0
0
I've been trying to convert some code that I found courtesy of vbnet.mvps.org. I've been able modify most of the code, but since I'm not very familiar with VB6 at all, I've had some trouble with the use of structures as well as some string manipulation. I'm only down to 6 errors, but I can't find the information that I need to fix the issue currently. Any help would be greatly appreciated.

vb.net Code:
  1. Option Explicit On
  2. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  3. ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
  4. ' Some pages may also contain other copyrights by the author.
  5. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  6. ' Distribution: You can freely use this code in your own
  7. '               applications, but you may not reproduce
  8. '               or publish this code on any web site,
  9. '               online service, or distribute as source
  10. '               on any media without express permission.
  11.  
  12. Public Class FrmChgPrnt
  13.  
  14.     Private Structure PRINTER_INFO_4
  15.         Dim pPrinterName As Long
  16.         Dim pServerName As Long
  17.         Dim Attributes As Long
  18.     End Structure
  19.  
  20.  
  21.  
  22.     'This is non-windows constant
  23.     'defined for this method
  24.     Private Const SIZEOFPRINTER_INFO_4 = 12
  25.  
  26.     Private Const HWND_BROADCAST As Long = &HFFFF&
  27.     Private Const WM_WININICHANGE As Long = &H1A
  28.     Private Const PRINTER_LEVEL4 = &H4
  29.     Private Const PRINTER_ENUM_LOCAL = &H2
  30.  
  31.     Private Declare Function EnumPrinters Lib "winspool.drv" _
  32.        Alias "EnumPrintersA" _
  33.       (ByVal Flags As Long, _
  34.        ByVal Name As String, _
  35.        ByVal Level As Long, _
  36.        pPrinterEnum As String, _
  37.        ByVal cbBuffer As Long, _
  38.        pcbNeeded As Long, _
  39.        pcReturned As Long) As Long
  40.     Private Declare Function EnumPrintersNull Lib "winspool.drv" _
  41.         Alias "EnumPrintersA" _
  42.         (ByVal pPrinterEnum As Long)
  43.  
  44.     Private Declare Function SendNotifyMessage Lib "user32" _
  45.        Alias "SendNotifyMessageA" _
  46.       (ByVal hwnd As Long, _
  47.        ByVal msg As Long, _
  48.        ByVal wParam As Long, _
  49.         lParam As String) As Long
  50.  
  51.     Private Declare Function SendNotifyMessageNull Lib "user32" _
  52.        Alias "SendNotifyMessageA" _
  53.       (ByVal lParam As Long)
  54.  
  55.  
  56.     Private Declare Function SetDefaultPrinter Lib "winspool.drv" _
  57.        Alias "SetDefaultPrinterA" _
  58.       (ByVal pszPrinter As String) As Long
  59.  
  60.     Private Declare Function lstrcpyA Lib "kernel32" _
  61.       (ByVal RetVal As String, ByVal ptr As Long) As Long
  62.  
  63.     Private Declare Function lstrlenA Lib "kernel32" _
  64.       (ByVal ptr As String) As Long
  65.  
  66.     Private Declare Function lstrlenANull Lib "kernel32" _
  67.     (ByVal ptr As Long) As Long
  68.  
  69.  
  70.  
  71.     Private Sub Form_Load()
  72.  
  73.         With Command1
  74.             .Text = "Set Default Printer"
  75.         End With
  76.  
  77.         Call EnumPrintersWinNTPlus()
  78.  
  79.     End Sub
  80.  
  81.  
  82.     Private Sub Command1_Click()
  83.  
  84.         'set the default printer to the
  85.         'selected item
  86.         SetDefaultPrinter(List1.SelectedItem)
  87.  
  88.         'broadcast the change
  89.  
  90.  
  91.  
  92.         ''BREAKPOINT = Expression expected.
  93.  
  94.          Call SendNotifyMessage(HWND_BROADCAST, _
  95.                           WM_WININICHANGE, _
  96.                           0, ByVal "windows")
  97.         ''BREAKPOINT
  98.  
  99.  
  100.  
  101.  
  102.     End Sub
  103.  
  104.     Private Function EnumPrintersWinNTPlus() As Long
  105.  
  106.         Dim cbRequired As Long
  107.         Dim cbBuffer As Long
  108.         Dim ptr() As PRINTER_INFO_4
  109.         Dim nEntries As Long
  110.         Dim cnt As Long
  111.  
  112.         List1.Items.Clear()
  113.  
  114.         'To determine the required buffer size,
  115.         'call EnumPrinters with cbBuffer set to zero.
  116.         'EnumPrinters fails, and Err.LastDLLError
  117.         'returns ERROR_INSUFFICIENT_BUFFER, filling
  118.         'in the cbRequired parameter with the size,
  119.         'in bytes, of the buffer required to hold
  120.         'the array of structures and their data.
  121.         Call EnumPrinters(PRINTER_ENUM_LOCAL, _
  122.                           vbNullString, _
  123.                           PRINTER_LEVEL4, _
  124.                           0, 0, _
  125.                           cbRequired, _
  126.                           nEntries)
  127.  
  128.         'The strings pointed to by each PRINTER_INFO_4
  129.         'struct's members reside in memory after the end
  130.         'of the array of structs. So we're not only
  131.         'allocating memory for the structs themselves,
  132.         'but all the strings pointed to by each struct's
  133.         'member as well.
  134.         ReDim ptr((cbRequired \ SIZEOFPRINTER_INFO_4))
  135.  
  136.         'Set cbBuffer equal to the size of the buffer
  137.         cbBuffer = cbRequired
  138.  
  139.         'Enumerate the printers. If the function succeeds,
  140.         'the return value is nonzero. If the function fails,
  141.         'the return value is zero.
  142.  
  143.  
  144.  
  145.         ''BREAKPOINT = Value of type 'WindowsApplication1.FrmChgPrnt.PRINTER_INFO_4' cannot be converted to 'String'.
  146.         If EnumPrinters(PRINTER_ENUM_LOCAL, _
  147.                         vbNullString, _
  148.                         PRINTER_LEVEL4, _
  149.                         ptr(0), cbBuffer, _
  150.                         cbRequired, nEntries) Then
  151.          ''BREAKPOINT
  152.  
  153.  
  154.  
  155.             For cnt = 0 To nEntries - 1
  156.  
  157.                 With ptr(cnt)
  158.  
  159.                     List1.Items.Add(GetStrFromPtrA(.pPrinterName))
  160.  
  161.                 End With
  162.  
  163.             Next cnt
  164.  
  165.         Else
  166.             List1.Items.Add("Error enumerating printers.")
  167.         End If  'EnumPrinters
  168.  
  169.         EnumPrintersWinNTPlus = nEntries
  170.  
  171.     End Function
  172.  
  173.  
  174.     Private Function GetStrFromPtrA(ByVal lpszA As Long) As String
  175.  
  176.  
  177.  
  178.         ''BREAKPOINT = Error    3   'String' is a type and cannot be used as an expression, expression expected, expression expected,
  179.         ''expression expected
  180.    GetStrFromPtrA = String$(lstrlenA(ByVal lpszA), 0)
  181.    Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
  182.         ''BREAKPOINT
  183.  
  184.  
  185.  
  186.  
  187.     End Function
  188.  
  189.     Private Sub FrmChgPrnt_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  190.  
  191.     End Sub
  192.  
  193.  
  194.  
  195.     Private Sub List1_SelectedIndexChanged(sender As Object, e As EventArgs) Handles List1.SelectedIndexChanged
  196.         If List1.SelectedIndex > -1 Then
  197.             Command1.Enabled = True
  198.         Else
  199.             Command1.Enabled = False
  200.         End If
  201.     End Sub
  202.  
  203.     Private Sub Command1_Click(sender As Object, e As EventArgs) Handles Command1.Click
  204.    
  205.     End Sub
  206. End Class

Thanks again!
Attached Files

Db engine confusion

$
0
0
Hi all

Still confused by the DB ENGINE subject .

In case I develop a relational database (NOt client server !!) that is intended to run on my client PC
What DB ENGINE I should use at design time on my PC , so that that app will run smooth at runtime
at my client PC without the need to install any DBengine ?

Thanks

Elico

[RESOLVED] Run .sql text script using ODBC connection to SQL Server

$
0
0
Anyone know the connection setup to run a .sql script file using ODBC connection to SQL Server database or if it is possible? I have a .sql file that I normally just run via SSMS and export to a file, but would like to automate and run via code. Thanks!

[RESOLVED] ImageList question

$
0
0
Using ImageList V5

Does ImageList have a limit to number of images it will contain

Adding images to ImageList question

$
0
0
I'm using the following code to add images to ImageList

Code:

  '
  '
Private Translate As Collection
  '
  '
Private Sub Form_Load()
  '
  '
 Set Translate = New Collection
  '
  '
End sub

Private Function AddItemIcon(FileType As String, ByVal FileName As String, ByVal FilePath As String) As Long
 Dim IconIndex As Long
 Dim Icon As StdPicture
 Dim Key As String
 
 IconIndex = GetSmallDefaultIconIndex(Icon, FileName, FilePath, IIf(UCase$(FileType) = "D", vbDirectory, vbNormal))
   
 Key = CStr(IconIndex)
   
 On Error Resume Next

 IconIndex = Translate(Key)
 
 If Err Then
  On Error GoTo 0
  IconIndex = ImageList2.ListImages.Count + 1
  Translate.Add IconIndex, Key
  ImageList2.ListImages.Add IconIndex, , Icon
 Else
  On Error GoTo 0
 End If
 
 AddItemIcon = IconIndex
End Function

The code works fine and what it does is to first get the icon of the item from the ListView by calling GetSmallDefaultIconIndex(Icon, FileName, Path, IIf(UCase$(FileType) = "D", vbDirectory, vbNormal)) which puts the icon handle in the argument 'Icon' and also returns a number which I think is a number that represents the index of the icon from the file.

The line at IconIndex = Translate(Key) finds the key in the collection and if it already exists it will go to the Else clause of the If Err Then statement otherwise it will add the new IconIndex to the Collection and use it as the index to the ImageList for this icon.

This keeps the ImageList ListImages down to a minimum by insuring that all files with the same extension use the same icon index number and this is great since many directories have several files of the same extension (.txt, .frm, .bas, etc).

However it does have one drawback. It prevents me from getting the actual icon associated with any .exe file and therefore all .exe file will take the same icon as the first .exe file found which is not what I want. So, to insure I will always get the actual icon I simply wound up using only the ImageList's .Count + 1 .....

Code:

Public Function AddItemIcon(FileType As String, ByVal FileName As String, ByVal FilePath As String) As Long
 Dim IconIndex As Long
 Dim Icon As StdPicture
 
 GetSmallDefaultIconIndex Icon, FileName, FilePath, IIf(UCase$(FileType) = "D", vbDirectory, vbNormal)
   
 IconIndex = ImageList2.ListImages.Count + 1

 ImageList2.ListImages.Add IconIndex, , Icon
 
 AddItemIcon = IconIndex
End Function

...which will now add a different icon for each .exe file it encounters. This too, works OK but now I wind up having the same icon added to the ImageList multiple times for other files as well, like, .txt, etc.

I know the ImageList can hold up 32767 images and I doubt very much I will ever encounter a directory with that many files in it but as the user goes from one directory to another then icons for those files are added to the ImageList so sooner or later I could get an overflow error.

I would like to know what can I do to keep the same method as my first code example shows but also add the different icons for files that have same extensions but also have different icons associated with them

Need help in less then 10 hours :)

$
0
0
I am fairly new to Visual Basic, learning and here i sort of copied from an working project.
http://prntscr.com/9bcv36

I have 2 forms and 2 files. on second form, i made file that fills combobox with "Match event" on first form. And also list them in listbox on second form. But t when i click on the "Match event" in listbox ( i need delete/edit) them i get this error. NullReferenceException was unhandled . Object reference not set to an instance of an object.

Error should be at end of first code, but i put all in. I need this till tomorrow morning to be able to enter exam, so well i dont give much hopes but you all are my last hopes :P

Code:

Public Class TekmaS

    Private Sub btnVnos_Click(sender As System.Object, e As System.EventArgs) Handles btnVnos.Click
        If txtKrajTekme.Text = "" Then
            MsgBox("Vpišite kraj tekme!")
            txtKrajTekme.Focus()
            Exit Sub
        End If
        If cmbDrzavaTekme.SelectedIndex = -1 Then
            MsgBox("Izberite državo tekme!")
            Exit Sub
        End If
        'If dtpDatumTekme.Value > Now Then
        'MsgBox("Datum ne sme biti poznejši od današnjega dne!")
        ' dtpDatumTekme.Value = Now
        ' dtpDatumTekme.Focus()
        ' Exit Sub
        ' End If
        With zapis
            .krajTekme = txtKrajTekme.Text
            .drzavaTekme = cmbDrzavaTekme.Text
            .datumTekme = dtpDatumTekme.Value.Date
            FileOpen(1, datoteka, OpenMode.Append)
            WriteLine(1, .krajTekme, .drzavaTekme, .datumTekme)
            FileClose(1)
        End With
        txtKrajTekme.Clear()
        cmbDrzavaTekme.SelectedIndex = -1
        dtpDatumTekme.Value = Now
    End Sub

    Private Sub Tekma_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Call nalozi()
        cmbDrzavaTekme.Items.AddRange({"Nemčija", "Norveška", "Avstrija", "Slovenija", "Japonska", "Poljska", "Češka", "Švica", "Finska", "Rusija", "Francija", "Italija", "Bolgarija", "ZDA", "Koreja"})
    End Sub

    Private Sub btnZapri_Click(sender As System.Object, e As System.EventArgs) Handles btnZapri.Click
        Me.Close()
    End Sub

    Private Sub btnIsciTekmo_Click(sender As System.Object, e As System.EventArgs) Handles btnIsciTekmo.Click
        Dim Nasel As Boolean
        Dim Isci As String
        Dim Odgovor As Integer

        If txtKrajTekme.Text = "" Then
            MsgBox("Polje za kraj tekme ne sme biti prazno")
            txtKrajTekme.Focus()
            Exit Sub
        End If
        Isci = txtKrajTekme.Text
        FileOpen(1, datoteka, OpenMode.Input)
        Do Until EOF(1) Or Nasel = True
            With zapis
                Input(1, .krajTekme)
                Input(1, .drzavaTekme)
                Input(1, .datumTekme)
                If .krajTekme.ToLower = Isci.ToLower Then
                    txtKrajTekme.Text = .krajTekme
                    cmbDrzavaTekme.Text = .drzavaTekme
                    dtpDatumTekme.Value = .datumTekme
                    Nasel = True
                    Odgovor = MsgBox("Ali iščete to tekmo?", MsgBoxStyle.YesNo)
                    If Odgovor = 4 Then
                        Nasel = False
                    Else
                        Nasel = True
                    End If
                End If
            End With
        Loop
        FileClose(1)
        If Nasel = False Then
            MsgBox("Tekma ne obstaja")
        End If
    End Sub

    Private Sub btnBrisi_Click(sender As System.Object, e As System.EventArgs) Handles btnBrisi.Click
        ' iz ekrana spremenjene podatke zapišemo v tabelo trenutno
        ' izbrane vrstice listboxs-a + 1
        With tabUredi(lstTekme.SelectedIndex + 1)
            .krajTekme = txtKrajTekme.Text
            .drzavaTekme = cmbDrzavaTekme.Text
            .datumTekme = dtpDatumTekme.Value
        End With
        ' zbrišemo vsebino ListBox-a saj se bo spremenila
        lstTekme.Items.Clear()
        ' odpremo datoteko z Output - zbrišemo staro datoteko
        FileOpen(1, datoteka, OpenMode.Output)
        ' iz tabele prepišemo podatke v datoteko
        For stevec = 1 To UBound(tabUredi)
            ' če je kraj tekme prazen, potem to vrstico tabele  ne prepišemo v datoteko in jo tako zbrišemo
            If tabUredi(stevec).krajTekme <> "" Then
                ' iz tabele prepišemo v zapis
                With zapis
                    .krajTekme = tabUredi(stevec).krajTekme
                    .drzavaTekme = tabUredi(stevec).drzavaTekme
                    .datumTekme = tabUredi(stevec).datumTekme
                    ' iz tabele prepišemo kraj tekme na ListBox
                    lstTekme.Items.Add(.krajTekme)
                    ' zapis vpišemo v datoteko
                    WriteLine(1, .krajTekme, .drzavaTekme, .datumTekme)

                End With
            End If

        Next
        FileClose(1)
        btnBrisi.Visible = False
        lblBrisi.Visible = False
        ' pokličemo podprogram za brisanje gradnikov na ekranu
        ' Call brisi()
    End Sub

    Private Sub lstTekme_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles lstTekme.SelectedIndexChanged

        With tabUredi(lstTekme.SelectedIndex + 1)
            txtKrajTekme.Text = .krajTekme
            cmbDrzavaTekme.Text = .drzavaTekme
            dtpDatumTekme.Value = .datumTekme

        End With
        btnBrisi.Visible = True
        lblBrisi.Visible = True

    End Sub
End Class

Threads

$
0
0
I have a question about VB and Threads?

Opening a Form with a RichTextBox where a large amount of data is being loaded, would using a separate thread allow the user to start working while the data is still being loaded?

If so is this a huge undertaking to just have a bit of convenience?

Thanks.

Question about drag in Windows 8

$
0
0
I realize that in Windows 8 when I use admin rights in my aplication I can't drag from wordpad to my usercontrol, but I can drag text from a form in my application to another form. When I use no admin rights then all works fine.
I can drag text from my application to wordpad in either rights (admon or not).
In windows 7 I have no problem.

vbAccelerator site gone?

$
0
0
Another one bites the dust?

vbAccelerator appears to have been dispossessed, or perhaps is just being locked out by the landlord until back rent gets paid:

Quote:

vbaccelerator.com expired on 11/24/2015 and is pending renewal or deletion.
Viewing all 21178 articles
Browse latest View live


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>