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

[VB6] GDI+ Workaround: TIFF > JPEG-compressed images

0
0
Note: Tests of successful loading of the image without applying the workaround have been done on various O/S. This patch may not be required on Win7 and above

You probably know that GDI+ is useful for loading various image formats, but GDI+ also has issues with every format it loads. For TIFFs specifically, one of the compression options it won't support is JPEG compression. Well, GDI+ does support loading/writing JPEGs, so it isn't that difficult to get these JPEG pages loaded when all is said and done.

The attached txt file is a VB class. After you save it to disk, rename it to .cls
I've also included a JPEG encoded TIFF file for you to play with, but they aren't that hard to find on the web.

A note here. I did not attempt to handle JPEG-6 compression, just JPEG-7. The v6 is pretty old nowadays and if I find the time, maybe I'll play with it. Only have 1 example with v6 encoding, most you will find now is v7.

So, to play.
1) Download the txt file & rename it .cls
2) Create a new project and add that class to your project
3) On your form, add two controls: combobox and commandbutton
4) Set the combobox style to 2
5) Paste this code to your form & run project
6) Drag/drop a TIFF onto the form
Code:

Option Explicit

Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "GdiPlus.dll" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal srcX As Long, ByVal srcY As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "GdiPlus.dll" (ByVal hDC As Long, hGraphics As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long
Private Type GdiplusStartupInput
    GdiplusVersion          As Long
    DebugEventCallback      As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs  As Long
End Type

Private m_Token As Long
Private m_TIFF As cTIFFreader

Private Sub Form_Load()
    If Me.Combo1.Style <> 2 Then
        Me.Show
        DoEvents
        MsgBox "The combo box must be set to Style=2", vbExclamation + vbOKOnly
        Unload Me
        Exit Sub
    End If

    Call pvCreateToken
    If m_Token = 0 Or m_Token = -1 Then
        Me.Show
        DoEvents
        MsgBox "Failed to start up GDI+", vbExclamation + vbOKOnly
        Unload Me
        Exit Sub
    End If
    Set m_TIFF = New cTIFFreader
   
    Me.Move (Screen.Width - 10245) \ 2, (Screen.Height - 6585) \ 2, 10245, 6585
    Me.ScaleMode = vbPixels
    Me.Combo1.Move 0, 0, Me.ScaleWidth \ 2
    Me.Command1.Move Me.Combo1.Width + 6, 0, Me.Command1.Width, Me.Combo1.Height
    Me.Command1.Caption = "Refresh"
    Me.OLEDropMode = vbOLEDropManual
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set m_TIFF = Nothing
    If Not (m_Token = 0& Or m_Token = -1&) Then pvDestroyToken
End Sub

Private Function pvCreateToken() As Boolean
    Dim GSI As GdiplusStartupInput
    On Error Resume Next
    If Not m_Token = -1 Then
        GSI.GdiplusVersion = 1&
        Call GdiplusStartup(m_Token, GSI)
        If m_Token = 0 Then
            m_Token = -1&
        Else
            pvCreateToken = True
        End If
    End If
End Function

Private Sub pvDestroyToken()
    If Not (m_Token = 0 Or m_Token = -1) Then GdiplusShutdown m_Token
    m_Token = 0&
End Sub

Private Sub Command1_Click()
    Call Combo1_Click
End Sub

Private Sub Combo1_Click()
    If Not m_TIFF.ImageCount = 0& Then
       
        Dim hGraphics As Long, w As Long, h As Long, sngRatio As Single
        Dim x As Long, Y As Long, cx As Long, cy As Long
        Const UnitPixel As Long = 2&
       
        m_TIFF.Index = Combo1.ListIndex + 1
        w = m_TIFF.Width
        h = m_TIFF.Height
        cy = Me.ScaleHeight - Combo1.Height
        If Me.ScaleWidth / w > cy / h Then
            sngRatio = cy / h
        Else
            sngRatio = Me.ScaleWidth / w
        End If
        If sngRatio > 1! Then sngRatio = 1&
        cx = w * sngRatio
        cy = h * sngRatio
        x = (Me.ScaleWidth - cx) \ 2
        Y = ((Me.ScaleHeight - Combo1.Height) - cy) \ 2 + Combo1.Height
       
        Me.Cls
        GdipCreateFromHDC Me.hDC, hGraphics
        GdipDrawImageRectRectI hGraphics, m_TIFF.Handle, x, Y, cx, cy, 0, 0, w, h, UnitPixel, 0, 0, 0
        GdipDeleteGraphics hGraphics
    End If
End Sub

Private Sub pvReset()
    Dim t As Long, sItem As String
    Combo1.Clear
    For t = 1 To m_TIFF.ImageCount
        sItem = t & ". " & m_TIFF.Width(t) & " x " & m_TIFF.Height(t)
        sItem = sItem & "  DPI: " & CLng(m_TIFF.DPI_Horizontal(t)) & " x " & CLng(m_TIFF.DPI_Vertical(t))
        Combo1.AddItem sItem
    Next
    If Combo1.ListCount Then
        Combo1.ListIndex = 0
    Else
        MsgBox "No images were loaded"
    End If
End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Data.Files.Count Then
        m_TIFF.FileName = Data.Files.Item(1)
        Call pvReset
    End If
End Sub

See Also:
GDI+ Workaround: JPG > Zero-Length APP Markers
GDI+ Workaround: BMP > Alpha Channels + JPG/PNG Encoded

Edited: If interested how the class works, please spend some time and review the numerous comments throughout the attached class
Attached Files

[VB6] GDI+ Workaround: JPG > Zero-Length APP Markers

0
0
Note: Tests of successful loading of the image without applying the workaround have been done on various O/S. This patch may not be required on Win7 and above

You probably know that GDI+ is useful for loading various image formats, but GDI+ also has issues with every format it loads. For JPGs specifically, if certain APP markers within the file have zero length data then one of two things can happen: 1) image won't load or 2) image loads, but the size reported by GDI+ is 0x0

The attached txt file is a VB class. After you save it to disk, rename it to .cls
I've also included a JPG with a zero-length APP marker.

So, to play.
1) Download the txt file & rename it .cls
2) Create a new project and add that class to your project
3) On the form, add a commandbutton
4) Paste this code to your form & run project
5) Drag/drop a JPG onto the form
Code:

Option Explicit

Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "GdiPlus.dll" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal srcX As Long, ByVal srcY As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "GdiPlus.dll" (ByVal hDC As Long, hGraphics As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long
Private Type GdiplusStartupInput
    GdiplusVersion          As Long
    DebugEventCallback      As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs  As Long
End Type

Private m_Token As Long
Private m_JPG As cJPGreader

Private Sub Form_Load()
   
    Call pvCreateToken
    If m_Token = 0 Or m_Token = -1 Then
        Me.Show
        DoEvents
        MsgBox "Failed to start up GDI+", vbExclamation + vbOKOnly
        Unload Me
        Exit Sub
    End If
    Set m_JPG = New cJPGreader
   
    Me.Move (Screen.Width - 10245) \ 2, (Screen.Height - 6585) \ 2, 10245, 6585
    Me.ScaleMode = vbPixels
    Me.Command1.Move 0, 0
    Me.Command1.Caption = "Refresh"
    Me.OLEDropMode = vbOLEDropManual
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set m_JPG = Nothing
    If Not (m_Token = 0& Or m_Token = -1&) Then pvDestroyToken
End Sub

Private Function pvCreateToken() As Boolean
    Dim GSI As GdiplusStartupInput
    On Error Resume Next
    If Not m_Token = -1 Then
        GSI.GdiplusVersion = 1&
        Call GdiplusStartup(m_Token, GSI)
        If m_Token = 0 Then
            m_Token = -1&
        Else
            pvCreateToken = True
        End If
    End If
End Function

Private Sub pvDestroyToken()
    If Not (m_Token = 0 Or m_Token = -1) Then GdiplusShutdown m_Token
    m_Token = 0&
End Sub

Private Sub Command1_Click()
    Call pvRenderImage
End Sub

Private Sub pvRenderImage()
    If Not m_JPG.Handle = 0& Then
       
        Dim hGraphics As Long, w As Long, h As Long, sngRatio As Single
        Dim x As Long, Y As Long, cx As Long, cy As Long
        Const UnitPixel As Long = 2&
       
        w = m_JPG.Width
        h = m_JPG.Height
        cy = Me.ScaleHeight - Command1.Height
        If Me.ScaleWidth / w > cy / h Then
            sngRatio = cy / h
        Else
            sngRatio = Me.ScaleWidth / w
        End If
        If sngRatio > 1! Then sngRatio = 1&
        cx = w * sngRatio
        cy = h * sngRatio
        x = (Me.ScaleWidth - cx) \ 2
        Y = ((Me.ScaleHeight - Command1.Height) - cy) \ 2 + Command1.Height
       
        Me.Cls
        GdipCreateFromHDC Me.hDC, hGraphics
        GdipDrawImageRectRectI hGraphics, m_JPG.Handle, x, Y, cx, cy, 0, 0, w, h, UnitPixel, 0, 0, 0
        GdipDeleteGraphics hGraphics
    End If

End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Data.Files.Count Then
        m_JPG.FileName = Data.Files.Item(1)
        Call pvRenderImage
    End If
End Sub

See also:
GDI+ Workaround: TIFF > JPEG-compressed images
GDI+ Workaround: BMP > Alpha Channels + JPG/PNG Encoded
Attached Files

[VB6] GDI+ Workaround: BMP > Alpha Channels + JPG/PNG Encoded

0
0
Note: Tests of successful loading of the image without applying the workaround have been done on various O/S. This patch appears to be required on Win7 and lower. Win8 not yet tested

You probably know that GDI+ is useful for loading various image formats, but GDI+ also has issues with every format it loads. For BMPs specifically, GDI+ has 1 major flaw in my opinion and another minor one:

a) Translucent bitmaps. 32 bit, 4 bytes per pixel, bitmaps can contain transparency just like other modern image formats. However, when GDI+ loads these, it reports back that the image format does not use the alpha channel even when the image actually does use it. This issue presents itself whether the RGB components are premultiplied against the alpha channel or not.

b) PNG/JPG embedded bitmaps. Huh? If you aren't aware these are possible, then that's probably why GDI+ doesn't directly support them. Besides, they weren't intended for display anyway, they were intended for printers. Anyway, a JPG or PNG file can be placed in a bitmap as the bitmap's pixel data. The only real change to the bitmap file format is that the bitmap's BitCount property must be zero, its SizeImage property must be the size of the JPG/PNG embedded file and that its Compression property be BI_PNG or BI_JPG as appropriate.

The attached txt file is a VB class. After you save it to disk, rename it to .cls
I've also included 4 bitmaps to play with:
1) One that uses semi-transparency
2) One that uses semi-transparency, but pixels are premultiplied against the alpha channel
3) One that has a JPG embedded into it
4) One that has a PNG embedded into it

So, to play.
1) Download the txt file & rename it .cls
2) Create a new project and add that class to your project
3) On the form, add a commandbutton
4) Paste this code to your form & run project
5) Drag/drop a BMP onto the form
Code:

Option Explicit

Private Declare Function GdipDeleteGraphics Lib "GdiPlus.dll" (ByVal mGraphics As Long) As Long
Private Declare Function GdipDrawImageRectRectI Lib "GdiPlus.dll" (ByVal hGraphics As Long, ByVal hImage As Long, ByVal dstX As Long, ByVal dstY As Long, ByVal dstWidth As Long, ByVal dstHeight As Long, ByVal srcX As Long, ByVal srcY As Long, ByVal srcWidth As Long, ByVal srcHeight As Long, ByVal srcUnit As Long, ByVal imageAttributes As Long, ByVal Callback As Long, ByVal callbackData As Long) As Long
Private Declare Function GdipCreateFromHDC Lib "GdiPlus.dll" (ByVal hDC As Long, hGraphics As Long) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal Token As Long)
Private Declare Function GdiplusStartup Lib "gdiplus" (Token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long
Private Type GdiplusStartupInput
    GdiplusVersion          As Long
    DebugEventCallback      As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs  As Long
End Type

Private m_Token As Long
Private m_BMP As cBMPreader

Private Sub Form_Load()
   
    Call pvCreateToken
    If m_Token = 0 Or m_Token = -1 Then
        Me.Show
        DoEvents
        MsgBox "Failed to start up GDI+", vbExclamation + vbOKOnly
        Unload Me
        Exit Sub
    End If
    Set m_BMP = New cBMPreader
   
    Me.Move (Screen.Width - 10245) \ 2, (Screen.Height - 6585) \ 2, 10245, 6585
    Me.ScaleMode = vbPixels
    Me.Command1.Move 0, 0
    Me.Command1.Caption = "Refresh"
    Me.OLEDropMode = vbOLEDropManual
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set m_BMP = Nothing
    If Not (m_Token = 0& Or m_Token = -1&) Then pvDestroyToken
End Sub

Private Function pvCreateToken() As Boolean
    Dim GSI As GdiplusStartupInput
    On Error Resume Next
    If Not m_Token = -1 Then
        GSI.GdiplusVersion = 1&
        Call GdiplusStartup(m_Token, GSI)
        If m_Token = 0 Then
            m_Token = -1&
        Else
            pvCreateToken = True
        End If
    End If
End Function

Private Sub pvDestroyToken()
    If Not (m_Token = 0 Or m_Token = -1) Then GdiplusShutdown m_Token
    m_Token = 0&
End Sub

Private Sub Command1_Click()
    Call pvRenderImage
End Sub

Private Sub pvRenderImage()
    If Not m_BMP.Handle = 0& Then
       
        Dim hGraphics As Long, w As Long, h As Long, sngRatio As Single
        Dim X As Long, Y As Long, cx As Long, cy As Long
        Const UnitPixel As Long = 2&
       
        w = m_BMP.Width
        h = m_BMP.Height
        cy = Me.ScaleHeight - Command1.Height
        If Me.ScaleWidth / w > cy / h Then
            sngRatio = cy / h
        Else
            sngRatio = Me.ScaleWidth / w
        End If
        If sngRatio > 1! Then sngRatio = 1&
        cx = w * sngRatio
        cy = h * sngRatio
        X = (Me.ScaleWidth - cx) \ 2
        Y = ((Me.ScaleHeight - Command1.Height) - cy) \ 2 + Command1.Height
       
        Me.Cls
        GdipCreateFromHDC Me.hDC, hGraphics
        GdipDrawImageRectRectI hGraphics, m_BMP.Handle, X, Y, cx, cy, 0, 0, w, h, UnitPixel, 0, 0, 0
        GdipDeleteGraphics hGraphics
    End If

End Sub

Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Data.Files.Count Then
        m_BMP.FileName = Data.Files.Item(1)
        Call pvRenderImage
    End If
End Sub

See also:
GDI+ Workaround: JPG > Zero-Length APP Markers
GDI+ Workaround: TIFF > JPEG-compressed images
Attached Files

Search files in folder tree recursively and asynchronously (New Scrollio also)

0
0
This is a simple Viewer for Zooming big images, and an example for scrollio control, LargeBar, dib processing and an example of how to search files in folder tree recursively and asynchronously.

We going a step ahead with this example. Now we can open a folder and we can search in that folder and all folders under that for a list of file types, and saved in a list sorted by time modified, for each folder. This was done with a class using WithEvents.

Also we have an advanced scrollio and an advance largebar. Now with up arrow and down arrow we can zoom the scrollio using equal step of zooming. Now the LargeBar can modified to use for clicking a smallchange as a logarithmic one. LargeChange change as before.
Scrollio now can hide mouse pointer so can display in code in the form (out of scrollio) our drawing as mouse pointer. Also I found the solution for a previously problem, of how with only a mouse move event can simulate the mouse down..So now we can scroll the scrollio in reverse without the starting jump... So now we can move the pointer in any point in the image, with auto scrolling, as we move it. Use shift + control to use the other way of moving, pushing (this is the default is scrollio control and the scrolling at the direction of pointer is out of scrollio, in code in the form and translate the X,Y to the default method. One method for two...). Also shift only or control only... make the move to one axis only.
I use ISHF_Ex.tlb for opening folders dialog.

The new file Viewer2.zip has some minor things changed..

I want this program to run wuth WINE in linux...so I found a way to reduce the entering to mousemove event.
In xp there isn't problem (i run it in a virtualbox) but in linux the time slicing is different.
Code:

Private Sub paper_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Static timestamp As Double
If timestamp = 0 Then timestamp = Timer
If (timestamp + 0.05) > Timer Then Exit Sub
timestamp = Timer

My last problem is the dir function in linux...from wine return the name of file in small letters...(isn't case sensitive). But the paths are ok...l found that some files are readed and other not even they have capital letters both.
Attached Files

Video-Decompression with the VCM (ICM-Win32-API)

0
0
Just a small example, how to use the ICM-API (hosted in msvfw32.dll), to decode
YUV-RawData-Blobs as they may come in from Web- or other Cam-Drivers...

These APIs are still supported also on Win8/Win8.1 - and are wrapped here in a
small Class (cICMDecode.cls).

Two example-RawDataBlobs are contained in the Zip-File ...
- one representing a 640x480 12Bit 4:2:0 Input (460800 Bytes)
- the other a 640x480 16Bit 4:2:2 Input (614400 Bytes)

Some Background-Infos about YUV-ColorSpaces and -Decoding can be found here:
http://msdn.microsoft.com/en-us/libr...5%29.aspx#yv12
http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

The Video-Compression-Manager-API is described here:
http://msdn.microsoft.com/en-us/libr...=vs.85%29.aspx

The Form-Code of the small Demo in the Zip depends on vbRichClient5 (downloadable from http://vbRichClient.com),
but the cICMDecode.cls itself has no RC5-dependency - so if you have your own
24Bit-RGB-DIB-Class-encapsulation at hand, you can adapt the Form-Code to your
own destination-buffer-handling - and achieve the same results...

The Form-Code is not very large:
Code:

Option Explicit

Private SrcBytes420_12Bit() As Byte, DecIYUV As New cICMDecode
Private SrcBytes422_16Bit() As Byte, DecYUY2 As New cICMDecode
 
Private DstDIB As cDIB '<- to provide the RGB24-decoding-buffer for both cases

Private Sub Form_Load()
  'try to open the two different ICM-Decoders first
  If Not DecIYUV.OpenDecoder(640, 480, DecIYUV.Make4CC("IYUV"), 12, 24) Then
    MsgBox "Couldn't open the IYUV(4:2:0) decoder": Unload Me: Exit Sub
  End If
  If Not DecYUY2.OpenDecoder(640, 480, DecYUY2.Make4CC("YUY2"), 16, 24) Then
    MsgBox "Couldn't open the YUY2(4:2:2) decoder": Unload Me: Exit Sub
  End If
 
  SrcBytes420_12Bit = New_c.FSO.ReadByteContent(App.Path & "\Planar YUV420.dat")
  SrcBytes422_16Bit = New_c.FSO.ReadByteContent(App.Path & "\Interleaved YUV422.dat")
 
  Set DstDIB = New_c.DIB(640, 480) 'allocate RGB24 decoding-memory in DstDIB
End Sub
 
Private Sub cmd420_Click()
  New_c.Timing True
    DecIYUV.Decode VarPtr(SrcBytes420_12Bit(0)), UBound(SrcBytes420_12Bit) + 1, DstDIB.pDIB
  Caption = New_c.Timing
  DstDIB.DrawTo picVidImg.hDC
End Sub

Private Sub cmd422_Click()
  New_c.Timing True
    DecYUY2.Decode VarPtr(SrcBytes422_16Bit(0)), UBound(SrcBytes422_16Bit) + 1, DstDIB.pDIB
  Caption = New_c.Timing
  DstDIB.DrawTo picVidImg.hDC
End Sub

Here's the Download-Link for the Zip-File (Code and Raw-Data-Files):
http://vbRichClient.com/Downloads/ICMDecoding.zip

And here a ScreenShot:


Olaf

Search files in folder tree recursively and asynchronously (New Scrollio Ver 4)

0
0
This is a simple Viewer for Zooming big images, and an example for scrollio control, LargeBar, dib processing and an example of how to search files in folder tree recursively and asynchronously.

We going a step ahead with this example. Now we can open a folder and we can search in that folder and all folders under that for a list of file types, and saved in a list sorted by time modified, for each folder. This was done with a class using WithEvents.

Also we have an advanced scrollio and an advance largebar. Now with up arrow and down arrow we can zoom the scrollio using equal step of zooming. Now the LargeBar can modified to use for clicking a smallchange as a logarithmic one. LargeChange change as before.
Scrollio now can hide mouse pointer so can display in code in the form (out of scrollio) our drawing as mouse pointer. Also I found the solution for a previously problem, of how with only a mouse move event can simulate the mouse down..So now we can scroll the scrollio in reverse without the starting jump... So now we can move the pointer in any point in the image, with auto scrolling, as we move it. Use shift + control to use the other way of moving, pushing (this is the default is scrollio control and the scrolling at the direction of pointer is out of scrollio, in code in the form and translate the X,Y to the default method. One method for two...). Also shift only or control only... make the move to one axis only.
I use ISHF_Ex.tlb for opening folders dialog.

I want this program to run wuth WINE in linux...so I found a way to reduce the entering to mousemove event.
In xp there isn't problem (i run it in a virtualbox) but in linux the time slicing is different.
Code:

Private Sub paper_MouseMove(Button As Integer, Shift As Integer, X As Single, y As Single)
Static timestamp As Double
If timestamp = 0 Then timestamp = Timer
If (timestamp + 0.05) > Timer Then Exit Sub
timestamp = Timer

My last problem is the dir function in linux...from wine return the name of file in small letters...(isn't case sensitive). But the paths are ok...l found that some files are readed and other not even they have capital letters both.

Version 4 arrive..
You can crop to the viewport, you can crop and copy to clipboard, you can paint with a brush (left button green and right button white ) (use shift and contol for paint horizntal or vertical lines, use both to move to any place in the image without painting). Sliders for opacity and size of brush.
The new for painting is that we can paint with auto scrolling (version 3 has auto scrolling too but not so good and not with painting procedure. )
Attached Files

[VBS] IP Adress with Google Speech

0
0
Description :
This script will display three messages box with 3 different languages ​​with Google Voice Speech.
1. English
2. French
3. Arabic

Code:

Option Explicit
Call Ip_Publique()
'***********************************************************************************************************************************************************
Sub Ip_Publique()
        Dim Titre,URL,ie,objFSO,Data,OutPut,objRegex,Match,Matches,ip_public,IP
        Dim MessageEN,MessageFR,MessageAR,URLEN,URLFR,URLAR,Copyright
        Copyright = "(2014 © Hackoo)"
        MessageEN = "You are connected to the internet !" & VbCrlf & "Your Public IP Adress is "
        MessageFR = "Vous êtes connecté à internet !" & VbCrlf & "Votre IP Publique est "
        MessageAR = ChrW(1571)&ChrW(1606)&ChrW(1578)&ChrW(32)&ChrW(1605)&ChrW(1578)&ChrW(1589)&ChrW(1604)&_
        ChrW(32)&ChrW(1576)&ChrW(1588)&ChrW(1576)&ChrW(1603)&ChrW(1577)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1573)&_
        ChrW(1606)&ChrW(1578)&ChrW(1585)&ChrW(1606)&ChrW(1578)& VbCrlf & "IP "
        URLEN = "http://translate.google.com/translate_tts?tl=en&q=" & MessageEN
        URLFR = "http://translate.google.com/translate_tts?tl=fr&q=" & MessageFR
        URLAR = "http://translate.google.com/translate_tts?ie=UTF-8&tl=ar&q=" & MessageAR
        Titre = "Adresse IP Publique " & Copyright
        URL = "http://monip.org"
        If OnLine("smtp.gmail.com") = True Then
                Set ie = CreateObject("InternetExplorer.Application")
                Set objFSO = CreateObject("Scripting.FileSystemObject")
                ie.Navigate (URL)
                ie.Visible=False
                DO WHILE ie.busy
                        Wscript.Sleep 100
                Loop
                Data = ie.document.documentElement.innertext
                Set objRegex = new RegExp
                objRegex.Pattern = "\b([0-9]{1,3}\.){3}[0-9]{1,3}\b"
                objRegex.Global = False
                objRegex.IgnoreCase = True
                Set Matches = objRegex.Execute(Data)
                For Each Match in Matches
                        IP =  Match.Value
                        Call NavigateIE(URLEN & IP)
                        MsgBox MessageEN & IP,64,Titre
                        Call NavigateIE(URLFR & IP)
                        MsgBox MessageFR & IP,64,Titre
                        Call NavigateIE(URLAR & IP)
                        MsgBox MessageAR & IP,64,Titre
                Next
                ie.Quit
                Set ie = Nothing
        Else
                MsgBox "Vérifier votre connexion internet puis re-executer ce script",48,Titre
                Exit Sub
        End If
End Sub
'************************************************************************************************************************************************************
Function OnLine(strHost)
        Dim objPing,z,objRetStatus,PingStatus
        Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strHost & "'")
        z = 0
        Do 
                z = z + 1
                For Each objRetStatus In objPing
                        If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
                                PingStatus = False
                        Else
                                PingStatus = True
                        End If   
                Next 
                Call Pause(1)
                If z = 4 Then Exit Do
        Loop until PingStatus = True
        If PingStatus = True Then
                OnLine = True
        Else
                OnLine = False
        End If
End Function
'*********************************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
        DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
Sub Pause(NSeconds)
        Wscript.Sleep(NSeconds*1000)
End Sub
'**********************************************************************************************
Sub NavigateIE(URL)
Dim objExplorer
Set objExplorer = CreateObject("InternetExplorer.Application")
        with objExplorer
                        .Navigate(URL)
                        .Visible = False
        end with
End Sub
'**********************************************************************************************

First attempt for a new compact file selector

0
0
This is a work on my glist and myDir class (this class expanded here, but I use it in scrolliodo 4).
The good news
We bit Android...Yes we can scroll up down (not with super fast move, but with an accelerated move) bu pushing the list item up or down. If we select to hide scroll bar, when we push the list, the scroll bar be visible and we can operate it until we choose an item...and scroll bar hide.
Glist is updated to work with no data inside (as an option). So we take the data in myDir class and use that data without copy in the list. Because tehe list expose hdc, and the rect to draw...we can do a lot of things in code ind the form and not in the glist. This glist has inside merged in code a largebar control, so we can put a lot of items (no integer, but long for indexing)
We can display a folder, with or without files, and a folder and all folders under with or without files. Also we can sort files and folders (using the quicksort), by timestamp, by name or by type(for folders type is equal to name). We can select the multiselect option and we do a clik in the left area of an item, and as many as we like, but no on folders, that we define in a event routine out of glist.

I don't use dir, in myDir class but an advanced code to read in unicode.
Any suggestion is welcome
Attached Images
 
Attached Files

Test two vb codes for changes

0
0
This is a small program, based on gEditBox. I made this for gEditBox because I have some customize..custom controls and I want to find the differences.
It is a fast coding (one day) so...I do the basics...Two edit boxes, on with auto colorizing vb6 code (my way), and the other to put by three way code for testing similarity.

There is also a small gEditbox for searching.
No word wrapping enabled here for clarity. Also form isn't sizable (you can arrange controls better if you like).
From left there are buttons for:
1. Clear Up (clear "up" textbox - ctrl a and delete is the same but slower). "Up" is the name of up textbox...

- We want to find from Up textbox the similarities with the "Down" textbox. (You may think that these are the same....but the Up textbox..colorize the code, and the searching is like a moving in chess...we going forward but we looking from the other side to our side. This is my first such a search routine...Any idea for to help for a better code is appreciated.

2. Load Up (we load from a temporary test.doc file in %temp%.

3. Copy Down...(copy from Up to Down)

Under Search Box, Buttons up (search in UP editbox), and down (search in DOWN editbox) Searching means also moving to next. In search box we write something to be "like" not equal (also automatic embedded asterisks in fron and behind the searching string). Another way to search is by automatic select word, or you can select a part of a line and perform search in this or the other editbox (from any of these).

4. Clear Mark
This colorize the code "again" the color in Up editbox and colorize with one "neutral" color the down editbox. Because when we do a search (our scope) both editboxes changes colors.

There is a frame named Down Text with these buttons:
5. Clear Down - Same as for UP.
6. Mark new or changed lines of code (our goal)
7.Move Top Line (because searching done from cursor, we set cursor to top, first line)
8. Move to change. All changes lines are colored, so this is very helping
9. Move Up as Down. Moving up to same line in number. Maybe not the same line as content.

10. Save down. AS you see we load Up but we save Down. This is for making at the down the merging...So we need to feed data to Up and export only from Down. We can copy to clipboard, or we can drag (7941 lines has the gEditBox code...end perform good), and we can save to test.doc as unicode utf16 with doc extension (open with Word).
Name:  tester.jpg
Views: 218
Size:  87.4 KB
Attached Images
 
Attached Files

glist4 as file selector, menu and other things

0
0
This is a work on my glist and myDir class (this class expanded here, but I use it in scrolliodo 4).
The good news
We bit Android...Yes we can scroll up down (not with super fast move, but with an accelerated move) bu pushing the list item up or down. If we select to hide scroll bar, when we push the list, the scroll bar be visible and we can operate it until we choose an item...and scroll bar hide.
Glist is updated to work with no data inside (as an option). So we take the data in myDir class and use that data without copy in the list. Because tehe list expose hdc, and the rect to draw...we can do a lot of things in code ind the form and not in the glist. This glist has inside merged in code a largebar control, so we can put a lot of items (no integer, but long for indexing)
We can display a folder, with or without files, and a folder and all folders under with or without files. Also we can sort files and folders (using the quicksort), by timestamp, by name or by type(for folders type is equal to name). We can select the multiselect option and we do a clik in the left area of an item, and as many as we like, but no on folders, that we define in a event routine out of glist.

I don't use dir, in myDir class but an advanced code to read in unicode.
Any suggestion is welcome


***********Glist4 is finished***************
I have in the last zip all the examples to master the glist4.
Glist4 is not only a listbox. It is a text viewer, a menu, a dropdown menu or list, a file selector, a control container, a floating control. Has header multiline with custom wrapping (break at spaces and slash, and can break big words). For menu we can have radio buttons, or just checked, or all of them, plus lines to separate items. We can enabled or disable menu items, and we can move with arrow keys, home/end, page up and down. In all situations scroll bar auto hide when we didn't need it. Except checked, radio buttons, enabled/disabled, we have multiselect listbox with a box in every item to select or not.

There are classes to subclassing the glist4 with just using WithEvents and the right object references.

So for a file selector:
Code:

Public WithEvents mySelector As FileSelector

in form load event.............................................
Set mySelector = New FileSelector
With mySelector
Set .glistN = gList4
Set .Text1 = Text2
.FileTypesToDisplay = "TXT"
.SortType = 1  ' 0 timestamp - 1 name - 2 type
.FilePath = "C:\"
End With
.............................

Private Sub mySelector_DoubleClick(file As String)
myTextViewer.Title = file
myTextViewer.filename = file
End Sub

Attached Images
 
Attached Files

[VB6] Friend Callback Procedures

0
0
The attached project below demonstrates how to set up Friend procedures inside object modules (FRM, CLS, CTL, etc.) for Windows API callback purposes. The goal of such a technique is to keep as much code as possible within the object module in order to make it as self-contained as possible and also to reduce memory consumption once the object module is unloaded. There is a possibly significant disadvantage to this approach however - the overhead of redirecting calls to procedures in an object module naturally imposes some performance penalty.

(This code has been inspired by the following post: Re: Problem with Public UDT: 'Only public user defined types......)
Attached Files

Using FileSelector class to make a compact Open File dialog.

0
0
This example using the latest glist4 and fileselector class for a compact file loader.
From setup menu we can change the sort type, the behavior, the performance (normal recursive 3 levels, recursive all levels). For this example the scope is to open an image file so we have a preview. We can select "multiselect" and we can fill the list on the main form with files not only from one folder but from any folder that we can open "recursive". Each file has path on it.
We can set a top folder so we can't go up beyond top folder.
It is easy to use.
Next time I make the Save File (need to take input...and I would like to finish gEditbox).

2 bug fixes. One is a logic bug, because I use internal list and external list to populate the listbox without block the logic for menus. I fixed that making the flag in selector class as a property so in a change of it, secondary changes a flag in the glist so menu parcing is blocked. So simple. The other bug is also from menu. When you select a non selected radio button and click in an other line (wrong Y position) in right X position then that click goes to the radio button and enabled. So I put an condition check and bug is over.


Programming is an art to describe your faults.
Attached Images
  
Attached Files

WIA Loader and Saver class

0
0
This class allows you to load and save all kinds of image files, including PNG and TIF. It is requires WIA 2.0 which is a Microsoft created DLL file called wiaaut.dll. A complete description of the capabilities of this class is included with the class as a text file. The entire thing is packaged in the ZIP file that is attached to this post, including the required DLL file. Though I don't normally package executables with my source code on the Codebank, it is an essential file, without which my class would not work, and it is an official file from Microsoft. I would usually choose to link to the Microsoft download page for the file, except that Microsoft is no longer distributing it (the page that had it before is now gone). Thus it is included in the ZIP file along with my class. Also included is Helpfile.txt (it explains in great detail, everything that my class does), License.txt (it explains how you may use, alter, distribute, etc my class file), and EULA.txt (the Microsoft EULA for the DLL file).
Attached Files

Some code to calculate the Greatest Common Divisor

0
0
This code sample calculates the GCD of numbers A and B, using the Euclidean algorithm (as described at https://www.khanacademy.org/computin...dean-algorithm).

Code:

Private Function CalculateGCD(ByVal A As Long, ByVal B As Long) As Long
Dim Remainder As Long

' If B is greater than A, then use the xor data swap technique.
If B > A Then
    B = A Xor B
    A = A Xor B
    B = A Xor B
End If

' Calculate the GCD.
Do Until B = 0
    Remainder = A Mod B
    A = B
    B = Remainder
Loop

CalculateGCD = A
End Function


And here's a small bit of code used to test the above function.
Code:

Private Sub Form_Load()
MsgBox CalculateGCD(100, 36)
End Sub

The output for this example should be 4.



Another thing that the GCD is useful for is to find if two given numbers are mutually prime. By definition, any two numbers are mutually prime if those numbers have a GCD of 1. The below code is a random mutual prime number pair generator. Its outputs are 31 bit numbers. It must be 31 bits, not 32, because all numbers larger than &h7FFFFFFF actually used as two's compliment negative numbers in VB6's data type. So I can't use the full 32 bit range. However, this works great for demonstrating the idea of mutually prime numbers.

Code:

Private Sub Form_Load()
Dim A As Long
Dim B As Long

Randomize

Do
    A = Int(Rnd * 256) * &H1& + Int(Rnd * 256) * &H100& + Int(Rnd * 256) * &H10000 + Int(Rnd * 128) * &H1000000
    B = Int(Rnd * 256) * &H1& + Int(Rnd * 256) * &H100& + Int(Rnd * 256) * &H10000 + Int(Rnd * 128) * &H1000000
Loop Until CalculateGCD(A, B) = 1

MsgBox "A=" & CStr(A) & " and B=" & CStr(B)
End Sub

A custom compact and resizable Open File/Save File/Folder Select.

0
0
This example using the latest glist4 and fileselector class for a compact file loader.
From setup menu we can change the sort type, the behavior, the performance (normal recursive 3 levels, recursive all levels). For this example the scope is to open an image file so we have a preview. We can select "multiselect" and we can fill the list on the main form with files not only from one folder but from any folder that we can open "recursive". Each file has path on it.
We can set a top folder so we can't go up beyond top folder.
It is easy to use.
Next time I make the Save File (need to take input...and I would like to finish gEditbox).

2 bug fixes. One is a logic bug, because I use internal list and external list to populate the listbox without block the logic for menus. I fixed that making the flag in selector class as a property so in a change of it, secondary changes a flag in the glist so menu parcing is blocked. So simple. The other bug is also from menu. When you select a non selected radio button and click in an other line (wrong Y position) in right X position then that click goes to the radio button and enabled. So I put an condition check and bug is over.


Programming is an art to describe your faults.

*********** Good News ******
The control is done. Now We can Save/Load/Select Folder only. Multiselection for files, tree of folders and or files, preview images (for the example). Also now glist can edit line and centered line too.
Attached Images
  
Attached Files

Kingsoft Spreadsheet and VB6

0
0
Reading through the forums, there seems to be some confusion on how to create an Excel Spreadsheet using the Kingsoft Spreadsheet package via Automation with Visual Basic 6.

Here is sample source code;
Code:

Dim oExcel
Dim oBook
Dim oSheet

'Start a new workbook in Kingsoft Spreadsheet
Set oExcel = CreateObject("et.Application")
Set oBook = oExcel.Workbooks.Add

'Add data to cells of the first worksheet in the new workbook
Set oSheet = oBook.Worksheets(1)
oSheet.Range("A1").Value = "Last Name"
oSheet.Range("B1").Value = "First Name"
oSheet.Range("A1:B1").Font.Bold = True
oSheet.Range("A2").Value = "Dunn"
oSheet.Range("B2").Value = "Elias"

'Save the Workbook and Quit Excel
oBook.SaveAs "C:\utils\example.xls"
oExcel.Quit
'***********END***********

The free copy of Kingsoft Spreadsheet is available from http://www.kingsoftstore.com/spreadsheets-free.html

While this code was written for use with VBScript, it works the same in Visual Basic 6.

Elias

BF Interpreter - an interpreter for a minimalist programming language

0
0
Attached to this thread is an interpreter for a minimalist programming language called Brain***** designed by Urban Müller. It only has eight different commands. The interpreter I made for it can load and execute files containing source code for the language.

The code for a "Hello World!" program:
Code:

++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
Wikipedia has more information, but due to the language's somewhat offensive name part of the url is censored by this forum so I can't post a direct link. Just search for "Urban Müller" and you should be able to find it.
Attached Files

Connect Four/Four in a Row game

0
0
Here's a simple Connect Four game written in Microsoft Visual Basic 6.0. The game has the following options:

-Set who plays first. (red or yellow)
-Whether one of the players is the computer, and if so, which color it plays with.

The code should be fairly easy to customize.
Attached Files

[VB6] Color Management with GDI+

0
0
Updates (see post #2 for bug descriptions):
31 Aug 14: Fixed JPG related GDI+ bug

Higher quality images often have a color management profile (ICM/ICC) embedded into their file. These embedded profiles can be retrieved from GDI+ most times. Not many image formats support embedded profiles, but these do per ICC.org: png, tif, jpg & gif.

When embedded, the image's creator provided it so that it can be used to reproduce the image on any monitor/printer in the colors that the creator intended. By ignoring the profile, what you get is not what the creator intended. Sometimes it can be radically different. Images without ICC profiles are at the mercy of the rendering application. GDI+ does a fair job without embedded profiles, but its hands are tied when best-guessing how to interpret the colors.

Windows provided color management for quite awhile now, but it is the application's responsibility to apply it. The flat GDI+ API wrapper doesn't support color management directly. But with the use of Windows APIs we can still use GDI+ and apply color management

For a project that doesn't rely on GDI+ for displaying images with embedded ICC profiles, see Tanner's work here. This project is not meant to be competitive with Tanner's hDC-based solution, it is provided as a workaround for those that exclusively use GDI+ for image rendering/processing, no device contexts used in transformations. I started this about 2 years ago & lost interest. Can rest easier now :)

This sample project uses Windows to help transform colors, but the result is maintained and used by GDI+. From the sample screenshot, you can see a radical example along with a real-world example of how color management can improve what is displayed. And this sample project may include the only VB6 code that processes a GIF embedded ICC profile instead of ignoring them. To be fair, embedded GIFs are really hard to find.

To find other images to play with, google for: color profile test

From time to time, will update this as needed

Request. If anyone would like to upload an 8 bit grayscale JPG, TIFF or PNG with the appropriate ICC profile, embedded or not, please do so. I'd like to examine them. Currently, processing 8 bit images other than GIF is turned off in the code.
Attached Images
 
Attached Files

[VB6] RSA Public Key Encryption via CNG

0
0
Now that Windows XP has joined earlier versions of Windows as unsupported software we can feel more free to move away from legacy technologies.

Cryptography API: Next Generation is one of the new Windows features introduced in Windows Vista.


RSA Public Key Encryption

The basic concept here is that you can create an asymmetric pair of keys: a "public" key that you give to others and a "private" key you keep yourself. Other users can all encrypt messages for you using the public key, but they cannot decrypt each others' messages to you. You can decrypt the messages using your private key.


CngRsa.cls

This is a VB6 Class that uses several CNG API calls to implement basic RSA encryption. It does not implement a key container format portable between operating systems and platforms, or a message container format.

For Windows to Windows messaging the binary BLOBs can be exchanged and work just fine. For multiplatform use you would need to expand upon this.


Caution

I won't pretend to be a cryptographer or cryptography software expert. There may be weaknesses in my usage of these API calls, and there could be quite a few areas worthy of improvement.

However this might be a useful example to get you started using the CNG API for encryption and hashing.


Requirements

As noted above, CNG became available beginning in Windows Vista. There was never a redist version of the Windows libraries involved for installation into Windows XP or earlier.

You'll also need VB6.


Demo

The demo should run fine either in the IDE or compiled. Be sure to set Break on Unhandled Errors unless you need to debug the internals of the CngRsa Class.

Running the demo should be straightforward, most of it is UI management logic that should lead you through testing step by step. There are 6 "panels" selected via buttons along the top, each becoming enabled as it becomes relevant.

After generating the key pair you can view each key in hex, or enter an input message and encrypt it.

Once you have encrypted a message you can view the cipher text and decrypt it.

After this you can go back to the message input panel, clear, and enter another message to decrypt.

You can also go back and generate a new key pair.


Name:  sshot.png
Views: 57
Size:  25.5 KB

Ready to decrypt


The demo does not persist keys or messages.


Usage

Adding CngRas.cls to a new Project is easy. There is just one file (no .BAS modules, etc.). There are no dependencies beyond those that ship as part of Windows.

See the ReadMe.txt file included for some usage notes, required sequence of calls, etc.
Attached Images
 
Attached Files
Viewing all 1305 articles
Browse latest View live




Latest Images