Sending data to device via MS Comm VB6 - vb6

I need to send a file to some electronic device and execute it.
I couldn't find any information online regarding MS Comms and I didn't find Documentation on the Microsoft (https://msdn.microsoft.com/en-us/library/aa231237(v=vs.60).aspx) any useful :
' Send Byte array data
MSComm1.Output = Out
Would be great if you guys could give me some pointers and help me to solve my problem. The problem that I am experiencing is an infinite loop at Loop Until MSComm1.OutBufferCount = 0, when I return "MSComm1.OutBufferCount" between Do and Loop "MSComm1.OutBufferCount" is 0 and files dont seem to be sent over to the device.
Closest function I got to at the present moment is below:
Function SendFile(tmp$)
Dim temp$
Dim hsend, bsize, LF&
' Open file
Open tmp$ For Binary Access Read As #2
' Check size on Mscomm1 OutBuffer
bsize = MSComm1.OutBufferSize
' Check file length
LF& = LOF(2)
' This code makes tiny pieces of data (Buffer sized)
' And send's it
Do Until EOF(2)
If LF& - Loc(2) <= bsize Then
bsize = LF& - Loc(2) + 1
End If
' Make room for some data
temp$ = Space$(bsize)
' Put the data piece in the Temp$ string
Get #2, , temp$
MSComm1.Output = temp$
Do
' Wait until the buffer is empty
Loop Until MSComm1.OutBufferCount = 0
Loop
' close file
Close #2
End Function

Have a look at the RThreshold and SThreshold properties
Below is a simple example project :
'1 form with :
' 1 label control : name=Label1
' 1 textbox control : name=Text1
' 1 command button : name=Command1
Option Explicit
Private Sub Command1_Click()
'send command
MSComm1.Output = Text1.Text & vbCr
End Sub
Private Sub Form_Load()
'config mscomm control and open connection
With MSComm1
.Settings = "9600,N,8,1"
.RThreshold = 1
.SThreshold = 0
.CommPort = 1
.PortOpen = True
End With 'MSComm1
End Sub
Private Sub Form_Resize()
'position controls
Dim sngWidth As Single, sngHeight As Single
Dim sngCmdWidth As Single, sngCmdHeight As Single
Dim sngTxtWidth As Single
Dim sngLblHeight As Single
sngWidth = ScaleWidth
sngHeight = ScaleHeight
sngCmdWidth = 1215
sngCmdHeight = 495
sngLblHeight = sngHeight - sngCmdHeight
sngTxtWidth = sngWidth - sngCmdWidth
Label1.Move 0, 0, sngWidth, sngLblHeight
Text1.Move 0, sngLblHeight, sngTxtWidth, sngCmdHeight
Command1.Move sngTxtWidth, sngLblHeight, sngCmdWidth, sngCmdHeight
End Sub
Private Sub MSComm1_OnComm()
'process received data
Dim strInput As String
Select Case MSComm1.CommEvent
Case comEvReceive
strInput = MSComm1.Input
Label1.Caption = Label1.Caption & strInput
End Select
End Sub
In Command1_Click I add a carriage return to the command from Text1 as most devices require the command to be finished by that
In MSComm1_OnComm I just print the received data to the label, but you might want to add the received data to a global variable, and then process the contents of that variable, as all data might not be received at once

Related

How to get saved texts from saved file

I am making a number generator for my own purpose.
I already made it to work with these features:
- Saves the generated number
What features I want :
- When I close it loads the last generated number from the notepad.
here is the code:
Private Const FilePath As String = "C:\Users\sto0007404\Documents\Numbers.txt"
Private CurrentNumber As Long
Private Sub Command1_Click()
CurrentNumber = CurrentNumber + 1
txtRefNo.Text = "EM" & Format(CurrentNumber, String(4, "0"))
End Sub
Private Sub Form_Load()
Dim TextFileData As String, MyArray() As String, i As Long
' Open file as binary
Open "FilePath" For Binary As #1
' Read entire file's data in one go
TextFileData = Space$(LOF(1))
Get #1, , TextFileData
' Close File
Close #1
' Split the data in separate lines
MyArray() = Split(TextFileData, vbCrLf)
For i = 0 To UBound(MyArray())
' Set CurrentNumber equal to the current max
CurrentNumber = Val(Mid$(MyArray(i), 2))
Next
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim i As Long
' delete the old file
If Not LenB(Dir(FilePath)) = 0 Then Kill FilePath
'open the file for writing
Open FilePath For Output As #1
For i = 1 To CurrentNumber
Write #1, "EM" & Format(i, String(4, "0"))
Next
'close the file (if you dont do this, you wont be able to open it again!)
Close #1
End Sub
Independent of use binary mode...
open file for output as #1
print #1, "Some text"
close #1
open file for input as #1
line input #1, myvariable
close #1
msgbox myvariable
The flow is the same that you show, so what is the problem ?

VBA Macro gets slower with every execution

I have a macro that reads a .txt file line by line. I check every line if it's equal to some code for a new page, say it's "NEXT" - if yes, then a page break is inserted. After certain amount of "NEXT" occurences the whole document gets exported to pdf. Then the content of .doc gets deleted and I continue reading & exporting the txt file until EOF.
Problem: macro gets slower with every execution.
My test file has 27300 lines / 791 kB (real files are somewhere between 10 and 100MB). Before I start the macro, the WINWORD process takes 40K of memory. The memory usage gets bigger after every execution of the macro.
Time Max.MemoryUsage MemoryUsageAfterwards
Run1 11.9s 70K 64K
Run2 19.7s 90K 84K
Run3 22.3s 99K 92K
I know a partial solution is to close and reopen the .doc file manually and run the macro with next .txt file as input. However, it takes long time to even close the Word after one run of macro, although there is no content in the file that I can see.
What I'm asking is if there is another way to solve this, what I believe is to be a memory clearing issue?
My code:
When the document is opened:
Private Sub Document_Open()
ReadAndSplit
End Sub
Global variables and declarations:
Option Explicit
'---------------------------------------------------------------------------
' GLOBAL VARIABLES
'---------------------------------------------------------------------------
Public numOfBreaks As Integer ' number of page breaks made
Public numOfPdfs As Integer ' number of currently printed pdf
Public filePrefix As String ' name prefix for .pdf files
Public sFileName As String ' name of Input File
Public breakAfter As Integer ' print after this number of NEXT
Public cancelActive As Boolean ' cancel Button pressed? (for exit)
Main macro:
Sub ReadAndSplit()
'---------------------------------------------------------------------------
' VARIABLES
'---------------------------------------------------------------------------
Dim sLine As String ' line from text file
Dim numOfLines As Long ' number of lines read from .txt input
Dim execStart As Single ' starting time of script execution
Dim nextPage As Boolean ' indicates if new document beginns
'---------------------------------------------------------------------------
' INITIAL PROCESSING
'---------------------------------------------------------------------------
Application.Visible = False
Application.ScreenUpdating = False
Selection.WholeStory ' clear the document
Selection.Delete
UserForm1.Show ' show user dialog
If cancelActive Then ' Cancel button handling
Application.Visible = True
Exit Sub
End If
With ActiveDocument.PageSetup ' set page margins & orientation
.TopMargin = 0.1
.BottomMargin = 0.1
.LeftMargin = 0.1
.RightMargin = 0.1
End With
'---------------------------------------------------------------------------
' MAIN PROCESSING
'---------------------------------------------------------------------------
numOfBreaks = 0 ' GLOBALS
numOfPdfs = 1
numOfLines = 0 ' LOCALS
nextPage = True
execStart = Timer
Open sFileName For Input As #1
Do While Not EOF(1)
If nextPage Then ' write 2 empty lines
Selection.TypeText (vbNewLine & vbNewLine)
nextPage = False
End If
Line Input #1, sLine ' read 1 line from input
numOfLines = numOfLines + 1 ' count lines
If sLine <> "NEXT" Then ' test for NEXT
Selection.TypeText (sLine) & vbNewLine ' write line from input .txt
Else
Selection.InsertBreak Type:=wdPageBreak ' NEXT -> new page
numOfBreaks = numOfBreaks + 1 ' count new receipts
If numOfBreaks = breakAfter Then ' compare with PARAM
PrintAsPDF ' export to pdf
numOfBreaks = 0
End If
nextPage = True ' switch new page on
End If
Loop
If numOfBreaks <> 0 Then ' print out the last part
PrintAsPDF
End If
Close #1
Debug.Print vbNewLine & "-----EXECUTION-----"
Debug.Print Now
Debug.Print "Lines: " & numOfLines
Debug.Print "Time: " & (Timer - execStart)
Debug.Print "-------------------" & vbNewLine
Selection.WholeStory ' clear the word document
Selection.Delete
Application.Visible = True
End Sub
Macro used for printing PDF:
Sub PrintAsPDF()
Dim newPdfFileName As String ' path + name for current .pdf file
newPdfFileName = ActiveDocument.Path & "\" & filePrefix & "-" & numOfPdfs & ".pdf"
Selection.WholeStory ' set font
With Selection.Font
.Name = "Courier New"
.Size = 10.5
End With
ActiveDocument.SaveAs2 newPdfFileName, 17
numOfPdfs = numOfPdfs + 1
Selection.WholeStory
Selection.Delete
End Sub
UserForm code:
'---------------------------------------------------------------------------
' OK BUTTON
'---------------------------------------------------------------------------
Private Sub OKButton_Click()
Dim inputFileOk As Boolean ' input file path
Dim inputSplitOk As Boolean ' split
Dim prefixOk As Boolean ' prefix
If FileTxtBox.Text = vbNullString Then ' validate file path
inputFileOk = False
MsgBox ("File path missing!")
Else
inputFileOk = True
End If
If IsNumeric(SplitTxtBox.Text) Then ' validate breakAfter
breakAfter = SplitTxtBox.Text
inputSplitOk = True
Else
MsgBox ("Non-numeric value for SPLIT!")
End If
If PrefixTxtBox <> vbNullString Then ' validate prefix
filePrefix = PrefixTxtBox.Text
prefixOk = True
Else
MsgBox ("Missing prefix!")
End If
' check if all inputs are ok
If inputFileOk And inputSplitOk And prefixOk Then
cancelActive = False
Unload Me
End If
End Sub
'---------------------------------------------------------------------------
' CANCEL BUTTON
'---------------------------------------------------------------------------
Private Sub CancelButton_Click()
cancelActive = True ' for script termination
Unload Me
End Sub
'---------------------------------------------------------------------------
' FILE BUTTON
'---------------------------------------------------------------------------
Private Sub FileButton_Click()
Dim i As Integer ' file selection index
' show file chooser dialog and assign selected file to sFileName
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
i = Application.FileDialog(msoFileDialogOpen).Show
If i <> 0 Then
sFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
FileTxtBox.Text = sFileName
End If
End Sub
Word stores a lot of information in "temp" files in order to track "unlimited" Undo. If you perform a lot of actions without saving the file or clearing the Undo buffer, this slows Word down. I recommend, therefore:
Clear the Undo buffer (ActiveDocument.UndoClear)
Save the (empty) document periodically
in order to free resources.

Export pictures from excel file into jpg using VBA

I have an Excel file which includes pictures in column B and I want like to export them into several files as .jpg (or any other picture file format). The name of the file should be generated from text in column A. I tried following VBA macro:
Private Sub CommandButton1_Click()
Dim oTxt As Object
For Each cell In Ark1.Range("A1:A" & Ark1.UsedRange.Rows.Count)
' you can change the sheet1 to your own choice
saveText = cell.Text
Open "H:\Webshop_Zpider\Strukturbildene\" & saveText & ".jpg" For Output As #1
Print #1, cell.Offset(0, 1).text
Close #1
Next cell
End Sub
The result is that it generates files (jpg), without any content. I assume the line Print #1, cell.Offset(0, 1).text. is wrong.
I don't know what I need to change it into, cell.Offset(0, 1).pix?
Can anybody help me? Thanks!
If i remember correctly, you need to use the "Shapes" property of your sheet.
Each Shape object has a TopLeftCell and BottomRightCell attributes that tell you the position of the image.
Here's a piece of code i used a while ago, roughly adapted to your needs. I don't remember the specifics about all those ChartObjects and whatnot, but here it is:
For Each oShape In ActiveSheet.Shapes
strImageName = ActiveSheet.Cells(oShape.TopLeftCell.Row, 1).Value
oShape.Select
'Picture format initialization
Selection.ShapeRange.PictureFormat.Contrast = 0.5: Selection.ShapeRange.PictureFormat.Brightness = 0.5: Selection.ShapeRange.PictureFormat.ColorType = msoPictureAutomatic: Selection.ShapeRange.PictureFormat.TransparentBackground = msoFalse: Selection.ShapeRange.Fill.Visible = msoFalse: Selection.ShapeRange.Line.Visible = msoFalse: Selection.ShapeRange.Rotation = 0#: Selection.ShapeRange.PictureFormat.CropLeft = 0#: Selection.ShapeRange.PictureFormat.CropRight = 0#: Selection.ShapeRange.PictureFormat.CropTop = 0#: Selection.ShapeRange.PictureFormat.CropBottom = 0#: Selection.ShapeRange.ScaleHeight 1#, msoTrue, msoScaleFromTopLeft: Selection.ShapeRange.ScaleWidth 1#, msoTrue, msoScaleFromTopLeft
'/Picture format initialization
Application.Selection.CopyPicture
Set oDia = ActiveSheet.ChartObjects.Add(0, 0, oShape.Width, oShape.Height)
Set oChartArea = oDia.Chart
oDia.Activate
With oChartArea
.ChartArea.Select
.Paste
.Export ("H:\Webshop_Zpider\Strukturbildene\" & strImageName & ".jpg")
End With
oDia.Delete 'oChartArea.Delete
Next
This code:
Option Explicit
Sub ExportMyPicture()
Dim MyChart As String, MyPicture As String
Dim PicWidth As Long, PicHeight As Long
Application.ScreenUpdating = False
On Error GoTo Finish
MyPicture = Selection.Name
With Selection
PicHeight = .ShapeRange.Height
PicWidth = .ShapeRange.Width
End With
Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
Selection.Border.LineStyle = 0
MyChart = Selection.Name & " " & Split(ActiveChart.Name, " ")(2)
With ActiveSheet
With .Shapes(MyChart)
.Width = PicWidth
.Height = PicHeight
End With
.Shapes(MyPicture).Copy
With ActiveChart
.ChartArea.Select
.Paste
End With
.ChartObjects(1).Chart.Export Filename:="MyPic.jpg", FilterName:="jpg"
.Shapes(MyChart).Cut
End With
Application.ScreenUpdating = True
Exit Sub
Finish:
MsgBox "You must select a picture"
End Sub
was copied directly from here, and works beautifully for the cases I tested.
''' Set Range you want to export to the folder
Workbooks("your workbook name").Sheets("yoursheet name").Select
Dim rgExp As Range: Set rgExp = Range("A1:H31")
''' Copy range as picture onto Clipboard
rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
''' Create an empty chart with exact size of range copied
With ActiveSheet.ChartObjects.Add(Left:=rgExp.Left, Top:=rgExp.Top, _
Width:=rgExp.Width, Height:=rgExp.Height)
.Name = "ChartVolumeMetricsDevEXPORT"
.Activate
End With
''' Paste into chart area, export to file, delete chart.
ActiveChart.Paste
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Chart.Export "C:\ExportmyChart.jpg"
ActiveSheet.ChartObjects("ChartVolumeMetricsDevEXPORT").Delete
Dim filepath as string
Sheets("Sheet 1").ChartObjects("Chart 1").Chart.Export filepath & "Name.jpg"
Slimmed down the code to the absolute minimum if needed.
New versions of excel have made old answers obsolete. It took a long time to make this, but it does a pretty good job. Note that the maximum image size is limited and the aspect ratio is ever so slightly off, as I was not able to perfectly optimize the reshaping math. Note that I've named one of my worksheets wsTMP, you can replace it with Sheet1 or the like. Takes about 1 second to print the screenshot to target path.
Option Explicit
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Sub weGucciFam()
Dim tmp As Variant, str As String, h As Double, w As Double
Application.PrintCommunication = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
If Application.StatusBar = False Then Application.StatusBar = "EVENTS DISABLED"
keybd_event vbKeyMenu, 0, 0, 0 'these do just active window
keybd_event vbKeySnapshot, 0, 0, 0
keybd_event vbKeySnapshot, 0, 2, 0
keybd_event vbKeyMenu, 0, 2, 0 'sendkeys alt+printscreen doesn't work
wsTMP.Paste
DoEvents
Const dw As Double = 1186.56
Const dh As Double = 755.28
str = "C:\Users\YOURUSERNAMEHERE\Desktop\Screenshot.jpeg"
w = wsTMP.Shapes(1).Width
h = wsTMP.Shapes(1).Height
Application.DisplayAlerts = False
Set tmp = Charts.Add
On Error Resume Next
With tmp
.PageSetup.PaperSize = xlPaper11x17
.PageSetup.TopMargin = IIf(w > dw, dh - dw * h / w, dh - h) + 28
.PageSetup.BottomMargin = 0
.PageSetup.RightMargin = IIf(h > dh, dw - dh * w / h, dw - w) + 36
.PageSetup.LeftMargin = 0
.PageSetup.HeaderMargin = 0
.PageSetup.FooterMargin = 0
.SeriesCollection(1).Delete
DoEvents
.Paste
DoEvents
.Export Filename:=str, Filtername:="jpeg"
.Delete
End With
On Error GoTo 0
Do Until wsTMP.Shapes.Count < 1
wsTMP.Shapes(1).Delete
Loop
Application.PrintCommunication = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Thanks for the ideas! I used the above ideas to make a macro to do a bulk file conversion--convert every file of one format in a folder to another format.
This code requires a sheet with cells named "FilePath" (which must end in a "\"), "StartExt" (original file extension), and "EndExt" (desired file extension). Warning: it doesn't ask for confirmation before replacing existing files with the same name and extension.
Private Sub CommandButton1_Click()
Dim path As String
Dim pathExt As String
Dim file As String
Dim oldExt As String
Dim newExt As String
Dim newFile As String
Dim shp As Picture
Dim chrt As ChartObject
Dim chrtArea As Chart
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Get settings entered by user
path = Range("FilePath")
oldExt = Range("StartExt")
pathExt = path & "*." & oldExt
newExt = Range("EndExt")
file = Dir(pathExt)
Do While Not file = "" 'cycle through all images in folder of selected format
Set shp = ActiveSheet.Pictures.Insert(path & file) 'Import image
newFile = Replace(file, "." & oldExt, "." & newExt) 'Determine new file name
Set chrt = ActiveSheet.ChartObjects.Add(0, 0, shp.Width, shp.Height) 'Create blank chart for embedding image
Set chrtArea = chrt.Chart
shp.CopyPicture 'Copy image to clipboard
With chrtArea 'Paste image to chart, then export
.ChartArea.Select
.Paste
.Export (path & newFile)
End With
chrt.Delete 'Delete chart
shp.Delete 'Delete imported image
file = Dir 'Advance to next file
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Here is another cool way to do it- using en external viewer that accepts command line switches (IrfanView in this case) :
* I based the loop on what Michal Krzych has written above.
Sub ExportPicturesToFiles()
Const saveSceenshotTo As String = "C:\temp\"
Const pictureFormat As String = ".jpg"
Dim pic As Shape
Dim sFileName As String
Dim i As Long
i = 1
For Each pic In ActiveSheet.Shapes
pic.Copy
sFileName = saveSceenshotTo & Range("A" & i).Text & pictureFormat
Call ExportPicWithIfran(sFileName)
i = i + 1
Next
End Sub
Public Sub ExportPicWithIfran(sSaveAsPath As String)
Const sIfranPath As String = "C:\Program Files\IrfanView\i_view32.exe"
Dim sRunIfran As String
sRunIfran = sIfranPath & " /clippaste /convert=" & _
sSaveAsPath & " /killmesoftly"
' Shell is no good here. If you have more than 1 pic, it will
' mess things up (pics will over run other pics, becuase Shell does
' not make vba wait for the script to finish).
' Shell sRunIfran, vbHide
' Correct way (it will now wait for the batch to finish):
call MyShell(sRunIfran )
End Sub
Edit:
Private Sub MyShell(strShell As String)
' based on:
' http://stackoverflow.com/questions/15951837/excel-vba-wait-for-shell-command-to-complete
' by Nate Hekman
Dim wsh As Object
Dim waitOnReturn As Boolean:
Dim windowStyle As VbAppWinStyle
Set wsh = VBA.CreateObject("WScript.Shell")
waitOnReturn = True
windowStyle = vbHide
wsh.Run strShell, windowStyle, waitOnReturn
End Sub

How to store and then display picture using vb6 and oracle?

'code to load picture into database table
Private Function GetPic()
Dim filelen As Long
Dim numlock As Integer
Dim leftover As Long
Const blocksize = 100000
Dim pic As String
Dim bytedata() As Byte
Dim sfile As Integer
sql = "select PICS from student_record_database " //empty field with no pictures
RES.Open sql, CON, adOpenDynamic, adLockOptimistic
sfile = App.Path & "/mypic/Book1.xls" //error : type mismatch
Open sfile For Binary Access Read As #1
filelen = LOF(sfile)
If filelen = 0 Then
Close sfile
MsgBox ("empty or not found")
Else
numlock = filelen / blocksize
leftover = filelen Mod blocksize
ReDim bytedata(leftover)
Get sfile, , bytedata()
RES(1).AppendChunk bytedata()
ReDim bytedata(blocksize)
For i = 1 To numlock
Get sfile, , bytedata()
RES(1).AppendChunk bytedata()
Next i
RES.Update
Close sfile
End If
End Function
'code to display picture in picture box from table
Private Function ShowPic()
Dim bytedata() As Byte
Dim file As String
Dim filelen As Long
Dim numlock As Integer
Dim leftover As Long
Const blocksize = 100000
file = App.Path & "\image1.jpeg"
Open file For Binary As #1
numlock = filelen / blocksize
leftover = filelen Mod blocksize
bytedata() = RES(1).GetChunk(leftover)
Put file, , bytedata()
For i = 1 To numlock
bytedata() = RES(1).GetChunk(blocksize)
Put file, , bytedata()
Next i
Close file
End Function
Here is my full code to insert pictures using vb in an oracle table database.
Next I display those pictures in picture box of vb application as per their records, but it is showing an error of "type mismatch" and picture is not shown in picture box.
you declared sFile as an integer, but are trying to load a string in it
Dim sFile as string
sfile = App.Path & "/mypic/Book1.xls"

Applying a command on many objects ? VB6

thanks for reading.
I'm writing a program to create a list consisting of 8 cols. so there are8 listboxes and a textbox under each one.
I want to check each textbox one by one if anyone is empty or not. ...and dunno how to do that!
I need your help!
thanks
instead of using 8 listboxes you might consider using a flexgrid control
but using 8 listboxes and 8 textboxes, you can create them as an array and check them as follows :
'1 form with with
' 1 listbox : name=List1 index=0
' 1 textbox : name=Text1 index=0
' 1 commandbutton : name=Command1
Option Explicit
Private Sub Command1_Click()
If IsEmpty Then
MsgBox "Textboxes are all empty", vbInformation, "IsEmpty"
Else
MsgBox "At least 1 Textbox is not empty", vbInformation, "IsEmpty"
End If
End Sub
Private Sub Form_Load()
Dim intIndex As Integer
For intIndex = 1 To 7
Load List1(intIndex)
Load Text1(intIndex)
List1(intIndex).Visible = True
Text1(intIndex).Visible = True
Next intIndex
Move 0, 0, 10000, 10000
End Sub
Private Function IsEmpty() As Boolean
Dim intIndex As Integer
Dim blnEmpty As Boolean
blnEmpty = True
For intIndex = 0 To Text1.Count - 1
If Len(Text1(intIndex).Text) > 0 Then
blnEmpty = False
Exit For
End If
Next intIndex
IsEmpty = blnEmpty
End Function
Private Sub Form_Resize()
Dim intIndex As Integer
Dim sngWidth As Single
Dim sngListWidth As Single, sngListHeight As Single
Dim sngTextHeight As Single
Dim sngCmdHeight As Single
sngWidth = ScaleWidth
sngListWidth = sngWidth / List1.Count
sngTextHeight = 315
sngCmdHeight = 315
sngListHeight = ScaleHeight - sngTextHeight - sngCmdHeight
For intIndex = 0 To List1.Count - 1
List1(intIndex).Move intIndex * sngListWidth, 0, sngListWidth, sngListHeight
Text1(intIndex).Move intIndex * sngListWidth, sngListHeight, sngListWidth, sngTextHeight
Next intIndex
Command1.Move 0, sngListHeight + sngTextHeight, sngWidth, sngCmdHeight
End Sub

Resources