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

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
↧
Search

[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
↧
↧

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
↧
Search

Μ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
↧
↧

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!
Attached Files
↧

AlphaBlend and Per Pixel Alpha Help needed

June 7, 2014, 7:49 am
$
0
0
Hi,

Im currently using the Alphablend API for full image alphablending from a source DC to a dest DC, and am aware that you can set its parameter to do per pixel also.

A ton of questions;

1. Is the blending done based on the source alpha only, or does it take into consideration the dest alpha channel and average it out with the result dest alpha being replaced?

2. Premultiplied Alpha for the RGB values are required I read, so does this mean I need to convert a typical RGB with alpha channel image (such as a non premultiplied PNG) prior to getting the effect I need and if im running in 32bpp, does my DC store the image as a premultiplied RGB?

3. I've noticed hardware acceleration applies to the Alphablend API on Windows 7/8, however, I seem to only get this when I work with a source/dest DC that belongs to a form, if I create an offscreen DC through the API, I seem to loose hardware acceleration. I presume this is because hardware acceleration is tied to the WDDM, and any DC's not considered a program window aren't kept in video memory. Is there anyway I can circumvent this, to force a API created DC to be treated like a form's DC and remain hardware accelerated.

4. Hardware acceleration does not apply to GDI+, only GDI API. From what I read the BitBlt, StretchBlt, TransparentBlt and AlphaBlend functions are hw accelerated. TrueType fonts are supposed to be hardware accelerated as well I hear, so I guess api like TextOut is as well. I presume calls to SetPixel(v)/GetPixel result in a surface lock/unlock per call similar to if one was working with a surface in directdraw and thus should be avoided?

Cheers!

Tim
↧
Search

VB6 - SMTP Relay

June 7, 2014, 10:23 pm
$
0
0
SMTPRelay is a Relay or Proxy server for sending email, and was born of the need to send email from a PC that is not connected to the Internet, but is a member of a private network with access to the Internet. It consists of 3 projects, all of which use the Unicode compatible NewSocket Class.

prjRelay is more or less a demonstration program. By default there is no SMTP Server defined, and the program responds with it's own SMTP responses. Remove the comment on the 'Server = "smtp.isp.net" line and add your own SMTP server. Then Telnet or use an email program from elsewhere on the network on port 25. The program should relay an email similar to:
<-- 220 cmta14.telus.net TELUS ESMTP server ready
--> HELO me
<-- 250 cmta14.telus.net hello [206.116.168.96], pleased to meet you
--> MAIL FROM: <xxxxxxx@telus.net>
<-- 250 2.1.0 <xxxxxxx@telus.net> sender ok
--> RCPT TO: xxxxxxx@pobox.com>
<-- 250 2.1.5 <xxxxxxx@pobox.com> recipient ok
--> DATA
<-- 354 enter mail, end with "." on a line by itself
--> To: <xxxxxxx@pobox.com>
--> From: <xxxxxxx@telus.net>
--> Subject: Test Message!
-->
Testing SMTP server speed!
--> .
<-- 250 2.0.0 BUdk1o00E257f4m01UdkC4 mail accepted for delivery
--> QUIT
<-- 221 2.0.0 cmta14.telus.net TELUS closing connection

prjSRSvc is the same thing without the ability to produce it's own responses, but is designed to run as a service. There are no visible forms or controls, and the SMTP Server, the Listening Port, and the Connecting Port are all defined in the registry. A word of caution is necessary here. When compiled, installed as a service, and activated, it will not automatically update the Windows Firewall (at least not in Win 8.1). To facilitate this, run the compiled executable directly. You will have to use the Task Manager or reboot the system to shut the program down as there is no visible interface.

prjInterface is the visible program used to manage the service. It will Install/Uninstall the service, Start/Stop the service, and Setup the registry values. Because the registry entries are in a section of the registry to which the System has access, it must be run in Administrative Mode. It uses the Microsoft NTService Control, which is readily available on the Internet.

J.A. Coutts
Attached Files
↧

VB6 Cairo-Blending-Performance (Collision-Handling using the Physics-Engine)

June 8, 2014, 8:44 am
$
0
0
A small Demo, referring to the Blending-comparison-thread here:
http://www.vbforums.com/showthread.p...-Cairo-Drawing

Now covering a more realistic "2D-game-scenario" with 12 moving PNG-Sprites (5 larger and 7 smaller ones),
which constantly change their Pixel-Contents whilst moving around on a more realistic gaming-surface-size
in the range of 1024x768 Pixels (each Sprite also updating itself with a Text-Rendering, showing the Collision-
Count it encountered so far).

What Cairo achieves with that amount of semitransparently rendered Sprites is about 250FPS
(measured on Win 8.1, on a 2.1GHz Intel-Mobile-CPU, singlethreaded) - whilst codewise consisting
of only about 40 lines in cBall.cls and about 60 lines of code in fTest.frm.

So the measured 250FPS in this scenario leave enough room for a lot more Sprites in the Game-Loop
(especially when those Sprites are not as large as the ones I've choosen here).

I consider that quite a good compromise between "convenient coding of complex graphics-stuff" -
and achievable 2D-game-performance.

Here's the Demo-Sources: http://vbRichClient.com/Downloads/Ca...erformance.zip

And here a ScreenShot:


Olaf
↧
↧

Using a cDibsection to paint, view and print bitmap

June 9, 2014, 6:14 am
$
0
0
This is an example of using a cDIBsection (based on code founded in vbAccelaratior.com) that I extend with some functionality to paint on it directly in a window in a scale defined by presets fit to width, 1:1, 100% etc.
With shift and mouse click you can paint and scroll the window to the edges of bitmap. You can use keyboard to write directly on cDIBsection. The painting procedure is like a brush with transparent feel.

For printing I have a way to hold all the parameters of a print properties dialog, and use them for printing the bitmap.

Enjoy it.
Attached Files
↧

[VB6] Generic Delimited Text File Reader

June 10, 2014, 11:05 pm
$
0
0
ReadDelimited

This is a simple Function defined within the DelimitedText.bas module.

You pass it a file name of a delimited text columnar data file along with a number of other parameters and get back a 2-dimensional Variant array of data.

Features

  • Only reads ANSI files where lines/rows are delimited by Cr or CrLf, since it uses Line Input # to read the lines.
  • Delimiter can be comma, Tab, etc.
  • First row can define the number of columns, or you can specify a "hard" number of columns. Extra columns are ignored, missing columns are left Empty. Probably best when used without type conversion, but you could enhance this function to accept an array of default values to use.
  • Optionally can parse the first row as column headers.
  • Optionally can convert column data types from String to an array of specified types (vbLong, vbDate, etc.).
  • Conversion can be done for specific locales to handle alternate decimal point symbols and date formats.
  • Quotes (") are parsed off to allow delimiter characters within values, optionally this can be overriddden to retain quotes as part of the data.


Miscelleneous

Little effort has gone into optimization. The relatively slow Split() function is used extensively here.

The module is attached here within a demo project that dumps the result into a flexgrid control for viewing, along with some sample data files.

Name: sshot.png Views: 41 Size: 13.2 KB
Attached Images
 
Attached Files
↧

[VB6] Send mail via Command Line ( No Dependencies )

June 11, 2014, 11:45 am
$
0
0
Command Line Emailing using Windows CDO.Message

This will allow developers \ coders \ whoever, to send basic email using a shell \ shellexecute \ batch file.

You may also use this to send attachments, html pages, etc although it will require some additional coding
(i left very detailed instruction and functions to make it as easy as possible to manipulate)

the Module is found on github, with all comments and explanations.

https://github.com/StavM/Send-eMail-...ommandline.bas

you may compile, and use the Windows Command Prompt to run it and pass parameters as described in the example below

Module
Code:
Attribute VB_Name = "cmdMailModule"
'Command prompt \ Command line mailing executable by Stav Mann. ® Stavmann2@gmail.com
'Open-Source, you may use as you wish.
'Visual Basic 6.0

'Usage:
'Important: You can not just run this through the Visual Basic IDE, you must compile and use the Command-Line to pass parameters !

'To use this, start your Visual Studio IDE and load the .vbp file \ emailFromCommandline.bas file
'If the mail account you wish to use to send the mail is not Gmail, make sure you change settings and credentials on the function.
'Compile to .exe
'
'Shell from vb \ from a command line using this syntax for your Gmail account (use your own credentials to test this if you want):
'<File Path> user=USERNAME pass=PASSWORD mail=Sendto@mail.com from=Sentfrom@mail.com subj=Subject body=This Is The Body of the letter

'P.S HTML tags work flawlessly here, so if you wish to make a new line of text, just type in a <BR> tag.

'Example:
'C:\cmdMail.exe user=myGmailUsername pass=myGmailPassword mail=stavmann2@gmail.com from=mail@mail.com subj=Hello This-Is A Subject body=This Is The Mail Body.<BR><BR>Good-Bye :)


Option Explicit

Private Const cmdUSER As String = "user="      'SMTP Username
Private Const cmdPASS As String = "pass="      'SMTP Password
Private Const cmdMAIL As String = "mail="      'Targeted eMail address (Must have legit email address template (mail@domain.com) )
Private Const cmdFROM As String = "from="      '"Replay To" address    (Must have legit email address template (mail@domain.com) )
Private Const cmdSUBJ As String = "subj="      'eMail Subject
Private Const cmdBODY As String = "body="      'eMail Body
Private Const cmdEND  As String = "=END="      'eMail Body

Public Sub Main()

'The idea is to simply grab the parameters, and split them to text strings, and then implement them straight to the mailing function.
'if went well, Msgbox (Mail Sent), Else Msgbox Error (written in the mailing function itself)

If mailSend(Trim(GetBetween(cmdUSER, cmdPASS)), _
            Trim(GetBetween(cmdPASS, cmdMAIL)), _
            Trim(GetBetween(cmdMAIL, cmdFROM)), _
            GetBetween(cmdFROM, cmdSUBJ), _
            GetBetween(cmdSUBJ, cmdBODY), _
            GetBetween(cmdBODY, cmdEND) _
            ) = 0 Then Call MsgBox("Mail Sent!", vbInformation)
     
End Sub



Private Function mailSend(xUsername, xPassword, xMailTo, xFrom, xSubject, xMainText) As Integer

Dim msgA As Object 'declare the CDO
Set msgA = CreateObject("CDO.Message") 'set the CDO to reffer as CDO.Message (microsoft default object that can be found on almost all windows versions since vista by default)
   
    msgA.To = xMailTo 'get targeted mail from command
    msgA.Subject = xSubject 'get subject from command
    msgA.HTMLBody = xMainText 'Main Text - You may use HTML tags here, for example <BR> to immitate "VBCRLF" (start new line) etc.
    msgA.From = xFrom 'The from part, make sure its syntax template is a valid mail one, user@domain.com, or something.
   
    'Notice, i simplified it, however, you may use more values depending on your needs, such as:
    '.Bcc = "mail@mail.com" ' - BCC..
    '.Cc = "mail@mail.com" ' - CC..
    '.CreateMHTMLBody ("www.mywebsite.com/index.html) 'send an entire webpage from a site
    '.CreateMHTMLBody ("c:\program files\download.htm) 'Send an entire webpage from your PC
    '.AddAttachment ("c:\myfile.zip") 'Send a file from your pc (notice uploading may take a while depending on your connection)

   
    'Gmail Username (from which mail will be sent)
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = xUsername
    'Gmail Password
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = xPassword
   
    'Mail Server address.
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
   
    'To set SMTP over the network = 2
    'To set Local SMTP = 1
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
   
    'Type of Authenthication
    '0 - None
    '1 - Base 64 encoded (Normal)
    '2 - NTLM
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
   
    'Outgoing Port
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
   
    'Send using SSL True\False
    msgA.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
   
    'Update values of the SMTP configuration
    msgA.Configuration.Fields.Update
   
    'Send it.
    msgA.Send
   
    mailSend = Err.Number
        If Err.Number <> 0 Then Call MsgBox("Mail delivery failed: " & Err.Description, vbExclamation)
 
End Function


Private Function GetBetween(strOne As String, strTwo As String) As String

'Grab parameters as a whole, and place the line of text on strBody, in addition to the END-OF-PARAMETERS Flag called cmdEnd.
Dim strBody As String
    strBody = Command$ & cmdEND

'Locate each word's location within strBody, if its not found, don't continue.
Dim lngLocationOne As Long
Dim lngLocationTwo As Long
   
lngLocationOne = InStr(1, strBody, strOne, vbTextCompare)
    If (lngLocationOne = 0) Then GoTo ErrHandle
   
lngLocationTwo = InStr(1, strBody, strTwo, vbTextCompare)
    If (lngLocationTwo = 0) Then GoTo ErrHandle

'Grab a parameter value and return it.
GetBetween = Mid(strBody, lngLocationOne + Len(strOne), (lngLocationTwo - lngLocationOne - Len(strOne)))
       
Exit Function
ErrHandle:
    GetBetween = vbNullString

End Function
Usage:
Code:
Private Sub Form_Load()

    Shell ("C:\cmdMail.exe user=myGmailUsername pass=myGmailPassword mail=target-mail@mail.com from=my@mail.com subj=Hello This-Is A Subject body=This Is The Mail Body.<BR><BR>Good-Bye :)")

End Sub
↧
Viewing all 1496 articles
Browse latest View live
Search
<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>