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

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

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
↧

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

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

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
↧

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

[VB6] Formatted Text Record Parser

June 12, 2014, 1:32 pm
$
0
0
FormattedText

This is a Class for use in parsing data fields from fixed-format records based on one or more simple "Fortran like" format strings.

You assign the LCID to be used for conversion, defaulting to the current user's locale settings. Then assign one or more RecordFormat(n) properties to formatting strings.

Then read your raw records from a file line by line as text and call the ParseRecord() method, passing the String, a Variant array to receive the parsed values, and the format index for the format to be applied to the record.


RecordFormat Strings

These consist of a comma-separated list of optional "repeat counts", "type" characters, and field lengths in characters. Missing or non-numeric repeat count or length values are treated as 1.

Types and Pseudotypes:

X - "filler" (skipped, not returned as a field value)
S - String
T - String (trimmed)
I - Integer
L - Long
R - "real" (Single)
D - Double
B - Boolean
H - Hex (Long)
C - "chron" (Date) for date and time values

The Boolean type requires a field length at least as long as the localized words used for True and False (i.e. 5 for English). If you need to handle a field using T and F for example, make it a String field and test it yourself after parsing each record.

Examples:

"X3,S10,T10,C10,C19,R13,B6,H8"
"7T11"
"R10, 17R13"

The RecordFormat property expects an index value from 0 to n, allowing you to set up multiple formats before you being parsing records.

Demos

The attached archive contains FormattedText.cls along with two demo Projects FmtText1 and FmtTest2 along with sample data.

FmtTest1 scans its way through a file of mixed record types and locates and extracts column headings and data values, putting the data into a 2-dimensional array with lower bounds of 1 instead of 0. Then this information is dumped to a flexgrid for viewing.

FmtTest2 reads a much simpler file containing several kinds of fields. It is also a German file where values are localized using German OLE conventions for data conversion from text.

In both cases the dumped data is displayed using current locale settings.
Attached Files
↧

A Listbox for millions items, transparent background, and changeable charset

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).

I add a new form to show how this listbox help to have previews when scroll the caret by mouse movemnet, and that previews are labels which response to a click event and perform software selection on the list. When the move is fast then the previews are not changed. So if that was images the walking through the list can be done without time consuming image preview for each item. When we select an item form preview list then the selection didn't fire a "selected" event but a "softselected" so maybe we can leave it without code...What we want is done, no selected event produced and that is right because the selection was made by preview list for a list item.

glistCharset shows how you can have any charset to your listbox...(ordinary listbox they don't change charset even they change the property). I change font to Verdana (unicode) and a put several charset, kyrilic, tourkish...etc
Name: listbox.JPG Views: 21 Size: 22.5 KB
Attached Images
 
Attached Files
↧
↧

Simplest way to read a joystick in VB6

June 16, 2014, 10:40 pm
$
0
0
This uses the Windows API.

Below is the code. Place this code your form (Form1), and place a timer control (Timer1) and picturebox control (Picture1) in on the form. Set the timer interval property to 1 (1ms). Set the scalemode property for both the form and the picturebox to Pixels, and set the autoredraw property on both also to tru. Set the picturebox appearance property to flat, borderstyle to none, and fillstyle to solid.

Code:
Private Const JOY_RETURNBUTTONS As Long = &H80&
Private Const JOY_RETURNCENTERED As Long = &H400&
Private Const JOY_RETURNPOV As Long = &H40&
Private Const JOY_RETURNPOVCTS As Long = &H200&
Private Const JOY_RETURNR As Long = &H8&
Private Const JOY_RETURNRAWDATA As Long = &H100&
Private Const JOY_RETURNU As Long = &H10
Private Const JOY_RETURNV As Long = &H20
Private Const JOY_RETURNX As Long = &H1&
Private Const JOY_RETURNY As Long = &H2&
Private Const JOY_RETURNZ As Long = &H4&
Private Const JOY_RETURNALL As Long = (JOY_RETURNX Or JOY_RETURNY Or JOY_RETURNZ Or JOY_RETURNR Or JOY_RETURNU Or JOY_RETURNV Or JOY_RETURNPOV Or JOY_RETURNBUTTONS)

Private Type JOYINFOEX
    dwSize As Long ' size of structure
    dwFlags As Long ' flags to dicate what to return
    dwXpos As Long ' x position
    dwYpos As Long ' y position
    dwZpos As Long ' z position
    dwRpos As Long ' rudder/4th axis position
    dwUpos As Long ' 5th axis position
    dwVpos As Long ' 6th axis position
    dwButtons As Long ' button states
    dwButtonNumber As Long ' current button number pressed
    dwPOV As Long ' point of view state
    dwReserved1 As Long ' reserved for communication between winmm driver
    dwReserved2 As Long ' reserved for future expansion
End Type

Private Declare Function joyGetPosEx Lib "winmm.dll" (ByVal uJoyID As Long, ByRef pji As JOYINFOEX) As Long

Dim JI As JOYINFOEX

Const JNum As Long = 0
'Set this to the number of the joystick that
'you want to read (a value between 0 and 15).
'The first joystick plugged in is number 0.
'The API for reading joysticks supports up to
'16 simultaniously plugged in joysticks.
'Change this Const to a Dim if you want to set
'it at runtime.

Private Sub Form_Load()
JI.dwSize = Len(JI)
JI.dwFlags = JOY_RETURNALL
End Sub

Private Sub Timer1_Timer()
Cls
If joyGetPosEx(JNum, JI) <> 0 Then
    Print "Joystick #"; CStr(JNum); " is not plugged in, or is not working."
Else
    With JI
        Print "X = "; CStr(.dwXpos)
        Print "Y = "; CStr(.dwYpos)
        Print "Z = "; CStr(.dwZpos)
        Print "R = "; CStr(.dwRpos)
        Print "U = "; CStr(.dwUpos)
        Print "V = "; CStr(.dwVpos)
        If .dwPOV < &HFFFF& Then Print "PovAngle = "; CStr(.dwPOV / 100) Else Print "PovCentered"
        Print "ButtonsPressedCount = "; CStr(.dwButtonNumber)
        Print "ButtonBinaryFlags = "; CStr(.dwButtons)
        Picture1.Cls
        Picture1.Circle (.dwXpos / &HFFFF& * (Picture1.Width - 1), .dwYpos / &HFFFF& * (Picture1.Height - 1)), 2
    End With
End If
End Sub
Then run it. If you have a joystick plugged in it will show all the values for the joysticks controls (all axes, all buttons, and POV hat). All controls that are not supported by the device remain zero. If the joystick with the set number isn't plugged in (or doesn't work), then an error message will display. It will immediately start displaying joystick data though the moment a working josystick is plugged in.
↧

Convert your application to Shareware (many ways..)

June 17, 2014, 10:06 am
$
0
0
This project is created in vb6 for converting your vb6 compiled exe's to shareware you can set expiry to days,counts or date..you can set trial key or full secret codes to unlock the application.Just take a view Download it write a comment below :)
P.S: i don't know the original author of this project but I'm not :D
Attached Files
↧

VB6 - Add System DSN

June 18, 2014, 8:03 pm
$
0
0
Microsoft recommends that application data for "All Users" use the "ProgramData" directory. But if you have ever tried to create a DSN in this directory using the ODBC Manager, you have discovered that directory is not available. The reason is that particular directory is configured as hidden. But it is quite easy to do it programatically.
Code:
Option Explicit

Private DataPath As String
Private DataBase As String
Private AllUserPath As String
Private adoConn1 As ADODB.Connection
Private ADOConnStr1 As String

Private Const ODBC_ADD_DSN = 1      ' Add user data source
Private Const ODBC_CONFIG_DSN = 2  ' Modify user data source
Private Const ODBC_REMOVE_DSN = 3  ' Delete user data source
Private Const ODBC_ADD_SYS_DSN = 4  ' System DSN functions only work
Private Const ODBC_CONFIG_SYS_DSN = 5 ' when logged in as administrator
Private Const ODBC_REMOVE_SYS_DSN = 6
Private Const ODBC_REMOVE_DEFAULT_DSN = 7

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002

Private Function SQLConfigDataSource Lib "odbccp32.dll" (ByVal hWndParent As Long, ByVal fRequest As Long, ByVal lpszDriver As String, ByVal lpszAttributes As String) As Long

Private Function LocalInit() As Long
' Purpose:
'  Starting point for application.
' =====================================================
    Dim TaskID As Long
    Dim sErr As Variant
    Const sProc As String = "LocalInit"
    On Error GoTo LocalInitErr
    DataBase = "New_DB"
    AllUserPath = "C:\ProgramData\NewApp\"
    DataPath = AllUserPath & "NewDB.mdb"
    'Verify database exists
    TaskID = TestFile(AllUserPath, "NewDB.mdb")
    If Not GetDSN(DataBase, "Microsoft Access Driver (*.mdb)", DataPath, ODBC_ADD_SYS_DSN) Then
        Err.Raise 53 'File Not Found
    End If
    ADOConnStr1 = "DSN=" + DataBase + ";uid=;pwd=;database='tblNew';"
    Set adoConn1 = CreateObject("ADODB.Connection")
    adoConn1.Open ADOConnStr1
    LocalInit = False
    Exit Function
LocalInitErr:
    sErr = Err
    LocalInit = sErr
End Function

Private Function TestFile(PathName As String, FileName As String) As Boolean
    Dim lngRet As Long
    On Error GoTo TestFileErr
    If Len(Dir(PathName & FileName)) = 0 Then
        MkDir AllUserPath
        lngRet = MsgBox("Database not Found!" & vbCrLf & "Copy blank one?", vbYesNo)
        If lngRet = vbYes Then
            FileCopy App.Path & "\NewDB.mdb.org", PathName & FileName
        End If
    End If
    Exit Function
TestFileErr:
    If Err = 75 Then Resume Next
End Function

Private Function GetDSN(sDSN As String, sDriver As String, sDBFile As String, lAction As Long) As Long
    Dim sAttributes As String
    Dim sDBQ As String
    Dim lngRet As Long
    Dim hKey As Long
    Dim regValue As String
    Dim valueType As Long
    ' query the Registry to check whether the DSN is already installed
    ' open the key
    sDBQ = RegQuery(HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" + sDSN, "DBQ")
    If Left$(sDBQ, 11) = "No Such Key" Then
        If Len(sDBFile) Then 'File path/name supplied
            lngRet = MsgBox(sDBQ & vbCrLf & "CREATE IT?", vbYesNo)
            If lngRet = vbYes Then
                sDBQ = ""
            Else
                'Routine failed
                GetDSN = False
                Exit Function
            End If
        Else 'No file name supplied
            GetDSN = False
            Exit Function
        End If
    End If
    If Len(sDBQ) Then 'DBQ found
        If lAction = ODBC_ADD_SYS_DSN Or lAction = ODBC_ADD_DSN Then
            'Verify file actually exists
            If Len(Dir$(sDBFile)) Then
                'Simply return DBQ
                sDBFile = sDBQ
                GetDSN = True
                Exit Function
            Else 'return error
                GetDSN = False
                Exit Function
            End If
        Else 'Delete it
            sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
            lngRet = SQLConfigDataSource(0&, lAction, sDriver, sAttributes)
        End If
    Else 'Add it
        ' check that the file actually exists
        If Len(sDBFile) > 0 And Len(Dir$(sDBFile)) Then 'create DSN
            sAttributes = "DSN=" & sDSN & vbNullChar & "DBQ=" & sDBFile & vbNullChar
            lngRet = SQLConfigDataSource(0&, lAction, sDriver, sAttributes)
        Else 'Return with error
            MsgBox "Database file doesn't exist!", vbOKOnly + vbCritical
            GetDSN = False
            Exit Function
        End If
    End If
    If lngRet Then
        GetDSN = True
    Else
        GetDSN = False
    End If
End Function
Microsoft still does not offer 64 bit drivers for anything but SQLServer, but at least Win 8.1 shows both the 32 bit & 64 bit ODBC Managers.

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