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

VB5/6/VBA - HeapsortVarVar, Another VB Sort

$
0
0
This is a VB6 static (.BAS) module for sorting a Variant array of Variant arrays using the Heapsort algorithm. It could easily be converted to a class (.CLS) if desired as well.

It should be usable in VB5 and VBA, but this hasn't been tested. it should even be convertable to VBScript, though with much reduced performance of course.


Why VarVars?

When I need to work on large sets of row/col-based (tabular) data and I can't use a database or ADO Recordset I find Variant arrays of Variant arrays handy. Much handier then a 2-D array of String because I can used typed data, far less clunky than working with inflexible UDT arrays where you can't iterate over the fields, and even more useful than 2-D Variant arrays.

Typed data instead of String for everything can be very useful. In a field typed as Single, Double, Currency, etc. 2 and 2.0 will compare properly.

For another thing you can build a "row" of fields easily just using the VB Array() function, then assign it to a "row" slot in your Variant rows array.


Why Heapsort?

The Heapsort is reasonably speedy, doesn't require additional space, and performs well even in worst-case input sequences.

But the main reason is that it is easy to modify to perform the sort in several steps. This makes it possible to use a Timer control to drive a "background" sort that doesn't cause your programs to become unresponsive. This does add to the time a little, but the Timer.Interval need only be 16 to 32 milliseconds for most purposes. It also allows you update progress bars, handle "cancel" button clicks, etc.

This has always been the preferred way to handle this in VB6, as the manual states in many places. DoEvents() calls have their place, but DoEvents() is evil, should rarely be used, and even then only used quite carefully.

However both a synchronous sort and a quantified "pseudo-async" sort are provided here.


Usage

Basically, just add HeapsortVarVar.bas to your projects.

Then when you have a Variant array of Variant arrays to sort, call the SortBy() subroutine (or the QuantumSortBy() function until it returns False).

You pass the column index to sort on, the outer (rows) array to be sorted, and an optional Boolean Descending value (True or False, default False) to specify the direction of the sort.

QuantumSortBy() has two more parameters but the source code comments should explain those. These need to be initialized before the first call of each sort to be performed.

There are no extra dependencies.


Issues

There are sorts that can be faster, Quicksort is popular. However they aren't usually enough faster to warrant sacrificing some of the things that are easy to do to Heapsort (e.g. a quantified pseudo-async version).

If you create a Quicksort adapted for this I'd love to see it. Right now HeapsortVarVar works plenty fast for me, but more speed without additional pain is always appreciated.

Bugs. As far as I can tell there aren't any, but if you find some I'd like to know about them.

I find this very versatile, and once "known bug free" it should make a useful and easily reusable sort for VB users. While you can use it for sorting single items, it would be better to just create a new version tailored to work on a simple single-valued 1-D array.


Demos

There are two in the ZIP archive attachment. They are "ready to run" with a sample input file included, though I'd try testing after compiling to an EXE first. There is more data included than it appears, though it ZIPpped fairly small because it's about 1500 records copied into the file multiple times. The sort isn't too bad even in the IDE, however populating and re-populating the flexgrid can take a while.

Yes, I know the flexgrids can sort, but here it is just being used for demo purposes.

HeapsortDemo

This is a GUI program that loads and parses the sample data into a VarVar and displays it in an MSHFlexGrid. Then you can click or shift-click the column headers to sort and redisplay the VarVar contents.

Yes, there are a couple of UI quirks, related to the column click selecting cells in the grid. The program tries to clear these selections but it doesn't always succeed. The grid is merely being used for demo purposes here anyway. But you may already know of a fix for that if you care.

DeleteDups

A simpler program without any Forms that loads up the sample data, then sorts on the second column as a Single value, then
writes a new file including only the first row for each unique "second column" value.

It uses MsgBox calls to display when it reaches each phase and the time each phase takes.
Attached Files

VB6 - SillyStream Encrypted Text I/O

$
0
0
While hand-rolled encryption is never a good idea, sometimes you don't need a high-security solution. SillyStream is a text I/O class that you can set a few parameters on and then do low-volme encrypted text file I/O. It would need optimization if you really need to work on large files, but it was really intended for smaller items such as settings files.


Usage

Pretty simple, just add SillyStream.cls to your Project. Then create instances as you need them (eaach only handles one file at a a time). Call Init() to set the parameters, then one of the open methods (input, output, append), and use the read and write methods, and finally the close method. Then you can open a new file either with or without setting new parameters first.


Parameters

There are two mask values (one a Byte, another a Long) and two dimensional parameters. These have funny names in the class and in the demo Project. See the comments for an explanation.


Cipher Used Here

This is a combination cipher, based on two very very simple ciphers.

The main feature here is a transposition cipher using the two dimensions provided to create a buffer block as a matrix. When writing or reading the file, the data is an inversion of this matrix.

On top of that we have simple (really simple) substitution cipher. All of the data characters a XORed with a one Byte mask. With some effort you could use a longer "password" mask but it complicates things (especially "open append" operations).

The final block is padded with pseudorandom values.

Finally, to make this work even with a padded final block, the actual data length is stored in the first 4 bytes of the file as a Long value. This is XORed with the Long mask you provide to help obscure it a bit. Adding these 4 bytes has another advantage: It makes it all little tougher to crack because simply trying to factor the file size will be a bit of a red herring even if someone guesses it uses a rectangular transposition cipher.

Dumb but cheap, and perhaps good enough.


Demo

The demo Project lets you open a new files, type some stuff, write is as characters or as a line 9adding newline), etc, and then close. Then you can read it back and see it displayed, using both reading by byte count or the slower reading by line.

Even though slower, I expect most people to just read by line most of the time. Writing by line is probably going to be more useful then by text length as well.

Sample inputs:
Code:

This is a test.
This is only a test.
How now, brown cow?
Mellow yellow, such a silly fellow!
Test test test test test test test test test test testing!

Hex dump:
Code:

0000        e5 54 12 f0 0f 2f 35 13  35 2c 33 37 28 2f 2f 3e  .T.../5.5,37(//>
0010        51 7c 07 8c 15 33 75 37  34 7b 7b 7b 34 2f 3e 7b  Q|...3u74{{{4/>{
0020        28 04 83 14 93 22 32 56  22 2c 38 22 3a 2c 7b 28  (...."2V",8":,{(
0030        2f 2f 0b 90 1b a0 29 28  51 7b 7b 34 3e 7b 7a 2f  //....)(Q{{4>{z/
0040        2f 3e 7b 18 97 28 a7 36  7b 0f 3a 35 2c 37 28 56  />{..(.6{.:5,7(V
0050        3e 7b 28 2f 1f a4 2f b4  3d 32 33 7b 34 64 37 32  >{(/../.=23{4d72
0060        51 28 2f 2f 3e 2c ab 3c  bb 4a 28 32 2f 2c 56 34  Q(//>,.<.J(2/,V4
0070        37 0f 2f 3e 7b 28 33 b8  43 c8 51 7b 28 3e 77 51  7./>{(3.C.Q{(>wQ
0080        2c 37 3e 7b 28 2f 2f 40  bf 50 cf 5e 3a 7b 28 7b  ,7>{(//@.P.^:{({
0090        16 77 22 28 2f 2f 3e 32  47 cc 57 dc 65 7b 32 2f  .w"(//>2G.W.e{2/
00a0        39 3e 7b 7b 2f 3e 7b 28  35 54 d3 64 e3 72 2f 28  9>{{/>{(5T.d.r/(
00b0        75 29 37 28 3d 7b 28 2f  2f 3c 5b e0 6b f0 79 3e  u)7(={(//<[.k.y>
00c0        7b 56 34 37 2e 3e 2f 2f  3e 7b 7a 68 e7 78 f7 86  {V47.>//>{zh.x..
00d0        28 34 51 2c 34 38 37 3e  7b 28 2f 56 6f f4 7f 0e  (4Q,487>{(/Vo...
00e0        8d                                                .

Hex dump of a test with the data XORing omitted. Normally you wouldn't do this but it shows that the transposition and padding can be effective all alone:
Code:

0000        e5 54 12 f0 54 74 6e 48  6e 77 68 6c 73 74 74 65  .T..TtnHnwhlstte
0010        0a af 30 b5 3c 68 2e 6c  6f 20 20 20 6f 74 65 20  ..0.<h.lo  ote
0020        73 37 b6 3d bc 49 69 0d  79 77 63 79 61 77 20 73  s7.=.Ii.ywcyaw s
0030        74 74 3e c3 44 c9 50 73  0a 20 20 6f 65 20 21 74  tt>.D.Ps.  oe !t
0040        74 65 20 4b ca 51 d0 5d  20 54 61 6e 77 6c 73 0d  te K.Q.] Tanwls.
0050        65 20 73 74 52 d7 58 dd  64 69 68 20 6f 3f 6c 69  e stR.X.dih o?li
0060        0a 73 74 74 65 5f de 65  e4 71 73 69 74 77 0d 6f  .stte_.e.qsitw.o
0070        6c 54 74 65 20 73 66 eb  6c f1 78 20 73 65 2c 0a  lTte sf.l.x se,.
0080        77 6c 65 20 73 74 74 73  f2 79 f8 85 61 20 73 20  wle stts.y..a s
0090        4d 2c 79 73 74 74 65 69  7a ff 80 0d 8c 20 69 74  M,ystteiz.... it
00a0        62 65 20 20 74 65 20 73  6e 87 08 8d 14 99 74 73  be  te sn.....ts
00b0        2e 72 6c 73 66 20 73 74  74 67 8e 15 94 21 a0 65  .rlsf sttg...!.e
00c0        20 0d 6f 6c 75 65 74 74  65 20 21 9b 1c a1 28 ad    .oluette !...(.
00d0        73 6f 0a 77 6f 63 6c 65  20 73 74 0d a2 29 a8 35  so.wocle st..).5
00e0        b4                                                .


Bugs

I havent found any, but if you do be sure to mention them.
Attached Files

[RESOLVED] [VB6] Coloring Excel Cell from VB6

$
0
0
Hi Guys,

Do you have any idea how to set excel cell from VB6 Codes?

Set ExlObj = CreateObject("excel.application")
ExlObj.ActiveSheet.Cells(1, 1).Columns.ColumnWidth = 18
ExlObj.ActiveSheet.Cells(l, m).Rows.BackColor = vbGreen << IS NOT WORKING

Thanks,
Jefri

How to Make a Round (Circular) Form

$
0
0
Ever want a round form? This short VB6 code will create it for you. I know it works on XP and Win7. Not tested on Win8.

Open a new VB6 project
I added two shapes and one label to the form---not necessary, but looks pretty! :-)
I use a Double-Click to unload the form, but you can use any ctrl/code you desire.

Code:

Option Explicit
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Sub Form_DblClick()
  Unload Me
End Sub
Private Sub Form_Load()
    Dim lngRegion As Long
    Dim lngReturn As Long
    Dim lngFormWidth As Long
    Dim lngFormHeight As Long
    Me.Width = Me.Height
   
    lngFormWidth = Me.Width / Screen.TwipsPerPixelX
    lngFormHeight = Me.Height / Screen.TwipsPerPixelY
    lngRegion = CreateEllipticRgn(0, 0, lngFormWidth, lngFormHeight)
    lngReturn = SetWindowRgn(Me.hWnd, lngRegion, True)
    Shape1.Left = (Me.Width / 2) - (Shape1.Width / 2)
    Shape2.Left = (Me.Width / 2) - (Shape2.Width / 2)
    Shape1.Top = (Me.Height / 2) - (Shape1.Height / 2)
    Shape2.Top = (Me.Height / 2) - (Shape2.Height / 2)
    Label1.Top = (Me.Height / 2) - (Label1.Height / 2)
    Label1.Left = (Me.Width / 2) - (Label1.Width / 2)
End Sub
Private Sub Label1_Click()
  Unload frmRound
End Sub

Here's How to Make a Form With a HOLE in it.

$
0
0
Want a form that you can move around and see what is behind the center of it? Not sure what good it is, but it's kinda cool. Maybe you can find a good use for it. Noting to add to a project---only the form that you see when you start a new poject.

Code:

Option Explicit
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Sub Form_Resize()
Const RGN_DIFF = 4
Dim outer_rgn As Long
Dim inner_rgn As Long
Dim combined_rgn As Long
Dim wid As Single
Dim hgt As Single
Dim border_width As Single
Dim title_height As Single
    If WindowState = vbMinimized Then Exit Sub
   
    ' Create the regions.
    wid = ScaleX(Width, vbTwips, vbPixels)
    hgt = ScaleY(Height, vbTwips, vbPixels)
    outer_rgn = CreateRectRgn(0, 0, wid, hgt)
   
    border_width = (wid - ScaleWidth) / 2
    title_height = hgt - border_width - ScaleHeight
    inner_rgn = CreateRectRgn( _
        wid * 0.25, hgt * 0.25, _
        wid * 0.75, hgt * 0.75)
    ' Subtract the inner region from the outer.
    combined_rgn = CreateRectRgn(0, 0, 0, 0)
    CombineRgn combined_rgn, outer_rgn, _
        inner_rgn, RGN_DIFF
   
    ' Restrict the window to the region.
    SetWindowRgn hWnd, combined_rgn, True
    DeleteObject combined_rgn
    DeleteObject inner_rgn
    DeleteObject outer_rgn
End Sub

VB6 - MMapper, Memory Mapped File Demo

$
0
0
Background

People are often scrounging for easy to use IPC alternatives for Visual Basic programs. Windows offers a ton of choices, but unless you can state your requirements it is difficult for somebody else to make a recommendation.

One obvious route is to use a common disk file shared among your program instances (processes). This really isn't as bad as it sounds, but there is a somewhat lighter-weight alternative to a shared temporary file that often isn't considered.

Files can be mapped into shared memory, but we can go a step further and "back" such shared memory with the system paging file instead. This thread talks about some simple code to do this in a bare bones fashion.


MMapper

MMapper is a simple class using the basic set of API calls required to create, open, read, write, and close such a chunk of shared memory.

As written, it sets up a BLOB of bytes as shared and then treats it as a single place to write or read data that multiple processes can use. Since you do not get fine control over where this memory is mapped into your processes' address spaces it is normally used along with CopyMemory() calls.

MMapper handles this by accepting pointer and length arguments for its read and write methods. This means you can pass String variables, Byte arrays, or even UDTs that are flat (do not contain dynamic-length fields).


The Demo

The attached demo contains the MMapper class and two projects: Writer and Reader.

Writer is responsible for creating the mapped file and writing data to it. Reader opens this mapped file (which requires that it is first created by Writer) and reads data from it.

MMapper creates/opens the mapped file with read/write access, so the fixed roles of Reader and Writer are simply to make the operation easier to understand.

You could easily have every program (and every instance of each program) try to create the mapped file, and they could all both read and write. It's just a matter of figuring out how you want to coordinate things among all of the running processes, and that part is up to you.

Here I use a small UDT to pass one Long value and one String * 100 value.


Enhancements

It is easy enough to extend MMapper in several ways.

Some of these involve security options to allow sharing among users. You can also treat the mapped space as several separate items instead of one BLOB. And you can map an actual disk file, providing persistence across sessions.

See your MSDN Library CDs or Windows SDK for more details.

This even works on Win9x with a few limitations inherent in the platform (such as no Terminal Services or Fast User Switching or other multi-user support).
Attached Images
 
Attached Files

[VB6] Steam Account/Password Manager 1.0.1 (Account Safe, Fully encrypted) [SRC]

$
0
0
As i said a few weeks ago i believe 9 weeks ago. I was planning on making such a app.
Here is it. I made it a while ago by now. But uhm just uploads it now.

Demo:



Download:
See attached zip file.

Have fun and let me know what you think of it :wave:
Attached Files

operator & is not defined for string"select....."and data row view

$
0
0
i have 2 ddls and i want to populate the second one based on the value of the first one. so i went on to use a row filter to filter the data view to get the data i need on the second ddl but when the page loads i get the error operator & not defined for string "Select distinct Zones....." and data row view. i click ok on the dialog error box to close it and it goes on to open the form and the code actually works. so how do i get rid of the error

cmd.CommandText = "Select Distinct Zones.ZoneID,CustomerItems.CustomerID as CustomerID,Zones.Zone " & _
"From CustomerItems Inner Join Zones On Zones.ZoneID=CustomerItems.ZoneID " & _
"Inner Join StockItems On StockItems.StockID=CustomerItems.StockID Where CustomerItems.CustomerID='" & ddlCustomers.SelectedValue & "'"
da = New SqlDataAdapter(cmd)
da.Fill(ds, "Zones")

'Populate Zones
ddlZone.DisplayMember = "Zone"
ddlZone.ValueMember = "ZoneID"
ddlZone.DataSource = ds.Tables("Zones")


setup = False
If Not setup Then
Dim dv As DataView
dv = New DataView(ds.Tables("Zones"))
'dv.RowFilter = "CustomerID = '" & ddlCustomers.SelectedValue & "'"
dv.RowFilter = "[CustomerID] = " & ddlCustomers.SelectedValue
ddlZone.DataSource = dv
ddlZone.ValueMember = "ZoneID"
ddlZone.DisplayMember = "Zone"
setup = False
End If

CommonControlsEx (Replacement of the MS common controls)

$
0
0
This project is intended to replace the MS common controls for VB6.

As for now, the „MSCOMCT2.OCX“ can be replaced completly. (Except the FlatScrollBar control, because this is not supported on comctl32 v6.0)
The „MSCOMCTL.OCX“ can not yet replaced fully, as for example the ListView/TreeView control is missing. (But might be included soon)

These are the controls that are available at the moment:

- Animation
- DTPicker
- ImageList
- MonthView
- ProgressBar
- Slider
- TabStrip
- UpDown
- ToolTip (This is new, because it does not exist in the MS common controls for VB6)

For the ImageList and the TabStrip is a property page implementation. That means you can add items at design time.

At design time (IDE) there is only one dependency. (OLEGuids.tlb)
This is a modified version of the original .tlb from the vbaccelerator website.

But for the compiled .exe there is no dependency, because the .tlb gets then compiled into the .exe.

Attachment 93081

Attachment 93087
The underscores at the tabstrip control are added to demonstrate that the shortcut via ALT key is supported.

Attached is the demo project.
Everything should be self explained, because all functions and properties have a description.
Attached Images
   
Attached Files

Creating a window by using the API

$
0
0
The attached code (Create Window.zip) demonstrates how to use the CreateWindowEx API function to create a window and controls inside it.
Attached Files

Expore and create desktops

$
0
0
Desktop Explorer demonstrates get a list of active window stations and any desktops attached to them. The program also allows the user to create a new desktop and launch programs on it. Depending on the user's version of Windows and security settings it won't be possible to detect/access all window stations and desktops.
Attached Files

How to create a console application

$
0
0
Console is a program that demonstrates how create a console and write text to it. It also demonstates how to read user input and how to set/get the console's properties such as its title.

When compiled, Visual Basic 5/6 applications that use a console, are considered to be GUI applications and are treated as such. To solve this use the linker as follows:
path of Visual Basic\Link.exe /EDIT /SUBSYSTEM:CONSOLE executable
Attached Files

Explore and create desktops

$
0
0
Desktop Explorer demonstrates get a list of active window stations and any desktops attached to them. The program also allows the user to create a new desktop and launch programs on it. Depending on the user's version of Windows and security settings it won't be possible to detect/access all window stations and desktops.
Attached Files

Reading the memory of another process

$
0
0
The attached program demonstrates how to read the memory of another process. The user can either launch a new process or specify the process id of a running process. The result is saved in a file.
Attached Files

Word Wrap

$
0
0
a basic WordWrap program i created or modified from various source codes found on the InterNet .

it does not do a 100% percent job on every type of Text entered,
so please feel free to help improve this Source Code to handle every combination of Characters/Numbers/Etc.

Attachment 93469
Attached Images
 
Attached Files

Client/Server - a winsock example

$
0
0
Client/Server is a program that demonstrates how to use winsock to connect to a server or how to accept connections from a client. The program allows the user to send and receive data. Non printable characters are displayed as escape sequences and can also be entered as such. Here is one easy way to try this program:

1. Start two instances of the program.
2. Select "client mode" for one instance and "server mode" for the other.
3. Specify an ip address/host name and port to listen to for the server, then select "Listen" in the "Monitor" menu.
4. Specify a remote ip address/host name and port to connect to for the client, then select "Connect" in the "Client" menu.
5. You should now be able to send data between the two instances of the program through winsock.
Attached Files

Code for a four point transformation of an image

$
0
0
This code can be used to manipulate an image into any space defined by four corners. Unlike an affine-transform (3 point transformation) which uses a parallelogram shaped space, this 4 point transformation can use absolutely any generic shape that can be defined by four points. Below is this code, split into the two files that I ended up using.

Code for DPointType.bas
Code:

Public Type DPOINT
X As Double
Y As Double
End Type

Code for FourPointTransform.cls
Code:

'Requires DPointType.bas

'The Points array holds 4 points. Below is an explanation of each point.
'Points(0) is the position that a rectangle's upper left point is mapped to.
'Points(1) is the position that a rectangle's upper right point is mapped to.
'Points(2) is the position that a rectangle's lower left point is mapped to.
'Points(3) is the position that a rectangle's lower right point is mapped to.

Friend Function X2(ByVal X As Double, ByVal Y As Double, ByVal ImgWidth As Double, ByVal ImgHeight As Double, _
ByRef Points() As DPOINT) As Double
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double
b = (Points(1).X - Points(0).X) / (ImgWidth - 1)
d = Points(0).X
c = (Points(2).X - Points(0).X) / (ImgHeight - 1)
a = (Points(3).X - (ImgHeight - 1) * c - d - (ImgWidth - 1) * b) / ((ImgWidth - 1) * (ImgHeight - 1))
X2 = X * (Y * a + b) + Y * c + d
End Function

Friend Function Y2(ByVal X As Double, ByVal Y As Double, ByVal ImgWidth As Double, ByVal ImgHeight As Double, _
ByRef Points() As DPOINT) As Double
Dim a As Double
Dim b As Double
Dim c As Double
Dim d As Double
b = (Points(2).Y - Points(0).Y) / (ImgHeight - 1)
d = Points(0).Y
c = (Points(1).Y - Points(0).Y) / (ImgWidth - 1)
a = (Points(3).Y - (ImgHeight - 1) * b - (ImgWidth - 1) * c - d) / ((ImgHeight - 1) * (ImgWidth - 1))
Y2 = Y * (X * a + b) + X * c + d
End Function

Use the above class to transform an image in one picture box into a random shape in a second picture box, using the sample code below:
Code:

Private Sub TransformImage()
dim Xfrm as new FourPointTransform
dim Points(3) as DPOINT
Points(0).X=100 : Points(0).Y=20
Points(1).X=300 : Points(1).Y=45
Points(2).X=115 : Points(2).Y=200
Points(3).X=290 : Points(3).Y=230
for y = 0 to Picture1.Height-1
for x = 0 to Picture1.Width-1
u = Xfrm.X2(X, Y, Picture1.Width, Picture1.Height, Points)
v = Xfrm.Y2(X, Y, Picture1.Width, Picture1.Height, Points)
Picture2.pset(u,v),Picture1.point(x,y)
next x
next y
End Sub

Or use the above class to transform a portion of an image defined by any random 4-point shape in one picture box to fit correctly into a second picture box. This is the inverse of the above transformation. The code is very similar to the above, with just a few changes. See the code below
Code:

Private Sub InverseTransformImage()
dim Xfrm as new FourPointTransform
dim Points(3) as DPOINT
Points(0).X=100 : Points(0).Y=20
Points(1).X=300 : Points(1).Y=45
Points(2).X=115 : Points(2).Y=200
Points(3).X=290 : Points(3).Y=230
for y = 0 to Picture2.Height-1
for x = 0 to Picture2.Width-1
u = Xfrm.X2(X, Y, Picture2.Width, Picture2.Height, Points)
v = Xfrm.Y2(X, Y, Picture2.Width, Picture2.Height, Points)
Picture2.pset(x,y),Picture1.point(u,v)
next x
next y
End Sub

[VB6] Function Wait (non-freezing & non-CPU-intensive)

$
0
0
This routine waits for the specified amount of time without freezing the GUI or raising up the CPU usage.

Code:


Private Type MSG
    hWnd    As Long
    Message As Long
    wParam  As Long
    lParam  As Long
    Time    As Long
    Pt_X    As Long
    Pt_Y    As Long
End Type

Private Declare Function
KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function
PeekMessage Lib "user32.dll" Alias "PeekMessageW" (ByRef lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function
SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, Optional ByVal lpTimerFunc As Long) As Long
Private Declare Function
WaitMessage Lib "user32.dll" () As Long

'This routine waits for the specified amount of time before resuming with the next line of code
Public Function Wait(ByVal Milliseconds As Long) As Boolean
    Const
PM_QS_POSTMESSAGE = &H980000, WM_TIMER = &H113&
    Dim TimerID As Long, M As MSG

    TimerID = SetTimer(0&, App.ThreadID, Milliseconds)
    If TimerID Then
        Do
:  Wait = WaitMessage
            If PeekMessage(M, -1&, WM_TIMER, WM_TIMER, PM_QS_POSTMESSAGE) Then If M.wParam = TimerID Then Exit Do
        Loop Until
DoEvents < 0
        TimerID = KillTimer(0&, TimerID):    Debug.Assert TimerID
    End If
End Function


The attached Form demonstrates usage of this simple function.
Attached Files

[VB6] Shell & Wait

$
0
0
The module included in the attachment contains 3 routines that supplements VB's intrinsic Shell function by waiting for the shelled program to terminate before resuming with the next line of code without blocking other events from firing. The accompanying Form demonstrates usage of each function.

The Shell_n_Wait function augments the native Shell function by waiting for the shelled process until it exits. It also auto-expands environment variables before relaying them to Shell. Instead of retrieving the Process ID/Task ID, Shell_n_Wait returns the terminated process' Exit Code.

The ShellW function is probably the most flexible yet easy-to-use shelling routine ever coded. It accepts Unicode paths to executables or documents (registered file types). Paths can be fully qualified or relative and may contain navigational elements ("." or ".."), environment variables and/or arguments/parameters. The window style (normal, minimized, maximized, hidden, etc.) can be optionally requested. It features the ability to wait for the shelled program indefinitely or exactly as specified. Its return value depends on whether the shelled process is still alive or not. If the process still exists, it retrieves the Process ID, otherwise it returns the Exit Code.

The ShellWS function wraps the Windows Script Host's Run method as shown below:

Code:


'Runs a program in a new process.
Public Function ShellWS(ByRef Command As String, Optional ByVal WindowStyle As VbAppWinStyle = vbNormalFocus, _
                                                Optional ByVal WaitOnReturn As Boolean) As Long
    #Const Referenced = True
    #If Not Referenced Then
        ShellWS = CreateObject("WScript.Shell").Run(Command, WindowStyle, WaitOnReturn)
    #Else
        With New
WshShell
            ShellWS = .Run(Command, WindowStyle, WaitOnReturn)
        End With
    #End If      'Adapted from "Best Shell & Wait (No API's!)" by Matthew Roberts
End Function    'http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=8349&lngWId=1

Attached Images
 
Attached Files

Client/Server a raw TCP client (Winsock example.)

$
0
0
Client/Server is a program that demonstrates how to use winsock to make raw TCP connections to a server and how to accept connections from a client. The program allows the user to send and receive data. Non printable characters are displayed as escape sequences and can also be entered as such. Here is one easy way to try this program:

1. Start two instances of the program.
2. Select "client mode" for one instance and "server mode" for the other.
3. Specify an ip address/host name and port to listen to for the server, then select "Listen" in the "Monitor" menu.
4. Specify a remote ip address/host name and port to connect to for the client, then select "Connect" in the "Client" menu.
5. You should now be able to send data between the two instances of the program through winsock.
Attached Files
Viewing all 1469 articles
Browse latest View live


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