[VB6] AddIn - Comment/Code Display + Highlight + Extra Hotkeys v0.8c

May 9, 2021, 9:49 pm

≫ Next: [VB6] AddIn - Comment/Code Display + Highlight + Extra Hotkeys v0.8d

≪ Previous: SimpleSock User Control

$

0

0

This is an add-in to display comments and code of user generated
Functons/Methods/Properties and also some info from typelibs in the project

It takes the text inside comments over the declarations and also from the menu
Tools->Procedure Attributes or inside typelibs

(optional) Also have extra hotkeys:
CTRL+Q: Smart lines comment / uncomment
CTRL+D: Duplicate Lines
CTRL+SHIFT+UP and CTRL+SHIFT+DOWN: Move Up or Down selected lines

(optional) Also has selection highlight on editor on all ocurrences of text/selection


IMPORTANT: This is a WIA (Work In Progress) I'm releasing this AddIn as
an unfinished project. Its working but I feel there is still some more
polishing to do. Just dont have the time needed right now.


NOTE: If highlighting a word doesnt seem to work try selecting another word and then
reselecting the word you want to hihglight OR scroll the editor up/down to force
re apply highlighting.


Special thanks to Fafalone and LaVolpe for helping how to access typelibs data.

DOWNLOAD: prj (AddIn) ComCodeDisplay v0.8c.zip

Attached Images

  

Attached Files

• prj (AddIn) ComCodeDisplay v0.8c.zip (125.5 KB)

---

[VB6] AddIn - Comment/Code Display + Highlight + Extra Hotkeys v0.8d

May 9, 2021, 9:49 pm

≫ Next: ucShellBrowse

≪ Previous: [VB6] AddIn - Comment/Code Display + Highlight + Extra Hotkeys v0.8c

$

0

0

This is an add-in to display comments and code of user generated
Functons/Methods/Properties and also some info from typelibs in the project

It takes the text inside comments over the declarations and also from the menu
Tools->Procedure Attributes or inside typelibs

(optional) Also have extra hotkeys:
CTRL+Q: Smart lines comment / uncomment
CTRL+D: Duplicate Lines
CTRL+SHIFT+UP and CTRL+SHIFT+DOWN: Move Up or Down selected lines

(optional) Also has selection highlight on editor on all ocurrences of text/selection


IMPORTANT: This is a WIA (Work In Progress) I'm releasing this AddIn as
an unfinished project. Its working but I feel there is still some more
polishing to do. Just dont have the time needed right now.


NOTE: If highlighting a word doesnt seem to work try selecting another word and then
reselecting the word you want to hihglight OR scroll the editor up/down to force
re apply highlighting.


Special thanks to Fafalone and LaVolpe for helping how to access typelibs data.

DOWNLOAD: prj (AddIn) ComCodeDisplay v0.8d.zip

Changelog:
v0.8 (06/05/21)
+Initial release.
v0.8b (07/05/21)
+Highlight: Fixed default font values and without comment viewer
v0.8c (10/05/21)
+Highlight: Fixed horizontal scrolling on editor
v0.8d (11/05/21)
+Highlight: Fixed lines with ampersand ('&')
+Removed reference to Office objects

Attached Images

  

Attached Files

• prj (AddIn) ComCodeDisplay v0.8d.zip (125.7 KB)

ucShellBrowse

May 11, 2021, 9:53 pm

≫ Next: [VB6] AddIn - Comment/Code Display + Highlight + Extra Hotkeys v0.8e

≪ Previous: [VB6] AddIn - Comment/Code Display + Highlight + Extra Hotkeys v0.8d

$

0

0

Hello Community, I need your help.
I want to use the ucShellBrowser but got an error and something with the icons doesn't work for me.


I have the version ucShellBrowse100R4 and opened the project ..\Demo\ShellBrowseDemo.vbp.
After start I have the following list:



If I click the button <View> and change to Thumbnail view, I get this error:



If I go back to Details, the files have the wrong icons.




What can I do?
Do you have any idea for me?

Thank you.

Rasmo

Attached Images

   

[VB6] AddIn - Comment/Code Display + Highlight + Extra Hotkeys v0.8e

May 9, 2021, 9:49 pm

≫ Next: Roulette Table

≪ Previous: ucShellBrowse

$

0

0

This is an add-in to display comments and code of user generated
Functons/Methods/Properties and also some info from typelibs in the project

It takes the text inside comments over the declarations and also from the menu
Tools->Procedure Attributes or inside typelibs

(optional) Also have extra hotkeys:
CTRL+Q: Smart lines comment / uncomment
CTRL+D: Duplicate Lines
CTRL+SHIFT+UP and CTRL+SHIFT+DOWN: Move Up or Down selected lines

(optional) Also has selection highlight on editor on all ocurrences of text/selection. Note: Only support MONOSPACE FONTS


IMPORTANT: This is a WIA (Work In Progress) I'm releasing this AddIn as
an unfinished project. Its working but I feel there is still some more
polishing to do. Just dont have the time needed right now.


NOTE: If highlighting a word doesnt seem to work try selecting another word and then
reselecting the word you want to hihglight OR scroll the editor up/down to force
re apply highlighting.


Special thanks to Fafalone and LaVolpe for helping how to access typelibs data.

DOWNLOAD: prj (AddIn) ComCodeDisplay v0.8e.zip

Changelog:
v0.8 (06/05/21)
+Initial release.
v0.8b (07/05/21)
+Highlight: Fixed default font values and without comment viewer
v0.8c (10/05/21)
+Highlight: Fixed horizontal scrolling on editor
v0.8d (11/05/21)
+Highlight: Fixed lines with ampersand ('&')
+Removed reference to Office objects
v0.8e (12/05/21)
+Fixed default VB6 to Courier New and not Times New Roman
(for people who have never changed the font)

Attached Images

  

Attached Files

• prj (AddIn) ComCodeDisplay v0.8e.zip (126.0 KB)

Roulette Table

May 12, 2021, 8:29 am

≫ Next: Load ICO From Res or Byte array by vb6,Get All Size ,BitCount

≪ Previous: [VB6] AddIn - Comment/Code Display + Highlight + Extra Hotkeys v0.8e

$

0

0

roulette.zip
My version of roulette. Tried to imitate the slowing of the wheel. Drag chips onto board and spin. Good luck.

Attached Images

 

Attached Files

• roulette.zip (745.5 KB)

Load ICO From Res or Byte array by vb6,Get All Size ,BitCount

May 12, 2021, 8:51 pm

≫ Next: Asynchronous Beep by vb6(NtDeviceIoControlFile)

≪ Previous: Roulette Table

$

0

0

Code:

---

'FORM1.FRM

Dim NewCursor As Long, OldCursor As Long
'add 2 control: Text1,picture1

Private Sub Command1_Click()
Dim bt() As Byte

'bt = OpenBinFile(App.Path & "\02.ico")
 
 Dim SizeArr() As String
 SizeArr = GetIcoSizeArr(bt)
 MsgBox Join(SizeArr, vbCrLf)
 
 NewCursor = LoadIcoByByte(bt, 256, 32)
 'NewCursor = LoadIcoByByte(bt, 0)
 

Text1.MousePointer = vbCustom
OldCursor = SetClassLong(Text1.hwnd, GCL_HCURSOR, NewCursor)

Picture1.Width = 256 * Screen.TwipsPerPixelX + Picture1.Width - Picture1.ScaleWidth
Picture1.Height = 256 * Screen.TwipsPerPixelY + Picture1.Height - Picture1.ScaleHeight

DrawIconEx Picture1.Hdc, 0, 0, NewCursor, 256, 256, 0, 0, DI_NORMAL
Picture1.Refresh
End Sub

Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.AutoSize = True
Command1_Click
End Sub

---

Code:

---

'*.BAS

Option Explicit
Private Declare Function CreateIconFromResourceEx Lib "user32" (presbits As Byte, ByVal dwResSize As Long, ByVal fIcon As Long, ByVal dwVer As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal uFlags As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

 Private Type ICONDIRENTRY
    bWidth  As Byte
    bHeight  As Byte
    bColorCount  As Byte
    bReserved  As Byte
    wPlanes  As Integer
    wBitCount  As Integer
    dwBytesInRes  As Long
    dwImageOffset  As Long
End Type
Public Const GCL_HCURSOR = -12


Public Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Public Const DI_NORMAL = &H3 '用常规方式绘图 (DI_IMAGE 和 DI_MASK)
Public Declare Function DrawIconEx Lib "user32" (ByVal Hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long

Public Function GetIcoSizeArr(mIcon() As Byte) As String()
 'good
'从字节数组内存流中创建ICO图标
Dim SizeArr() As String
    Dim IDETY As ICONDIRENTRY
    Dim W As Long, H As Long
    Dim i As Long, iLen As Long, pData As Long, id As Long
    iLen = LenB(IDETY)
    pData = VarPtr(mIcon(0))
    ReDim SizeArr(mIcon(4) - 1)
    For i = 1 To mIcon(4)  '第5个字节就是子图标的数目
        CopyMemory IDETY, ByVal pData + 6 + (i - 1) * iLen, iLen '读 图标目录 结构数据
        W = IDETY.bWidth
        H = IDETY.bHeight
        If W = H Then
            If W = 0 Then W = 256: H = 256
            SizeArr(id) = W & "*" & H & "," & IIf(IDETY.wBitCount = 0, "32位透明", IDETY.wBitCount)
            id = id + 1
        Else
            Exit For
        End If
    Next
    If id > 0 Then
        ReDim Preserve SizeArr(id - 1)
    Else
        ReDim SizeArr(-1 To -1)
    End If
    GetIcoSizeArr = SizeArr
End Function
Public Function LoadIcoByByte(mIcon() As Byte, Optional ByVal iSize As Long = 16&, Optional BitCount As Long) As Long
'version 2021-5-13
 'good
'从字节数组内存流中创建ICO图标,条件：大小，位度
    Dim IDETY As ICONDIRENTRY, FindSize As Long
    Dim i As Long, iLen As Long, pData As Long
    Dim FindBitCount As Boolean
    If iSize = 0 Then iSize = 256
    If iSize = 256 Then
        FindSize = 0
    Else
        FindSize = iSize
    End If
    iLen = LenB(IDETY)
    pData = VarPtr(mIcon(0))
    For i = 1 To mIcon(4)  '第5个字节就是子图标的数目
        CopyMemory IDETY, ByVal pData + 6 + (i - 1) * iLen, iLen '读 图标目录 结构数据
        If BitCount = 0 Then
            FindBitCount = True
        Else
            FindBitCount = IDETY.wBitCount = BitCount
        End If
        If FindBitCount Then
            If iSize = -1 Then
                iSize = IDETY.bWidth
                If iSize = 0 Then iSize = 256 'edit:2021-5-13
                GoTo DoLoadIco
            ElseIf IDETY.bWidth = FindSize Then '寻找符合尺寸的子图标
DoLoadIco:
                LoadIcoByByte = CreateIconFromResourceEx(mIcon(IDETY.dwImageOffset) _
                                , IDETY.dwBytesInRes, -1, &H30000, iSize, iSize, 0)
                Exit For
            End If
        End If
    Next
End Function

Function OpenBinFile(filename As String, Optional ErrInfo As String) As Byte()
  '[mycode_id:1903],edittime:2011/7/11 13:27:34
On Error Resume Next
Dim hFile As Integer
hFile = FreeFile
Open filename For Binary As #hFile
ReDim OpenBinFile(LOF(hFile) - 1)
Get #hFile, , OpenBinFile
Close #hFile
End Function

---

Asynchronous Beep by vb6(NtDeviceIoControlFile)

May 13, 2021, 12:50 am

≫ Next: (VB6) Implement the Print method on any object

≪ Previous: Load ICO From Res or Byte array by vb6,Get All Size ,BitCount

$

0

0

Play the sound of the specified frequency and duration

Code:

---

Sub Main()
Dim AsyncBeep2 As New AsyncBeep
AsyncBeep2.Play 1000, 2024
MsgBox "ok"
End Sub

---

Code:

---

' 异步版 Beep，作者YY菌，技术交流群（QQ）：250264265
'AsyncBeep.cls
'Asynchronous version of Beep, author YY bacteria, technical exchange group (QQ): 250264265
Option Explicit

'Input and output status
Private Type IO_STATUS_BLOCK
    Status As Long
    Information As Long
End Type

'Unicode string
Private Type UNICODE_STRING
    Length As Integer
    MaximumLength As Integer
    Buffer As String
End Type

'Object properties
Private Type OBJECT_ATTRIBUTES
    Length As Long
    RootDirectory As Long
    ObjectName As Long
    Attributes As Long
    SecurityDescriptor As Long
    SecurityQualityOfService As Long
End Type

'Beep parameter
Private Type BEEP_SET_PARAMETERS
    Frequency As Long
    Duration As Long
End Type

'Beep related constants
Const BEEP_FREQUENCY_MINIMUM& = &H25&
Const BEEP_FREQUENCY_MAXIMUM& = &H7FFF&
Const IOCTL_BEEP_SET& = &H10000
Const DD_BEEP_DEVICE_NAME$ = "\Device\Beep"

'Permission constant
Private Enum ACCESS_MASK
    FILE_READ_DATA = &H1&
    FILE_WRITE_DATA = &H2&
End Enum

'Open constant
Private Enum CREATE_DISPOSITION
    CREATE_NEW = 1
    CREATE_ALWAYS = 2
    OPEN_EXISTING = 3
    OPEN_ALWAYS = 4
    TRUNCATE_EXISTING = 5
End Enum

'API statement
Private Declare Function NtCreateFile Lib "ntdll" (ByRef FileHandle As Long, ByVal DesiredAccess As ACCESS_MASK, ObjectAttributes As OBJECT_ATTRIBUTES, IoStatusBlock As IO_STATUS_BLOCK, ByVal AllocationSize As Long, ByVal FileAttributes As Long, ByVal ShareAccess As ACCESS_MASK, ByVal CreateDisposition As CREATE_DISPOSITION, ByVal CreateOptions As Long, EaBuffer As Any, ByVal EaLength As Long) As Long
Private Declare Function NtDeviceIoControlFile Lib "ntdll" (ByVal FileHandle As Long, ByVal EventHandle As Long, ByVal ApcRoutine As Long, ByVal ApcContext As Long, IoStatusBlock As IO_STATUS_BLOCK, ByVal IoControlCode As Long, InputBuffer As Any, ByVal InputBufferLength As Long, OutputBuffer As Any, ByVal OutputBufferLength As Long) As Long
Private Declare Function NtClose Lib "ntdll" (ByVal FileHandle As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'Device handle
Dim hDev As Long

'Constructor (open the Beep device)
Private Sub Class_Initialize()
    Dim iosb As IO_STATUS_BLOCK
    Dim path As UNICODE_STRING
    Dim objAttr As OBJECT_ATTRIBUTES
    With path
        .Buffer = DD_BEEP_DEVICE_NAME
        .Length = LenB(.Buffer)
        .MaximumLength = .Length + 2
    End With
    With objAttr
        .Length = path.Length
        .ObjectName = VarPtr(path)
    End With
    NtCreateFile hDev, FILE_WRITE_DATA, objAttr, iosb, 0&, 0&, FILE_READ_DATA Or FILE_WRITE_DATA, OPEN_EXISTING, 0&, ByVal 0&, 0&
End Sub

'Destructor (close the Beep device)
Private Sub Class_Terminate()
    NtClose hDev
End Sub

'Get Beep device handle
Public Property Get Handle() As Long
    Handle = hDev
End Property

'Play the sound of the specified frequency and duration
Public Function Play(ByVal dwFreq As Long, ByVal dwDuration As Long) As Boolean
    Dim iosb As IO_STATUS_BLOCK
    Dim bsp As BEEP_SET_PARAMETERS
    With bsp
        .Frequency = dwFreq
        .Duration = dwDuration
    End With
    Play = NtDeviceIoControlFile(hDev, 0&, 0&, 0&, iosb, IOCTL_BEEP_SET, bsp, LenB(bsp), ByVal 0&, 0&) >= 0
End Function

---

(VB6) Implement the Print method on any object

May 15, 2021, 9:00 pm

≫ Next: Spin transparent image

≪ Previous: Asynchronous Beep by vb6(NtDeviceIoControlFile)

$

0

0

You can implement the Print method on any object with the IVBPrint interface (I discovered it some time ago thanks to The Trick).

But besides the interface, you also need some code to handle it.
This sample has in a class module the basics of that code.

It prints on a form, just used as the canvas and also for comparison with the Form's own Print method.

I'm posting this mainly trying to help the new Basics developers, just in case they can take any advantage of this information.

As a side note: this Print method prints Unicode.

Here is the Print method documentation on MSDN.

I have also code for the implementation of all the other related properties and methods:
Circle
Line
PaintPicture
ScaleMode
Scale
ScaleLeft/ScaleTop/ScaleWidth/ScaleHeight
ScaleX/ScaleY

They are not included here, but if they are needed I could help.

Attached Files

• VB_Print_Method.zip (4.6 KB)

---

Spin transparent image

May 16, 2021, 7:32 am

≫ Next: VirtualList,VirtualCombo,Virtual_ListView by vb6

≪ Previous: (VB6) Implement the Print method on any object

$

0

0

l have a transparent gif . l would like to be able with a button or rightclicking on it to make it rotate clockwise to 90 degrees .
l have searched here and googled but found nothing .

Thanks for feedback

VirtualList,VirtualCombo,Virtual_ListView by vb6

May 16, 2021, 8:41 pm

≫ Next: VB6 MultiThreading,A new way to get the VB header,For CreateThread

≪ Previous: Spin transparent image

$

0

0

Tutorial - Using Unicode in Visual Basic 6.0 - Free Unicode Controls
http://toolboxw.com/UnicodeTutorialVb.htm
VirtualCombo http://toolboxw.com/UnicodeTutorialV...ucVirtualCombo
VirtualList http://toolboxw.com/UnicodeTutorialVb.htm#ucVirtualList
Credits:
Olaf Schmidt
The Trick Subclass


vbVision -- Various Visual Basic Demos Grouped by Type
http://mvps.org/vbvision/grouped_demos.htm
Virtual_Listbox_Demo
http://mvps.org/vbvision/_samples/Vi...stbox_Demo.zip
Virtual_ListView_Demo
http://mvps.org/vbvision/_samples/Vi...tView_Demo.zip
http://mvps.org/vbvision/_other_files/DbgWProc.zip

VB6 MultiThreading,A new way to get the VB header,For CreateThread

May 17, 2021, 8:13 pm

≫ Next: Make a Delimited File Demo

≪ Previous: VirtualList,VirtualCombo,Virtual_ListView by vb6

$

0

0

Msgbox GetVBHeader

Code:

---

Private Type MODULEINFO
    lpBaseDLL As Long
    ImageSize As Long
    EntryPoint As Long
End Type

Private Declare Function GetModuleInformation Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, mInfo As MODULEINFO, ByVal cbSize As Long) As Long
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Function GetVBHeader() As Long
  Dim mInfo As MODULEINFO
  GetModuleInformation GetCurrentProcess(), &H400000, mInfo, 12
  If mInfo.EntryPoint Then CopyMemory GetVBHeader, ByVal mInfo.EntryPoint + 1, 4
End Function

---

Make a Delimited File Demo

May 21, 2021, 5:34 pm

≫ Next: Capacitor Values Converter

≪ Previous: VB6 MultiThreading,A new way to get the VB header,For CreateThread

$

0

0

Was not busy ,so I went thru my junk box and threw this together. May be something usable here for someone. Enjoy.

Attached Images

 

Attached Files

• Commas Demo.zip (7.1 KB)

Capacitor Values Converter

May 22, 2021, 3:04 pm

≫ Next: Remove Blank Lines and Extra Spaces

≪ Previous: Make a Delimited File Demo

$

0

0

This is another project I started but didn't finish. Did not like the way the code was flowing so I stopped working on it . I know there has to be a better way to do this project.

Attached Images

 

Attached Files

• CapConverter.zip (3.2 KB)

Remove Blank Lines and Extra Spaces

May 27, 2021, 4:07 pm

≫ Next: [VB6] AddIn IDE Codefolding

≪ Previous: Capacitor Values Converter

$

0

0

This code will remove blank lines and spaces from your code and resave it converted. I would like it to keep a one blank line between procedures but haven't been able to figure it out yet. If anyone can come up with a solution I would appreciate it.

Attached Files

• Remove Blank Lines Spaces.zip (4.2 KB)

[VB6] AddIn IDE Codefolding

June 3, 2021, 2:57 pm

≫ Next: Create Procedure Headers

≪ Previous: Remove Blank Lines and Extra Spaces

$

0

0

This is an add-in to Add Codefolding like capabilities to VB6 IDE

Unfortunately VB6 doesnt support codefolding so I came with an idea to mimic its functionality
by relocating part of the code (Functions/Sub or Regions) towards the bottom of the file and
leaving a placeholder that can be expanded (It can be used with subclasing. The fold storage can be moved up without problems)

I divide foldable content into two types:

-Function/Sub:

They can be Folded without any problem. The project can be opened by anyone without the AddIn and
be 100% compatible.

-Regions:

This are the user defined area (they can be created by selecting the lines and opening the context
menu with the right mouse). Regions can be of three types:

-Outer regions:

Regions that have several Functions/Sub inside. Like before this leave a 100% compatible project.

-Outer region with declares/enums/type:

This ones (usually at the top of the module) are automatically marked to unfold on run/compile.

-Inner region:

This are the regions inside functions.There is no limit on the number of sublevels that can be

created. If folded they are automatically unfolded on run/compile and refolded after.

IMPORTANT!!!: Inner regions need to be padded and every region inside another need another extra level
of padding. Not respecting this rule may break your code.

The last two groups needs the AddIn to be enabled only if they are Folded.
An Unfolded project is still 100% compatible with any VB6 IDE not using the AddIn.

NOTES:

-Sub/Function/Props need scope to be explicit ("Public Sub","Private Sub","Public Func...)
-May fail on FULL COMPILE (CTRL+F5) when Regions are folded and VB6 is configured with
"General->Compile on demand" (This is a bug on VB6 IDE. It dont raise the addIn event)

DOWNLOAD: prj (AddIn) CodeFold v1.0.0.zip

Attached Images

   

Attached Files

• prj (AddIn) CodeFold v1.0.0.zip (47.1 KB)

---

Create Procedure Headers

June 4, 2021, 8:29 am

≫ Next: Simple Usercontrol Toggle/Button

≪ Previous: [VB6] AddIn IDE Codefolding

$

0

0

Creates a Procedure Header and copies it to clipboard , to be copied into your code. Very simple code. Added an Update

Attached Images

 

Attached Files

• Proced Header.zip (20.2 KB)

Simple Usercontrol Toggle/Button

June 7, 2021, 7:35 am

≫ Next: Print to specific PDF file name

≪ Previous: Create Procedure Headers

$

0

0

This is a simple toggle/Button usercontrol I threw together. Its probably not perfect, but still useable. See what you think of it. Enjoy.

Attached Images

 

Attached Files

• Button.zip (9.5 KB)

Print to specific PDF file name

June 12, 2021, 11:55 am

≫ Next: Scramble letters in a word except for the first and last letter

≪ Previous: Simple Usercontrol Toggle/Button

$

0

0

Assumes Windows 10 with the optional Microsoft Print to PDF driver installed. This is normally the default unless the user has removed it via Windows Features.

Bare bones example. Note that for the most part printing must be done via API calls to avoid raising the driver's file picker dialog:

Code:

---

Option Explicit

Private Declare Function EndDoc Lib "gdi32" (ByVal hDC As Long) As Long

Private Declare Function EndPage Lib "gdi32" (ByVal hDC As Long) As Long

Private Type DOCINFO
    cbSize As Long
    DocName As String
    Output As String
    Datatype As String
    fwType As Long
End Type

Private Declare Function StartDoc Lib "gdi32" Alias "StartDocA" ( _
    ByVal hDC As Long, _
    ByRef DOCINFO As DOCINFO) As Long

Private Declare Function StartPage Lib "gdi32" (ByVal hDC As Long) As Long

Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" ( _
    ByVal hDC As Long, _
    ByVal X As Long, _
    ByVal Y As Long, _
    ByVal Text As String, _
    ByVal nCount As Long) As Long

Private Sub Main()
    Const LMARGIN As Long = 300
    Const TMARGIN As Long = 500
    Dim P As Printer
    Dim DOCINFO As DOCINFO
    Dim LineHeight As Long
    Dim Y As Long
    Dim I As Long
    Dim Text As String

    For Each P In Printers
        If P.DeviceName = "Microsoft Print to PDF" Then
            Set Printer = P
            GoTo FoundPDF
        End If
    Next
    MsgBox "No ""Microsoft Print to PDF"" driver!", vbExclamation
    Exit Sub

FoundPDF:
    'We can't use Printer.EndPage, Printer.EndDoc, Printer.Print, Printer.PaintPicture,
    'etc. because we need StartDoc() which VB6 will try to do for us "automagically,"
    'thus preventing us from designating the output file programmatically.  I.e. the
    'user will always see the driver's dialog to pick an output file.
    With Printer
        On Error Resume Next
        Kill App.Path & "\specific.pdf"
        On Error GoTo 0
        With DOCINFO
            .cbSize = LenB(DOCINFO)
            .DocName = "To specific file"
            .Output = App.Path & "\specific.pdf"
        End With
        StartDoc .hDC, DOCINFO
        With .Font
            .Name = "Arial"
            .Size = 12
        End With
        LineHeight = Int(.ScaleY(.TextHeight("X"), .ScaleMode, vbPixels))
        StartPage .hDC
        Y = TMARGIN
        For I = 1 To 10
            Text = "Hello"
            TextOut .hDC, LMARGIN, Y, Text, Len(Text)
            Y = Y + LineHeight
            Text = "world!"
            TextOut .hDC, LMARGIN + 250, Y, Text, Len(Text)
            Y = Y + LineHeight * 2 'Double-space here.
        Next
        EndPage .hDC
        EndDoc .hDC
    End With
    MsgBox "Complete"
End Sub

---

DrawText() normally makes more sense than TextOut(). You can use StdPicture.Render() but not Printer.PaintPicture(), or use BitBlt(), StretchBlt(), etc. for images.

Scramble letters in a word except for the first and last letter

June 12, 2021, 3:13 pm

≫ Next: Image Viewer

≪ Previous: Print to specific PDF file name

$

0

0

This will scramble the letters in a word.

Attached Images

 

Attached Files

• ScrambleLetters.zip (2.7 KB)

Image Viewer

June 13, 2021, 3:35 pm

≫ Next: Floating Desktop Date

≪ Previous: Scramble letters in a word except for the first and last letter

$

0

0

Attached is a Picture Viewer. It does not have a bunch of fancy features, because the intent was to use as much of the screen as possible for the image itself. Inspiration for this program came from dilettante with his "Drop Send Pic".
https://www.vbforums.com/showthread....mage-to-Base64
Before anyone tells me that I could have just loaded the files directly into the Picture Box or the form Picture, I had difficulty in meeting the objectives doing it that way. I needed to not only adjust the container to suit the size of the image, but also to adjust the container for the size of the screen. I loaded the file into a byte array, and then I used a Picture Box because it was the only thing that would support "AutoRedraw". My intent is to eventually produce a remote Picture Viewer similar to dilettantes.

I don't know the reason why, but some "png" files load, and some do not?

J.A. Coutts

Updated: 06/13/2021

Attached Files

• PicView.zip (3.0 KB)