how can I create a textbox with two forward slashes that when I input date, those forward slashes will just stay in place? I will not be using datepicker
↧
[RESOLVED] textbox with slash for date
↧
Private vs. Public User Control?
Ok not sure if the title is the most descriptive one, but I have this problem. In a User Control (UC) I have the following
But it causes the exception
This component doesn't support this set of events (Error 459)
Not every component supports client sinking of events. This error has the following cause and solution:
I suspect it's the 2nd reason that applies here, although not sure. The idea is to hook or embed some of the form events inside the UC to run some code. Also, the idea is that the form shouldn't need to now if the UC is sited on it or not. Furthermore, the same code would need to run on any form UC is sited on, so this removes the need to add this code to each form UC is sited on.
Question is though, can this be done at all? And if it's a question of Private vs. Public scope/instance of UC, how can Public be acheived? I also would like to add that, although I have done VB6 basically since its release I have never come to work with UCs until now, so maybe it's obvious in a way I don't see because my mind is trying to look at too many things at one time. But this UC is in an ocx project, is that what makes it private? Would putting it directly in the StandardEXE project achieve what I want?
Greatful for any input or deriction to where I can find more and deeper info. I tried to google but didn't get anything relevant back.
/Joakim
Code:
'UC Declaration section
Private WithEvents mFrm As Form
...
Private Sub UserControl_InitProperties()
..
Set mFrm = Extender.Parent
...
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
...
Set mFrm = Extender.Parent
...
End SubQuote:
This component doesn't support this set of events (Error 459)
Not every component supports client sinking of events. This error has the following cause and solution:
- You tried to use a WithEvents variable with a component that can't work as an event source for the specified set of events. For example, you may be sinking events of an object, then create another object that Implements the first object. Although you might think you could sink the events from the implemented object, that isn't automatically the case. Implements only implements an interface for methods and properties.
You can't sink events for a component that doesn't source events. - WithEvents isn't supported for Private UserControls, because the type-info needed to raise the ObjectEvent isn't available at runtime.
Question is though, can this be done at all? And if it's a question of Private vs. Public scope/instance of UC, how can Public be acheived? I also would like to add that, although I have done VB6 basically since its release I have never come to work with UCs until now, so maybe it's obvious in a way I don't see because my mind is trying to look at too many things at one time. But this UC is in an ocx project, is that what makes it private? Would putting it directly in the StandardEXE project achieve what I want?
Greatful for any input or deriction to where I can find more and deeper info. I tried to google but didn't get anything relevant back.
/Joakim
↧
↧
MsFlexGrid sorted
Hi !
From a Random access file I collect first- and surnames and put them in a MsFlexGrid (G1), using sort for col no 1:
To sort by first name works fine. But the very last of the first names in the file happens to be placed in the first row, even when it's not belong there at all.
It doesn't help if I shorten the input, to stop with the next last item and reduce the number of rows. Now the second last of the first names will also be placed at the uppermost place - just as before.
It helps to add an empty post at the end of the file, or make an empty post after the for-next loop, but then I have an empty row to start the name list in my grid...
I don't understand what I'm doing wrong and why this happens...
What can I do to get it straight ?
Best regards
/Kalle in Sweden
From a Random access file I collect first- and surnames and put them in a MsFlexGrid (G1), using sort for col no 1:
Code:
G1.Cols = 3: G1.Rows = File Records: G1.ColWidth(1) = Width1: G1.ColWidth(2) = Width2
For A = 1 To File Records
Get #1, A, FilePost
G1.Col = 0: G1.Text = CStr(A)
G1.Col = 1: G1.Sort = 1: G1.Text = Trim(FirstName)
G1.Col = 2: G1.Text = Trim(SureName)
Next AIt doesn't help if I shorten the input, to stop with the next last item and reduce the number of rows. Now the second last of the first names will also be placed at the uppermost place - just as before.
It helps to add an empty post at the end of the file, or make an empty post after the for-next loop, but then I have an empty row to start the name list in my grid...
I don't understand what I'm doing wrong and why this happens...
What can I do to get it straight ?
Best regards
/Kalle in Sweden
↧
Assigning values to byte variables. Help! :(
hello everyone
I have downloaded a vb steganography program from the following URL
PROGRAM HERE
I have modified it so it contains another form. On this form the user can connect to a database. In this database are 7 fields and likewise there are 7 textboxes inside the form. The user can load, clear and save these numeric values liasing with the database.
Once the user is happy the user clicks a button and all 7 values are transferred to 7 hidden textboxes on the main form. Now this is where I need help with the following ...
In the following sub routine ......
on the original form from the URL above is code as follows....
My present modified form code for UnRGB sub routine is as follows
but when I type message and assign password and encode, the same message and assign password doesnt decode the the message properly. What am I doing wrong?
Below is the rest of the form code
Any help given I shall be thankful for
regards
I have downloaded a vb steganography program from the following URL
PROGRAM HERE
I have modified it so it contains another form. On this form the user can connect to a database. In this database are 7 fields and likewise there are 7 textboxes inside the form. The user can load, clear and save these numeric values liasing with the database.
Once the user is happy the user clicks a button and all 7 values are transferred to 7 hidden textboxes on the main form. Now this is where I need help with the following ...
In the following sub routine ......
Code:
Private Sub UnRGB(ByVal color As OLE_COLOR, ByRef r As Byte, ByRef g As Byte, ByRef b As Byte)Code:
r = color And &HFF&
g = (color And &HFF00&) \ &H100&
b = (color And &HFF0000) \ &H10000Code:
Dim rhx1 As Byte
Dim ghx1 As Byte
Dim ghx2 As Byte
Dim bhx1 As Byte
Dim bhx2 As Byte
rhx1 = txtRed.Text
ghx1 = txtGreen1.Text
ghx2 = txtGreen2.Text
bhx1 = txtBlue1.Text
bhx2 = txtBlue2.Text
r = color And rhx1
g = (color And ghx1) \ ghx2
b = (color And bhx1) \ bhx2Below is the rest of the form code
Code:
Option Explicit
Private Sub ArrangeControls()
Dim wid As Single
Width = picImage.Left + picImage.Width + Width - ScaleWidth + 120
Height = picImage.Top + picImage.Height + Height - ScaleHeight + 120
wid = ScaleWidth - txtMessage.Left - 120
If wid < 120 Then wid = 120
txtMessage.Width = wid
txtPassword.Width = wid
End Sub
' Encode this byte's data.
Private Sub EncodeByte(ByVal Value As Byte, ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByVal show_pixels As Boolean)
Dim i As Integer
Dim byte_mask As Integer
Dim r As Integer
Dim c As Integer
Dim pixel As Integer
Dim clrr As Byte
Dim clrg As Byte
Dim clrb As Byte
Dim color_mask As Integer
byte_mask = 1
For i = 1 To 8
' Pick a random pixel and RGB component.
PickPosition used_positions, wid, hgt, r, c, pixel
' Get the pixel's color components.
UnRGB picImage.Point(r, c), clrr, clrg, clrb
If show_pixels Then
clrr = 255
clrg = clrg And &H1
clrb = clrb And &H1
End If
' Get the value we must store.
If Value And byte_mask Then
color_mask = 1
Else
color_mask = 0
End If
' Update the color.
Select Case pixel
Case 0
clrr = (clrr And &HFE) Or color_mask
Case 1
clrg = (clrg And &HFE) Or color_mask
Case 2
clrb = (clrb And &HFE) Or color_mask
End Select
' Set the pixel's color.
picImage.PSet (r, c), RGB(clrr, clrg, clrb)
byte_mask = byte_mask * 2
Next i
End Sub
' Decode this byte's data.
Private Function DecodeByte(ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByVal show_pixels As Boolean) As Byte
Dim Value As Integer
Dim i As Integer
Dim byte_mask As Integer
Dim r As Integer
Dim c As Integer
Dim pixel As Integer
Dim clrr As Byte
Dim clrg As Byte
Dim clrb As Byte
Dim color_mask As Integer
byte_mask = 1
For i = 1 To 8
' Pick a random pixel and RGB component.
PickPosition used_positions, wid, hgt, r, c, pixel
' Get the pixel's color components.
UnRGB picImage.Point(r, c), clrr, clrg, clrb
' Get the stored value.
Select Case pixel
Case 0
color_mask = (clrr And &H1)
Case 1
color_mask = (clrg And &H1)
Case 2
color_mask = (clrb And &H1)
End Select
If color_mask Then
Value = Value Or byte_mask
End If
If show_pixels Then
picImage.PSet (r, c), RGB( _
clrr And &H1, _
clrg And &H1, _
clrb And &H1)
End If
byte_mask = byte_mask * 2
Next i
DecodeByte = CByte(Value)
End Function
' Translate a password into an offset value.
Private Function NumericPassword(ByVal password As String) As Long
Dim Value As Long
Dim ch As Long
Dim shift1 As Long
Dim shift2 As Long
Dim i As Integer
Dim str_len As Integer
' Initialize the shift values to different
' non-zero values.
'shift1 = 3
'shift2 = 17
shift1 = txtShift1.Text
shift2 = txtShift2.Text
' Process the message.
str_len = Len(password)
For i = 1 To str_len
' Add the next letter.
ch = Asc(Mid$(password, i, 1))
Value = Value Xor (ch * 2 ^ shift1)
Value = Value Xor (ch * 2 ^ shift2)
' Change the shift offsets.
shift1 = (shift1 + 7) Mod 19
shift2 = (shift2 + 13) Mod 23
Next i
NumericPassword = Value
End Function
' Pick an unused (r, c, pixel) combination.
Private Sub PickPosition(ByVal used_positions As Collection, ByVal wid As Integer, ByVal hgt As Integer, ByRef r As Integer, ByRef c As Integer, ByRef pixel As Integer)
Dim position_code As String
On Error Resume Next
Do
' Pick a position.
r = Int(Rnd * wid)
c = Int(Rnd * hgt)
pixel = Int(Rnd * 3)
' See if the position is unused.
position_code = "(" & r & "," & c & "," & pixel & ")"
used_positions.Add position_code, position_code
If Err.Number = 0 Then Exit Do
Err.Clear
Loop
End Sub
' Return the color's components.
Private Sub UnRGB(ByVal color As OLE_COLOR, ByRef r As Byte, ByRef g As Byte, ByRef b As Byte)
Dim rhx1 As Byte
Dim ghx1 As Byte
Dim ghx2 As Byte
Dim bhx1 As Byte
Dim bhx2 As Byte
rhx1 = txtRed.Text
ghx1 = txtGreen1.Text
ghx2 = txtGreen2.Text
bhx1 = txtBlue1.Text
bhx2 = txtBlue2.Text
r = color And rhx1
g = (color And ghx1) \ ghx2
b = (color And bhx1) \ bhx2
End Sub
Private Sub cmd1_Click()
frmSettings.Show
End Sub
Private Sub cmdDecode_Click()
Dim msg_length As Byte
Dim msg As String
Dim ch As Byte
Dim i As Integer
Dim used_positions As Collection
Dim wid As Integer
Dim hgt As Integer
Dim show_pixels As Boolean
Screen.MousePointer = vbHourglass
DoEvents
' Initialize the random number generator.
Rnd -1
Randomize NumericPassword(txtPassword.Text)
wid = picImage.ScaleWidth
hgt = picImage.ScaleHeight
show_pixels = chkShowPixels.Value
Set used_positions = New Collection
' Decode the message length.
msg_length = DecodeByte(used_positions, wid, hgt, show_pixels)
' Decode the message.
For i = 1 To msg_length
ch = DecodeByte(used_positions, wid, hgt, show_pixels)
msg = msg & Chr$(ch)
Next i
picImage.Picture = picImage.Image
txtMessage.Text = msg
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdEncode_Click()
Dim msg As String
Dim i As Integer
Dim used_positions As Collection
Dim wid As Integer
Dim hgt As Integer
Dim show_pixels As Boolean
Screen.MousePointer = vbHourglass
DoEvents
' Initialize the random number generator.
Rnd -1
Randomize NumericPassword(txtPassword.Text)
wid = picImage.ScaleWidth
hgt = picImage.ScaleHeight
msg = Left$(txtMessage.Text, 255)
show_pixels = chkShowPixels.Value
Set used_positions = New Collection
' Encode the message length.
EncodeByte CByte(Len(msg)), _
used_positions, wid, hgt, show_pixels
' Encode the message.
For i = 1 To Len(msg)
EncodeByte Asc(Mid$(msg, i, 1)), _
used_positions, wid, hgt, show_pixels
Next i
picImage.Picture = picImage.Image
Screen.MousePointer = vbDefault
End Sub
Private Sub Form_Load()
picImage.ScaleMode = vbPixels
picImage.AutoRedraw = True
dlgImage.InitDir = App.Path
ArrangeControls
End Sub
Private Sub mnuFileOpen_Click()
On Error Resume Next
dlgImage.CancelError = True
dlgImage.Flags = _
cdlOFNFileMustExist Or _
cdlOFNHideReadOnly Or _
cdlOFNLongNames
dlgImage.ShowOpen
If Err.Number <> 0 Then Exit Sub
picImage.Picture = LoadPicture(dlgImage.FileName)
ArrangeControls
If Err.Number <> 0 Then Exit Sub
dlgImage.InitDir = dlgImage.FileName
dlgImage.FileName = dlgImage.FileTitle
End Sub
Private Sub mnuFileSaveAs_Click()
On Error Resume Next
dlgImage.CancelError = True
dlgImage.Flags = _
cdlOFNOverwritePrompt Or _
cdlOFNHideReadOnly Or _
cdlOFNLongNames
dlgImage.ShowSave
If Err.Number <> 0 Then Exit Sub
SavePicture picImage.Picture, dlgImage.FileName
If Err.Number <> 0 Then Exit Sub
dlgImage.InitDir = dlgImage.FileName
dlgImage.FileName = dlgImage.FileTitle
End SubAny help given I shall be thankful for
regards
↧
TLB file for IMultiLanguage3
Hi, I'm trying to make a TLB file with for VB6 with the IMultiLanguage3 interface, but I can't seem to find a whole lot of information on how to do this.
I tried creating a TLB in the normal way, using the MIDL compiler to compile mlang.idl, which has the interface, but the resulting TLB doesn't seem to do anything when added as a reference in VB6, it doesn't even try to load.
Can anyone give me a guide on how to create TLBs for VB6? Does anyone happen to have one lying around that covers this interface?
Thanks!
I tried creating a TLB in the normal way, using the MIDL compiler to compile mlang.idl, which has the interface, but the resulting TLB doesn't seem to do anything when added as a reference in VB6, it doesn't even try to load.
Can anyone give me a guide on how to create TLBs for VB6? Does anyone happen to have one lying around that covers this interface?
Thanks!
↧
↧
[RESOLVED] MsFlexGrid sorted
Hi !
From a Random access file I collect first- and surnames and put them in a MsFlexGrid (G1), using sort for col no 1:
To sort by first name works fine. But the very last of the first names in the file happens to be placed in the first row, even when it's not belong there at all.
It doesn't help if I shorten the input, to stop with the next last item and reduce the number of rows. Now the second last of the first names will also be placed at the uppermost place - just as before.
It helps to add an empty post at the end of the file, or make an empty post after the for-next loop, but then I have an empty row to start the name list in my grid...
I don't understand what I'm doing wrong and why this happens...
What can I do to get it straight ?
Best regards
/Kalle in Sweden
From a Random access file I collect first- and surnames and put them in a MsFlexGrid (G1), using sort for col no 1:
Code:
G1.Cols = 3: G1.Rows = File Records: G1.ColWidth(1) = Width1: G1.ColWidth(2) = Width2
For A = 1 To File Records
Get #1, A, FilePost
G1.Col = 0: G1.Text = CStr(A)
G1.Col = 1: G1.Sort = 1: G1.Text = Trim(FirstName)
G1.Col = 2: G1.Text = Trim(SureName)
Next AIt doesn't help if I shorten the input, to stop with the next last item and reduce the number of rows. Now the second last of the first names will also be placed at the uppermost place - just as before.
It helps to add an empty post at the end of the file, or make an empty post after the for-next loop, but then I have an empty row to start the name list in my grid...
I don't understand what I'm doing wrong and why this happens...
What can I do to get it straight ?
Best regards
/Kalle in Sweden
↧
[RESOLVED] TLB file for IMultiLanguage3
Hi, I'm trying to make a TLB file with for VB6 with the IMultiLanguage3 interface, but I can't seem to find a whole lot of information on how to do this.
I tried creating a TLB in the normal way, using the MIDL compiler to compile mlang.idl, which has the interface, but the resulting TLB doesn't seem to do anything when added as a reference in VB6, it doesn't even try to load.
Can anyone give me a guide on how to create TLBs for VB6? Does anyone happen to have one lying around that covers this interface?
Thanks!
I tried creating a TLB in the normal way, using the MIDL compiler to compile mlang.idl, which has the interface, but the resulting TLB doesn't seem to do anything when added as a reference in VB6, it doesn't even try to load.
Can anyone give me a guide on how to create TLBs for VB6? Does anyone happen to have one lying around that covers this interface?
Thanks!
↧
Booking rooms in a hotel... calendar? Help!
Hi.
I'm creating a vb program that will allow the user to manage hotel bookings but I ran into some trouble while trying to book the rooms.
Obviously, the program shouldn't allow the user to book a room if it is being used in the selected dates... how can i do this? can i associate a boolean calendar with an object?
Any help is welcome :)
Thank you!
I'm creating a vb program that will allow the user to manage hotel bookings but I ran into some trouble while trying to book the rooms.
Obviously, the program shouldn't allow the user to book a room if it is being used in the selected dates... how can i do this? can i associate a boolean calendar with an object?
Any help is welcome :)
Thank you!
↧
Random Access Files - Get & Put
I am learning old methods of reading and writing to files using VB6.
I can open a random access file to read and populate text boxes (using getdatafromfile routine) . My problem is writing (using putdatatofile routine). The first 4 records I write out are fine, after the 5th a blank record seems to go in. This continues to duplicate as I write out more records
I have put a breakpoint on my code and I can see my total records and position incrementing by 1, but I cannot see where this additional record is being added
I need a second pair of eyes please!
My form has add and save buttons, and 5 text boxes.
general declarations
Option Explicit
Private iTotalRecords As Integer
Private iCurrentRecordNumber As Integer
Private Sub cmdAdd_Click()
txtEmployeeID.Text = ""
txtFirstName.Text = ""
txtLastName.Text = ""
txtCompanyName.Text = ""
txtFirstName.SetFocus
cmdSave.Enabled = True
cmdAdd.Enabled = False
End Sub
Private Sub cmdSave_Click()
PutDataToFile
cmdSave.Enabled = False
cmdAdd.Enabled = True
End Sub
Sub PutDataToFile()
Dim MyStaffMember As udtCompanyStaff
Dim iPosition As Integer
iPosition = iTotalRecords + 1
iTotalRecords = iTotalRecords + 1
txtEmployeeID.Text = iTotalRecords
MyStaffMember.EmployeeID = Val(txtEmployeeID.Text)
MyStaffMember.FirstName = txtFirstName.Text
MyStaffMember.LastName = txtLastName.Text
MyStaffMember.CompanyName = txtCompanyName.Text
Open App.Path & "\CompanyStaff.TXT" For Random As #1
Put #1, iPosition, MyStaffMember
Close #1
txtRecordPointer.Text = "Rec " & iPosition & " of " & iTotalRecords
txtEmployeeID.Text = MyStaffMember.EmployeeID
txtFirstName.Text = MyStaffMember.FirstName
txtLastName.Text = MyStaffMember.LastName
txtCompanyName.Text = MyStaffMember.CompanyName
End Sub
Sub GetDataFromFile(Optional ByVal ipos As Integer)
Dim MyStaffMember As udtCompanyStaff
'Dim iPosition As Integer
Open App.Path & "\CompanyStaff.TXT" For Random As #1
iTotalRecords = LOF(1) / Len(MyStaffMember)
Get #1, ipos, MyStaffMember
Close #1
txtRecordPointer.Text = "Rec " & ipos & " of " & iTotalRecords
txtEmployeeID.Text = MyStaffMember.EmployeeID
txtFirstName.Text = MyStaffMember.FirstName
txtLastName.Text = MyStaffMember.LastName
txtCompanyName.Text = MyStaffMember.CompanyName
End Sub
I can open a random access file to read and populate text boxes (using getdatafromfile routine) . My problem is writing (using putdatatofile routine). The first 4 records I write out are fine, after the 5th a blank record seems to go in. This continues to duplicate as I write out more records
I have put a breakpoint on my code and I can see my total records and position incrementing by 1, but I cannot see where this additional record is being added
I need a second pair of eyes please!
My form has add and save buttons, and 5 text boxes.
general declarations
Option Explicit
Private iTotalRecords As Integer
Private iCurrentRecordNumber As Integer
Private Sub cmdAdd_Click()
txtEmployeeID.Text = ""
txtFirstName.Text = ""
txtLastName.Text = ""
txtCompanyName.Text = ""
txtFirstName.SetFocus
cmdSave.Enabled = True
cmdAdd.Enabled = False
End Sub
Private Sub cmdSave_Click()
PutDataToFile
cmdSave.Enabled = False
cmdAdd.Enabled = True
End Sub
Sub PutDataToFile()
Dim MyStaffMember As udtCompanyStaff
Dim iPosition As Integer
iPosition = iTotalRecords + 1
iTotalRecords = iTotalRecords + 1
txtEmployeeID.Text = iTotalRecords
MyStaffMember.EmployeeID = Val(txtEmployeeID.Text)
MyStaffMember.FirstName = txtFirstName.Text
MyStaffMember.LastName = txtLastName.Text
MyStaffMember.CompanyName = txtCompanyName.Text
Open App.Path & "\CompanyStaff.TXT" For Random As #1
Put #1, iPosition, MyStaffMember
Close #1
txtRecordPointer.Text = "Rec " & iPosition & " of " & iTotalRecords
txtEmployeeID.Text = MyStaffMember.EmployeeID
txtFirstName.Text = MyStaffMember.FirstName
txtLastName.Text = MyStaffMember.LastName
txtCompanyName.Text = MyStaffMember.CompanyName
End Sub
Sub GetDataFromFile(Optional ByVal ipos As Integer)
Dim MyStaffMember As udtCompanyStaff
'Dim iPosition As Integer
Open App.Path & "\CompanyStaff.TXT" For Random As #1
iTotalRecords = LOF(1) / Len(MyStaffMember)
Get #1, ipos, MyStaffMember
Close #1
txtRecordPointer.Text = "Rec " & ipos & " of " & iTotalRecords
txtEmployeeID.Text = MyStaffMember.EmployeeID
txtFirstName.Text = MyStaffMember.FirstName
txtLastName.Text = MyStaffMember.LastName
txtCompanyName.Text = MyStaffMember.CompanyName
End Sub
↧
↧
Windows 7 DAO OpenRecordset problem
My program accesses a DAO recordset. Compiled on a 32bit machine, tested on XP 32 bit while running as Admin and as a normal user, without any problems, and running on Win 7 64bit Professional as a normal user, without problems, however when running as Admin the I can't open the recordset properly.
When I open the database I can see the file lock in the directory and I can enumerate all 12 tables with TableDef, but when I open the recordset it shows no records. Can anyone shed some light on this???
Dim UserDB as Database
Dim UserRS as Recordset
Dim UserDBname as string
Dim i as Integer
UserDBName = AppPath & UserDBFile
Set UserDB = OpenDatabase(UserDBName)
Set UserRS = OpenRecordset("Select * FROM UserTable ORDER BY UserID")
'the following are used for troubleshooting
'The following returns a 1
MsgBox "Recordsets: " & UserDB.Recordsets.Count
'The following returns a 12
MsgBox "TableDefs: " & UserDB.TableDefs.Count
'enumerate all tables, and UserTable shows to be one of the tables
For i = 0 to UserDB.TableDefs.Count -1
MsgBox "i: " & i & " " & UserDB.TableDefs(i).Name
Next
'this returns a 0, when there is actually a record in the table
Msgbox "Recordcount: " & UserRS.Recordcount
The strange part like I said, is that the record can be found when the User is NOT running as Admin.
When I open the database I can see the file lock in the directory and I can enumerate all 12 tables with TableDef, but when I open the recordset it shows no records. Can anyone shed some light on this???
Dim UserDB as Database
Dim UserRS as Recordset
Dim UserDBname as string
Dim i as Integer
UserDBName = AppPath & UserDBFile
Set UserDB = OpenDatabase(UserDBName)
Set UserRS = OpenRecordset("Select * FROM UserTable ORDER BY UserID")
'the following are used for troubleshooting
'The following returns a 1
MsgBox "Recordsets: " & UserDB.Recordsets.Count
'The following returns a 12
MsgBox "TableDefs: " & UserDB.TableDefs.Count
'enumerate all tables, and UserTable shows to be one of the tables
For i = 0 to UserDB.TableDefs.Count -1
MsgBox "i: " & i & " " & UserDB.TableDefs(i).Name
Next
'this returns a 0, when there is actually a record in the table
Msgbox "Recordcount: " & UserRS.Recordcount
The strange part like I said, is that the record can be found when the User is NOT running as Admin.
↧
Uploading to your website
Is it possible to use WebBrowser to upload files to my personal Website
↧
Border of MSHFlexgrid not printing with Fancy Printing Demo code
Hi,
I've downloaded the Fancy Printing demo dilettante posted and used it to learn how to print hi quality graphics.
Great program!
I'm trying to print the MSHFlexgrid with a border.
The border shows up just fine on the screen, however, on the printout, the right side and bottom border is missing.
I've tried enlarging the capture area, increase the line width, set to 3D mode, etc.
Even on the demo, the top and left border is missing.
I have found no method that will accomplish my objective.
Anyone have a suggestion?
Thanks!
I've downloaded the Fancy Printing demo dilettante posted and used it to learn how to print hi quality graphics.
Great program!
I'm trying to print the MSHFlexgrid with a border.
The border shows up just fine on the screen, however, on the printout, the right side and bottom border is missing.
I've tried enlarging the capture area, increase the line width, set to 3D mode, etc.
Even on the demo, the top and left border is missing.
I have found no method that will accomplish my objective.
Anyone have a suggestion?
Thanks!
↧
ADO reference
I'm using ADO to connect to an Access 2000 data base by setting a reference to 'Microsoft ActiveX Objects 6.1 Library'. Now my database has been updated to Access 2013. What reference do I have to set?
↧
↧
[RESOLVED] ADO reference
I'm using ADO to connect to an Access 2000 data base by setting a reference to 'Microsoft ActiveX Objects 6.1 Library'. Now my database has been updated to Access 2013. What reference do I have to set?
↧
Random Access Files - Populating Combobox
Following on from my last post Random Access Files Get & Put, I have successfully wrote and retrieved records from files.
Further on in the project I have successfully retrieved data from file (First Name and Last Name) and populated combobox based on my UDT setup, and based on combobox selection in populates a textbox on the form. I don't know if this is possible, however, I would like to pull in the associated Company name from that file, hide it from the combobox dropdown, and based on combobox selection of the First Name Last Name, the company name is populated into another text box on the form.
I hope this makes sense
Here is my successful code that pulls in the data from file to populate my Combo Box, and behind the combo box click event it populates the form text box. I would like to pull in MyCompanyStaff.CompanyName also and populate another text box. Is this possible, or would I be looking at populating an array??
Dim iFilePass As Integer
Dim MyCompanyStaff As udtCompanyStaff
Dim i As Integer
cboRequestedBy.Visible = True
cboRequestedBy.Clear
iFilePass = FreeFile
Open App.Path & "\CompanyStaff.dat" For Random As iFilePass Len = Len(MyCompanyStaff)
For i = 1 To Int(LOF(1) / Len(MyCompanyStaff))
Get #iFilePass, i, MyCompanyStaff
cboRequestedBy.AddItem Trim(MyCompanyStaff.LastName) & " ," & Trim(MyCompanyStaff.FirstName)
Next
Close iFilePass
Private Sub cboRequestedBy_Click()
txtRequestedBy.Text = cboRequestedBy.Text
End Sub
Further on in the project I have successfully retrieved data from file (First Name and Last Name) and populated combobox based on my UDT setup, and based on combobox selection in populates a textbox on the form. I don't know if this is possible, however, I would like to pull in the associated Company name from that file, hide it from the combobox dropdown, and based on combobox selection of the First Name Last Name, the company name is populated into another text box on the form.
I hope this makes sense
Here is my successful code that pulls in the data from file to populate my Combo Box, and behind the combo box click event it populates the form text box. I would like to pull in MyCompanyStaff.CompanyName also and populate another text box. Is this possible, or would I be looking at populating an array??
Dim iFilePass As Integer
Dim MyCompanyStaff As udtCompanyStaff
Dim i As Integer
cboRequestedBy.Visible = True
cboRequestedBy.Clear
iFilePass = FreeFile
Open App.Path & "\CompanyStaff.dat" For Random As iFilePass Len = Len(MyCompanyStaff)
For i = 1 To Int(LOF(1) / Len(MyCompanyStaff))
Get #iFilePass, i, MyCompanyStaff
cboRequestedBy.AddItem Trim(MyCompanyStaff.LastName) & " ," & Trim(MyCompanyStaff.FirstName)
Next
Close iFilePass
Private Sub cboRequestedBy_Click()
txtRequestedBy.Text = cboRequestedBy.Text
End Sub
↧
[RESOLVED] Savepicture when dpi aware and dpi > 96
Hi folks,
I have been updating a program to be dpi aware and have solved all the problems except one.
This is a screenshot of a picturebox...
![Name: Before.jpg
Views: 49
Size: 24.4 KB]()
The result of Savepicture Picturebox.picture , File$ is as above when performed in the VB6 environment but like this when run compiled.
![Name: after.jpg
Views: 43
Size: 25.8 KB]()
The difference in scale is a result of snapping the second shot from the windows picture viewer. Both are actually scalled the same. The problem is that the saved graphic is cropped by the scalling factor.
If anyone can suggest a way round this, I would be eternally grateful!
I guess what I'm loking for is code to get the image from Picturebox.hdc to File.bmp without using the VB Savepicture!
I have been updating a program to be dpi aware and have solved all the problems except one.
This is a screenshot of a picturebox...
The result of Savepicture Picturebox.picture , File$ is as above when performed in the VB6 environment but like this when run compiled.
The difference in scale is a result of snapping the second shot from the windows picture viewer. Both are actually scalled the same. The problem is that the saved graphic is cropped by the scalling factor.
If anyone can suggest a way round this, I would be eternally grateful!
I guess what I'm loking for is code to get the image from Picturebox.hdc to File.bmp without using the VB Savepicture!
↧
[RESOLVED] USB ports enable/disable by code
In this registry key
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\USBSTOR
I want to modify by code the value of Start to 3 or 4 to enable/disable the USB ports.
However, my googling for a solution has left me somewhat confused. What's the most straightforward solution?
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\services\USBSTOR
I want to modify by code the value of Start to 3 or 4 to enable/disable the USB ports.
However, my googling for a solution has left me somewhat confused. What's the most straightforward solution?
↧
↧
SQL Query
Hi
I have written the below query in visual basic & then through loop i fill grid. System is connected through Wi-Fi & it is at a distance of 4-5 km from server. It sometimes takes long time to display records in grid. What can be done to improve the performance.
rstrans.Open "select * from test where status='P' order by todate desc", cnn2, adOpenDynamic, adLockOptimistic, adCmdText
Thanks
I have written the below query in visual basic & then through loop i fill grid. System is connected through Wi-Fi & it is at a distance of 4-5 km from server. It sometimes takes long time to display records in grid. What can be done to improve the performance.
rstrans.Open "select * from test where status='P' order by todate desc", cnn2, adOpenDynamic, adLockOptimistic, adCmdText
Thanks
↧
[RESOLVED] calculation tax can figure it out
i am trying for sometime to figure out how to calculate a tax but i cannot get the result
what is wrong?:confused:
this is my code
LblTaxAfterDisc needs to show me the tax of the TxtCashValue
E.X
lets say i have 900 Euro in TxtCashValue
and the tax value is 1.18
so the LblTaxAfterDisc needs to show 137.29 right?
well it dosnt
i cant figure this out
any help will be appreciated
salsa31
what is wrong?:confused:
this is my code
Code:
Dim VAtPay As Currency
VAtPay = TxtCashValue.Text - 0 (TxtCashValue holds a certain amount)
LblTaxAfterDisc.Caption = VAtPay - (TxtCashValue.Text / 1.18)
LblTaxAfterDisc.Caption = FormatNumber(LblTaxAfterDisc.Caption, 2, vbTrue)E.X
lets say i have 900 Euro in TxtCashValue
and the tax value is 1.18
so the LblTaxAfterDisc needs to show 137.29 right?
well it dosnt
i cant figure this out
any help will be appreciated
salsa31
↧
Random Access Files - Problem Erasing
I have wrote code below to erase a record from a RAS file. The code writes out all records bar the one I do want deleted to a new file. I plan on deleting the original file and renaming the new one so my original Get code will work when reading in a file from the form
The code is deleting records where only one instance of the Surname exists, but where I have two surnames the same in skips the two of them. This is why I included an IF firstname <> AND lastname <> , yet it still deletes the two of them
I do have an employeeID in my UDT and I can target that for deletion which is successful, however, if I go to add a record this will impact my employeeID assignment as I set that ID to totalrecords in my file + 1
Any thoughts on the code below deleting where the first and last name match on the record I read in?
Private Sub cmdErase_Click()
Dim bFinish As Boolean
Dim Mystaffmember As udtCompanyStaff
Open App.Path & "\CompanyStaff.dat" For Random As #1 Len = Len(Mystaffmember)
Open App.Path & "\CompanyStaffCopy.dat" For Random As #2 Len = Len(Mystaffmember)
bFinish = False
Do
Get #1, , Mystaffmember
If Not EOF(1) Then
If Mystaffmember.FirstName <> txtFirstName.Text And Mystaffmember.LastName <> txtLastName.Text Then
Put #2, , Mystaffmember
End If
Else
bFinish = True
End If
Loop Until bFinish = True
Close #1
Close #2
End Sub
The code is deleting records where only one instance of the Surname exists, but where I have two surnames the same in skips the two of them. This is why I included an IF firstname <> AND lastname <> , yet it still deletes the two of them
I do have an employeeID in my UDT and I can target that for deletion which is successful, however, if I go to add a record this will impact my employeeID assignment as I set that ID to totalrecords in my file + 1
Any thoughts on the code below deleting where the first and last name match on the record I read in?
Private Sub cmdErase_Click()
Dim bFinish As Boolean
Dim Mystaffmember As udtCompanyStaff
Open App.Path & "\CompanyStaff.dat" For Random As #1 Len = Len(Mystaffmember)
Open App.Path & "\CompanyStaffCopy.dat" For Random As #2 Len = Len(Mystaffmember)
bFinish = False
Do
Get #1, , Mystaffmember
If Not EOF(1) Then
If Mystaffmember.FirstName <> txtFirstName.Text And Mystaffmember.LastName <> txtLastName.Text Then
Put #2, , Mystaffmember
End If
Else
bFinish = True
End If
Loop Until bFinish = True
Close #1
Close #2
End Sub
↧