VB6 label.caption property not changing - vb6

I have a label that the caption property does not change when written to.
The label caption stays with the text condition on program start.
The BackColor changes properly.
txtBlower.LinkTopic = strTopic 'get F/A Blower Status
txtBlower.LinkItem = "N7:12"
txtBlower.LinkMode = 1
If txtBlower.Text = "1" Then
lblBlower.BackColor = vbGreen
lblBlower.Caption = "BLOWER ON"
End If
If txtBlower.Text = "0" Then
lblBlower.BackColor = vbRed
lblBlower.Caption = "BLOWER OFF"
End If
The following is also in the program and works just fine.
txtWinter.LinkTopic = strTopic 'get Winter bit
txtWinter.LinkItem = "N7:19"
txtWinter.LinkMode = 1
If txtWinter.Text = "1" Then
lblWinter.BackColor = vbBlue
lblWinter.Caption = " WINTER"
Else:
lblWinter.BackColor = vbYellow
lblWinter.Caption = " SUMMER"
End If
I can't find any differences in the properties of the text boxes or the labels.

Related

Using CDO.Message in VBscript - can't send binary attachment

Sending an email with a text file attached, this works (test email is received):
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "sender#domain.tld"
emailObj.To = "recipient#domain.tld"
emailObj.Subject = "File attached"
emailObj.TextBody = "Please have a look at the attached file. Thanks."
emailObj.AddAttachment "d:\temp\test.txt"
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "server.webhost.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "sender#domain.tld"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "top_secret"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Your file has been sent. Someone will respond as soon as possible."
But when I try to send a binary file, this does NOT work (test email message is not received):
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "sender#domain.tld"
emailObj.To = "recipient#domain.tld"
emailObj.Subject = "File attached"
emailObj.TextBody = "Please have a look at the attached file. Thanks."
emailObj.AddAttachment "d:\temp\test.rtf"
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "server.webhost.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "sender#domain.tld"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "top_secret"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Your file has been sent. Someone will respond as soon as possible."
What do I need to add/change to be able to attach a binary file?

Crystal report not showing in application

I have a function that i am using to show crystal reports in my application. Everything was fine until yesterday afternoon and now it is showing nothing but a blank window. But it is not giving any error.In crystal report designer it is showing values while previewing. I am using stored procedure to retrieve values from DB. Here is my code
Public Sub ShowReport(ParamArray reportParameters())
On Error GoTo Catch
Dim NTOT As Integer
Dim nCtr As Integer
Dim LoopCount As Integer
Dim ReportPath As String
Open App.Path & "/Reports.txt" For Input As #1
Input #1, ReportPath
Close #1
ReportPath = ReportPath & "\Reports\" & reportParameters(0)
'MsgBox ReportPath
Screen.MousePointer = vbHourglass
With frmReports.Crpt
.Reset
.WindowTop = 0
.WindowLeft = 0
.ReportFileName = ReportPath
'.RetrieveStoredProcParams
For LoopCount = 3 To UBound(reportParameters)
.StoredProcParam(LoopCount - 3) = reportParameters(LoopCount)
Next
.WindowTitle = reportParameters(1)
.ReportTitle = reportParameters(1)
.WindowParentHandle = frmReports.hwnd
.WindowShowSearchBtn = True
.WindowShowPrintSetupBtn = True
.WindowShowRefreshBtn = True
.WindowShowProgressCtls = True
.WindowShowZoomCtl = True
.WindowShowGroupTree = True
.WindowAllowDrillDown = True
.ProgressDialog = True
.PageZoom (100)
.WindowState = crptMaximized
If reportParameters(2) = "P" Then
.Destination = crptToPrinter
Else
.Destination = crptToWindow
End If
.Action = 1
End With
Screen.MousePointer = vbNormal
Exit Sub
Catch:
Screen.MousePointer = vbNormal
End Sub
I am using VB6 and crystal reports version is 8
what is wrong in this code? Can anyone find a solution for this

how search for an item in a datagrid view

I am having a problem while searching for an item in datagridview
here is my code but whenever i search for an item which already exist in the database, it is telling not found
If txtfirstname.Text = "" Then
MsgBox("Please enter first name!")
Else
Dim totalrow As Integer = DataGridView1.RowCount - 2
Dim rowin As Integer
Dim flag As Boolean = False
Dim sear As String = CStr(txtfirstname.Text)
For rowin = 0 To totalrow
Dim id As String = DataGridView1.Item(0, rowin).Value
If sear = id Then
DataGridView1.ClearSelection()
DataGridView1.Rows(rowin).Selected = True
DataGridView1.CurrentCell = DataGridView1.Item(0, rowin)
flag = True
Exit Sub
Else
flag = False
End If
Next rowin
If flag = False Then
MessageBox.Show("Firstname " & txtfirstname.Text & " is not found in database.", "Search Information", MessageBoxButtons.OK, MessageBoxIcon.Information)
End If
End If
By setting
Dim totalrow As Integer = DataGridView1.RowCount - 2
you are always missing the last record in your dataset.
Try
Dim totalrow As Integer = DataGridView1.RowCount - 1
to set the upper bound value of your For loop.

Flex grid non editable column

I don't want to edit some of the column in flex gird.
Flex Grid
column1, column2, .... column35
i want to edit from column1... column10 only, remaining columns i don't want to edit or type.
How to do in vb6.
I believe the MS Flex Grid was designed for displaying data and not editing. If you need to edit cell data you can accomplish it using the Flex Grid using an approach of superimposing a textbox at runtime to capture user data entry and set the "Text" property of the cell in code. Otherwise you can choose to use a different control.
Here are some examples of the aforementioned approach:
http://support.microsoft.com/kb/241355
http://www.vb-helper.com/howto_edit_flexgrid_control.html
I've made a special user control in VB6 to an editable grid. If you want I can send you a copy.
The code I use to enable to edit a cell is the follow:
Private Sub fg_KeyDown(KeyCode As Integer, Shift As Integer)
Dim Cancel As Boolean
Dim Idc As Long
Dim x
If KeyCode = vbKeyEscape And Shift = 0 Then
If Not fgLocked Then
If fgRowChanged Then
RaiseEvent BeforeRestoreBuffer
For Idc = 1 To UBound(fgBuffer)
x = fgBuffer(Idc)
fgValues(Idc, fg.Row) = x
If fgColFormat(Idc) = "*" And fgBuffer(Idc) <> "" Then
fg.TextMatrix(fg.Row, Idc) = "*******"
ElseIf fgColFormat(Idc) = "RTF" Then
fg.TextMatrix(fg.Row, Idc) = Format(fgBuffer(Idc), "")
Else
fg.TextMatrix(fg.Row, Idc) = Format(fgBuffer(Idc), fgColFormat(Idc))
End If
Next
fgRowChanged = False
RaiseEvent RestoreBuffer
End If
End If
ElseIf KeyCode = vbKeyReturn And Shift = 0 Then
NextCell
ElseIf KeyCode = vbKeyF2 And Shift = 0 Then
If Not fgLocked Then
If fgColFormat(fg.Col) = "RTF" Then
CellEditBig fgValues(fg.Col, fg.Row)
Else
CellEdit fgValues(fg.Col, fg.Row)
End If
End If
ElseIf KeyCode = vbKeyF2 And Shift = vbShiftMask Then
If Not fgLocked Then
CellEditBig fgValues(fg.Col, fg.Row)
End If
ElseIf KeyCode = vbKeyDelete And Shift = 0 Then
If Not fgLocked Then
RaiseEvent BeforeDelete(Cancel)
If Not Cancel Then
If fg.Rows = fg.FixedRows + 1 Then
fg.AddItem ""
If fgRowNumber Then fg.TextMatrix(fg.Rows - 1, 0) = fg.Rows - 1
fgValues_AddItem ""
End If
fg.RemoveItem fg.Row
If fgRowNumber Then Renumera
fgValues_RemoveItem fg.Row
LoadBuffer fg.Row
RaiseEvent AfterDelete
End If
End If
ElseIf KeyCode = vbKeyInsert And Shift = 0 Then
If Not fgLocked Then
RaiseEvent BeforeInsert(Cancel)
If Not Cancel Then
fg.AddItem "", fg.Row
If fgRowNumber Then Renumera
fgValues_AddItem "", fg.Row
RaiseEvent AfterInsert
End If
End If
Else
RaiseEvent KeyDown(KeyCode, Shift)
End If
End Sub

How to change listbox instead of list view

Below code is working for list view, but i want to use listbox instead of list view
lst = listview from the below code
Dim idx as integer
idx = 1
lst.ListItems.Clear
If Emp.Employees.RecordCount > 0 Then
Emp.Employees.MoveFirst
While Not Employees.EOF
lst.ListItems.Add idx, , EmployeeID
lst.ListItems(idx).ListSubItems.Add , , FirstName
If IsAssigned(EmployeeID, CurrentSchedule) Then
lst.ListItems(idx).Checked = True
Else
lst.ListItems(idx).Checked = False
End If
idx = idx + 1
Employees.MoveNext
Wend
End If
Listbox name is lstbox
I tried
lstbox.selected(I) = true is not working instead of lst.ListItems(idx).Checked = True
with aListbox
.Clear
'//loop here
.additem "The Item Text"
'//add the numeric id value
.itemdata(.NewIndex) = 112233
'//check it
if (condition) then
.Selected(.NewIndex) = True
end if
end with
'//sample click
msgbox aListbox.list(aListbox.listindex) & " id=" & aListbox.itemdata(aListbox.listindex)

Resources