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

VB6 - WIA "BlendPaint" Demo - comparison with Cairo-Drawing

April 10, 2014, 4:54 pm
$
0
0
The Demo here depends on a reference to vbRichClient5 (http://vbrichclient.com/#/en/Downloads.htm)

Just demonstrating what is needed (coding wise) and what the performance-differences
are - compared with preinstalled MS-system-libs.

Below is all the code which is needed, to achieve the same effect as the nice Demo of dilettante
here: http://www.vbforums.com/showthread.p...aint-quot-Demo

Code:
Option Explicit

Private Sub mnuPGBsCairo_Click()
    Cairo.ImageList.AddImage "BGnd", App.Path & "\background.jpg"
    Cairo.ImageList.AddImage "Ball", App.Path & "\glass_ball.png"

    New_c.Timing True
      RenderPerCairo Cairo.CreateSurface(480, 360).CreateContext
    Caption = New_c.Timing
End Sub

Private Sub RenderPerCairo(CC As cCairoContext)
    CC.RenderSurfaceContent "BGnd", 0, 0
    CC.RenderSurfaceContent "Ball", 20, 200, 160, 120, , , True
    CC.RenderSurfaceContent "Ball", 300, 220, 160, 120, , , True
    CC.RenderSurfaceContent "Ball", -60, -80
    Set Picture = CC.Surface.Picture
End Sub
Performance is about factor 10 better (4-5msec for Cairo-Blending vs. 45-55msec for the WIA-approach).

Here the Download as a Zip-Archive (re-using dilettantes resources):
http://vbrichclient.com/Downloads/WIA_and_Cairo.zip

And a Screenshot:


Olaf
↧
Search
↧

[vbRichClient] Interactive Dartboard Demo

April 12, 2014, 12:04 pm
$
0
0
Here's something I put together for fun. It's an interactive dartboard that supports mouse-over and click events.

The idea was that it could become a score-recording application but once I got to this point I thought I'd pass it along to somebody who actually plays darts as I, myself, do not!

This project has one external dependency (not included) that can be downloaded from Olaf Schmidts site: www.vbrichclient.com

If nothing else, the code might serve as a useful learning tool for somebody playing around with circles...

The dartboard, btw, was entirely drawn in code via the Cairo wrapper that vbRichClient exposes - it isn't a PNG file I just threw in there!
Attached Images
 
Attached Files
↧

[VB6] Shell Video Thumbnail Images

April 18, 2014, 7:59 am
$
0
0
Summary

Thumbnail images for video files are accessible via Shell32's Automation (i.e. ActiveX) interface.

These can be obtained using a ShellFolderItem object's ExtendedProperty() method. The tough part is that these are returned as PROPVARIANT values and not regular Variants as we know them in VB6. For many ExtendedProperty() return values VB6 can handily coerce the PROPVARIANT to a Variant, even though you can still end up with unsupported subtypes (like unsigned integers of varying lengths).

Here we need to request the property by passing SCID_THUMBNAILSTREAM to ExtendedProperty. In this case it returns a PROPVARIANT with a VT_STREAM content subtype, making it a bit troublesome in that VB6 cannot convert it to a standard Variant.

Luckily that can be done by calling the PropVariantToVariant function, though it handles the situation by converting the VT_STREAM to a Variant's VT_UNKNOWN. Still, the IStream object reference is there and usable.

This particular stream is designed for consumption by GDI+/WindowsCodecs, and isn't a simple PNG or JPEG in a stream. But GdipCreateBitmapFromStream() can read it just fine, and from there you are on your way.


The Code

Most of the code in the sample program relates to a version of my ThumbnailsView UserControl. Without this the program would be a lot smaller, but we don't have many good controls for multi-image display. You almost always end up working with things like nested PictureBox controls and a scrollbar or two and some logic to glue it all together. There is also a funky SimpleProgressBar UserControl for visual feedback.

You can pretty much ignore both of those along with helper modules Picture2BMP.bas, BmpGen.cls, and ScaledLoader.cls that are used by ThumbnailsView.ctl.

Even Form1's code is mostly gingerbread, dealing with picking a folder of video files to fetch thumbnails for. Its ListAttributes() subroutine is the part that enumerates the folder items and retrieves the thumbnails, with the help of GdipLoader.cls to convert the stream into a StdPicture object.

Code:
Private Sub ListAttributes(ByVal FolderPath As String)
    Dim Folder As Shell32.Folder
    Dim ShellFolderItem As Shell32.ShellFolderItem
    Dim GdipLoader As GdipLoader
    Dim ExtProp As Variant

    Set Folder = ShellObject.NameSpace(FolderPath & "\")
    If Folder Is Nothing Then
        Unload Me
    Else
        Set GdipLoader = New GdipLoader
        With SimpleProgressBar1
            .Caption = ""
            .Max = Folder.Items.Count
        End With

        For Each ShellFolderItem In Folder.Items
            If Not (ShellFolderItem.IsFolder Or ShellFolderItem.IsLink) Then
                PropVariantToVariant ShellFolderItem.ExtendedProperty(SCID_THUMBNAILSTREAM), ExtProp
                'Note: vbDataObject value is really VT_UNKNOWN (i.e. 13):
                If VarType(ExtProp) = vbDataObject Then
                    ThumbnailsView1.Add GdipLoader.LoadPictureStream(ExtProp), ShellFolderItem.Name
                End If
            End If
            SimpleProgressBar1.Value = SimpleProgressBar1.Value + 1
        Next
    End If
End Sub

Issues

The first issue is that this isn't speedy. I'm not sure what Shell32 is going through to get thethumbnails even though I had assumed they were retrieved using typical OLE Storages & Streams mechanisms. It almost seems too slow for that though and since it uses video codecs there must be more involved.

The second issue is that depending on the video encoding format and codecs you have installed you might get nice results or a junk image back. I was almost ready to give it up until I realized I had VB6.exe in ffdshow's blacklist on my development PC.

But testing the compiled EXE (and allowing ffdshow use via the Compatibility Manager popup) returned good images from everything I tested but some DIVX formats.

See: ffdshow tryouts or use a search site.

Requirements

As written, the program requires a number of things, including running on Windows XP SP2 or later:

  • GDI+ version 1 - ships in XP and later, deployable back to Win95.
  • PropVariantToVariant() in propsys.dll - requires XP SP2 or later.
  • Microsoft Windows Image Acquisition Library v2.0 - ships in Vista or later, can be added to XP SP1 or later.
  • Edanmo's OLE interfaces and functions typelib (olelib.tlb) - needed for development, not needed at run time. Can be acquired from http://www.mvps.org/emorcillo/en/index.shtml.


By getting rid of ThumbnailsView and using some other multi-image control and associated code you can eliminate WIA 2.0 and Edanmo's olelib.tlb.


The Demo

Running the program you'll see the single Form user interface. It has a status/progress bar, a ThumbnailsView taking up the rest of the Form, and a single menu item "Choose Folder" you use to start the process.

The running progress shows you the current and total folder items being processed. Subfolders and links are skipped, as are files that do not have a ThumbnailStream return value.


Name: sshot1.jpg Views: 116 Size: 38.3 KB
Some videos using standard Windows codecs


Name: sshot3.jpg Views: 117 Size: 43.6 KB
Some videos that require additional codecs (MP4 mostly).
Work fine when ffdshow is used.


Remaining Issues

In theory all kinds of files ought to return thumbnails this way. However I get nothing useful for music folders, Word document folders, etc. I can only assume that the returned results are in another format this demo rejects (GDI+ Image object?). I'll have to investigate further.
Attached Images
  
Attached Files
↧

visual basic 6 master pack 1 , daily update

April 19, 2014, 6:25 pm
$
0
0
i will update this thread if u can post too.:thumb::):p



Move Controls at Runtime


Code:
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2


Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Command1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

Private Sub Command2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Command2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Text1.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

Private Sub Text2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Text2.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub
↧

[VB6] Shell Drive Free Space

April 21, 2014, 9:03 am
$
0
0
If you are using Shell objects there are lots of properties you can retrieve describing the filesystem and individual files. However the values returned are often types that VB is not prepared to cope with without some help.

Here we'll look at one of the Volume properties that gives you the capacity and free space for each drive in ssfDrives.


This program fetches the Drives Folder (ssfDrives) and retrieves the PKEY_Computer_DecoratedFreeSpace (as SCID_Computer_DecoratedFreeSpace).

The returned value is a PROPVARIANT, so we first convert it to a Variant for use in VB6.

The PROPVARIANT is empty or a "VT_VECTOR | VT_UI8" value, so if not empty we recast it as "VT_ARRAY | VT_CURRENCY" which is something we can play with in VB6.

Update:

It seems that VB6 can coerce these particular PROPVARIANTs to Variants itself. This saves an API call that isn't available in most pre-Vista Windows installations.

Then we format these values (1.) using normal techniques after scaling by 10000 to convert from our pseudo-Currency values to whole numbers, or (2.) by calling StrFormatByteSize() which produces abbreviated formats in KB, MB, GB, TB units.


You could probably also use PKEY_FreeSpace and PKEY_Capacity in separate calls of the ExtendedProperty() method, but I haven't tested that.


See the program comments: this code won't work before Vista except on XP SP2 or later with Windows Desktop Search (WDS) 3.0 or later installed. Those old systems do not have propsys.dll in them.

Update:

No longer a restriction.

Name: sshot.jpg Views: 85 Size: 33.5 KB
Attached Images
 
Attached Files
↧
↧

[VB6] UPrinter - Unicode Printer Class

April 23, 2014, 10:10 am
$
0
0
I looked around and didn't find many working samples of this... actually none at all but lots of questions about non-working code snippets. There may be some out there, and better than this basic one. I just didn't find any.

This version does not deal with top/bottom margins, colors, images, drawing, paper tray or size selection, orientation, etc. It only prints in whole lines (or multiples if you have embedded newlines), long lines should wrap.


I have attached an archive here containing a small demo Project that uses UPrinter.

Utf8Reader is is class for reading UTF-8 encoded text files. It in turn makes use of the Utf8Codec class. For this demo a UTF-8 CSV file is read as a source of sample Unicode text to print.

ParseCSV is here because the sample data is a CSV file and I want to split the data into fields and then print them with Tabs in between.

Each line of text after the first (heading) line is printed twice in this demo. The only purpose of that was to test page boundary overflow detection.


This hasn't been fully tested so it may fail with some printer drivers. As already stated it is an incomplete and minimal example but it should serve as a starting point if you want to implement more functionality.


Name: sshot.jpg Views: 128 Size: 51.2 KB


Updates:

New version replaces the earlier attachment here. A few small bug fixes, added properties TopMargin and BottomMargin and method KillDoc.
Attached Images
 
Attached Files
↧

A VB6 Recent Files Lister

April 24, 2014, 3:18 am
$
0
0
Here is a VB6 Recent Files lister. You can remove any entries from the list and the programme also checks that the entries have not been deleted or moved.

It is a simple programme which I hope some will find useful. One comment, do not use it from within the IDE or when VB6 is running. VB6 stores the list at startup and re-writes upon completion.

Enjoy - Steve.
Attached Files
↧

[VB6] Tabulator, Crosstab Class

April 26, 2014, 9:16 am
$
0
0
If you know what cross tabulation is you may have a need for this. If you've never heard of it the chances are this may just be a really confusing bit of code.

Quite often we're dealing with data from a database, and many DBMSs offer a built-in way to do this. For example for Jet/ACE SQL look up the TRANSFORM... PIVOT syntax. Normally this makes use of some aggregation function (SUM(), AVERAGE(), etc.).

This Tabulator class can be used with any data source. This version does not include aggregation support, but instead assumes you have simple unique value to collect for each intersection of Column and Row (i.e. "cell").

It can return rows in ascending order (default) or descending order by RowId value. Columns are always in ascending order by ColName values.


You might add aggregation a number of ways. You could hard-code that into Tabulator.cls or the TabulatorValue.cls (a helper class for value storage).

Or you might modify Tabulator.cls to accept an object reference that offers fixed-named methods such as Accumulate() and Report(). For SUM() aggregation Accumulate() might just add new values to the current sum in a cell, and Report() would jsut return the value without modification. For something like AVERAGE() you might have to add values and increment a count in Accumulate() and then divide in the Report() method.


An illustration may help. This is Project1 in the attached archive. Here we have data like:

Code:
GOLD 01-JAN-2010 70.19
OIL 01-JAN-2010 16.70
SUGAR 01-JAN-2010 44.51
COPPER 01-JAN-2010 2.57
GOLD 02-JAN-2010 68.30
OIL 02-JAN-2010 15.11
SUGAR 02-JAN-2010 49.23
COPPER 02-JAN-2010 5.58
GOLD 03-JAN-2010 70.78
OIL 03-JAN-2010 15.69
SUGAR 03-JAN-2010 48.71
COPPER 03-JAN-2010 9.29
GOLD 04-JAN-2010 69.87
OIL 04-JAN-2010 8.52
SUGAR 04-JAN-2010 43.70
We cross tabulate Price by Date and Commodity and display that (descending) in an MSHFlexGrid control:

Name: sshot1.gif Views: 42 Size: 23.9 KB


Project2 is another example, showing how Tabulate can handle complex values which can be arrays or even objects. Here each cell Value is an instance of a two-value class (Price and Volume).

The raw data looks like:

Code:
GOLD 15-APR-2014 74.70 42551
OIL 15-APR-2014 9.69 70748
SUGAR 15-APR-2014 49.28 109303
COPPER 15-APR-2014 12.02 28024
GOLD 01-JAN-2011 67.72 45741
OIL 01-JAN-2011 9.91 72771
SUGAR 01-JAN-2011 40.25 36548
COPPER 01-JAN-2011 6.92 94342
GOLD 02-JAN-2011 72.42 111129
OIL 02-JAN-2011 12.99 29290
SUGAR 02-JAN-2011 41.81 91619
COPPER 02-JAN-2011 2.63 93288
GOLD 03-JAN-2011 70.49 96250
OIL 03-JAN-2011 11.10 76063
SUGAR 03-JAN-2011 48.44 87550
COPPER 03-JAN-2011 11.76 90176
OIL 04-JAN-2011 16.53 107546
We'll tabulate this and report it in another MSHFlexGrid control:

Name: sshot2.jpg Views: 33 Size: 88.5 KB


Tabulate works by storing row data as a Collection of row Collection objects, RowId values as a Variant array, and "cell" values as TabulateValue.cls instances, each of which have a Variant property.

Peformance was improved by adding a binary search for doing row insertion. Since there are normally far fewer columns, a linear search is still being used to insert new columns as they are "put" into Tabulator. At this point Tabulator is reasonably fast, and the demo programs spend most of their time populating the grid after tabulation has completed.

It seems to be working properly, but if you find bugs please let everyone know by posting a reply here.

Note:

Bug fixed, reposted attachment.
Attached Images
  
Attached Files
↧
Search

RGB, XYZ, and Lab conversions

April 30, 2014, 11:16 pm
$
0
0
This program converts images between RGB, XYZ, and Lab formats. It's quite a large program (due to the 2 huge lookup tables for RGB/Lab conversion), so instead of posting it as an attachment, I've uploaded it to Mediafire, and have posted the download link here.

https://www.mediafire.com/?vdx3uy1z31g21as
↧
↧

[VB6] CommandButton with image and text: No UCs, ActiveX, or OwnerDraw/subclassing

May 1, 2014, 4:04 pm
$
0
0
Most of the solutions to place an image on a button either use a control or owner drawing. If all you want is a simple image button, with the image on the left and text on the right, it turns out all you need to do is call BM_SETIMAGE. Don't even need to set the style to graphical, or change the style with API. Transparency is preserved, and the button style doesn't change like it does if you set it to 'graphical' in vb6; so if you're using xp style manifests the button still stays that style.

A bonus with this sample, it shows how the icon you use can be stored in a resource file, as a custom resource, which bypasses VB's limitations. You can use any valid Windows icon, with any size (or multiple sizes) and any color depth, and even more, this sample will load the size closest to what you requested.

To use this sample, create a project with a form with a command button, and a module. Add a new resource file, then choose add custom resource (NOT icon or bitmap), and name it something like "ICO_01" as the id.

Then, this code is for the form, and all you need is this one line for any command button:

Code:
Option Explicit

Private Sub Form_Load()

Call SendMessage(Command1.hWnd, BM_SETIMAGE, IMAGE_ICON, ByVal ResIconTohIcon("ICO_01"))

End Sub
and this is the code for the module:

Code:
Option Explicit


Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, _
                                                                    Source As Any, _
                                                                    ByVal Length As Long)
                                                                   
Public Declare Function CreateIconFromResourceEx Lib "user32.dll" (ByRef presbits As Any, _
                                                                    ByVal dwResSize As Long, _
                                                                    ByVal fIcon As Long, _
                                                                    ByVal dwVer As Long, _
                                                                    ByVal cxDesired As Long, _
                                                                    ByVal cyDesired As Long, _
                                                                    ByVal flags As Long) As Long

Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, _
                                                                      ByVal wMsg As Long, _
                                                                      ByVal wParam As Long, _
                                                                      lParam As Any) As Long
                                                                   
Private Type IconHeader
    ihReserved      As Integer
    ihType          As Integer
    ihCount        As Integer
End Type

Private Type IconEntry
    ieWidth        As Byte
    ieHeight        As Byte
    ieColorCount    As Byte
    ieReserved      As Byte
    iePlanes        As Integer
    ieBitCount      As Integer
    ieBytesInRes    As Long
    ieImageOffset  As Long
End Type

Public Const BM_SETIMAGE = &HF7
Public Const IMAGE_BITMAP = 0
Public Const IMAGE_ICON = 1

Public Function ResIconTohIcon(id As String, Optional cx As Long = 24, Optional cy As Long = 24) As Long
'returns an hIcon from an icon in the resource file
'For unknown reasons, this will not work with the 'Icon' group in the res file
'Icons must be added as a custom resource

    Dim tIconHeader    As IconHeader
    Dim tIconEntry()    As IconEntry
    Dim MaxBitCount    As Long
    Dim MaxSize        As Long
    Dim Aproximate      As Long
    Dim IconID          As Long
    Dim hIcon          As Long
    Dim I              As Long
    Dim bytIcoData() As Byte
   
On Error GoTo e0

    bytIcoData = LoadResData(id, "CUSTOM")
    Call CopyMemory(tIconHeader, bytIcoData(0), Len(tIconHeader))

    If tIconHeader.ihCount >= 1 Then
   
        ReDim tIconEntry(tIconHeader.ihCount - 1)
       
        Call CopyMemory(tIconEntry(0), bytIcoData(Len(tIconHeader)), Len(tIconEntry(0)) * tIconHeader.ihCount)
       
        IconID = -1
         
        For I = 0 To tIconHeader.ihCount - 1
            If tIconEntry(I).ieBitCount > MaxBitCount Then MaxBitCount = tIconEntry(I).ieBitCount
        Next

     
        For I = 0 To tIconHeader.ihCount - 1
            If MaxBitCount = tIconEntry(I).ieBitCount Then
                MaxSize = CLng(tIconEntry(I).ieWidth) + CLng(tIconEntry(I).ieHeight)
                If MaxSize > Aproximate And MaxSize <= (cx + cy) Then
                    Aproximate = MaxSize
                    IconID = I
                End If
            End If
        Next
                 
        If IconID = -1 Then Exit Function
     
        With tIconEntry(IconID)
            hIcon = CreateIconFromResourceEx(bytIcoData(.ieImageOffset), .ieBytesInRes, 1, &H30000, cx, cy, &H0)
            If hIcon <> 0 Then
                ResIconTohIcon = hIcon
            End If
        End With
     
    End If

On Error GoTo 0
Exit Function

e0:
Debug.Print "ResIconTohIcon.Error->" & Err.Description & " (" & Err.Number & ")"

End Function
Thanks to Leandro Ascierto for the basis of the code to load an icon from a resource file into memory.
Attached Files
↧

webbrowser Control and cookies

May 1, 2014, 4:59 pm
$
0
0
hi my friend！ i have a question

for example in one form i have three webbrowsers controls，i want each web control used Different username to login the same bbs，but if one user login ，then other web control have the same username 。may be cookies is Public。who can help me

thanks 。my pool english。
↧

FOTOENHANCE3D.zip (download)

May 3, 2014, 12:34 am
$
0
0
:cool:

usualy soft like this i post is called filtre. u put in .jpg, .gif, .bmp. saving is with .bmp format. LMB\RMB +Shift is image rotation. esc for exit fullscreen mode.


Name: PIC201453239184096.jpg Views: 33 Size: 33.6 KB

u can get it here: https://app.box.com/s/5mh08jiobuc9rf3bh77q

there is source, so if would like to modify do not forget to place files on right path. when u open it u will see app.path function used so it can tell where it must be. move source codes to executable directory. i wrote it with vb6, using rmcontrol.ocx\directx7. other soft i write is accesible on: openfor.webs.com thank you.
Attached Images
 
↧

Move PowerPoint Slides using VB6 Code

May 3, 2014, 1:00 am
$
0
0
I want to move powerpoint slides (right and left) on a wireless remote, which at the receiver side has arduino connected to computer via USB cable. (Its hardware is ready)

Arduino is programmed to print "R" when given right input and "L" on left input(here to print means to give that alphabet as serial input to the computer).

I have a VB .exe along with .ini file, which is the software i found on a blog( 2embeddedrobotics.blogspot.com/2013/05/powerpoint-control-using-gesture.html). But the .exe is working only for right movement of slide and not for left.

Can anyone write the VB6 code for moving powerpoint slides right and left on receiving and two alphabets via USB.

The .exe which i've got has options for selecting COM port which is in the .ini file ( frmicon.Text1.text=6 ) and it also asks for copying MSCOMM32.OCX file in system32 folder of Windows XP.
↧
↧

VB6 - TLSCrypto (Unicode compatible)

May 4, 2014, 1:46 pm
$
0
0
After a fair degree of effort, I am making available a Version of TLSCrypto that is Unicode compatible. The original version had problems on systems that utilized a locale or character set other than Latin (as in English). A deeper explanation is contained in the Unicode.txt file.

ClsCrypto and NewSocket should now be Unicode compatible. They are NOT Unicode compliant. It's too bad that VB6 does not support a full slate of functions for byte strings as well as Unicode strings, but such is not the case. There was no discernible performance hit, so these Classes will probably replace the original Classes.

The Server routine will not work unless the Certificates have been set up properly. Hence the "localhost" URL will not test properly without the Server program. But the "www.mikestoolbox.org" URL should work with the Client program only.

J.A. Coutts
Attached Files
↧

Μ2000 Interpreter with Greek and English commands

May 16, 2014, 3:21 pm
$
0
0
This is version 6.5. I am working to include objects. This is an example of a big program including work from others and many hours of thinking and trying. 14 years...of writing! I am not a professional..just a curius about programming.
My itension is, this languag to be a definition for a startup language. M2000 has threads, an envorioment for graphics, multimedia and databases. i like a language to perform some easy tasks.
I have visual basic 5 and i like it. But it isn't what i want. I learned programming with an Acorn Electron..from early 80s.

I have some comments in Greek Laguage...but also my other comments perhaps are greeks for you..too.
i leave this here to see the changes from the 3rd revision m2000_6_5_rev2.zip

6.5 version rev 2. I wrote help database for 2D graphics and databases. Now online help show english text or greek text if there is a special word inside (transparent to the user). I prepare the database with a programm in M2000. I use greek comands but i can translated it, if anyone want to add something to this help base.

6.5 rev 3. Changes in rev 2 broke music score player. Fix it..Now "musicbox" music can play in the background.This is the 3d revision m2000_6_5_rev_3.zip
I also make a new read only variable the PLAYSCORE, so if this is trus...means that there are threads for musicbox..Threads of music box can play even when all modules terminated and we are in the command line interpreter mode. PLAY 0 send a mute to all score threads.
Code:
    SCORE 3, 1000, "C5F#@2B@2C5F#@2B"
    SCORE 1, 1000, "D@2E@2C#3 @2D5@2V90 @3F#4V127"
                    '/ C C# D D# E F F# G G# A# B
                    '/ space is a pause and you can handel duration with @number, number after id change octave..for the end, @ change duration...in portion of basic bit, here 1 second (1000 miliseconds)
    PLAY  1, 19, 3, 22  ' VOICE, INSTRUMENT
with the example "some" you can do another example in a module BB you can write that (module some is that on the video, and below in the code box)
So when BB run, a new module defined the pl and an new thread with handler kk, and then we call SOME (which this module has a MAIN.TASK loop as a leader thread, plus another thread that writes some graphics in the screen). Then you see a blinking number, and that is the running thread from the calling module, and you hear music (terrible I am not a musician), and that music restart after finish. When you press mouse button, the MAIN.TASK complete, and the module SOME terminate, but the wait command allows thrεad on BB to run. After the waiting of 2 seconds, and printing numbers to the screen, the KK thread terminate, but the music threads terminated when all scores time expire.
"thread this erase" is a command from a thread to kill itself...without knowing the number of this thread handler!

Code:
module pl {
SCORE 3, 1000, "C5F#@2B@2C5F#@2B"
    SCORE 1, 1000, "D@2E@2C#3 @2D5@2V90 @3F#4V127"
                    '/ C C# D D# E F F# G G# A# B
                    '/
    PLAY  1, 19, 3, 22  ' VOICE, INSTRUMENT
    }
    pl
i=0
thread { i++
print i
if not playscore then pl
if i>999 then thread this erase } as kk
thread kk interval 25
SOME
wait 2000
Attached Files
↧
Search

VB6 DB-Import of large CSV-Data (for both, SQLite and ADOJet)

May 19, 2014, 6:29 am
$
0
0
The Demo consists of two SubFolders (one for SQLite, the other for ADOJet) -
and the SQLite-Demo depends on the latest vbRichClient5-Version 5.0.15 (May 2014) -
so, make sure you grabbed the last one from here: http://vbrichclient.com/#/en/Downloads.htm

Ok, the CSV-Demo Download is this one here:
http://vbRichClient.com/Downloads/CSVImportDemo.zip
(the above Demo-download is about 800KB in size because it contains a larger example CSV-file from here:
http://support.spatialkey.com/spatia...mple-csv-data/)

The two examples in the two separate Folders show, how to perform Bulk-Inserts
against the two different DB-Engines with the best possible performance, whilst
parsing the Import-Records out of a CSV-File - (there's also a larger CSV-File to
test against, but this one will be automatically generated when the SQLite-Demo starts.

The Zip-included, smaller CSV-File contains about 36,000 Records - the autogenerated
larger one will contain a bit more than 1Mio Records.

Timed Performance:
SQLite has a performance-advantage of about factor 4.5 over ADO/Jet

On the smaller CSV:
SQLite: about 250msec
ADOJet: about 1200msec

On the larger CSV (1Mio Records):
SQLite: about 7.5sec
ADOJet: about 34sec

SQLite


ADOJet


The ADOJet-example is working in dBase-ISAM-mode, which allows a bit more
Space again, since the max size for each *.dbf-table-file is 2GB (whilst for
"normal single-file Jet *.mdbs" this 2GB limit already kicks in on the DB-File itself
(all tables, all indexes).

The dBase-ISAM-Mode was suggested by dilettante in this thread here:
http://www.vbforums.com/showthread.p...ursor-Location

Though the ADOJet-Demo (despite the dBase workaround) still has the following limitations:
- no convenient single-file-DB (SQLite handles everything in a single-file in the same way as *.mdbs)
- 2GB limit per DBF-table File (SQLite can handle filesizes > 100GByte)
- no Unicode-Support (SQLite is fully unicode-capable)
- 8Char-limitation in the Table-FieldNaming (no such restriction in SQLite)
- 8Char-limitation in the DBF-Table-File-name (no such restriction in SQLite)
- wasted space in the created files, due to fixed-length-Text-Fields (DBF-filesize in this example is about 4 times larger than the generated SQLite-DB)
- factor 4.5 slower with Bulk-Inserts than SQLite
- 2GB FileSize-limitation of the CSV-Import-File (the vbRichClient-cCSV-Class has huge-file-support)

The latter point can be resolved of course with ones own implementation of a CSV-parser,
in conjunction with a Class that also allows for huge-file-handling (> 4GB).

The only advantage the ADOJet approach offers, is "zero-deployment" (ADOJet comes preinstalled on any current Win-Version).

Well - your executable will have to be deployed of course also in the ADOJet-case. ;)

So the "disadvantage" with the vbRichClient5-builtin SQLite-engine is, that you will have
to ship "3 more dll-binaries" with your executable (7z-compressed this is ~1.6MB, not really
worth mentioning nowadays) - also regfree-support is only 3-4 lines of code away with
any vbRichClient5-based application (without any manifests).

Those who want to keep a good "competitive advantage" over other solutions in this category,
should definitely re-consider - and take SQLite into account. :)

Olaf
↧

Vb6 - utc

May 19, 2014, 12:08 pm
$
0
0
Many protocols (such as email) require the Date/Time in UTC. Wikipedia describes UTC as:

Coordinated Universal Time (French: Temps Universel Coordonné, UTC) is the primary time standard by which the world regulates clocks and time. It is one of several closely related successors to Greenwich Mean Time (GMT). For most purposes, UTC is used interchangeably with GMT, but GMT is no longer precisely defined by the scientific community.

This little routine creates UTC in the required format:
Sat, 17 May 2014 11:20:58 -0700
Code:
Option Explicit

Private Type SYSTEMTIME
  wYear        As Integer
  wMonth        As Integer
  wDayOfWeek    As Integer
  wDay          As Integer
  wHour        As Integer
  wMinute      As Integer
  wSecond      As Integer
  wMilliseconds As Integer
End Type

Private Type TIME_ZONE_INFORMATION
  Bias As Long
  StandardName(63) As Byte  'unicode (0-based)
  StandardDate As SYSTEMTIME
  StandardBias As Long
  DaylightName(63) As Byte  'unicode (0-based)
  DaylightDate As SYSTEMTIME
  DaylightBias As Long
End Type

Private Declare Function GetTimeZoneInformation Lib "kernel32" (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Sub Form_Load()
    txtDate.Text = GetUDTDateTime()
End Sub

Private Function GetUDTDateTime() As String
    Const TIME_ZONE_ID_DAYLIGHT As Long = 2
    Dim tzi As TIME_ZONE_INFORMATION
    Dim dwBias As Long
    Dim sZone As String
    Dim tmp As String
    Select Case GetTimeZoneInformation(tzi)
        Case TIME_ZONE_ID_DAYLIGHT
            dwBias = tzi.Bias + tzi.DaylightBias
            sZone = " (" & Left$(tzi.DaylightName, 1) & "DT)"
        Case Else
            dwBias = tzi.Bias + tzi.StandardBias
            sZone = " (" & Left$(tzi.StandardName, 1) & "ST)"
    End Select
    tmp = "  " & Right$("00" & CStr(dwBias \ 60), 2) & Right$("00" & CStr(dwBias Mod 60), 2) & sZone
    If dwBias > 0 Then
        Mid$(tmp, 2, 1) = "-"
    Else
        Mid$(tmp, 2, 2) = "+0"
    End If
    GetUDTDateTime = Format$(Now, "ddd, dd mmm yyyy Hh:Mm:Ss") & tmp
End Function
J.A. Coutts
↧
↧

VB6 Dynamic Menu-, Popup- and Toolbar-Demo (vbRichClient-based)

May 21, 2014, 7:09 pm
$
0
0
As the title says, just an example for dynamic Menu and ToolBar-handling,
based on the Graphics-Classes (the Widget- and Form-Engine) of vbRichClient5.dll:
http://vbrichclient.com/#/en/Downloads.htm

The contained Modules of the Demo:

modMenuResources.bas
Code:
Option Explicit

'this function returns a dynamically created Menu as a JSON-String (which could be stored in a DB, or elsewhere)
Public Function ExampleMenuAsJSONString() As String
Dim Root As cMenuItem
  Set Root = Cairo.CreateMenuItemRoot("MenuBar", "MenuBar")
 
  AddFileMenuEntriesTo Root.AddSubItem("File", "&File")
  AddEditMenuEntriesTo Root.AddSubItem("Edit", "&Edit")
  AddEditMenuEntriesTo Root.AddSubItem("Disabled", "&Disabled", , False)  'just to demonstrate a disabled entry
  AddExtrMenuEntriesTo Root.AddSubItem("Extras", "E&xtras")
  AddHelpMenuEntriesTo Root.AddSubItem("Help", "&Help")

  ExampleMenuAsJSONString = Root.ToJSONString
End Function

Public Sub AddFileMenuEntriesTo(MI As cMenuItem)
  MI.AddSubItem "New", "&New", "Document-New"
  MI.AddSubItem "Sep", "-"
  MI.AddSubItem "Open", "&Open...", "Document-Open"
  MI.AddSubItem "Save", "&Save", "Document-Save"
  MI.AddSubItem "SaveAs", "&Save as...", "Document-Save-As"
  MI.AddSubItem "Sep2", "-"
  MI.AddSubItem "ExitApp", "E&xit Application", "Application-Exit"
End Sub

Public Sub AddEditMenuEntriesTo(MI As cMenuItem)
  MI.AddSubItem "Cut", "C&ut", "Edit-Cut"
  MI.AddSubItem "Copy", "&Copy", "Edit-Copy"
  MI.AddSubItem "Paste", "&Paste", "Edit-Paste", CBool(Len(New_c.Clipboard.GetText))
  MI.AddSubItem "Delete", "&Delete", "Edit-Delete"
  MI.AddSubItem "Sep", "-" '<- a Menu-Separatorline-Definiton
  MI.AddSubItem "Select all", "&Select all", "Edit-Select-All"
End Sub

Public Sub AddExtrMenuEntriesTo(MI As cMenuItem)
Dim SubMenuPar As cMenuItem, SubSubMenuPar As cMenuItem
 
  MI.AddSubItem "Item1", "Menu-Item&1", "MenuIconKey1"
  MI.AddSubItem "Item2", "Menu-Item&2", "MenuIconKey3", False
  MI.AddSubItem "Item3", "-" '<- a Menu-Separatorline-Definiton
  MI.AddSubItem "Item4", "&Menu-Item2 disabled", "MenuIconKey1", , True
  Set SubMenuPar = MI.AddSubItem("Item5", "This pops up a &SubMenu", "MenuIconKey2")
 
    'two entries into the SubMenu (as children of 'Item5' of the above Code-Block)
    SubMenuPar.AddSubItem "SubItem1", "Caption SubItem1", "MenuIconKey1"
    Set SubSubMenuPar = SubMenuPar.AddSubItem("SubItem2", "Caption SubItem2", "MenuIconKey2")
 
      'and just 1 entry into the SubSubMenu (children of 'SubItem2' of the above Code-Block)
      SubSubMenuPar.AddSubItem "SubSubItem1", "Caption SubSubItem1", "MenuIconKey1"
End Sub
 
Public Sub AddHelpMenuEntriesTo(MI As cMenuItem)
  MI.AddSubItem "About", "&About", "About-Hint"
  MI.AddSubItem "Sep", "-"
  MI.AddSubItem "Index", "&Index...", "Help-Contents"
  MI.AddSubItem "Find", "&Find...", "Edit-Find"
End Sub
and modToolBarResources.bas
Code:
Option Explicit

Public Sub CreateToolBarEntriesOn(ToolBar As cwToolBar)
  ToolBar.AddItem "Home", "go-home", , , "normal Icon with 'IsCheckable = True'", , True
  ToolBar.AddItem "Undo", "go-previous", , , "normal Icon"
  ToolBar.AddItem "Redo", "go-next", , , "disabled Icon", False
  ToolBar.AddItem "Search", "page-zoom", , ddDropDown, "Icon with DropDownArrow"
  ToolBar.AddItem "Sep", , "-", , "Separator-Line"
  ToolBar.AddItem "TxtItem1", , "TxtItem1", , "plain Text-Item"
  ToolBar.AddItem "TxtItem2", "Document-Save-As", "TxtItem2", , "Text-Item with Icon"
  ToolBar.AddItem "Sep2", , "-", , "Separator-Line"
  ToolBar.AddItem "TxtItem3", , "TxtItem3", ddDropDown, "Text-Item with DropDown"
  ToolBar.AddItem "TxtItem4", "Edit-Find", "TxtItem4", ddDropDown, "Text-Item with Icon and DropDown"
  ToolBar.AddItem "Sep3", , "-", , "Separator-Line"
  ToolBar.AddItem "TxtItem5", "Document-Open", "TxtItem5", ddCrumbBar, "Text-Item with Icon and CrumbBar-Style-DropDown"
  ToolBar.AddItem "TxtItem6", , "TxtItem6", ddCrumbBar, "Text-Item with CrumbBar-Style-DropDown"
  ToolBar.AddItem "TxtItem7", , "TxtItem7", , "plain Text-Item"
End Sub
... contain the lines of code which are needed, to construct and achieve the following output:

MenuBar-DropDown:


ToolBar-DropDown as the result of a DropArrow-Click (showing a dynamic PopUp-Menu):


The constructed Menus use String-Keys to refer to previously loaded Icon and Image-Resources -
and they can be serialized to JSON-Strings (storable in a DB for example).

Any imaginable modern Alpha-Image-Resource can be used, as e.g. *.png, *.ico - but also
(as shown in the Demo) *.svg and *.svgz Vector-Images.

The example is completely ownerdrawn and truly independent from any MS-Menu-APIs, so one
can adapt *anything* as needed (e.g. the shape of the dropdown-form, colors, fonts, etc.) -
though the Demo as it is tries for a moderate style, mimicking a Win7-look roughly (with some
slight differences I personally like, but the whole thing is adaptable as said).

The code which implements this Menu-System is contained in one 'cf'-prefixed cWidgetForm-class
(cfPopUp for the hWnd-based Popups) - accompanied by 6 additional 'cw'-prefixed cWidgetBase-derived Classes:

cwMenuBar + cwMenuBarItem for the Menu-Strip
cwMenu + cwMenuItem for the DropDown-menus
cwToolBar + cwToolBarItem for the simple ToolBar-Implementation

I post this example more with regards to those, who want to learn how to program Widgets using
the vbRichClient-lib...
The above mentioned cwSomething Classes are programmable very similar to a VB-UserControl
(internally the same Event-Set is provided with KeyDown, MouseMove, MouseWheel, MouseEnter/MouseLeave etc.)

E.g. the cwToolBar-WidgetClass has only 100 lines of code - and the cwToolBarItem only 130 -
that's quite lean for what it does and offer, when you compare that with the efforts needed,
when "fighting" with SubClassing and SendMessage Calls against e.g. the MS-CommonControls. ;)

There's not a single Win-API-call throughout the implementation - but that's normal
for any framework, since they usually try to abstract from the underlying system.
The Menu- and ToolBar-Textrendering is Unicode-capable.

Have fun with it - here's the Zip-Download-Link: http://vbRichClient.com/Downloads/Me...oolbarDemo.zip

Olaf
↧

Populate Unique Number Array

May 25, 2014, 2:53 pm
$
0
0
Hello everyone I thought I'd post an example in the codebank since I see this asked by different people about every week. This function returns an array of Unique numbers from a specific number to a specific number.

For example you need 20 unique numbers (no numbers can be the same) from 1 to 80 .
Code:
Private Function UniqueNumberArray(FromNumber As Integer, ToNumber As Integer, ArraySize As Integer) As Integer()
Dim RndCol As New Collection
Dim RndArr() As Integer
Dim RndNum As Integer
Dim i As Integer
 
  Randomize
 
    ReDim RndArr(ArraySize - 1)
 
    For i = FromNumber To ToNumber
      RndCol.Add CStr(i)
    Next
   
    For i = 0 To ArraySize - 1
      RndNum = ((RndCol.Count - 1) - FromNumber + 1) * Rnd + FromNumber
      RndArr(i) = RndCol.Item(RndNum)
      RndCol.Remove RndNum
    Next
 
  UniqueNumberArray = RndArr
End Function

Private Sub Command1_Click()
Dim MyUniqueNumbers() As Integer
Dim i As Integer
  MyUniqueNumbers = UniqueNumberArray(1,80,20)
  For i = 0 to 19 'It will be indexed from 0, so 20 numbers (0 to 19)
    Debug.Print MyUniqueNumbers(i)
  next
End Sub
Please feel free to post more functions similar to this one, since we keep repeating ourselves we could simply tell them to go to this codebank link and study how to do it.
↧

A Listbox for millions items and transparent background

June 7, 2014, 6:29 am
$
0
0


This is my glist a big listbox as you see!

New,
This is the right version, wich is very fast for adding 1000000 items, and Vscroll bar using "logical lines" no lines (the visible lines of the usercontrol).
Attached Files
↧
Viewing all 1321 articles
Browse latest View live
More Pages to Explore .....
Search

Latest Images

National Poetry Month 2024: Maxine Starr

National Poetry Month 2024: Maxine Starr

April 19, 2024, 9:56 am
Vegan Chicken Pot Pie

Vegan Chicken Pot Pie

April 19, 2024, 9:18 am
Firefox UX: On Purpose: Collectively Defining Our Team’s Mission Statement

Firefox UX: On Purpose: Collectively Defining Our Team’s Mission Statement

April 19, 2024, 7:03 am
New $4.5 million East Bay trail path will connect bicyclists, pedestrians to...

New $4.5 million East Bay trail path will connect bicyclists, pedestrians to...

April 18, 2024, 11:05 am
Photographer Gifts for Clients / Print Packaging / 4x6 Photo Box by...

Photographer Gifts for Clients / Print Packaging / 4x6 Photo Box by...

April 17, 2024, 6:48 pm
Deepfake Video of Aamir Khan circulates Online

Deepfake Video of Aamir Khan circulates Online

April 17, 2024, 3:07 am
Very Hungry Caterpillar™ Shirt: World of Eric Carle™+ Little Goodall by...

Very Hungry Caterpillar™ Shirt: World of Eric Carle™+ Little Goodall by...

April 14, 2024, 8:14 am
Have you seen Michael Wines? Burien man has been missing since Saturday,...

Have you seen Michael Wines? Burien man has been missing since Saturday,...

April 12, 2024, 3:59 pm
Stay Salty POTS Awareness Stretchy Stacking Bracelets | Set of Three|...

Stay Salty POTS Awareness Stretchy Stacking Bracelets | Set of Three|...

April 11, 2024, 5:27 pm
19 Reader-Favourite March Purchases — From Steals To Splurges

19 Reader-Favourite March Purchases — From Steals To Splurges

April 11, 2024, 5:07 am