VBForums - Visual Basic 6 and Earlier

battleship help msflexgrid

firezap — Mon, 20 May 2013 02:41:15 GMT

This is what the computer's grid looks like. How to make computer randomly place his ships on the grid. Place vertically or horizontally randomly. The ships are: 1 ship of length 5, 1 ship of length 4, 1 ship of length 3, 1 ship of length 3, 1 ship of length 2. The grid will still look like this after the ships are placed. When i click on the grid how do i check for a hit or a miss? if it's a hit i want to change the CellBackColor to red or if it's miss then i change CellBackColor to white.

Attached Images

Question in IF STATEMENT

phatus — Mon, 20 May 2013 01:26:42 GMT

im adding a 3 o'clock habit in my program every 3 pm in the computer clock an automatic voice will speak here is my code

my code in Hour Label

Code:

lblhr.Caption = Format$(Now, "hh:mm:ss AM/PM")

this will be put in my Form_Load

Code:

If lblhr.caption=3:00:00 pm then

             

             Dim app_path As String

                  app_path = App.Path

             

             If Right$(app_path, 1) <> "\" Then

                      app_path = app_path & "\"

                           txtmusic.Text = app_path & "3oclockhabit.wav"

                  With mmcplayer

                      .Filename = txtmusic.text

                          .Command = "open"

                             .Command = "play"

                   End With

             End If



         End If

my problem is in the highlighted color what will i put... thanx

Initiating a do until loop

TryingtoCode — Sun, 19 May 2013 20:26:57 GMT

Hello!

I have a large set of data that I want to be extracted into certain phases. And I am trying to write a code to do so. For example the freezing cycle begins when the value in column F hits 1 and G is 18 goes until it F is 10 and G is -35 I am familiar with the do until loop which I have now and that will extract up until F is 10 and G is -15 However, is there a way to set an initial condition (F=1 and G=18)? The code below has it extracting and putting into new sheet. Thank you for your help!!

Dim mycount As Integer
mycount = 0
Dim myrow As Integer
myrow = 1
Dim oldrow As Integer
Dim startnext As Integer

Do
mycount = mycount + 1
oldrow = myrow + 1
startnext = oldrow
Sheets("Data").Select ''must be name of sheet with data

Do Until Cells(myrow, 6).Value = "10" And Cells(myrow, 7).Value = "-35"
myrow = myrow + 1
Loop

Sheets.Add
ActiveSheet.Name = "FreezeData"
Sheets("Data").Select
rows(oldrow & ":" & myrow).Select
Selection.Copy
Sheets("FreezeData").Select
Range("A1").Select
ActiveSheet.Paste

Loop Until Sheets("Data").Cells(1, myrow + 1) = ""

How to play sound from memory using mciSendString API

jmsrickland — Sun, 19 May 2013 18:50:02 GMT

VB 6

I know how to play sounds from reading a .wav file but I need to be able to play sounds from memory. I want to load a wave file into a byte array and then be able to play from that array using mciSendString.

i need help with my game

mslvr40 — Sun, 19 May 2013 16:37:13 GMT

I am trying to get an array of images to move in sequence. however when the value of i changes, one the barrel stops rolling and another one starts. how would i get them to continue rolling after the value of i changes. i have tried many different loops but i cant really get it to work.

Private Sub tmrbarrel_Timer()
If Image3(i).Visible = True Then
Image3(i).Left = Image3(i).Left + 25
End If
End Sub

Private Sub tmrcounter_Timer()
i = i + 1
Image3(i).Visible = True
End Sub

Thanks in advance

Having trouble with control array

mslvr40 — Sun, 19 May 2013 15:37:11 GMT

sorry if this is a noob problem.

I have 30 pictures in a control array and i keep getting an error message that says control array element 31 does not exist

Private Sub tmrbarrel_Timer()
For i = 0 To Image3.UBound
If Image3(i).Visible = True Then
Image3(i).Left = Image3(i).Left + 25
End If
Next
End Sub

Private Sub tmrcounter_Timer()
i = i + 1
Image3(i).Visible = True
End Sub

Conversion Problem

couttsj — Sun, 19 May 2013 15:21:53 GMT

I need some help with a Crypto call. According to MSDN, the following C++ call sets the random string from the client:

Code:

Data.pbData = pClientRandom;

Data.cbData = cbClientRandom;

CryptSetKeyParam(

        hMasterKey, 

        KP_CLIENT_RANDOM, 

        (PBYTE)&Data, 

        0);

Converting to VB, the function is declared as:

Code:

Private Declare Function CryptSetKeyParam Lib "advapi32.dll" (ByVal hKey As Long, ByVal dwParam As Long, ByVal pbData As Long, ByVal dwFlags As Long) As Long

The call:

Code:

CryptSetKeyParam(hMasterKey, KP_CLIENT_RANDOM, hClientRandom, 0)

returns an error. However, the call works when using KP_SCHANNEL_ALG (20) instead of KP_CLIENT_RANDOM (21) or KP_CLIENT_SERVER (22). According to Microsoft, the structure of "pbData" will vary, depending on the value of "dwParam". In the case of KP_CLIENT_RANDOM, "pbData" is a handle to a byte string containing 32 bytes of random data from the client followed by whatever cbClientRandom is. Some sources suggest that this is a BLOB structure, which means that cbClientRandom should be a 4 byte long integer (DWORD) containing the length of pClientRandom.

I have tried every combination I can think of, but the call always returns an error. Any help would be appreciated.

J.A. Coutts

Need two .wav files - one exactly 10 seconds and the other exactly 60 seconds

jmsrickland — Sun, 19 May 2013 15:14:19 GMT

How can I get a hold of or make two wave files one exactly 10 seconds duration and the other exactly 60 seconds duration. The sound doesn't matter.

hardware key

kushaladhikari12 — Sun, 19 May 2013 14:06:38 GMT

i am on vb6 and working on small program to get hardware register key on label1.caption when user clickes command button
help me plz

Allowing a Visual Basic Application to Accept Drag-and-Drop Files

ladoo — Sun, 19 May 2013 10:43:13 GMT

Tip 86: Allowing a Visual Basic Application to Accept Drag-and-Drop Files
May 15, 1995

Abstract
Many Windows�-based applications can accept, or process, a file that has been dragged from File Manager. This article explains how you can add this feature to your own Visual Basic� application.

Code:

Using MSGBLAST.VBX to Accept Drag-and-Drop Files

Using File Manager, you can drag a file to another application and, when you release the mouse button (drop the file), the target application can process the file any way it wants to.



In order for a program to be able to accept drag-and-drop files, however, the program must have a method of recognizing when a file has been sent to it. In Visual Basic�, this can be done by using the Message Blaster custom control and three Windows� application programming interface (API) functions: DragAcceptFiles, DragQueryFile, and DragFinish.



The DragAcceptFiles function tells Windows that a specific window (that is, your Visual Basic application's form) can accept files dropped from File Manager. The Declare statement for this function is:



Private Declare Sub DragAcceptFiles Lib "shell" (ByVal hWnd As Integer, ByVal 

   bool As Integer)



(Note that this Declare statement must be typed as a single line of code.)



The DragAcceptFiles function takes only two arguments: the handle of the window that will accept the dropped files, and an integer value that specifies if the file can be accepted or ignored. If the Boolean argument is set to True, the window can accept dropped files; if it is set to zero, the window can no longer accept dropped files.



You can retrieve the name of the file that was dropped on the target window by calling the DragQueryFile function. This function's declaration statement is:



Private Declare Function DragQueryFile Lib "shell" (ByVal wParam As Integer, 

   ByVal Index As Integer, ByVal lpszFile As Any, ByVal BufferSize As Integer)

   As Integer



(Note that this Declare statement must be typed as a single line of code.)



DragQueryFile requires four arguments, as follows:



wParam An integer value that contains the internal data structure's handle. This is provided by the WM_DROPFILES message. 

Index An integer value containing the number of the individual file to be retrieved. If this value is -1, the number of files listed in the wParam structure will be returned. 

lpszFile A string buffer that contains the name of the dropped file. 

BufferSize An integer value containing the maximum number of characters in lpszFile. 



After calling the DragQueryFile function, an integer value reports the status of the function. This value contains the number of characters copied to the lpszFile string or the number of files available if Index was set to zero.



The third function needed to work with drag-and-drop files is the DragFinish function. This function simply requires that the internal data structure's handle be passed to it. DragFinish frees all structures used when transferring the file to the target application.



The final step is to process the WM_DROPFILES message. This message is sent by Windows each time it needs to send a drag-and-drop request to a program. In your Visual Basic program you need only use the Message Blaster custom control to intercept the WM_DROPFILES message before Windows actually processes it itself. In the example program below, we use the Message Blaster control to retrieve the name of the dropped file and store that name in the List Box control.



Example Program

The example program below shows how to allow your Visual Basic application to accept drag-and-drop files from File Manager. To use this demonstration program, first execute the Windows Explorer or File Manager application. Then run the DEMO.EXE program. When you drag a file from File Manager to DEMO.EXE's window and release the mouse button, the filename will be displayed in the List Box control. 



Create a new project in Visual Basic. Form1 is created by default. 

Add the following code to the General Declarations section of Form1 (note that each Declare statement must be typed as a single line of code): 

Option Explicit

Private Declare Sub DragAcceptFiles Lib "shell" (ByVal hWnd As Integer, ByVal 

bool As Integer)

Private Declare Function DragQueryFile Lib "shell" (ByVal wParam As Integer, 

ByVal Index As Integer, ByVal lpszFile As Any, ByVal BufferSize As Integer) 

As Integer

Private Declare Sub DragFinish Lib "shell" (ByVal hDrop As Integer)

Const WM_DROPFILES = &H233



Add the following code to the Form_Load event for Form1: 

Private Sub Form_Load()

msgblaster1.MsgList(0) = WM_DROPFILES

msgblaster1.hWndTarget = Me.hWnd

msgblaster1.MsgPassage(0) = 1

DragAcceptFiles Me.hWnd, True



End Sub



Add a Message Blaster custom control to Form1. MsgBlaster1 is created by default. 

Add the following code to the MsgBlaster1_Message event for MsgBlaster1: 

Private Sub MsgBlaster1_Message(MsgVal As Integer, wParam As Integer, lParam As 

Long, ReturnVal As Long)

Dim hFilesInfo As Integer

Dim szFileName As String

hFilesInfo = wParam

wTotalFiles = DragQueryFile(hFilesInfo, &HFFFF, ByVal 0&, 0)

For wIndex = 0 To wTotalFiles

szFileName = Space$(50)

Retv% = DragQueryFile(hFilesInfo, wIndex, szFileName, 50)

list1.AddItem szFileName

Next wIndex

DragFinish (hFilesInfo)

End Sub



Compile the program. From Visual Basic's File menu, select Make EXE File to create the executable file called DEMO.EXE.

need help making this source

how to get the data on a text box?

jini.fernandez — Sun, 19 May 2013 07:46:35 GMT

hi,
i am trying to get a specific record to a number of textboxes from ms access database. but iam not able to do that. please help me here is the coding which i am trying to do. many thanks

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = Nothing
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\user\Desktop\NEW DB\FAITH.mdb;Persist Security Info=False"
cn.Open
Set rs = New ADODB.Recordset
rs.ActiveConnection = cn
rs.Source = (" SELECT * FROM FAITH WHERE EMPLOYEE_ID = ' " & Form2.Text1.Text & " '")
rs.Open
Text1.Text = rs.Fields("S NO").Value
Text2.Text = rs.Fields("FIRST NAME").Value

Help loading into an arry

kyle.smith — Sun, 19 May 2013 00:43:34 GMT

Hi folks,

Long time lurker, about 7 years now? This site has been a great amount of help over the years, but I can't find any answers for this one...

Basically, I have a bunch of XML files I have to open, read, parse and assign variables from that XML file to variables in my application.

Each script, for each XML file basically looks like this:

Code:

    Dim objNodeList As IXMLDOMNodeList

    Dim objNode As IXMLDOMNode

    Dim objAttrib As IXMLDOMAttribute

    Dim theDoc As MSXML2.DOMDocument

    Set theDoc = New MSXML2.DOMDocument

    theDoc.Load activeDirectory & "\file1.xml"

        

    location1name = theDoc.selectSingleNode("//location/neighborhood").Text



    set theDoc = Nothing

I have to do this for about 5-10 XML files, the amount of XML files changes depending on availability external to the app. Right now I have a logic in place that says if the file exists open it. If the file exists, it sets a flag that says xml1Present = 1

I then have to take another statement that says if xml1Present = 1, open xml 1

THEN once all the variables are assigned I have to use them with the application by individually calling them... To open the variable in the above code I would have to call:

Code:

MsgBox location1Name

Correct me if I'm wrong, but would it not be easier to have all of the load into an array?

ONE XML loading script that basically cycles though all 1 to maybe 15 XML files, then loads the variables (theDoc.selectSingleNode("//location/neighborhood").Text) into an array so that if I wanted to call that data, I'd just have to call:

Code:

MsgBox locationName(0)

MsgBox locationName(0)

' etc?

Thanks again for everyone help over the years.

Global/ public array problem

Josesilva35 — Sat, 18 May 2013 23:08:13 GMT

Hello guys, Im trying to develop a visualizer for a program that i have made before, i made some kind of searcher but one i get an array and try to use it in a different instance it shows an erres, i would appreciate any kind of help, thanks.

the error is when i try to use the array B() on the command 2 click, it says the subindex is out of the bound. any idea?

here's the code

Public num As Integer
Public tope As Integer
Public ruta As String
Public nactivo As String
Private Sub Command1_Click()
num = num + 1
If num >= tope Then
Command1.Enabled = False
Else
If (num >= 1 And num <= (tope - 1)) Then
Command1.Enabled = True
Command2.Enabled = True
End If
End If
Label2.Caption = num
End Sub
Public Sub Command2_Click()
num = num - 1
If num <= 0 Then
Command2.Enabled = False
Else
If (num >= 1 And num <= (tope - 1)) Then
Command1.Enabled = True
Command2.Enabled = True
End If
End If

Label2.Caption = num

OLE1.SourceDoc = ruta & "\" & nactivo & B(num)
OLE1.CreateEmbed ruta & "\" & nactivo & B(num)
OLE1.Update
End Sub

Public Sub Command3_Click()

Dim fso As New Scripting.FileSystemObject
Dim fld As Scripting.Folder
Dim fil As Scripting.File
Dim lngCount As Long
Dim count As Integer
Dim num As Integer
Dim A() As String
Dim arreglo(29) As String
Dim B() As String

arreglo(0) = "C:\SDOM\Caldera y auxiliares\aceite liviano"
arreglo(1) = "C:\SDOM\Caldera y auxiliares\Agua alimentacion"
arreglo(2) = "C:\SDOM\Caldera y auxiliares\Agua de circulacion"
arreglo(3) = "C:\SDOM\Caldera y auxiliares\Aire y gases de combustion"
arreglo(4) = "C:\SDOM\Caldera y auxiliares\Caldera"
arreglo(5) = "C:\SDOM\Caldera y auxiliares\Condensado principal"
arreglo(6) = "C:\SDOM\Caldera y auxiliares\Dosificador quimico"
arreglo(7) = "C:\SDOM\Caldera y auxiliares\Gas natural"
arreglo(8) = "C:\SDOM\Caldera y auxiliares\Manejo de ceniza"
arreglo(9) = "C:\SDOM\Caldera y auxiliares\Manejo y quemado de carbon"
arreglo(10) = "C:\SDOM\Caldera y auxiliares\Sopladores de hollin"
arreglo(11) = "C:\SDOM\Caldera y auxiliares\Tratamiento de agua"
arreglo(12) = "C:\SDOM\Caldera y auxiliares\Vapor auxiliar"
'-----
arreglo(13) = "C:\SDOM\Miscelaneos y auxiliares\Control automatico planta"
arreglo(14) = "C:\SDOM\Miscelaneos y auxiliares\Control ambiental"
arreglo(15) = "C:\SDOM\Miscelaneos y auxiliares\Comunicaciones planta"
arreglo(16) = "C:\SDOM\Miscelaneos y auxiliares\Drenaje planta"
arreglo(17) = "C:\SDOM\Miscelaneos y auxiliares\Agua enfriamiento cojinetes"
arreglo(18) = "C:\SDOM\Miscelaneos y auxiliares\Agua y servicio de agua potable"
arreglo(19) = "C:\SDOM\Miscelaneos y auxiliares\Aire comprimido e instrumentos"
arreglo(20) = "C:\SDOM\Miscelaneos y auxiliares\Alumbrado"
arreglo(21) = "C:\SDOM\Miscelaneos y auxiliares\Contraincendio"
arreglo(22) = "C:\SDOM\Miscelaneos y auxiliares\Edificio y vias"
arreglo(23) = "C:\SDOM\Miscelaneos y auxiliares\Equipos y herramientas talleres"
arreglo(24) = "C:\SDOM\Miscelaneos y auxiliares\Transporte carga"
'-----
arreglo(25) = "C:\SDOM\Turbogenerador y auxiliares\Bypass alta y baja presion"
arreglo(26) = "C:\SDOM\Turbogenerador y auxiliares\Generador"
arreglo(27) = "C:\SDOM\Turbogenerador y auxiliares\Potencia electrica"
arreglo(28) = "C:\SDOM\Turbogenerador y auxiliares\Turbina"
arreglo(29) = "C:\SDOM\Turbogenerador y auxiliares\Vapor sello y vacio condensador"

Dim numactivo() As Integer

count = 0
sal = 0
lngCount = 0
For i = 0 To 29

Set fld = fso.GetFolder(arreglo(i))

For Each fil In fld.Files
count = count + 1
ReDim A(count)
A(count) = fil.Name
nactivo = Left(A(count), 6)

auxnombre = fso.GetFileName(fil.Path)
auxnombre2 = Left(auxnombre, 6)

If auxnombre2 = text1.Text Then
lngCount = lngCount + 1

ReDim B(lngCount)

aux7 = Len(A(count))
aux8 = aux7 - 6
aux9 = Right(A(count), aux8)

B(lngCount) = aux9

MsgBox B(lngCount)

tope = lngCount
End If

If nactivo = text1.Text Then
ruta = arreglo(i)
numarchivos = lngCount
Archivo = A(count)

End If

'MsgBox A(count)

Next fil

Next i

MsgBox numarchivos
MsgBox ruta

Set fil = Nothing
Set fld = Nothing
Set fso = Nothing
MsgBox lngCount
num = count

OLE1.SourceDoc = ruta & "\" & Archivo
OLE1.CreateEmbed ruta & "\" & Archivo
OLE1.Update

End Sub

how do display the last customers entry

salsa31 — Sat, 18 May 2013 16:59:07 GMT

hello everyone
i have a database with customers that i add each day
im trying to figure out how to see the new entries that i add in the same day
how many customers i added in the same day
like a report or something like that
i need a idea where to start this
regards salsa

MSHFlexGrid edit problem: textbox won't show

jlynoel25 — Sat, 18 May 2013 14:23:25 GMT

I'm working on a program, which included an "editable" grid (MSHFlexGrid). I borrowed code from a VB book, which told me to superimpose a textbox whenever I click a cell.

With MSHFlexgrid1
' Cancel range selection, if any.
.RowSel = .Row
.ColSel = .Col
' Move the cell editor into place by making it one pixel smaller
' than the current cell.
txtCellEditor.Move .Left + .CellLeft, .Top + .CellTop, _
.CellWidth - ScaleX(1, vbPixels, vbTwips), _
.CellHeight - ScaleY(1, vbPixels, vbTwips)
' Transfer the contents of the current cell into the TextBox.
txtCellEditor.Text = .Text
' Move the TextBox in front of the grid.
txtCellEditor.Visible = True
txtCellEditor.ZOrder
txtCellEditor.SetFocus
' Remember current coordinates for later.
cellRow = .Row
cellCol = .Col
End With

I really don't see any problem with the code. I just don't know why the textbox (txtCellEditor) won't show whenever I invoke the click button on the grid. More surprisingly, the data I enter in the textbox is entered into the grid after the textbox loses focus. Just wondering how to make that textbox appear and let the user see what he is editing.

Hope anyone can help. Thanks in advance!!!