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

[vb6] Extending VB's Image Control for PNG, TIFF, and more [v1.1]

0
0
UPDATED on 11 Oct 2015. Major revision. Added animated GIF and mutlipage TIFF support.
Any previous version must be thrown away. You do not want to run both in the same project, trust me!
12 Oct 2015: Added more robust method of activating images at runtime from controls loaded at design-time. See post #11 for more

The VB Image control is now more flexible. Want to display PNG and TIFF without using a 3rd party control? It can do that. Want to display 32 bit alpha-blended bitmaps? It can do that. Want to animate GIFs and display nice 32 bit alpha-blended icons? Now it can ;)

What's even more amazing is that this isn't limited to the image control. These images can be displayed in most things with a Picture property -- not every Picture property, but most. Want to add a nice PNG to a button, yep it can be done. Regardless, true transparency is maintained, nothing faked. Change the backcolor of some container, and you don't have to reload the image to fake transparency again. Someone changes themes on the pc & it doesn't effect the transparency.

Major Limitations:
1. Cannot see transparency in bitmaps while in design-view.
2. Cannot load PNG,TIFF while in design-view

How this class works.
1. Converts non-icon/gif/metafile formats to 32bpp premultiplied RGB bitmap if image contains transparency. AlphaBlend API is used to render the image in that case
2. Icons/Cursors are loaded as-is and rendered with DrawIconEx API if icon/cursor is 32bpp
3. GDI+ is used to load PNG/TIF/Animated GIF and convert to 32bpp or 24bpp bitmaps for display
4. Only images that need special rendering are custom drawn
5. Subclassing of the picture is performed for two reasons: a) handle rendering as just described and b) tell VB that a picture contains transparency so VB will repaint behind the image before it's drawn.

This version of the class has a few active methods.

1. SetImage. This is a replacement for VB's LoadImage and Set methods that pertain to images. It allows unicode filenames and can support TIF, PNG, 32bpp bitmaps & icons/cursors, PNG-encoded Vista-style icons, plus what VB supports.

2. SetSubImage. If a multipage TIFF or animated GIF has been loaded with option chosen for navigation, this method changes the page/frame.

3. WantEvents. Method allows you to receive an event to enable you to draw behind or on top of any image

4. EnableSubclassing. Allows you to turn off subclassing. By default, subclassing is enabled. But since subclassing in IDE is not safe, it is recommended you disable subclassing when working on your project. Turn it on when you want to view the images with transparency for a quick look-see. Then close your project normally and disable subclassing as desired. Subclassing cannot be disabled when project is compiled. Once disabled during IDE run-time, cannot be re-enabled until project closes -- safety measure.

5. SubImageCount. Returns number of frames/pages if animated GIF or multipage TIFF loaded

6. GetGIFAnimationInfo. Returns the frame duration and loop count for animated GIFs

I have included a very simple sample project. The project's images you see in design view are one that is premultiplied and one that is not. Both are 32 bit bitmaps that use the alpha channel.

Screenshot below are two VB image controls. You can clearly see they are drawing blended alpha channels. Background is transparent, soft edges and shadows. The updated zip below does contain an animated GIF example.

Name:  Untitled.jpg
Views: 68
Size:  36.6 KB

Suggestion: GIF/TIFF animation/navigation is not disabled when EnableSubclassing = False. I feel it should be. GDI+ can cause crashes too in IDE if it is not shut down properly and hitting END prevents proper shutdown. If you agree, you will want to make this modification:

Routine: SetImage
Add the following before the line: Select Case PropertyName
Code:

If Me.EnableSubclassing = False Then RequiredImageType = RequiredImageType And Not lifAllowNavigation
Attached Images
 
Attached Files

VBIDEUtils now open sources

0
0
Hi

I wrote very very long time ago (in 1999) the best VB6 addin : VBIDEUtils (You still can find it on a lot of web sites)
In the past I was selling it, but as I had shutdown VBDiamond 10 years ago, I haven't sell it anymore
I use it off course everyday in all my VB6 projects, to clean code, indent, add automatic error handling, optimize code...
It does better job than MZtools, and also far more other things.

Here is a small description.
VBIDEUtils is a great add-in for VB 5.0 and VB 6.0. With
this add-in, you can do :
- Code Repository
- Store VB Code, Classes, Projects
- Store files
- Store HTML pages
- Store HTML links
- Search through all the database
- Store VB Scripts
- Java Scripts
- Java
- Icons
- Use bookmarks
- Enhanced search
- Search through all the VB Web sites
- Synchronize your local DB with the DB of VBDiamond
- Synchronize code with the major VB Code sites
- Search for programming books on the Web
- Save your code as HTML pages
-
- .....
- Make search through a very extensive Book repository
- Indent easily your code, procedure, block, variables
- Add comment to your modules and procedures
- Find the corresponding ending block instruction
- Know all the APIs error name
- Clear the debug Window
- Change easily the taborder of all your controls
- Add customized error handler to your code
- Add enhanced error handler to your code with loggin, trace
- Show the KeyAscii table to help you coding functions
- An assistant to create your messagebox
- A Toolbar code generator
- Close all the unused windows in the VB IDE
- Spy the classname of each windows
- An Icon browser
- A DBCreator code generator
- An ActiveX documentor
- Export all code to HTML files (from the VB IDE or the VBCodedatabase)
- Import/Export to VCL and DCB files
- Export the VB Code from the VB IDE to HTML files
- Extract all the strings and translate them directly in the addin for further use of resources String and so internationalize your applications
- Change/Modify the tooltips all your controls
- Add new procedure/functions/properties easily with parameters, description....
- Get all dependencies of an executable or a VB project
- Analyze VB projects
- Search all the web in the VB sites directly from the addin
- Added a VB project explorer
- Profile your VB projects and detect dead code including dead variables, dead procedures...
- Add/remove line numbering in your code
- Control properties assistant
- Accelerator assistant
- Generate code to create toolbar at runtime
- Get easily code from several VB Code websites on the web
- Added an enhanced find in VB projects
- Added the automatic creation of connections strings for ADO
- Generate automatically DLL Base Adresses
- Generate GUID
- A lot of of other new features

I decided to release the sources in order to add new possibilities with the community here, and eventually, why not doing a MS Access version compatible, and a .NET Version.
I made a .NET version for the first version of .NET (very long time ago, in 2010), but due to a lack of time, I stopped it.

You will have certainly to compile it, and just call the function "AddToINI" to add it to your VB6 Addins list as I removed all the install part

So here are the sources, of VBIDEUtils.
Please, don't forget, it has bee written in 1999, so 15 years ago, and of course, if I had to rewrite it now, I will use other coding way for many things.
Also, some parts of the code are not used anymore, but, this is normal for a such old project.

If you add functionalities, please post them here it order to make it even better, and offer other to other VB Coder.

Otherwise, you can us the code in your own project, and if like VBIDEUtils or the code, just say hello to your neighbors and all people in the street, in real life, as there is a big lack of real life those days.

Enjoy.

Well, I tried to upload the ZIP with the whole sources, but it more than 2Mb.
I try to find a way

Well, the size of the attachment is limited to 500K
So if a moderator could do something for me?

In the meantime, here is a link : https://github.com/tannerhelland/VBIDEUtils

[VB6] Locale Sensitive Sorting

0
0
There are times when you need to sort in a locale-aware manner.

One of the more obvious cases is probably when generating cryptographic signatures for web services. These often require you to create a hash-based message authentication code (HMAC) based on inputs including a canonicalized URI, several HTTP header values including a timestamp, a secret key, and perhaps other items. These items normally have to be sorted so that the server end can reproduce the same HMAC by calculation, and that means both ends have to agree on the collating sequence.

Often you can get away with a lot because most of the characters are going to fall within the 7-bit ASCII range. But when they don't you need to be sure you are using the "invariant, string-oriented" collating sequence and not your user session collating sequence or one that takes language quirks into account.

Many HMAC sigs require that you hash the UTF-8 too, but it works if you first sort UTF-16LE Unicode and then re-encode as UTF-8 (same sequence).

And of course sorting gets used all over - though most uses aren't as sensitive as crypto processes can be.


Subtleties

Accented characters may sort earlier or later depending on the language. Ligatures (e.g. mediæval vs. mediaeval) need to be considered. "String compare" and "linguistic compare" differ. And on and on it goes.


Demo

This demo uses a simplistic Insertion Sort. This is quick and dirty, understood by most sorting fans, and importantly it is a stable sort so it will help showcase my point here.

Basically there is nothing special about it except that it uses CompareStringEx() in Kernel32.dll to compare strings within the sort. For those still using the unsupported Windows XP or earlier you may have to hack it a bit to make use of the aging CompareString() instead.

While the new entrypoint accepts locale string values instead of LCIDs, it may be worth noting that the older one comes in both ANSI and Unicode flavors.

The demo includes a sample list of string data as a Unicode text file. You can modify this with interesting cases you may know of. It has a brief list of "western" languages. You can add or remove values to that list within the code ot change the program to load them from a file too.

The list is loaded up and displayed in a flexgrid with back-colors from white through deepening greenish-blue shades that help make sorting differences easier to see when you try various collating sequence modifications. Because of the not-so-clever way this is done a string list of more than 255 elements will crash the program. ;)

Name:  sshot.png
Views: 113
Size:  25.4 KB


Requirements

VB6, because VB6 comes with MSHFlexgrid which is Unicode-aware. VB5 will work if you substitute another Unicode grid or use the crusty old MSFlexgrid and avoid "invalid in your locale's ANSI" characters.

Windows Vista or later, because of the new CompareStringEx() used here. If you modify the program to call CopmareSting() instead it works on downlevel unsupported Windows versions but you can't use locale strings and will have to change the pick list to use LCID values instead.

Sticking with Unicode support means "eastern" languages can be tested too.


Running the Demo

Nothing special required, and it should just unzip, open, and run even without compiling to EXE first. MSHFlexgrid comes with VB6 so you're set. VB5 users see Requirements section above.

Click the "Sort" button. Change the settings and "Sort" again. Scroll through the list of interesting cases - the scroll position should be stable between "Sorts" so look at the O'Leary case and flip sorting between "String Sort" and "Linguistic Sort" (i.e. "String Sort" not chosen). Ancien Régime is another interesting case.
Attached Images
 
Attached Files

[VB6] Use System's Format PropPage Dialog at Run Time

0
0
I've never needed this but a question here got me thinking it couldn't be that hard. Then I started searching the MSDN Library and found nothing I recognized as helpful. Then I searched the web and was shocked to find almost nothing at all.

Finally I found a forum post at another site that led to me Edanmo's old VB6 archives, and a breadcrumb of information there. That was great until I realized how little it covered... such as how to apply the results once you'd managed to raise the dialog in the first place!

As far as I can tell you're pretty much going to need UserControls to implement such features because I can't figure out how to get VB to let you "host" Property Page dialogs in a Form. But this is just a working sample to get you started, and there may be lots for you to discover once you begin fiddling with it.


Requirements

VB6 of course. This might also be converted to work in VB5 but I can't be sure since I haven't tried to.

Any 32- or 64-bit Windows versions that supports VB6 programs.

Microsoft Data Formatting Object Library 6.0 (SP6), i.e. msstdfmt.dll, which comes with VB6 (older service pack versions may possibly be compatible). This needs to be deployed since it isn't among the bits Microsoft ships as part of Windows these days.


What we have here

The demo package attached includes a UserControl that I have named "FmtTextBox" which is basically wrapping a MultiLine = False intrinsic TextBox, a clickable Image control "icon/button" of sorts, and a Variant. The idea is that instead of text, this control's value property (cleverly named "Value") can be any simple data type, and the visible/editable text is parsed-into/formatted-from this Variant Value.

So this makes a sort of non-bindable "TextBox" that handles formatting of many Variant subtypes... and lets the user change the format at run time.

There is also a helper Class that I have named "SettingsManager" designed to assist the program in persisting and restoring these settings between runs of the program.

Then there's the Standard EXE project with one Form that demonstrates the items above.


Running the Demo

Just unzip the attached archive and open the .VBP file in the VB6 IDE via Explorer. You can run it there or compile it first.

I have built "FmtTextBox" to hide its "edit the format button/icon" until the program toggles this on. In the demo a check/uncheck menu item controls this. Here's a peek:


Name:  sshot1.png
Views: 97
Size:  17.1 KB

The menu controlling the "edit formatting" button


Name:  sshot2.png
Views: 83
Size:  16.9 KB

User can click here to open the Property Page dialog


Name:  sshot3.png
Views: 79
Size:  22.0 KB

The Property Page dialog


Whew

This was a lot more than I bargained for when I started it. Partly because a UserControl was needed but more so because using a UserControl fronting a Variant added complexity, and mostly because there was a ton of "guess then cut-and-try work" involved in figuring out how to make use of the PPG dialog once I could get it to show up!

No claims this is bug-free. Consider it a technique demonstration. I'm not sure how practical it might be to do for other controls, but perhaps that isn't needed as much for most controls. As it is I've never needed any of this myself.

But it sure killed some time waiting for phone calls and such.
Attached Images
   
Attached Files

[VB6] clsCursor - Setting the IDC_HAND & Other Cursors Properly

0
0
Most solutions that addresses the MousePointer property's lack of support for some of the standard cursors (most notably the "hand" cursor) tend to be based on either converting the standard cursor to a MouseIcon/DragIcon or setting the cursor using the SetCursor API function during the MouseMove event. While both approaches produce generally acceptable results most of the time, they still have obvious shortcomings that makes them appear like cheap workarounds. Converting a standard cursor to a MouseIcon/DragIcon, for instance, doesn't support animated cursors. Setting the cursor during the MouseMove event, on the other hand, exhibits an annoying flickering as the cursor rapidly alternates between the class cursor and the specified cursor. The proper way of dealing with this, according to MSDN, is through subclassing:

Quote:

Originally Posted by MSDN
The Window Class Cursor

When you register a window class, using the RegisterClass function, you can assign it a default cursor, known as the class cursor. After the application registers the window class, each window of that class has the specified class cursor.

To override the class cursor, process the WM_SETCURSOR message. You can also replace a class cursor by using the SetClassLong function. This function changes the default window settings for all windows of a specified class. For more information, see Class Cursor.

The small and simple class module (and supporting standard module) in the attachment below contains all of the logic needed to set the desired standard cursor for all of the specified windowed and/or windowless controls. A demo project is also included that illustrates its use.


Name:  clsCursor Demo.png
Views: 96
Size:  5.8 KB


Subclassing, of course, has its disadvantages as well, especially when debugging in the IDE. However, for those seeking more professional looking results, there's no better way of overriding the class cursor than via subclassing.
Attached Images
 
Attached Files

VB6 in AppServer-scenarios (DCOM Replacement per RC5)

0
0
In the early days of VB6-usage there was DCOM (later superseded by COM+).

It came with the promise of easy cross-machine-calls (RPCs) by simply using the second
(optional) Parameter [ServerName] of the CreateObject-call...

Now, is there anybody out there (aside from myself), who ever used that (or anybody who's still using it)?
I guess not - and there's a reason for it.

Don't get me wrong - DCOM/COM+ is a great technology - which still works to this day -
*but* - for proper usage you will have to study a few books about that topic, before you
make your first serious steps ... -> right into "config-hell".

So, basically "nice stuff" (and used to this day in some LAN-scenarios, after a "config-orgy"
and countless Proxy-installs on the clients) - but firing it up as easily as the CreateObject-call
suggests? ... Forget about it.

Well, the RichClient5 offers an alternative to DCOM/COM+, which in contrast supports:
- not touching the Registry (serverside Dlls don't need to be registered)
- avoidance of clientside Proxy-installs (to match the interfaces of the serverside COM-Dlls)
- easy movement of the RC5-RPC serverside part to a different Machine per X-Copy of the Server-RootFolder
- same performance as DCOM/COM+ (thousands of Remote-Requests per second in multiple WorkerThreads)
. but using only a single Port ... whereas DCOM/COM+ needs a complete Port-Range
- usable therefore also in Internet-Scenarios, also due to strong authentication/encryption and built-in compression

Ok, so where's the beef - how to use that thing?

Here's the Code for a SimpleRPC-Demo Attachment 130681 ...
and a short description with some background follows below...

A finished solution consists of three things (three VB6-Projects):


VB-Project #1: The Server-Application (providing the HostProcess for the AppServer-Listener)
- in the above Zip, this is the Project sitting in Path: ..\RPCServer\RPCServer.vbp

This is the most easy of the three parts, since it is not "ClientApp- or Server-Dll specific" -
just a hosting Exe-Project for the Service which will work with any ServerDll and any Client.

You will only have to compile it once - and can then forget about it...

Here's the complete SourceCode for this ServerHost-Executable (all in a little Form):
Code:

Private RPCListener As cRPCListener 'define the RPC-Server-Listener
Private IP As String, Port As Long, DllPath As String 'Start-Parameters

Private Sub Form_Load()
  'normally this part is contained in a Windows-Service-Executable (without any UI)
 
  IP = New_c.TCPServer.GetIP("")      'get the default-IP of the current machine
  Port = 22222                        'set a Port (22222 is the RC5-RPC default-port)
  DllPath = App.Path & "\RPCDlls\"  'Path, where the Server is looking for the RPCDlls
 
  Set RPCListener = New_c.RPCListener 'create the RPC-Listener-instance
 
  If RPCListener.StartServer(IP, Port, , , , , DllPath) Then '... now we try to start the RPC-Server
    Caption = "Server is listening on: " & IP & ":" & Port
  Else
    Caption = "Server-Start was not successful"
  End If
End Sub

Private Sub Form_Terminate()
  If Forms.Count = 0 Then New_c.CleanupRichClientDll
End Sub

That's it with regards to the ServerHost-instance (a normal UserMode-Executable in our Demo-case).


VB-Project(s) #2: One (or more) ActiveX-Server-Dll(s)
- in the above Zip, this is the Project sitting in Path: ..\RPCServer\RPCDlls\SimpleServerLib.vbp

When you look at the above code for the Service-Host - and its RPCListener.StartServer-function, you will see that it receives a
StartParameter 'DllPath' which in this case points to a SubFolder of the Serverhost-Executable: App.Path & "\RPCDlls\"

And this place (this RPCDlls-Folder) is, where you will have to put your compiled Server-Dlls into.
The Public Subs and Functions you will put into the Class(es) of these Dlls will be, what you later on call remotely
(without the need to register these Dlls).

Here's the whole code of the single Class (cServerClass), this Dll-Project contains -
and yes, you can write this code as any other VB6-Code, as normal Public Subs and Functions
(this little Dll-Project doesn't even have a reference to vbRichClient5, the only reference it contains,
is the one to "ADO 2.5", since it will transfer an ADO-Recordset back to the clientside later on).

Code:

Private Cnn As ADODB.Connection
 
Public Function StringReflection(S As String) As String
  StringReflection = StrReverse(S)
End Function

Public Function AddTwoLongs(ByVal L1 As Long, ByVal L2 As Long) As Long
  AddTwoLongs = L1 + L2
End Function

Public Function GetADORs(SQL As String) As ADODB.Recordset
  If Cnn Is Nothing Then OpenCnn
  Set GetADORs = New ADODB.Recordset
      GetADORs.Open SQL, Cnn, adOpenStatic, adLockBatchOptimistic 'return the ADO-Rs (its content will be auto-serialized)
End Function

Private Sub OpenCnn()
  Set Cnn = New Connection
      Cnn.CursorLocation = adUseClient
      Cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Test.mdb"
End Sub

That's it - nothing more is needed for the "active part" of the serverside (the Server-Dlls).
The serverside code is hereby (with #1 and #2) completely finished!


VB-Project #3: The Client-App
- in the above Zip, this is the Project sitting in Path: ..\ClientApp\SimpleRPC.vbp

What remains now, is the clientside part of the RPC - the one which *initiates* an
RPC-(Remote-Procedure-call).

The behaviour (to make the program-flow easier) is in case of the RC5-RPCs *always*
synchronously. That means, that RPCs will not return, until we got a Result, or an
Error-message - or a TimeOut-Error back from such a Remote-Method-call against the Server.

Although also the Clientside-Code is not more than 50 lines or so, I will put only
this smaller excerpt of the client-sides Form-code here into a code-section to explain...:

Code:

Private Const ServerDll$ = "SimpleServerLib.dll" 'Name of the used Dll in the \RPCDlls\-Folder
Private Const ServerCls$ = "cServerClass" 'Name of the Class, which is contained in above Dll
 
Private RPCConn As cRPCConnection 'define the Var for the clientside RPC-connection
 
Private Sub Form_Load()
  Set RPCConn = New_c.RPCConnection 'create the clientside-RPCConnection-instance
      RPCConn.DebugMode = (chkDEBUGMode.Value = vbChecked) 'Debug-Mode (should be switched Off when running as an Executable)
      RPCConn.Host = ""        'put an explicit Server-IP here later on, e.g. read from an Ini-File
      RPCConn.Port = 22222    'Port-Nr the Server is listening on (22222 is the RC5-RPC-default)
      RPCConn.KeepAlive = True 'set KeepAlive for better performance
End Sub

'... snipped the two other Methods, which we also wrap in this Form

Private Sub cmdAddTwoLongs_Click() 'an example Remote-Method-Call
On Error GoTo ErrMsg
 
  txtAdd.Text = RPCConn.RPC(ServerDll, ServerCls, "AddTwoLongs", 3, _
                CLng(txtL1.Text), CLng(txtL2.Text)) '<- Parameter-List (two Long-Values in this case)
 
ErrMsg: If Err Then MsgBox Err.Description
End Sub

You will notice the red-colored Object-Variable (of type cRPCConnection) -
which resembles in its usage a bit, how one would work with e.g. the WinHTTP 5.1 Object...
Simply put - it encapsulates "the needed Socket-stuff" which is necessary, to be able to
work across machine-boundaries.

After this Object was "set up" (in Form_Load or in Sub Main - or also in a dedicated little
Wrapper-Class), what remains is to look at, where "the RPC-call happens"...
(for simplicity's sake, in this Demo not in an additional WrapperClass, but directly in the Forms: cmdAddTwoLongs_Click()

Just ask yourselves - what will need to happen under the covers of: RPCConn.RPC(...)?
Right (please look at the Strings I've marked blue in the above code):
- to be able to instantiate a Dll regfree from within the serversides \RPCDlls\ folder, we will need the DllName and the ClassName
. (so that we can create an Object-instance, which we will call LateBound then)...
- and to be able to perform a LateBound-Call (per CallByName), we will need the third blue string: "AddTwoLongs" (the Method-name)
- another requirement in the Parameter-List will be a TimeOut-Value (in the above call this is the 4th argument, the '3')
- and then finally the two arguments, which the AddTwoLongs-Method expects at the serverside (a VB6-Param-Array came in handy here)

So that's it basically with regards to a little "How-To-Do RPC-calls the easy way" with the vbRichClient5.

Note, that the RichClient RPC-Classes are in use at hundreds of Client-installations worldwide - and
that these Classes were included from the very beginning of the RichClient-project (over a decade ago).
So, this stuff was quite hardened over the years - and is not a "toy-implementation".

4) One last thing, I'd like to mention still with regards to the Demo (before you run it):

The RPC-Classes support a DebugMode (as contained in the last code-snippet above over: RPCConn.DebugMode = ...)

When this Property is True, then one can do an easy "RoundTrip-Debugging", when the
serverside Dll-Project in question is included in a VB-ProjectGroup.

The Demo will start (without the need to compile any Binaries) per Default in DebugMode -
and an appropriate \SimpleRPC\RPC_Test_Group.vbg File is included in the Root-Folder of the Demo.

Check this mode out first (leaving the DebugMode-CheckBox checked) -
later, when you e.g. have stepped through an RPC-call (per <F8> Key),
you can disable the Debug-Mode - but before you do so, you will have to compile:
- the ServerHost-Project I've mentioned in #1
- the ServerDll-Project I've mentioned in #2 (please make sure, that you compile the Dll into the \RPCDlls\-Folder)
- followed by starting the compiled ServerRPC-Executable
After that you can switch DebugMode Off - and perform "real RPC-calls over sockets"

Here's a ScreenShot of the little Client-App:



Have fun.

Olaf

[VB6] JNode - JSON revisited

0
0
JNode is a "little brother" or alternative to my JsonBag.

This take on the subject is a kind of stripped down minimal implementation of a VB6 JSON handling Class. Don't read anything into the name (the "node" part is just a node, as in a node in a tree of objects).

JNode 1.0 weighs in at less than half the size of JsonBag 2.4 in source code terms. The main difference is that JNode makes no attempt to use any API calls or pointer operations to try to gain performance: everything is straight-up VB6 code. While this may reduce performance a bit most client-side real world JSON applications just aren't performance-critical anyway. In testing it seems plenty fast enough for most uses.


Requirements

Written as VB6 code, so you'd need VB6. But it is pretty "clean" VB6 so it may import right in and work in any VBA6 or later host, even 64-bit ones. Might work without changes in VB5 too, though I haven't looked at that.

A version of Windows that can run VB6 programs and has or can support Microsoft's Scripting Runtime - since JNode uses Dictionary objects.


Remarks

I had originally left out serializing adding white space. I decided to add that in though because a big hunk of JSON without it can be frustrating to read through when you are debugging.

This is not a drop-in replacement for JsonBag, but it should be reasonably close and usable as a replacement in many applications without a lot of trouble.

I haven't created any fancy documentation for JNode, which I have found almost nobody has been reading anyway. Perhaps the code in the test cases included in the demo Project is enough. I might address this later though.

I miss a few things, for example the CloneItem property in JsonBag. But not enough to bloat JNode by adding such a thing into it. Most of the things I use it for can by done simply by creating a new JNode and assigning its JSON property to the JSON property of the JNode I want to clone. Slow perhaps, but not that slow and good enough for most purposes anyway.
Attached Files

VB6 pipe-based UDT-serializing/deserializing InMemory

0
0
VB6 has a nice feature, when it comes to UDTs.

It has builtin serializing/deserializing routines, which are capable to write
an even complex and deeply nested UDT to a File per VBs Put-statement
(no matter whether this UDT contains dynamic members like Arrays or Strings) -
and later on it can read this UDT back from the File it was saved to (per Get).

Too bad, that this feature is restricted to the FileSystem (VBs Open, Put and Get calls) -
and not exposed in a way, to make it usable InMemory (writing and reading to ByteArrays).

The little Demo here does just that, with a little workaround (using Named-Pipes),
which VBs Open-Statement is able to understand and deal with.

The main-functionality sits in a little Class, named: cPipedUDTs ...
which throws an Event which allows you, to write your UDT for serialization
into the Pipe - and another Event for the opposite direction (the deserialization).

Not much code - and easy to understand I think (Demo contains comments as well):
UDTsPipeSerializing.zip

Have fun!

Olaf
Attached Files

VB6 LightWeight COM and vbFriendly-BaseInterfaces

0
0
Some stuff for the advanced VB-users among the community (or the curious) ...

I was recently working on some things in this area (preparations for the
C-Emitter of a new VB6-compiler, with regards to "C-style defined Classes") -
and this Tutorial is more or less a "by-product".

I've just brought parts of it into shape, since I think this stuff can be
useful for the community even whilst working with the old compiler.

To gain more IDE-safety (and keep some noise out of the Tutorial-Folders),
I've decided to implement the Base-stuff in its own little Dll-Project:
vbInterfaces.dll

The sources for this Helper-Dll are contained in an appropriate Folder
(vbFriendlyInterfaces\vbInterfaces-Dll\...) in this Tutorial-Zip here:
vbFriendlyInterfaces.zip

The Dll-Project currently contains vbFriendly (Callback-) Interfaces for:
- IUnknown
- IDispatch
- IEnumVariant
- IPicture

Feel free to contribute stuff you think would be useful to include in the
Dll-Project itself - although what it currently contains with regards to
IUnknown and IDispatch, allows to develop your own vtMyInterface-stuff
already "separately" (in a normal VB-StdExe-project for example).

Before entering the Tutorial-Folder and start running the Examples, please make
sure, that you compile the vbInterfaces.dll first from the above mentioned Folder.

The above Zip contains currently a set of 10 Tutorial-Apps, all in their own Folders
(numbered from 0 to 9, from "easy to more advanced") - and here is the
Tutorial-FolderList:
.. 0 - LightWeight COM without any Helpers
.. 1 - LightWeight LateBound-Objects
.. 2 - LightWeight EarlyBound-Objects
.. 3 - LightWeight Object-Lists
.. 4 - Enumerables per vbIEnumVariant
.. 5 - MultiEnumerations per vbIEnumerable
.. 6 - Performance of vbIDispatch
.. 7 - Dynamic usage of vbIDispatch
.. 8 - Simple SOAPDemo with vbIDispatch
.. 9 - usage of vbIPictureDisp

For the last two Tutorial-Demos above I will post separate CodeBank articles,
since they are larger ones - and deserve a few Extra-comments.

Maybe some explanations for NewComers to the topic, who want to learn what
the terms "LightWeight COM", or "C-style Class-implementation" mean:

First, there's a clear separation to be made between "a Class" and "an Object",
since these terms mean two different things really, which we need to look at separately.

- "a Class" is the "BluePrint", which lives in the static Memory of our running Apps or Dlls
- "an Object" (aka "an Instance of a Class") lives as a dynamic Memory-allocation (which refers back to the "BluePrint").

And VB-Objects (the ones we create as Instances from a VB-ClassModules "BluePrint" per New) are quite "large animals" -
since they will take up roughly 116 Bytes per instance-allocation, even when they don't contain any Private Variable Definitions.

A Lightweight COM-Object can be written in VB6 (later taking up only as few as 8Bytes per Instance),
when we resort to *.bas-Modules (similar to the code-modules one would write in plain C).

Here's some Code, how one would implement that (basically the same, as contained in Tutorial-Folder #0):

Let's say we want to implement a lightweight COM-Class (MyClass), which has only a single
Method (AddTwoLongs) in its Public Interface (IMyClass).

We start with the "BluePrint", and the VB-Module which implements that "C-style" would contain only:
Code:

Private Type tMyCOMcompatibleVTable
  'Space for the 3 Function-Pointers of the IUnknown-Interface
  QueryInterface As Long
  AddRef        As Long
  Release        As Long
  'followed by Space for the single Function-Pointer of our concrete Method
  AddTwoLongs    As Long
End Type

Private mVTable As tMyCOMcompatibleVTable 'preallocated (static, non-Heap) Space for the VTable

Public Function VTablePtr() As Long 'the only Public Function here (later called from modMyClassFactory)
  If mVTable.QueryInterface = 0 Then InitVTable 'initializes only, when not already done
  VTablePtr = VarPtr(mVTable) 'just hand out the Pointer to the statically defined mVTable-Variable
End Function

Private Sub InitVTable() 'this method will be called only once (and is thus not "performance-critical")
  mVTable.QueryInterface = FuncPtr(AddressOf modMyClassFactory.QueryInterface)
  mVTable.AddRef = FuncPtr(AddressOf modMyClassFactory.AddRef)
  mVTable.Release = FuncPtr(AddressOf modMyClassFactory.Release)
 
  mVTable.AddTwoLongs = FuncPtr(AddressOf modMyClassFactory.AddTwoLongs)
End Sub

I assume, the above is not that difficult to understand (most "static things" are easy this way) -
what it ensures is, that it "gathers things in one static place" - in this case:
"Function-Pointers in a certain Order" - this "List of Function-Pointers" remains (in its defined order)
behind the static UDT-variable mVTable - and that was it already...

What remains (perhaps a bit more difficult to understand to "make the leap") is,
how the above code-definition will interact, when we now come to the "dynamic part"
(the Objects and their instantiations from a BluePrint).

To have the dynamic part more separated, let's use an additional module (modMyClassFactory):

And as the choosen name (modMyClassFactory) suggests, this is the part which finally hands out
the new Instances (similar to one of the 4 exported Functions, which any ActiveX-Dll needs to support,
which is named 'DllGetClassFactory' for a reason).

So let's show the ObjectCreation-Function in that *.bas Module first:
Note, that UDT struct-definitions are only there for the compiler to "have info about needed space" -
(I've marked these Length-Info parts in light orange below - and the dynamic allocation part in magenta)...
Code:

Private Type tMyObject 'the Object-Instances will occupy only 8Bytes (that's half the size of a Variant-Type)
  pVTable As Long
  RefCount As Long
End Type
 
'Factory Helper-Function to create a new Class-Instance (a new Object) of type IMyClass
Public Function CreateInstance() As IMyClass '<- this Type is defined in a little TypeLib, contained in TutorialFolder #0
Dim MyObj As tMyObject 'we use our UDT-based Object-Type in a Stack-Variable for more convenience
    MyObj.pVTable = modMyClassDef.VTablePtr 'whilst filling its members (as e.g. pVTable here)
    MyObj.RefCount = 1 '<- the obvious value, since we are about to create a "fresh instance"

Dim pMem As Long
    pMem = CoTaskMemAlloc(LenB(MyObj)) 'allocate space for our little 8Byte large Object
    Assign ByVal pMem, MyObj, LenB(MyObj) 'copy-over the Data from our local MyObj-UDT-Variable
    Assign CreateInstance, pMem 'assign the new initialized Object-Reference to the Function-Result
End Function

What remains now, is to provide the Implementation-code for the 4 VTable-methods (which is contained in that same Module)
Code:

'IUnknown-Implementation
Public Function QueryInterface(This As tMyObject, ByVal pReqIID As Long, ppObj As stdole.IUnknown) As Long '<- HResult
  QueryInterface = &H80004002 'E_NOINTERFACE, just for safety reasons ... but there will be no casts in our little Demo
End Function

Public Function AddRef(This As tMyObject) As Long
  This.RefCount = This.RefCount + 1
  AddRef = This.RefCount
End Function

Public Function Release(This As tMyObject) As Long
  This.RefCount = This.RefCount - 1
  Release = This.RefCount
  If This.RefCount = 0 Then CoTaskMemFree VarPtr(This) '<- here's the dynamic part again, when a Class-instance dies
End Function

'IMyClass-implementation (IMyClass only contains this single method)
Public Function AddTwoLongs(This As tMyObject, ByVal L1 As Long, ByVal L2 As Long, Result As Long) As Long '<- HResult
  Result = L1 + L2 'note, that we set the Result ByRef-Parameter - not the Function-Result (which would be used for Error-Transport)
End Function

Finally (to have it complete) a Helper-Function and a few APIs, which are contained in another small *.bas Module
Code:

Declare Function CoTaskMemAlloc& Lib "ole32" (ByVal sz&)
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pMem&)
Declare Sub Assign Lib "kernel32" Alias "RtlMoveMemory" (Dst As Any, Src As Any, Optional ByVal CB& = 4)
 
Function FuncPtr(ByVal Addr As Long) As Long 'just a small Helper for the AddressOf KeyWord
  FuncPtr = Addr
End Function

So, what was (codewise) posted above, is complete - and how a bare-minimum-implementation
for a lightweight "8-Byte large COM-object" could look like in VB6 (and not much different in C) -
no need to copy it over into your own Modules because as said, this is all part of the first little
Demo (in Tutorial-Folder #0, which also includes the needed TypeLib to run the thing).

Happy studying and experimenting... ;)

Olaf
Attached Files

[VB6, Vista+] A compact function to retrieve any property by name, locally formatted

0
0
This is related to the greatly expanded property system available in Vista+, and is closely related to the more complete tour of the system in my other projects.

While this method is inefficient and shouldn't be used for large numbers of properties or large numbers of files*, if you just need a few specific properties from a single file this method is a quick way to get them. The results appear as they do in Explorer's Details view; according to your locale, with units, etc. The key shortcut here is the SHGetPropertyStoreFromParsingName function and other PS_ APIs, which let us skip over all the IShellItem interface work.

Requirements
-Windows Vista or higher
-oleexp 2.0 or higher (no new release related to this code)

Usage
After putting the below code in a module, just call the GetPropertyDisplayString(file, property) function, it will return a string with the property as it appears in Explorer. For example, System.Dimensions on a JPG file might return "640 x 480", or System.Width as "100 pixels"; or an AVI's System.Length as "01:30:20". It's more than just raw numbers (although those can be retrieved too; see the larger project).
sResult = GetPropertyDisplayString("C:\myfile.jpg", "System.Width")

Code
Code:

Public Declare Function PSGetPropertyKeyFromName Lib "propsys.dll" (ByVal pszName As Long, ppropkey As PROPERTYKEY) As Long
Public Declare Function PSFormatPropertyValue Lib "propsys.dll" (ByVal pps As Long, ByVal ppd As Long, ByVal pdff As PROPDESC_FORMAT_FLAGS, ppszDisplay As Long) As Long
Public Declare Function SHGetPropertyStoreFromParsingName Lib "shell32" (ByVal pszPath As Long, pbc As Any, ByVal Flags As GETPROPERTYSTOREFLAGS, riid As UUID, ppv As Any) As Long
Public Declare Function PSGetPropertyDescription Lib "propsys.dll" (PropKey As PROPERTYKEY, riid As UUID, ppv As Any) As Long
Public Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long
Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell

Public Function GetPropertyDisplayString(szFile As String, szProp As String) As String
'Gets the string value of the given canonical property; e.g. System.Company, System.Rating, etc
'This would be the value displayed in Explorer if you added the column in details view
Dim pkProp As PROPERTYKEY
Dim pps As IPropertyStore
Dim lpsz As Long
Dim ppd As IPropertyDescription

PSGetPropertyKeyFromName StrPtr(szProp), pkProp
SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT, IID_IPropertyStore, pps
PSGetPropertyDescription pkProp, IID_IPropertyDescription, ppd
PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
SysReAllocString VarPtr(GetPropertyDisplayString), lpsz
CoTaskMemFree lpsz


End Function

Include the following in your module only if you're not using the mIID.bas module from the oleexp thread:
Code:

Public Sub DEFINE_UUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
  With Name
    .Data1 = L
    .Data2 = w1
    .Data3 = w2
    .Data4(0) = B0
    .Data4(1) = b1
    .Data4(2) = b2
    .Data4(3) = B3
    .Data4(4) = b4
    .Data4(5) = b5
    .Data4(6) = b6
    .Data4(7) = b7
  End With
End Sub
Public Function IID_IPropertyStore() As UUID
'DEFINE_GUID(IID_IPropertyStore,0x886d8eeb, 0x8cf2, 0x4446, 0x8d,0x02,0xcd,0xba,0x1d,0xbd,0xcf,0x99);
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H886D8EEB, CInt(&H8CF2), CInt(&H4446), &H8D, &H2, &HCD, &HBA, &H1D, &HBD, &HCF, &H99)
  IID_IPropertyStore = IID
 
End Function
Public Function IID_IPropertyDescription() As UUID
'(IID_IPropertyDescription, 0x6f79d558, 0x3e96, 0x4549, 0xa1,0xd1, 0x7d,0x75,0xd2,0x28,0x88,0x14
Static IID As UUID
 If (IID.Data1 = 0) Then Call DEFINE_UUID(IID, &H6F79D558, CInt(&H3E96), CInt(&H4549), &HA1, &HD1, &H7D, &H75, &HD2, &H28, &H88, &H14)
  IID_IPropertyDescription = IID
 
End Function

ALTERNATIVE: Get directly by PROPERTYKEY
Now that I've published a complete list of PROPERTYKEY's from propkey.h, if you include the mPKEY.bas module from the oleexp project, you can use those directly like this:
Code:

Public Function GetPropertyKeyDisplayString(szFile As String, pkProp As PROPERTYKEY) As String
Dim pps As IPropertyStore
Dim lpsz As Long
Dim ppd As IPropertyDescription

SHGetPropertyStoreFromParsingName StrPtr(szFile), ByVal 0&, GPS_DEFAULT, IID_IPropertyStore, pps
PSGetPropertyDescription pkProp, IID_IPropertyDescription, ppd
PSFormatPropertyValue ObjPtr(pps), ObjPtr(ppd), PDFF_DEFAULT, lpsz
SysReAllocString VarPtr(GetPropertyKeyDisplayString), lpsz
CoTaskMemFree lpsz
End Function

Common Properties
For a full list of system properties, see propkey.h in the SDK (or unofficial copies online); or the larger projects I have that will enumerate them all.

Otherwise, see the MSDN post Metadata Properties for Media Files for the popular ones.

-------------------------------
* - When working with large numbers of files, or user-selectable properties, it's best to implement IShellItem and IPropertySystem based solutions from the ground up.

[vb6] SavePictureEx (Unicode compatible and a bit more)

0
0
Not anywhere close to deep-thought-provoking code nor is it any breakthrough. I thought I'd share a workaround I've been using for awhile.

VB's SavePicture uses existing APIs that have the ability to be unicode compatible. If we bypass VB and use those APIs instead, problem solved.

In addition, depending on how the picture was created and assigned in VB, the original data is cached and that data can be saved. For example, if you load a JPG during design-view into a VB picture property, the actual JPG data is preserved, but if you try to call VB's SavePicture, it is saved as a bitmap and not a JPG. We can save the the image as a JPG copy. This does not mean VB or the APIs can convert the image to JPG, it simply means that if the original image format is maintained, it can be saved. This also applies to GIFs and icons that contain multiple sub-icons. Anyone can take the routine provided below and super-size it to allow optional parameters that would be used to identify requests for image conversion to other formats. I'll leave that to you.

Rule of thumb is that VB will cache original data when pictures are loaded during design-time, not runtime.

In the code below, notice the blue-highlighted text? If the blue text were removed, then if the passed tgtPicture parameter contained the original image data for GIF/JPG, then the original image data would be saved.
Code:

' APIs used
Private Declare Function SHCreateStreamOnFileEx Lib "shlwapi.dll" (ByVal pszFile As Long, ByVal grfMode As Long, ByVal dwAttributes As Long, ByVal fCreate As Long, ByVal reserved As Long, ByRef ppstm As IUnknown) As Long
Private Declare Function GetFileAttributesW Lib "kernel32.dll" (ByVal lpFileName As Long) As Long

Code:

Public Sub SavePictureEx(tgtPicture As IPictureDisp, ByVal FileName As String)

    Dim oStream As IUnknown, oPicture As IPicture
    Dim lRtn As Long, bFlagCreate As Long
    Const INVALID_FILE_ATTRIBUTES As Long = -1&
    Const STGM_CREATE As Long = &H1000&
    Const STGM_WRITE As Long = &H1&
    Const FILE_ATTRIBUTE_NORMAL = &H80&
   
    If tgtPicture Is Nothing Then Exit Sub
    If tgtPicture.Handle = 0& Then Exit Sub
   
    If GetFileAttributesW(StrPtr(FileName)) = INVALID_FILE_ATTRIBUTES Then bFlagCreate = 1&
    lRtn = SHCreateStreamOnFileEx(StrPtr(FileName), STGM_WRITE Or (STGM_CREATE * bFlagCreate), _
                            FILE_ATTRIBUTE_NORMAL, bFlagCreate, 0&, oStream)
    If lRtn = 0& Then
        Set oPicture = tgtPicture
        If tgtPicture.Type = vbPicTypeBitmap Then
            oPicture.SaveAsFile ByVal ObjPtr(oStream), 1&, lRtn ' always save as bitmap
        Else
If oPicture.KeepOriginalFormat Then
            oPicture.SaveAsFile ByVal ObjPtr(oStream), 0&, lRtn ' save original data if it exists
        Else
            oPicture.SaveAsFile ByVal ObjPtr(oStream), 1&, lRtn ' save using VB's default SavePicture logic
        End If
        Set oStream = Nothing ' closes the file
    Else
        Err.Raise lRtn, "SavePictureEx"
    End If

End Sub

The above code is compatible with XP and above. The API SHCreateStreamOnFileEx doesn't exist on lower operating systems. If required, that API can be replaced with a custom function that:
- creates a compatible stream object (CreateStreamOnHGlobal API)
- saves the data to that stream (oPicture.SaveAsFile)
- creates a file (CreateFile API)
- reads the data from the stream pointer to the file (ReadFile API)
- close the file and unlock/release the stream

FYI: IUnknown and IPicture are valid objects in VB, they are just hidden by default from intellisense

[VB6] Register any control as a drop target that shows the Explorer drag image

0
0

Dragging from Explorer

Dragging from Firefox

So as we all know, the drag cursor for a VB drop target is a hideous relic of the Windows 3.1 days. No more! Ever since XP, there has been an interface called IDropTargetHelper that automatically shows the proper drag image. And not just for Explorer file drops; the drag image you see in any modern program will now also appear on your VB6 drop target. And more good news, it's only a tiny bit more complicated than using the normal OLEDragDrop features (this method completely replaces the native OLE DnD stuff and controls should be 'None' for OLEDropMode- the IDropTarget class has DragEnter, DragOver, DragLeave, and Drop events if you need them).

Requirements
-Windows XP or higher
-oleexp.tlb (any version; no new release is associated with this project and the interfaces used date back to the 1.x versions)

How It Works

-First, a class module that implements IDropTarget and contains an instance of IDropTargetHelper needs to be created
-The only tricky thing is getting the file list from the IDataObject; but the sample class handles this and just passes a file list back.
-Then, any control can call the RegisterDragDrop API to become a target supporting the new images!

Note that while the example just accepts file drops with the standard CF_HDROP format, you have the full data object passed from the source of the drag, and could retrieve any format it contains (there's tons of clipboard formats; text, html, images, etc).

Note on Unicode support: All the code is designed to support Unicode, but the file names in the sample project are displayed in a regular VB textbox which cannot show extended characters-- but the file names returned are in Unicode and if displayed in a Unicode-enabled control will be rendered correctly.

Code
cDropTarget
Code:

Option Explicit
Private Declare Function DragQueryFileW Lib "shell32.dll" (ByVal hDrop As Long, ByVal iFile As Long, Optional ByVal lpszFile As Long, Optional ByVal cch As Long) As Long
Private Declare Function SysReAllocStringLen Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long, Optional ByVal Length As Long) As Long
Private Declare Function CoCreateInstance Lib "ole32" (rclsid As Any, ByVal pUnkOuter As Long, ByVal dwClsContext As Long, riid As Any, pvarResult As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpszGuid As Long, pGuid As Any) As Long

'IDropTargetHelper is what lets us show the drag image
Private pDTH As IDropTargetHelper

Private Const CLSID_DragDropHelper = "{4657278A-411B-11D2-839A-00C04FD918D0}"
Private Const IID_IDropTarget = "{4657278B-411B-11D2-839A-00C04FD918D0}"

Implements IDropTarget

Private Sub Class_Initialize()
Dim dhiid As UUID
Dim dthiid As UUID

Call CLSIDFromString(StrPtr(CLSID_DragDropHelper), dhiid)
Call CLSIDFromString(StrPtr(IID_IDropTarget), dthiid)
Call CoCreateInstance(dhiid, 0&, CLSCTX_INPROC_SERVER, dthiid, pDTH)
End Sub

Private Sub IDropTarget_DragEnter(ByVal pDataObj As oleexp3.IDataObject, ByVal grfKeyState As Long, ByVal ptX As Long, ByVal ptY As Long, pdwEffect As oleexp3.DROPEFFECTS)
  Debug.Print "DragEnter"
 
  Dim pt As oleexp3.POINT
  pt.x = ptX
  pt.y = ptY
 
  pDTH.DragEnter Form1.Picture1.hWnd, pDataObj, pt, pdwEffect

End Sub

Private Sub IDropTarget_DragLeave()
Debug.Print "DragLeave"

pDTH.DragLeave
 
End Sub

Private Sub IDropTarget_DragOver(ByVal grfKeyState As Long, ByVal ptX As Long, ByVal ptY As Long, pdwEffect As oleexp3.DROPEFFECTS)
    Debug.Print "DragOver"

  Dim pt As oleexp3.POINT
  pt.x = ptX
  pt.y = ptY

    pDTH.DragOver pt, pdwEffect
   
    'Notice that the text shows 'Move' in the caption; you can change pdwEffect to something else
    'pdwEffect = DROPEFFECT_COPY
    'pdwEffect = DROPEFFECT_NONE 'this shows that a drop is not allowed, and the drop event won't fire
End Sub

Private Sub IDropTarget_Drop(ByVal pDataObj As oleexp3.IDataObject, ByVal grfKeyState As Long, ByVal ptX As Long, ByVal ptY As Long, pdwEffect As oleexp3.DROPEFFECTS)
Debug.Print "Drop"
Dim idx As Long
  Dim pt As oleexp3.POINT
  pt.x = ptX
  pt.y = ptY
 
 pDTH.Drop pDataObj, pt, pdwEffect
 
 'For this project, we're just going to accept the files and pass back what
 'operation we did with them. But to add more functionality, you can look
 'at grfKeyState; that will tell you if ctrl is being held so you can move,
 'or if the right mouse button is down and you should show a menu of options
 Dim fmt As FORMATETC
 fmt.cfFormat = CF_HDROP
 fmt.TYMED = TYMED_HGLOBAL
 fmt.dwAspect = DVASPECT_CONTENT
 fmt.lindex = -1
 
 Dim stg As STGMEDIUM
 
 If pDataObj.QueryGetData(fmt) = S_OK Then
    pDataObj.GetData fmt, stg
    Dim nFiles As Long, sFiles() As String
    Dim i As Long
    Dim sBuffer As String
    nFiles = DragQueryFileW(stg.Data, &HFFFFFFFF, 0, 0)
    ReDim sFiles(nFiles - 1)
    For i = 0 To nFiles - 1
        SysReAllocStringLen VarPtr(sBuffer), , DragQueryFileW(stg.Data, i)
        DragQueryFileW stg.Data, i, StrPtr(sBuffer), Len(sBuffer) + 1&
        sFiles(i) = sBuffer
    Next
Else
    Debug.Print "failed querygetdata"
End If
   

  pdwEffect = Form1.DropFiles(sFiles, grfKeyState)
End Sub

Sample Form
Code:

Option Explicit
Private Declare Function RegisterDragDrop Lib "ole32" _
        (ByVal hWnd As Long, ByVal DropTarget As IDropTarget) As Long
Private Declare Function RevokeDragDrop Lib "ole32" (ByVal hWnd As Long) As Long

Private cIDT As cDropTarget

Public Function DropFiles(sFiles() As String, KeyState As Long) As DROPEFFECTS
'Do whatever with the files
Text1.Text = ""
Text1.Text = Join(sFiles, vbCrLf)
DropFiles = DROPEFFECT_NONE 'We didn't do anything with the dropped files here,
                            'but if you do move/copy/link them, report that back
End Function

Private Sub Form_Load()
Set cIDT = New cDropTarget
Call RegisterDragDrop(Picture1.hWnd, cIDT)

End Sub

Private Sub Form_Unload(Cancel As Integer)
Call RevokeDragDrop(Picture1.hWnd)
End Sub

Dragging FROM controls
Note that if you combine this method with a control that's a drag source for files using my SHCreateDataObject/SHDoDragDrop method, you will now see the Explorer icon right on the control you're dragging from, and the filetype icon will now show up. No additional coding required. At some point in the future I'll release a sample combining them, but in the mean time they are completely compatible if someone else wants to. (I have tested and confirmed this, it's just ripping out the file listview that has dozens of other features and thousands of lines of code associated with it-- testing is easier on a fully complete file view-- isn't practical)

------------------------------------------
Project updated: Forgot DragDropHelper coclass can't be used on XP; updated to use it by CLSID with CoCreateInstance. Code for Class_Initialize updated in sample project and above in this post.
Attached Files

[VB6] PicSave - Simple SavePicture as GIF, PNG, JPEG

0
0
Sometimes you need a better SavePicture() function. Not a lot better, just one that can save in some compressed format instead of just BMP format. Like JPEG usually, or PNG. Well this one does that, and throws in GIF as well though as usual (being based on GDI+) those tend to come out dithered and sort of crap in general.

What we have here is a simple preclared-instance Class with one method: SavePicture().

You give it a StdPiture, a file name (yes, it can save using Unicode paths), which format you want, and for JPEG you can add a "quality" in percent. It saves to disk, not to Byte arrays.

Nothing here people haven't seen before. This is just a "stripped to essentials" rendition of the well worn theme.


It only requires a version of Windows with IE 5 or later. It uses GDI+ but most systems with IE 5 or later cover that as well. In any case it should work on nearly anything you run anymore.

There are no 3rd party DLLs required, and not even any typelibs. Just add PicSave.cls to your Projects.


The attachment contains a simple demo. Its bulk is all source image data.


The StdPicture you pass to it must have a bitmap handle. In practical terms this means you may have to pass it the persistant-image property (.Image) if you have drawn your picture onto a Form, PictureBox, etc. and there is no provision for dealing with metafile vector images.


Notes:

New attachment incorporating feedback from discussion below to address issues encountered when GDI v. 1.1 is in play, running on 64-bit Windows, etc.

Also note that this makes no effort to handle transparency or alpha-channel translucency for GIF or PNG output. It saves simple "whole bitmap" images. If you load a picture with transparency into a StdPicture and save it back using this class the transparency is lost.
Attached Files

[VB6] Creation of GIF-animation with the transparent background.

0
0
Hi everyone!
This project allows to create an GIF animations with the transparent background. As far as i know the GDI+ doesn't allow to set the property of "Disposal Method" in the "Graphic Control Extension" block, therefore each next frame is overlayed to the previous frame. For the opaque frames it's doesn't matter. In order to solve this issue i decide to change the needed bytes manually in the raw GIF file.
It allows to prevent the restrictions of the transparent frames. Also this example contains the oct-tree class, which calculates the optimal palette for the each frame. There are the ability of the additional settings: threshold of the transparency, duration, and number of the loops for entire animation. For the disabling of the transparency enough set the threshold to zero. The greater the value of the threshold field the greater semitransparent pixels become transparent completely.

Name:  Безымянный.png
Views: 58
Size:  105.4 KB
Regards,
Кривоус Анатолий.
Attached Images
 
Attached Files

[VB6] - Library info.

0
0
Hi everyone.
This is quite simple project, which allows to view some information about libraries and PE-files:
  • Export;
  • Import;
  • Delay import;
  • For type libraries and PE which contains the type libraries:
    1. Interfaces;
    2. CoClasses;
    3. Types;
    4. Enumerations;
    5. Aliases.

It requires Edanmo's OLE interfaces & functions (olelib.tlb) for the work.

Regards,
Кривоус Анатолий.
Attached Files

[vb6] Class to Support PNG, TIF and GIF Animation

0
0
We all know VB is old and doesn't support many of the common image formats, specifically: TIF, PNG and alpha-blended icons. The attached class enables VB to support those formats and a bit more. There is no usercontrol involved. Just a bit of subclassing (IDE safe) to enable the images to be rendered with APIs that do support the alpha channel: AlphaBlend and DrawIconEx. The class methods/properties can be categorized as follows:

I. VB Replacement Methods
- LoadPicture: Unicode supported. Has options to keep original image format when loading. This enables you to navigate animated GIF frames and multipage TIFs. It also allows you to save that original data to file. Method accepts byte arrays also.
- SavePicture: Unicode supported. Has options to always save to bitmap or save original format if it exists
- PictureType: Returns the original image format, i.e., GIF, PNG, TIF, etc, if that format exists

II. Management Methods
- IsManaged: Return whether the class is rendering the image or VB is
- UnManage: Simply unsubclasses a managed image

III. Navigation Methods
- SubImageCount: Returns the number of frames/pages contained within the managed image
- SubImageIndex: Returns the current frame/page displayed by the managed image
- SubImage: Returns a stdPicture object of the requested frame/page
- GetGIFAnimationInfo: Returns an array containing loop count and each frame's display interval for animated GIFs

Quickly. How does this class do it?

1. It creates thunks to subclass the VB picture objects. The source code of the thunks are provided in the package. These thunks draw the image using the APIs AlphaBlend or DrawIconEx. For you ASM gurus out there: I'm a noob with ASM. I'm sure others can rewrite that ASM code to be more efficient.

2. To support AlphaBlend API, images may be converted to a 32bit bitmap having the pixel data premultiplied against the alpha channel. These bitmaps will never display correctly outside of the class. Therefore the class' SavePicture function allows you to create a copy of the bitmap that can be displayed outside of the class. This copy can be passed to the clipboard and/or drag/drop methods of your project.

3. GDI+ is relied upon to parse/load TIF and PNG. It is also used to support JPG in CMYK format and multi-frame GIF rendering. GDI+ is a requirement for the class. If it fails to load or thunks fail to be created, the class will silently fall back to standard VB methods and VB restrictions.

The transparency displayed by the image control is not faked. It is true transparency and the attached test project should easily prove that. For those of you that follow my projects, you are aware of another similar solution I posted last month. This is far better, far safer (crash-wise) and in many ways, far easier to use. Just drop the class in your project & go.

Important to understand. TIF and PNG support is not available at design-time. This is because the class code isn't activated until run-time. Some motivated individuals out there could easily create a windowless usercontrol that hosts an image control that could support all formats at design-time. Just a thought and subtle prod.

The class can be expanded by those willing to put in the effort. Ideas would be to incorporate GDI+ high quality scaling, conversion from one image format to another, image effects like rotation, blur, and more. Other image formats can easily be supported from outside the class. If you can parse/render that new format to a 32bpp bitmap, then you can use the class' LoadPicture to display that image. Have fun.

We all know VB when compiled can behave differently vs when uncompiled. Some differences are subtle, others are not. Here's one that is key for animating GIFs. In the test project posted below, the animation works because VB caches the GIF format for the GIF that was loaded into Image1 during design-time. During run-time that info is still cached by VB so the class can extract the entire GIF. But when you compile the project, the GIF no longer animates. Why? Well, when compiled, the GIF information is lost. VB no longer caches it. This can be proven in a simple test project. Add a image control and button. Add a GIF or JPG to that image control. Add the following code behind the button. Click the button when project is running compiled and uncompiled. Different results. The workaround is simply to save GIFs you want to animate in a resource file and load the GIF from that.
Code:

Dim IPic As IPicture
Set IPic = Image1.Picture
MsgBox CStr(IPic.KeepOriginalFormat)

Name:  Untitled.jpg
Views: 61
Size:  40.7 KB
Attached Images
 
Attached Files

[vb6] Class to make Image Controls Support PNG, TIF, GIF Animation

0
0
We all know VB is old and doesn't support many of the common image formats, specifically: TIF, PNG and alpha-blended icons. The attached class enables VB to support those formats and a bit more. There is no usercontrol involved. Just a bit of subclassing (IDE safe) to enable the images to be rendered with APIs that do support the alpha channel: AlphaBlend and DrawIconEx. The class is not limited to just Image controls, can be applied to most (if not all) of VB's picture, icon, and other image properties.

Image formats supported. The 'includes' below are in addition to what VB supports:
:: BMP. Includes 32bpp alpha and/or premultiplied. Includes those stored with v4 & v5 of the bitmap info header
:: GIF. Includes methods to navigate frames
:: JPG. Includes CMYK color space
:: ICO,CUR. Includes 32bpp alpha and/or PNG-encoded Vista-type icons
:: WMF. Includes non-placeable (next update)
:: EMF
:: PNG
:: TIF. Both single page & multi-page. Supported compression schemes depend on version of GDI+ installed

The class methods/properties can be categorized as follows:

I. VB Replacement Methods
- LoadPicture: Unicode supported. Has options to keep original image format when loading. This enables you to navigate animated GIF frames and multipage TIFs. Cached data allows you to save that original data to file
- SavePicture: Unicode supported. Has options to always save to bitmap or save original format if it exists
- PictureType: Returns the original image format, i.e., GIF, PNG, TIF, etc, if that format exists
note: LoadPicture & SavePicture both accept byte array as source/destination medium

II. Management Methods
- IsManaged: Return whether the class is rendering the image or VB is
- UnManage: Simply unsubclasses a managed image
- HasOriginalFormat: Return whether or not any Picture is caching original image format data

III. Navigation Methods
- SubImageCount: Returns the number of frames/pages contained within the managed image
- SubImageIndex: Returns the current frame/page displayed by the managed image
- SubImage: Returns a stdPicture object of the requested frame/page
- GetGIFAnimationInfo: Returns an array containing loop count and each frame's display interval for animated GIFs

Quickly. How does this class do it?

1. It creates thunks to subclass the VB picture objects. The source code of the thunks are provided in the package. These thunks draw the image using the APIs AlphaBlend or DrawIconEx. For you ASM gurus out there: I'm a noob with ASM. I'm sure others can rewrite that ASM code to be more efficient.

2. To support AlphaBlend API, images may be converted to a 32bit bitmap having the pixel data premultiplied against the alpha channel. These bitmaps will never display correctly outside of the class. Therefore the class' SavePicture function allows you to create a copy of the bitmap that can be displayed outside of the class. This copy can be passed to the clipboard and/or drag/drop methods of your project.

3. GDI+ is relied upon to parse/load TIF and PNG. It is also used to support JPG in CMYK format and multi-frame GIF rendering. GDI+ is a requirement for the class. If it fails to load or thunks fail to be created, the class will silently fall back to standard VB methods and VB restrictions.

The transparency displayed by the image control is not faked. It is true transparency and the attached test project should easily prove that. Important to understand. TIF and PNG support is not available at design-time. This is because the class code isn't activated until run-time. Some motivated individuals out there could easily create a windowless usercontrol that hosts an image control (and this class) that could support all formats at design-time. Just a thought and subtle prod.

The class can be expanded by those willing to put in the effort. Ideas would be to incorporate GDI+ high quality scaling, conversion from one image format to another, image effects like rotation, blur, and more. Other image formats can easily be supported from outside the class. If you can parse/render that new format to a 32bpp bitmap, then you can use the class' LoadPicture to display that image. Have fun.

When compiled, VB can behave differently vs when uncompiled. Some differences are subtle, others are not. Here's one that is key for animating GIFs. In the test project posted below, the animation works because VB caches the GIF format for the GIF that was loaded into Image1 during design-time. During run-time that info is still cached by VB so the class can extract the entire GIF. But when you compile the project, the GIF no longer animates. Why? Well, when compiled, the GIF information is lost. VB no longer caches it. This can be proven in a simple test project. Add a image control and button. Add a GIF or JPG to that image control. Add the following code behind the button. Click the button when project is running compiled and uncompiled. Different results. The workaround is simply to save GIFs you want to animate in a resource file and load the GIF from that.
Code:

Dim IPic As IPicture
Set IPic = Image1.Picture
MsgBox CStr(IPic.KeepOriginalFormat)

Design-time vs. Run-time screenshot
Name:  Untitled.jpg
Views: 20
Size:  33.2 KB
Attached Images
 
Attached Files

[VB6] Create a ZIP file without any DLL depends using IStorage and IDropTarget

0
0
About
This project is a followup to [VB6] Basic unzip without 3rd party DLL or shell32- IStorage-based, to create a zip using the same method. At the time, I didn't know if it was possible, and later I thought you'd have to implement a custom IDataObject, so I hadn't thought it worth the effort. But I revisited this topic after a question, and found that with a couple workarounds for some weird errors, it's entirely possible to not only do it, but to do it without a custom IDataObject.

Requirements
-oleexp3.tlb 3.0 or higher.
-Windows XP or higher (the core ZipFiles() sub should work on XP, HOWEVER.. for simplicity the demo project uses Vista+ dialogs to choose files; you'll need a new way of selecting files for XP)

The Challenges
(background info, these are solved issues, not needed to use the code)
There were three very strange issues I had to work around. First, a reference needed to be created to the zip file being created. This reference was found by using the immediate parent folder and the relative pointer to that file... think of it as using "C:\folder" and "file.zip". That is used to get the drop target for the file (this method uses the drag-drop interface in code). folder is asked for the drop target for file.zip-- this fails. BUT.. if we combine them, and ask the desktop for the drop target for "C:\folder\file.zip", it succeeds. This makes very little sense to me.

The second issue was the error that had other people created their own IDataObject implementation. When you try to drop multiple files on an empty zip, you get an error saying that it can't add files to a new zip file because the new zip file is empty. Of course it's empty. A more detailed and app-crashing error says the IDataObject is invalid. Fortunately, by luck my initial test only tried to add one file. And this worked without producing the error. And if that wasn't bizarre enough, once that first file is added you can then add multiple files-- and not even one at a time, it will now accept the same type of multi-file IDataObject it errored on before.

Lastly, if 9 or more files were being added, Windows would display a compressed folders error (not an error in VB/the program) saying it couldn't find/read the first file. The first file would then not appear in the zip, but the rest would. But only on the first time files from that folder were added to a zip. But if that's the case, why wouldn't trying to add the other 8 files trigger the can't-add-multi-to-empty error?? Since it was an external error, I added a Sleep/DoEvents/Sleep routine to try to figure out where precisely the error was happening; but then since adding it I have not been able to reproduce the bug (it comes back without sleep). So please let me know if this one rears its head again... I think the solution at that point would to only add in blocks of 8.

The Code
Here's the core routine and its supporting APIs and functions:
Code:

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal PV As Long) ' Frees memory allocated by the shell
Public Declare Function ILCombine Lib "shell32" (ByVal pidl1 As Long, ByVal pidl2 As Long) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long
Public Declare Sub ILFree Lib "shell32" (ByVal pidl As Long)
Public Declare Function SHCreateFileDataObject Lib "shell32" Alias "#740" (ByVal pidlFolder As Long, ByVal cidl As Long, ByVal apidl As Long, pDataInner As Any, ppDataObj As oleexp3.IDataObject) As Long
Public Declare Function SHGetDesktopFolder Lib "shell32" (ppshf As IShellFolder) As Long ' Retrieves the IShellFolder interface for the desktop folder.
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Declare Function SysReAllocString Lib "oleaut32.dll" (ByVal pBSTR As Long, Optional ByVal pszStrPtr As Long) As Long

Public Const MK_LBUTTON = 1

Public Sub ZipFiles(sZipPath As String, pszToZip() As String)
Dim pZipStg As oleexp3.IStorage
Dim pZipStrm As oleexp3.IStream
Dim psfZipFolder As IShellFolder
Dim pidlZipFolder As Long
Dim pDT As IDropTarget

Dim pidlToZip() As Long
Dim idoToZip As oleexp3.IDataObject

'So weird bug... if you try to drop multiple files onto the newly created
'empty zip file, you get an error saying it can't create it because it's
'empty. stupid to begin with, of course it's empty to begin with. but even
'stupider, if you only drop 1 file, it works. so we have to only drop one
'file at first, then we can drop the rest
Dim pidlToZip2() As Long
Dim idoToZip2 As oleexp3.IDataObject

Dim pszZipFile As String 'name of zip file only, e.g. blah.zip
Dim pszZipFolder As String 'full path to folder that will contain .zip
Dim pidlZipFile As Long

Dim pchEaten As Long
Dim q As Long
Dim bMulti As Boolean

ReDim pidlZip(0)
ReDim pidlToZip(0)
pszZipFolder = Left$(sZipPath, InStrRev(sZipPath, "\") - 1)
pszZipFile = Right$(sZipPath, Len(sZipPath) - InStrRev(sZipPath, "\"))
Debug.Print "zipfolder=" & pszZipFolder
Debug.Print "zipfile=" & pszZipFile

pidlToZip(0) = ILCreateFromPathW(StrPtr(pszToZip(0)))
If UBound(pszToZip) > 0 Then
    ReDim pidlToZip2(UBound(pszToZip) - 1)
    For q = 1 To UBound(pszToZip)
        pidlToZip2(q - 1) = ILCreateFromPathW(StrPtr(pszToZip(q)))
    Next
    bMulti = True
End If
pidlZipFolder = ILCreateFromPathW(StrPtr(pszZipFolder))

Set psfZipFolder = GetIShellFolder(isfDesktop, pidlZipFolder)
Set pZipStg = psfZipFolder 'this calls QueryInterface internally
If (pZipStg Is Nothing) Then
    Debug.Print "Failed to create IStorage"
    GoTo clnup
End If

Set pZipStrm = pZipStg.CreateStream(pszZipFile, STGM_CREATE, 0, 0)
If (pZipStrm Is Nothing) Then
    Debug.Print "Failed to create IStream"
    GoTo clnup
End If

psfZipFolder.ParseDisplayName 0&, 0&, StrPtr(pszZipFile), pchEaten, pidlZipFile, 0&
If pidlZipFile = 0 Then
    Debug.Print "Failed to get pidl for zip file"
    GoTo clnup
End If

Call SHCreateFileDataObject(VarPtr(0&), UBound(pidlToZip) + 1, VarPtr(pidlToZip(0)), ByVal 0&, idoToZip)
If (idoToZip Is Nothing) Then
    Debug.Print "Failed to get IDataObject for ToZip"
    GoTo clnup
End If

Dim pidlFQZF As Long
pidlFQZF = ILCombine(pidlZipFolder, pidlZipFile)
'This is very weird. Both psfZipFolder and pidlZipFile(0) are valid, but if we request the IDropTarget using those,
'pDT fails to be generated. But when the zip file's relative pidl is combined with the pidl for its folder, and
'passed to isfDesktop as a fully qualified pidl, it works
'psfZipFolder.GetUIObjectOf 0&, 1, pidlZipFile(0), IID_IDropTarget, 0&, pDT
isfDesktop.GetUIObjectOf 0&, 1, pidlFQZF, IID_IDropTarget, 0&, pDT

If (pDT Is Nothing) Then
    Debug.Print "Failed to get drop target"
    GoTo clnup
End If


pDT.DragEnter idoToZip, MK_LBUTTON, 0&, 0&, DROPEFFECT_COPY
pDT.Drop idoToZip, MK_LBUTTON, 0&, 0&, DROPEFFECT_COPY

If bMulti Then
    Sleep 1500
    DoEvents
    Sleep 1500
    Debug.Print "adding rest of files..."
    Call SHCreateFileDataObject(VarPtr(0&), UBound(pidlToZip2) + 1, VarPtr(pidlToZip2(0)), ByVal 0&, idoToZip2)
    If (idoToZip2 Is Nothing) Then
        Debug.Print "Failed to get IDataObject for ToZip2"
        GoTo clnup
    End If
   
    pDT.DragEnter idoToZip2, MK_LBUTTON, 0, 0, DROPEFFECT_COPY
    pDT.Drop idoToZip2, MK_LBUTTON, 0, 0, DROPEFFECT_COPY
End If
'cleanup
clnup:
ILFree pidlToZip(0)
If bMulti Then
    For q = 0 To UBound(pidlToZip2)
        Call ILFree(pidlToZip2(q))
    Next
End If
Call ILFree(pidlZipFile)
Call ILFree(pidlZipFolder)
Call ILFree(pidlFQZF)
End Sub

'-----------------------------
'Supporting functions
Public Function GetIShellFolder(isfParent As IShellFolder, pidlRel As Long) As IShellFolder
  Dim isf As IShellFolder
  On Error GoTo out

  Call isfParent.BindToObject(pidlRel, 0, IID_IShellFolder, isf)

out:
  If Err Or (isf Is Nothing) Then
    Set GetIShellFolder = isfDesktop
  Else
    Set GetIShellFolder = isf
  End If

End Function
Public Function isfDesktop() As IShellFolder
  Static isf As IShellFolder
  If (isf Is Nothing) Then Call SHGetDesktopFolder(isf)
  Set isfDesktop = isf
End Function
Public Function LPWSTRtoStr(lPtr As Long, Optional ByVal fFree As Boolean = True) As String
SysReAllocString VarPtr(LPWSTRtoStr), lPtr
If fFree Then
    Call CoTaskMemFree(lPtr)
End If
End Function

'----------------------------------------------
'Below not needed in a project with mIID.bas
'----------------------------------------------

Private Function IID_IDropTarget() As UUID
'{00000122-0000-0000-C000-000000000046}
Static iid As UUID
 If (iid.Data1 = 0) Then Call DEFINE_UUID(iid, &H122, CInt(&H0), CInt(&H0), &HC0, &H0, &H0, &H0, &H0, &H0, &H0, &H46)
 IID_IDropTarget = iid
End Function
Private Function IID_IShellFolder() As UUID
  Static iid As UUID
  If (iid.Data1 = 0) Then Call DEFINE_OLEGUID(iid, &H214E6, 0, 0)
  IID_IShellFolder = iid
End Function
Private Sub DEFINE_OLEGUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer)
  DEFINE_UUID Name, L, w1, w2, &HC0, 0, 0, 0, 0, 0, 0, &H46
End Sub
Private Sub DEFINE_UUID(Name As UUID, L As Long, w1 As Integer, w2 As Integer, B0 As Byte, b1 As Byte, b2 As Byte, B3 As Byte, b4 As Byte, b5 As Byte, b6 As Byte, b7 As Byte)
  With Name
    .Data1 = L
    .Data2 = w1
    .Data3 = w2
    .Data4(0) = B0
    .Data4(1) = b1
    .Data4(2) = b2
    .Data4(3) = B3
    .Data4(4) = b4
    .Data4(5) = b5
    .Data4(6) = b6
    .Data4(7) = b7
  End With
End Sub

Existing Archives
If you wanted to add to existing archive, it's just a few adjustments. All you'd have to do is skip over the parts that generate a new zip file, and go directly to getting an IDropTarget for it and dropping the file IDataObject. If there's enough interest I may add some sample code for this in the future.
Attached Files

VB6 Virtual unicode-aware ListControl (grouping TreeList-Demo)

0
0
A Virtual-ListControl is sufficient for almost any purpose,
since anything it will render will be triggered from the outside,
in appropriate OwnerDraw-Events - which will then visualize
Data which is hosted outside of the Control as well.

This allows for quite some flexibility, even when one tries
to implement a TreeList-scenario on just such a simple "VList".

The VList-Control which comes with this Demo is (codewise) quite
small (about 350 lines of code) - and based on a normal ListBox-
WindowClass (and not a ListView).

Nevertheless, it:
- is Unicode-aware
- has no dependencies to other COM-libs
- supports OwnerDrawn-Headers
- supports multiple Columns (including HScrolling if needed)
- supports Sorting (including SortMarker-Rendering on the Col-Headers)
- encapsulates already the Basic-GDI-routines (no GDI-Declares needed at the outside)
- when used in conjunction with cGDIPlusCache can render Icons and Png-Content in each Cell

So, all in all a good wireframe to start developing your own (relative lightweight)
GridControl around it.

Here's a ScreenShot, what the Demo will produce "TreeList-wise":



In the above Picture, "Group 2" is in collapsed state - and please note
the formatted and right-aligned output in the last Column, which is
currently in "Sorted-Ascending"-state (ensured by a HeaderClick).

This sorting is ensured over the outside DataContainer (a normal ADO-Recordset),
and works (due to the Data-arrangement within that Recordset) "below the Group-Level"
(inside the Group-Nodes).

Here's the Demo-Zip: VList_GroupDemo_Classic.zip
(please use the VB-ProjectGroup-File: "_TestGroup.vbg" -
as long as you don't want to compile the VList.ocx into a binary first).

Have fun!

Olaf
Attached Files

one selecting answer

0
0
i need a one selecting answer program written by vb6, becouse i have a project in how to build an e_exam
Viewing all 1304 articles
Browse latest View live




Latest Images