Quantcast
Channel: VBForums - CodeBank - Visual Basic 6 and earlier
Viewing all 1509 articles
Browse latest View live

VB6 Png-Alpha-Rendering (using WIA)

$
0
0
So, yeah - this Demo is not dependent on vbRichClient for a change ;), but on a System-lib instead (wiaaut.dll),
which comes pre-installed on newer systems.

The Demo-Code contains two Classes:
cPngCache (showing how to read Pngs per WIA, copying Alpha-Channel-ByteArray-content - premultiplying it - converting it into a 32bpp-VB-StdPicture)
cButton (makes use of the Class above, then dealing appropriately with Multi-State PNG-content ... ButtonNormal, ButtonPressed, Hovered, etc.)

Well, not much more to say, the Demo is small and the classes do not contain much code ... here's a screenshot:



And here the Download-Link: http://vbRichClient.com/Downloads/PngAlphaRendering.zip (~200KB, containing a few Image-Resources)

Olaf

VB6 Png-Alpha-Rendering with GDI+ (alternatively per WIA)

$
0
0
So, yeah - this Demo is not dependent on vbRichClient for a change ;), but on a System-lib instead,
which comes pre-installed on newer systems.

The Demo-Code contains two Classes:
cPngCache (showing how to read Pngs per GDI+ (alternatively per WIA), copying premultiplied Alpha-Channel-content - and converting (caching) it into a 32bpp-VB-StdPicture)
cButton (makes use of the Class above, then dealing appropriately with Multi-State PNG-content ... ButtonNormal, ButtonPressed, Hovered, etc.)

Well, not much more to say, the Demo is small and the classes do not contain much code ... here's a screenshot:

Edit: Changed the Demo to use GDI+ as a default now, since the WIA-libs are not on each and every XP-system (though GDI+ usually is).
The older WIA-class is still contained in the *.vbp though.



And here the Download-Link: http://vbRichClient.com/Downloads/PngAlphaRendering.zip (~200KB, containing a few Image-Resources)

Olaf

VB6 - JsonBag, Another JSON Parser/Generator

$
0
0
With SOAP basically a dead duck and XML itself fading in importance, JSON is becoming more and more important as a serialization format today.

I've seen a number of VB6 JSON implementations around, including a couple posted right here in the CodeBank. Sadly none of them are very good, with little quirks and latent bugs (like improperly handling numeric data). Most of these ignore and flout the JSON standards at JSON too!

In any case I have my own implementation designed to conform as closely as possible to the standard, and now at version 1.6 it seems mature enough to share. I rewrote my notes into six pages of documentation which should make it a bit easier for others to use.


Bug reports are welcome. Though it seems to be working fine it is hard to prove code to be correct and there are probably edge cases I've never encountered.

Performance seems more than adequate for its purpose, which is mainly access to cloud computing services. Local config files are probably best still handled as plain old INI format files, though one could use JSON for that as well I suppose.


There is just one Class involved: JsonBag.cls, and as the documentation suggests it should be easy enough to import into a VBA host (Excel, etc.) as long as you tweak the API calls for 64-bit hosts when required.


The attachment includes this Class along with the documentation in RTF format, packaged up as a testbed Project JsonBagTest.vbp:

Name:  sshot.png
Views: 246
Size:  20.5 KB

As you can see JsonBag supports a Whitespace property to format JSON for readability. By default compact JSON is generated.


Accessing the "document model" and creating JSON documents in code is easy enough. This is illustrated by a fragment from the test Project:

Code:

Private Sub cmdGenSerialize_Click()
    With JB
        .Clear
        .IsArray = False 'Actually the default after Clear.

        ![First] = 1
        ![Second] = Null
        With .AddNewArray("Third")
            .Item = "These"
            .Item = "Add"
            .Item = "One"
            .Item = "After"
            .Item = "The"
            .Item = "Next"
            .Item(1) = "*These*" 'Should overwrite 1st Item, without moving it.

            'Add a JSON "object" to this "array" (thus no name supplied):
            With .AddNewObject()
                .Item("A") = True
                !B = False
                !C = 3.14E+16
            End With
        End With
        With .AddNewObject("Fourth")
            .Item("Force Case") = 1 'Use quoted String form to force case of names.
            .Item("force Case") = 2
            .Item("force case") = 3

            'This syntax can be risky with case-sensitive JSON since the text is
            'treated like any other VB identifier, i.e. if such a symbol ("Force"
            'or "Case" here) is already defined in the language (VB) or in your
            'code the casing of that symbol will be enforced by the IDE:

            ![Force Case] = 666 'Should overwrite matching-case named item, which
                                'also moves it to the end.
            'Safer:
            .Item("Force Case") = 666
        End With
        'Can also use implied (default) property:
        JB("Fifth") = Null

        txtSerialized.Text = .JSON
    End With
End Sub

Attached Images
 
Attached Files

Fuzzy Search Demo [VB6/vbRichClient5]

$
0
0
The vbRichClient5 library for VB6 includes support for the SQLite database engine, and acts as a wrapper for the user defined collation (sort) and user-defined functions features of SQLite. Thanks to the work of Olaf Schmidt, it is really easy to create standard VB6 classes that extend the functionality of SQLite.

I've been experimenting with some "fuzzy" search routines using my own custom collation and ranking code (modified Metaphone), intertwined with the vbRC5 ranking code (RatCliff), and have put together a little demo here:

RC5SearchDemo.zip

Before you can use this demo, you will need to download and register the vbRichClient5 library from http://www.vbrichclient.com/#/en/Downloads.htm

"Search" is a really interesting (and constantly evolving) area of human>computer interaction, and I think VB6 is somewhat lacking (no native regex, no built-in fuzzy algorithms like metaphone, ratcliff, etc...). I'm really hoping for some input from the community on how to make this fuzzy matching better, under more search/language scenarios - for the benefit of all. Please feel free to hack away with the above demo and report back with your results, and let's see if we can create a search algorithm (or suite of algorithms) that produce consistently useful results.
Attached Files

DNS Filter

$
0
0
Our DNS server was being used as an attack vector against primarily Chinese servers. DNS by preference uses UDP packets instead of TCP packets. The UDP protocol is much faster than TCP, but unlike TCP it does not perform a handshake. It is essentially one way communication with no confirmation of receipt. Because of that, it is possible to fake the sender IP address, and this is what the attackers were doing. A 128 byte request was causing a 388 byte invalid response to be sent to the target server. By enlisting many hacked computers, the attackers could overwhelm the target. Because the hackers were sending false source information to legitimate DNS servers, it was difficult to track the actual source.

Our DNS server has the capability to block source addresses that send too many requests per second, but it was getting to be a pain to update the list, and the list itself was getting quite long. So I set about to design a filter. For this purpose I am using the Windows Packet Filter Kit from NT Kernel Resources. This high performance packet filtering framework hooks the NDIS (Network Driver Interface Specification) driver in your Windows Operating System. This allows me to inspect each packet and only target incoming Port 53 UDP packets for further processing. A 20 element cache is maintained with the Source IP Address, the Question Type, the Question, and a Timeout. When a DNS request is received, the program checks the cache and if does not exist or is timed out, it is added with the maximun timeout. If it already exists, the timeout is reset to the maximum and the record dropped. A timer decrements the timeout values every second.

I had considered building this progam some time ago because some abusive DNS servers were using brute force by sending multiple requests for the same thing. The worst offender was Yahoo, which not only sent multiple requests from the same server, but also used multiple servers for the same thing. These hackers only served to elevate the priority.

This program is a work in progress, and once it has proven itself, I will convert it to run as a Service. To run as a Service, I must ensure that the program makes no attempt to display to the Desktop, as this can cause the operating system to get into an endless loop when the user is logged off and the desktop is not available. All potential errors must be trapped, and logged to the Event or other log.

J.A. Coutts
Edit: When the filter was put into production, a bug was discovered that caused Overflow errors in the PacketRead routine. The problem was caused by Message Types greater than 32,767, which got interpreted as negative numbers. The problem was resolved by changed the data type to long integer from integer. To facilitate this resolution, Error Trapping and a logging function was added.
Attached Files

Changing The Shape of your Form and Showing Transparent animation on the Desktop

$
0
0
This is a simple Form transparency demo. It simply demonstrates how you can make your Form any shape you want and show pictures and animation on the desktop in the shape of your Form. It basically shows you how to change the shape of your Form to almost anything or shape you would want and to show animation (using animated gif) on the desktop

Left mouse down to move the Form

Right mouse down for options
Attached Files

DNS Filter Service

$
0
0
This is the Service Version of the Filter program previously posted. The Service version of DNS Filter not only requires the WinpkFilter from NT Kernel Resources (free for personal use) but also the NT Service Control from Microsoft (freely available). So far it has been tested on Server 2000 and Windows Vista.

It consists of 2 programs; one is the actual service, and the other to load and manage the Service. Although the service can install itself, the management program is needed to store a couple of parameters. Because the Service runs in Session 0, the Registry values must be placed in the Registry in a location that allows System access. Because the management program runs in Session 1 or more, it has no actual interaction with the service. It deals entirely with the Service Manager (services.msc). I used to use the System Tray for interaction between a service and the desktop, but that is now difficult to do with Session Isolation. I also used to use the Dart Service Control (which I prefer), but that requires the user to purchase a license.

J.A. Coutts

Note: DNSFilSvc was designed to be run in Development mode as well as a Service. To compile the service, change the IsService flag to True. In order to get the logging routine to function on Server 2000, I had to manually create the DNS sub-directory in the Logfiles directory. Server 2000 would not automatically create it.

Addendum: I finally got the low level filtering in WinpkFilter working. This allowed me to only process Port 53 UDP requests, thereby reducing the amount of code needed and theoretically reducing system resources required. The problem turned out to be bad type declarations in the sample code provided.

Bug Fix 11/12/2013: A bug was discovered that randomly allowed some duplicated queries to get through the filter. A fixed length buffer (128 bytes) was maintained to receive incoming query names. This string information was of variable length, but always ended in a null character. When the name was added to the string array, VB only recognized up to the null character. If the previous query was longer than the current one, extra characters got left behind in the fixed length buffer. For example, if "12345678.com" was followed by "123456.com", what was shown in the buffer was "123456.com m", which of course did not compare to what was already in cache. This was corrected by clearing the fixed length buffer after every query. At the same time, table updates were sped up by maintaining an end of cache pointer.
Attached Files

Alphablending - A Simple Demo

$
0
0
This small demo shows you how you can alpha blend one picture onto another. In this demo only part of the target picture is alpha blended.
Attached Files

Slot Machine

$
0
0
This is a simple demo of a slot machine. It has three spinners that simulate a slot machine when the handle is pulled down (this uses a button instead of a handle).
Attached Files

Desktop Digital Clock

Simple way to Export FlexGrid to Excel

$
0
0
I see many people asking how to export a VB6 MSFlexgrid to an Excel workbook....this short code with a couple of simple For-Loops is an easy way to do it (Make sure you have a REFERENCE to MS Excel in your project).

Code:

Private Sub smnuExportExcel_Click()
    Dim oExcel As excel.Application
    Dim oWb As excel.Workbook
    Dim oSheet As excel.Worksheet
    Dim x As Integer
    Dim y As Integer
    Set oExcel = New excel.Application
    Set oExcel = CreateObject("Excel.Application")
    Set oWb = oExcel.Workbooks.Add
    Set oSheet = oWb.Worksheets("Sheet1")
    With oSheet
    For x = 0 To flexgrid1.Rows - 1 
        For y = 0 To 6
            .Cells(x + 1, y + 1) = flexgrid1.TextMatrix(x, y) 'Note, "x + 1" as Excel refers to rows and columns beginning with 1, whereas VB6's flexgrids start with 0.
        Next y
    Next x

    oWb.SaveAs FileName:=App.Path & "\myExcelFile.xlsx"
    oExcel.Visible = True
    Set oWb = Nothing
    Set oExcel = Nothing
End Sub

Excel Writer

$
0
0
Project to create an ActiveX DLL which is capable of writing Excel 2007 xlsx files directly.
No need for Excel to be installed.
An xlsx is just a ZIP archive with all kind of XML files and bunch of tables.
After a few weeks of reverse engineering I was able to create this project.

There are no pivot-tables or charts!

This project uses source code written by:
  • Andrew McMillan -> clsZipClass and clsZipFile
  • Steve McMahon -> clsStringBuilder
  • LaVolpe -> Collection Key routines


Also needed is the zlibwapi.dll which can be found in the zlib125dll.zip


Sample code (needs a reference to the created ActiveX DLL)

Code:

Option Explicit

Private Sub Command1_Click()
  Dim cExcel As clsExcel2007
  Dim cWS As clsWorksheet2007
  Dim tCell As tpExcelCell2007
 
  Set cExcel = New clsExcel2007
 
  ' Add the first Worksheet
  Set cWS = cExcel.AddWorkSheet("My first sheet")
 
  tCell = cExcel.NewCellType
  tCell.Row = 1: tCell.Column = 1:  tCell.Value = "A1"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 2: tCell.Column = 1:  tCell.Value = "A2"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 3: tCell.Column = 1:  tCell.Value = "A3"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 4: tCell.Column = 1:  tCell.Value = "A4"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType ' using empty values
  tCell.Row = 1: tCell.Column = 2: tCell.Value = "B1":  tCell.BackColor = vbRed
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType ' using empty values
  tCell.Row = 2: tCell.Column = 2: tCell.Value = "B2":  tCell.FontBold = True
  tCell.Comment = "Font Bold"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType ' using empty values
  tCell.Row = 3: tCell.Column = 2: tCell.Value = "B3":  tCell.ForeColor = RGB(0, 127, 0)
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType ' using empty values
  tCell.Row = 4: tCell.Column = 2: tCell.Value = "B4":  tCell.BorderLeftColor = vbBlue
  tCell.Comment = "Blue border"
  cWS.AddCellType tCell
 
  ' Add a second WorkSheet
  Set cWS = cExcel.AddWorkSheet("Sheet 2")
 
  tCell = cExcel.NewCellType
  tCell.Row = 1: tCell.Column = 1:  tCell.Value = Atn(1) * 4
  tCell.FormatString = "0.00"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 2: tCell.Column = 1:  tCell.Value = Date
  tCell.FormatString = "dd MMM yyyy"
  tCell.Comment = tCell.FormatString

 
  tCell = cExcel.NewCellType
  tCell.Row = 2: tCell.Column = 1:  tCell.Value = TimeSerial(25, 34, 12)
  tCell.FormatString = "[h]:mm"
  tCell.Comment = tCell.FormatString
  cWS.AddCellType tCell


  tCell = cExcel.NewCellType
  tCell.Row = 1: tCell.Column = 2: tCell.Value = "MergeCell"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 2: tCell.Column = 2: tCell.Value = "MergeCell"
  cWS.AddCellType tCell
 
  tCell = cExcel.NewCellType
  tCell.Row = 3: tCell.Column = 2: tCell.Value = "B3"
  tCell.HorizontalAlignment = chaCenter
  cWS.AddCellType tCell

  tCell = cExcel.NewCellType
  tCell.Row = 4: tCell.Column = 2: tCell.Value = "right"
  tCell.HorizontalAlignment = chaRight
  cWS.AddCellType tCell


  cWS.MergeCells 1, 2, 2, 2
 
  cExcel.Save "D:\Excel 2007 files\Reports\Test1.xlsx"
 
  cExcel.Terminate
 
  Set cWS = Nothing
  Set cExcel = Nothing
End Sub

Private Sub Command2_Click()
  Dim cExcel As clsExcel2007
  Dim cWS As clsWorksheet2007
  Dim tCell As tpExcelCell2007
  Dim lRow As Long, lCol As Long
 
  Set cExcel = New clsExcel2007
 
  Set cWS = cExcel.AddWorkSheet("Single sheet")
  For lRow = 1 To 200
    For lCol = 1 To 500
      tCell = cExcel.NewCellType
      tCell.Row = lRow
      tCell.Column = lCol
      tCell.Value = lRow * lCol
      cWS.AddCellType tCell
    Next lCol
  Next lRow
     
  cExcel.Save "D:\Excel 2007 files\Reports\Test2.xlsx"

  cWS.Terminate
  cExcel.Terminate
 
  Set cWS = Nothing
  Set cExcel = Nothing

End Sub

Attached Files

Color Management (ICC Profile) support in VB6: guide and sample project

$
0
0
Name:  Color_Management_Screenshot.jpg
Views: 72
Size:  108.4 KB


Download the sample project (250kb, including sample images)

VB6_ColorManagement.zip


What does the sample project include?

  • Color_Management (module). This contains all the necessary code for adding color management to your VB project.
  • pdLayer (class). A DIB wrapper borrowed from this vb6 project (hence the "pd" prefix). Useful if you want to load JPEG/PNG/TIFF files with embedded profiles. Not necessary if your application won't support loading images at run-time.
  • frmColorManagement (form). Sample form. Demonstrates use of the included module.
  • cCommonDialog (class). Code-only common dialog wrapper by Steve McMahon. Included to make loading images easier.


Acknowledgments

Many thanks to LaVolpe for this helpful post and sample code, which provided a great starting point for this topic.

What is color management and why does it matter?

Short answer: if your application uses images (and especially if it lets the user load or modify images), those images won't look 100% correct without color management.

Long answer: Color Management article on Wikipedia.

Do I need color management in my application?

It depends. If you do not use images in your application, then no - color management is a waste of your time.

If you do use images in your application, then color management is worth considering.

Most importantly, if you allow users to load their own images, I would consider color management a "must-have". Without it, you risk images not looking the same way they do in other software (including Windows photo viewer, PhotoShop, GIMP, etc). Users may think your software is broken, when really, it is just not color managed.

Is it hard to support color management in a VB6 app?

Yes and no, with an emphasis on "mostly no". Color management can be broken into two broad categories:

+ Color management for your forms and picture boxes. Retrieving the stock system color profile, assigning it to VB picture boxes and forms, then activating color management is extremely simple. With the sample project, you can do it in two lines of code. (Note that image boxes cannot be easily color managed, because they do not expose an hDC property.)

+ Color management for imported images. This is trickier, and it requires the use of GDI+ (or some other imaging library, like FreeImage) to parse the image data and extract any embedded ICC profile. The sample project simplifies the process to a few lines of code, but it assumes GDI+ is present (something that should be true for most anyone on Win XP SP2 or later, but which may not be guaranteed for earlier XP users). It also requires the use of DIBs, for which I provide a comprehensive wrapper, but which may complicate your project more than you want.

Can I drop your code into my project and assume everything is color managed?

Mostly. As I said, you'll need to manually activate color management for any forms or picture boxes that display images. This is done using two lines of code:

Code:

assignColorProfileToDC PictureBox.hDC
setColorManagementForDC PictureBox.hDC, True

Please note that if your picture boxes and/or forms use AutoRedraw, you may need to re-activate color management prior to drawing on the picture box, because AutoRedraw can cause the hDC of the picture box to change. (There is no measurable performance overhead in reapplying color management settings.)

If you allow the user to load images in your software, it will take more work to ensure color management for said images. Refer to the sample project for details.

What versions of Windows are supported?

Anything XP or later, assuming GDI+ is present on the target machine. If you don't care about supporting ICC profiles embedded in images, the code should work for Windows 2000 as well, though I haven't tested this.

Are any special dependencies required?

Nope! Windows itself provides a very capable color management engine, so you don't need to add any DLLs or other references to your project. Everything is accomplished by flat function calls to mscms.dll

Does this code provide the same level of color management as PhotoShop?

No, but it's closer than you might think. This project makes a number of assumptions in order to keep things simple and fast (like using the sRGB working space by default, rather than providing a choice). PhotoShop provides much more granular control over every step of the color management chain. That said, you should not notice any difference between images loaded via this sample project and images loaded via PhotoShop, assuming your copy of PhotoShop uses recommended settings.
Attached Images
 
Attached Files

[VB6] Lock ListView Columns

$
0
0
This code prevents the specified column(s) of a ListView control from being resized by the user. It does that by subclassing the ListView control and watching for the HDN_BEGINTRACK and HDN_DIVIDERDBLCLICK notification codes. Additionally, it also provides appropriate feedback to the user by displaying the "Unavailable" cursor when the mouse is over the locked column divider. That is done by subclassing the ListView's Header control and handling the WM_SETCURSOR message.


The modLockLVCols.bas file in the attached project below has been inspired by the codes in the following threads:

Preventing certain Listview columns from sizing...

[RESOLVED] Prevent User From Resizing Column Width in ListView


Also included in the attachment is frmLockLVColsDemo.frm:


Name:  Lock ListView Columns.png
Views: 125
Size:  14.0 KB
Attached Images
 
Attached Files

VB 6 Input Date format

$
0
0
Hi

I have a Date textfield, that describes to the user the format of the date (YYYY/MM) then I would use that date on my WHERE clause to update database. my Date in the database is also in the same format (YYYY/MM).

I need to write a code that will validate first if the input date is in the correct format before I can apply it on my WHERE clause. I have this code below, I need to extend it to cater for newly date column.

please help

If Len(txtSalary.Text) = 0 Or Len(txtmCover.Text) = 0 Or Len(txtMember.Text) = 0 Or Len(txtmRate.Text) = 0 Or Len(txtDate.Text) = 0 Then

MsgBox "Enter All The Fields Values"

Else
tsql = "UPDATE Hpacc4 SET SalaryBill = '" & txtSalary.Text & "', Rate = '" & txtmRate.Text & "', RateType = '" & comboRate.Text & "', Membership = '" & txtMember.Text & "', Cover = ' " & txtmCover & " ' Where Scheme = ' " & txtSCode & " ' AND RunMonth = ' " & txtDate & " ' AND AccCode = '110'"
MsgBox "Updated"

cnHPtest.Execute (tsql)

End If

Keeping VScroll Always At Bottom

Hmac

$
0
0
According to Wikipedia and verified with online HMAC routines, HMAC_SHA1("key", "The quick brown fox jumps over the lazy dog") should produce an HMAC of:
DE 7C 9B 85 B8 B7 8A A6 BC 8A 7A 36 F7 0A 90 70 1C 9D B4 D9
However, when I use the Example C Program: Creating an HMAC on MSDN:
http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx
I get:
41 4E 4C 89 33 30 47 9B 9E F1 85 DF 40 6A 66 33 49 D6 3A C7

The problem seems to be in the derivation of the Key itself (TestHMAC1). Microsoft requires that the key be hashed before deriving an actual key. The Key produced can be replicated and works if both ends are using the same process, but unfortunately it can't be used to communicate with remote servers using standard HMAC. As I have demonstrated in TestHMAC3, the correct HMAC can be produced using the MS Crypto API if you import the key rather than deriving it.

In the process of determing what was wrong with the MS routine, I wrote my own HMAC routine without the use of the Crypto API (TestHMAC2). In my humble opinion, this routine is far simpler than using the API, but you can judge for yourself. The only drawback is that you need the actual unencrypted key, and not just the handle to it. For keys created by the API, that means declaring the key as CRYPT_EXPORTABLE and exporting and decrypting it.

The program uses RSA/Schannel in a custom Container. If no Exchange key pair is available for the Container, it will create them. Schannel does not support a Signature key pair, so it will not create them.

J.A. Coutts
Attached Files

Fade Picture in Picturebox from One Picture to Another

$
0
0
'Need 2 pictureboxes (Picture1 & Picture2)
'Set both pictureboxes AutoRedraw to True
'Set both pictureboxes ScaleMode to vbPixels
'Paste the following code in the Decs

Private Const AC_SRC_OVER = &H0

Private Type BLENDFUNCTION
BlendOp As Byte
BlendFlags As Byte
SourceConstantAlpha As Byte
AlphaFormat As Byte
End Type

Private Declare Function AlphaBlend Lib "msimg32.dll" (ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hdc As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private BF As BLENDFUNCTION, lBF As Long, fade As Byte
Private FadeInProgress As Boolean

Public Function FadeThePicture(fromPicture As PictureBox, toPicture As PictureBox)
If FadeInProgress Then Exit Function

For fade = 1 To 60 Step 2
With BF
.BlendOp = AC_SRC_OVER
.BlendFlags = 0
.SourceConstantAlpha = fade
.AlphaFormat = 0
End With
RtlMoveMemory lBF, BF, 4
AlphaBlend toPicture.hdc, 0, 0, toPicture.ScaleWidth, toPicture.ScaleHeight, fromPicture.hdc, 0, 0, fromPicture.ScaleWidth, fromPicture.ScaleHeight, lBF
toPicture.Refresh
Sleep 25
Next fade

DoEvents
End Function

VB Export Project

$
0
0
Hi

I have a code below to export data from sql server db "Hpacc4" to Excel. my code just error at: rsHPData.MoveFirst, with error "Either BOF or EOF is True, or the current record has been deleted"

Please help

Code:


Private Sub btnRecon_Click() 'Export to Excel Button
 
  Dim tsql As String
 Dim oExcel As Object
 Dim oWB As Object
 Dim oWS As Object
 
  ' // ----------------------------------- //
  ' // Set up a connection to the DataBase //
  ' // ----------------------------------- //

  Set cnHPtest = New ADODB.Connection
  Set rsHPData = New ADODB.Recordset

  With cnHPtest
    .Provider = strDBProv
    .ConnectionString = strDBString
    .CommandTimeout = 1000
    .Open
  End With
 
 Screen.MousePointer = vbHourglass
    Dim x As Integer, numRecs As Integer

    Set oExcel = CreateObject("Excel.Application")
    Set oWB = oExcel.Workbooks.Add
    Set oWS = oWB.Worksheets("Sheet1")

        With rsHPData
            .CursorLocation = adUseClient
            .LockType = adLockReadOnly
            .Open "Select RunMonth, SalaryBill, Rate from Hpacc4 where Scheme = '" & frmLogin.MaskEdBox1.Text & "' AND RunMonth = '" & MaskEdDate.Text & "' AND AccCode = '110'", cnHPtest, adOpenForwardOnly, adLockReadOnly
        End With
       
        If rsHPData.EOF And rsHPData.BOF Then
       
        'Set rs = cmd.Execute()
        numRecs = rsHPData.RecordCount
        rsHPData.MoveFirst
       
        With oWS
          'SET THE TOP ROWS WITH TITLES--Change Font to Bold and Make The Font RED
            .Range("A1:C1").Font.Bold = True 'sets top row (stuff below) in bold print
            .Range("A1:C1").Font.ColorIndex = 3 'change font color to red
              .Cells(1, 1).Value = "STATE NAME"
              .Cells(1, 2).Value = "STATE ABBREVIATION"
              .Cells(1, 3).Value = "DATE ENTERED UNION"
        'Run through the RECORDSET, stating in ROW 2, until end of the RECORDSET
        For x = 2 To numRecs + 1  ' You can do this differently without using numRecs (do while not rs.eof)
              .Cells(x, 1).Value = Trim(rsHPData!RunMonth)  'State is a TEXT Field in my db
              .Cells(x, 2).Value = Trim(rsHPData!SalaryBill)      'St is a TEXT Field in my db
              .Cells(x, 3).Value = Trim(rsHPData!Rate)  'date_orig is a DATE Field in my db
        rsHPData.MoveNext  'Move through the RECORDSET
        Next x
        End With
        End If
        'This for-loop makes the columns just wide enough for the largest 'string' in each column
        For x = 1 To 3 'where 3, in my case is three columns  (State Name, State Abbreviation and Date Entered Union
              oWS.Columns(x).AutoFit
          Next x
        'close down the rs and connection
        rsHPData.Close
        cnHPtest.Close
        oExcel.Visible = True  'so you can see what you did
        'set up the active excel sheet
        Set oWS = oExcel.ActiveSheet
        Set oWB = oExcel.ActiveWorkbook
        oWB.SaveAs FileName:=App.Path + "\testfile.xlsx"  'use whatever name you want here
    Screen.MousePointer = vbDefault
End Sub

VB6 Date Validation

$
0
0
Hi

I'm using maskEdBox to accept date from the user in this format yyyymmdd, Now I want to validate this date to be a valid date, (i.e the user might input 1234/12/12), and also the date shouldn't be any future date, either with a month or a year, max date should be the current date. please help.
Viewing all 1509 articles
Browse latest View live


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