Load files outside the program

April 17, 2024, 1:39 pm

≫ Next: WinDevLib: A Better Way to Call Windows API Functions in twinBASIC

$

0

0

Hi guys
I want to call all the files outside the program and in a single file (external resource file)
I did this with the help of PBag Resources but it doesn't read all the files
Text files and images are called, but there is a problem with other files
For example, it cannot read the file to install the font

HTML Code:

---

Option Explicit
Private Declare Function AddFontResourceEx Lib "gdi32" Alias "AddFontResourceExA" _
(ByVal sFIleName As String, ByVal lFlags As Long, ByVal lReserved As Long) As Long
Private Const FR_PRIVATE As Long = &H10
Public Function InstallFont(pFontPath As String) As Long
InstallFont = AddFontResourceEx(pFontPath, FR_PRIVATE, 0&)
End Function
Private Sub Form_Load()
Dim BagFile As Integer
Dim ContentBytes() As Byte
BagFile = FreeFile(0)
Open "bag.dat" For Binary Access Read As #BagFile
ReDim ContentBytes(LOF(BagFile) - 1)
Get #BagFile, , ContentBytes
Close #BagFile
With New PropertyBag
.Contents = ContentBytes
lblBurger.Caption = .ReadProperty("Burger.txt")
lblFries.Caption = .ReadProperty("Fries.txt")
InstallFont (.ReadProperty("MyFont.ttf"))
End With
Text1.Font.Name = "MyFont"
End Sub

---

It gives an error that the data value named "MyFont.ttf" was not found
How can I call all the files?

Attached Files

• PBag.zip (11.2 KB)

---

WinDevLib: A Better Way to Call Windows API Functions in twinBASIC

April 17, 2024, 1:46 pm

≫ Next: Outlook Recipient (how to determine?)

≪ Previous: Load files outside the program

$

0

0

The Windows Development Library (aka, WinDevLib) is a twinBASIC package from VB6 and twinBASIC guru fafalone (aka, Jon Johnson).



Stop struggling to declare your Windows API calls in twinBASIC. Use the Windows Development Library twinPACK and let fafalone do all the hard work for you.

https://nolongerset.com/windevlib/

Attached Images

 

Outlook Recipient (how to determine?)

April 17, 2024, 6:04 pm

≫ Next: [RESOLVED] FAT32 Quick Format above 32gb

≪ Previous: WinDevLib: A Better Way to Call Windows API Functions in twinBASIC

$

0

0

Has anyone ever figured out a simple way to find out who the MAIN recipient is in Outlook?

I've done a lot of searching and from what I can tell there is no easy way. What Outlook gives you instead is a Recipient list that you have to iterate through and then I don't know what. It was too convoluted and messy for me to dive deeper into it. In the end I'm not even sure it was possible to figure out anything more than a list of the CC's and everyone else who got the e-mail.

Did I miss something or is it really that difficult? This is something I've wanted to put in my software for a long time and haven't been able to figure out.

Thanks. :)

[RESOLVED] FAT32 Quick Format above 32gb

April 17, 2024, 3:25 pm

≫ Next: VBA-RapidOCR how can i changed to vb6?

≪ Previous: Outlook Recipient (how to determine?)

$

0

0

Using VB6

Must use FAT32 file system for a device using a USB thumb drive now above 32gb. Need to make a "quick format" via code as a fast way to "erase" the drive. Currently shelling out to a batch file running in the command (DOS-like) system.

I can format above 32gb but no syntax variation I can find in the "Format" command will allow the /q option with return error indicating "FAT32 cannot be used above 32gb" yet there is no problem doing a complete and successful format of a 64gb drive without the /q option.

Is my only option using a batch file to teletype to into DiskPart? If so how do I find the disk number beforehand? I find nothing in either VB or the FileSystemObject to return a simple integer value of a drive to correspond with that in the DiskPart interface.

Thanks for any suggestions/assistance.

VBA-RapidOCR how can i changed to vb6?

April 17, 2024, 8:09 pm

≫ Next: Listview display degree, minutes, seconds

≪ Previous: [RESOLVED] FAT32 Quick Format above 32gb

$

0

0

Quote:

---

Originally Posted by Schmidt

You can call cdecl-defined functions also without compiling to a native-binary first,
when you use the DispCallFunc-API (no "hacking" needed) - e.g. via the module below:

Code:

---

Option Explicit

Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal offsetinVft As Long, ByVal CallConv As Long, ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, ByRef paValues As Long, ByRef retVAR As Variant) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function lstrlenA Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (Dst As Any, Src As Any, ByVal BLen As Long)

Private Enum CALLINGCONVENTION_ENUM
  CC_FASTCALL
  CC_CDECL
  CC_PASCAL
  CC_MACPASCAL
  CC_STDCALL
  CC_FPFASTCALL
  CC_SYSCALL
  CC_MPWCDECL
  CC_MPWPASCAL
End Enum

Private LibHdls As New Collection, VType(0 To 63) As Integer, VPtr(0 To 63) As Long

Public Function stdCallW(sDll As String, sFunc As String, ByVal RetType As VbVarType, ParamArray P() As Variant)
Dim i As Long, V(), HRes As Long
 
  V = P 'make a copy of the params, to prevent problems with VT_Byref-Members in the ParamArray
  For i = 0 To UBound(V)
    If VarType(P(i)) = vbString Then V(i) = StrPtr(P(i))
    VType(i) = VarType(V(i))
    VPtr(i) = VarPtr(V(i))
  Next i
 
  HRes = DispCallFunc(0, GetFuncPtr(sDll, sFunc), CC_STDCALL, RetType, i, VType(0), VPtr(0), stdCallW)
  If HRes Then Err.Raise HRes
End Function

Public Function cdeclCallW(sDll As String, sFunc As String, ByVal RetType As VbVarType, ParamArray P() As Variant)
Dim i As Long, pFunc As Long, V(), HRes As Long
 
  V = P 'make a copy of the params, to prevent problems with VT_Byref-Members in the ParamArray
  For i = 0 To UBound(V)
    If VarType(P(i)) = vbString Then V(i) = StrPtr(P(i))
    VType(i) = VarType(V(i))
    VPtr(i) = VarPtr(V(i))
  Next i
 
  HRes = DispCallFunc(0, GetFuncPtr(sDll, sFunc), CC_CDECL, RetType, i, VType(0), VPtr(0), cdeclCallW)
  If HRes Then Err.Raise HRes
End Function

Public Function stdCallA(sDll As String, sFunc As String, ByVal RetType As VbVarType, ParamArray P() As Variant)
Dim i As Long, pFunc As Long, V(), HRes As Long
 
  V = P 'make a copy of the params, to prevent problems with VT_Byref-Members in the ParamArray
  For i = 0 To UBound(V)
    If VarType(P(i)) = vbString Then P(i) = StrConv(P(i), vbFromUnicode): V(i) = StrPtr(P(i))
    VType(i) = VarType(V(i))
    VPtr(i) = VarPtr(V(i))
  Next i
 
  HRes = DispCallFunc(0, GetFuncPtr(sDll, sFunc), CC_STDCALL, RetType, i, VType(0), VPtr(0), stdCallA)
 
  For i = 0 To UBound(P) 'back-conversion of the ANSI-String-Results
    If VarType(P(i)) = vbString Then P(i) = StrConv(P(i), vbUnicode)
  Next i
  If HRes Then Err.Raise HRes
End Function

Public Function cdeclCallA(sDll As String, sFunc As String, ByVal RetType As VbVarType, ParamArray P() As Variant)
Dim i As Long, pFunc As Long, V(), HRes As Long
 
  V = P 'make a copy of the params, to prevent problems with VT_Byref-Members in the ParamArray
  For i = 0 To UBound(V)
    If VarType(P(i)) = vbString Then P(i) = StrConv(P(i), vbFromUnicode): V(i) = StrPtr(P(i))
    VType(i) = VarType(V(i))
    VPtr(i) = VarPtr(V(i))
  Next i
 
  HRes = DispCallFunc(0, GetFuncPtr(sDll, sFunc), CC_CDECL, RetType, i, VType(0), VPtr(0), cdeclCallA)
 
  For i = 0 To UBound(P) 'back-conversion of the ANSI-String-Results
    If VarType(P(i)) = vbString Then P(i) = StrConv(P(i), vbUnicode)
  Next i
  If HRes Then Err.Raise HRes
End Function

Public Function vtblCall(pUnk As Long, ByVal vtblIdx As Long, ParamArray P() As Variant)
Dim i As Long, V(), HRes As Long
  If pUnk = 0 Then Exit Function

  V = P 'make a copy of the params, to prevent problems with VT_ByRef-Members in the ParamArray
  For i = 0 To UBound(V)
    VType(i) = VarType(V(i))
    VPtr(i) = VarPtr(V(i))
  Next i
 
  HRes = DispCallFunc(pUnk, vtblIdx * 4, CC_STDCALL, vbLong, i, VType(0), VPtr(0), vtblCall)
  If HRes Then Err.Raise HRes
End Function

Public Function GetFuncPtr(sDll As String, sFunc As String) As Long
Static hLib As Long, sLib As String
  If sLib <> sDll Then 'just a bit of caching, to make resolving libHdls faster
    sLib = sDll
    On Error Resume Next
      hLib = 0
      hLib = LibHdls(sLib)
    On Error GoTo 0
   
    If hLib = 0 Then
      hLib = LoadLibrary(sLib)
      If hLib = 0 Then Err.Raise vbObjectError, , "Dll not found (or loadable): " & sLib
      LibHdls.Add hLib, sLib '<- cache it under the dll-name for the next call
    End If
  End If
  GetFuncPtr = GetProcAddress(hLib, sFunc)
  If GetFuncPtr = 0 Then Err.Raise 453, , "EntryPoint not found: " & sFunc & " in: " & sLib
End Function

Public Function GetBStrFromPtr(lpSrc As Long, Optional ByVal ANSI As Boolean) As String
Dim SLen As Long
  If lpSrc = 0 Then Exit Function
  If ANSI Then SLen = lstrlenA(lpSrc) Else SLen = lstrlenW(lpSrc)
  If SLen Then GetBStrFromPtr = Space$(SLen) Else Exit Function
     
  Select Case ANSI
    Case True: RtlMoveMemory ByVal GetBStrFromPtr, ByVal lpSrc, SLen
    Case Else: RtlMoveMemory ByVal StrPtr(GetBStrFromPtr), ByVal lpSrc, SLen * 2
  End Select
End Function

Public Sub CleanupLibHandles() 'not really needed - but callable (usually at process-shutdown) to clear things up
Dim LibHdl
  For Each LibHdl In LibHdls: FreeLibrary LibHdl: Next
  Set LibHdls = Nothing
End Sub

---

Using the drop-in-module above, your code could then look like:

Code:

---

Function OpenDeviceWithSerial(SerialNumber As String) As Long
  OpenDeviceWithSerial = cdeclCallA(YourDllFilePath, "usb_relay_device_open_with_serial_number", _
                          vbLong, SerialNumber, Len(SerialNumber))
End Function

---

HTH

Olaf

---

how can fixed

https://github.com/DanysysTeam/VBA-RapidOCR

i download this zip about ocr for vba

but if run to this

Code:

---

'https://www.vbforums.com/showthread.php?789217-C-DLL-to-VB6&p=5505940&viewfull=1#post5505940 - Schmidt
Private Function cdeclCallA(sDll As String, _
                            sFunc As String, _
                            ByVal RetType As VbVarType, _
                            ParamArray P() As Variant) As Variant
    Dim i As Long, pFunc As LongPtr, V() As Variant, HRes As Long
 
    V = P                                        'make a copy of the params, to prevent problems with VT_Byref-Members in the ParamArray

    For i = 0 To UBound(V)

        If VarType(P(i)) = vbString Then P(i) = StrConv(P(i), vbFromUnicode): V(i) = StrPtr(P(i))
        VType(i) = VarType(V(i))
        VPtr(i) = VarPtr(V(i))
    Next i
 
    pFunc = GetFuncPtr(sDll, sFunc)
    HRes = DispCallFunc(0, pFunc, CC_CDECL, RetType, i, VarPtr(VType(0)), VarPtr(VPtr(0)), cdeclCallA)
 
    For i = 0 To UBound(P)                      'back-conversion of the ANSI-String-Results

        If VarType(P(i)) = vbString Then P(i) = StrConv(P(i), vbUnicode)
    Next i

    If HRes Then Err.Raise HRes
End Function

---

HTML Code:

---

    HRes = DispCallFunc(0, pFunc, CC_CDECL, RetType, i, VarPtr(VType(0)), VarPtr(VPtr(0)), cdeclCallA)  ----- crashed

---

VBA-RapidOCR-main.zip

thanks

Attached Images

 

Attached Files

• VBA-RapidOCR-main.zip (597.6 KB)

Listview display degree, minutes, seconds

April 17, 2024, 10:44 pm

≫ Next: Split a branch into nodes, reconstrucing and running a query on each = inefficient?

≪ Previous: VBA-RapidOCR how can i changed to vb6?

$

0

0

How to display degree minutes and seconds in listview items? how to start with it?

Split a branch into nodes, reconstrucing and running a query on each = inefficient?

April 18, 2024, 1:17 am

≫ Next: VS 2019 Hyperlinks of cells missing while copying range from Excel.Please Help

≪ Previous: Listview display degree, minutes, seconds

$

0

0

Anyone have a better idea how to do this?

Working demo attached. I got the whole tree/branch/node thing sorted and like it.

Tree.zip

Also, DO NOT click create tree until you look at the Editor or you will wipe out the tree in the db.

Edit: This isn't in the upload but when I started this I was more interested in getting it working than anything else. So all the generic DB stuff in frmTree has been moved to the DB module.

Code:

---

Private Sub PopulateParentText()
Dim RST As DAO.Recordset
Dim SQL As String
Dim nRecordcount As Long
Dim sBranch() As String
Dim sToken As String
Dim n As Long
Dim sContent As String
Dim s As String

' Outputs All content in the Branch up to the Node being edited.

' This is convoluted.  There has to be a better way but this works.

' Typical Branch: 001_001_002_001

' Find the Content of 001, 001_001, 001_001_002, and 001_001_002_001

' E.g.

' 001 = "You come to a crossroad."
' 001_001 = "You decide to turn left.
' 001_001_002 = "You are stopped by a sharply dressed man."
' 001_001_002_001 = "He offers you a deal.
' skipping ahead...
' 001_001_002_001_001_003 = "YOU DIED!!"
' (make better choices)

txtParent.Text = vbNullString

sBranch = Split(cmbParent.Text, "_") ' Create an Array of Each Token in the string.

If Not ArrayInitialized(sBranch) Then Exit Sub ' Nothing there.

sToken = sBranch(0) ' First Token is a special case that doesn't contain an underscore.

SQL = "SELECT Content FROM Branches WHERE Branch = '" & sToken & "'"

nRecordcount = OpenRST(RST, SQL, idx_Recordset_Snapshot)
If nRecordcount = 0 Then Exit Sub

s = RST.Fields("Content") ' Save the string.

For n = LBound(sBranch) + 1 To UBound(sBranch)

  sToken = sToken & "_" & sBranch(n) ' Now add in tokens one at a time separated by an underscore.

  SQL = "SELECT Content FROM Branches WHERE Branch = '" & sToken & "'"

  nRecordcount = OpenRST(RST, SQL, idx_Recordset_Snapshot)

  If nRecordcount > 0 Then

      s = s & vbCrLf & RST.Fields("Content")

  end if
Next n

txtParent.Text = s

End Sub

---

Attached Files

• Tree.zip (108.7 KB)

VS 2019 Hyperlinks of cells missing while copying range from Excel.Please Help

April 18, 2024, 3:16 am

≫ Next: Inquiry Regarding Outlook Rules

≪ Previous: Split a branch into nodes, reconstrucing and running a query on each = inefficient?

$

0

0

Hi All,

My excel sheet has huge dat above 30k to process each row is taking time so I used Range .ExcelSheet.Range("A7:Z30000)date dumped in single range. Actually some columns contains Hyperlinks which are missing when we export data.

please help

---

Inquiry Regarding Outlook Rules

April 18, 2024, 3:29 am

≫ Next: Random-Depth Tree Creator/Editor

≪ Previous: VS 2019 Hyperlinks of cells missing while copying range from Excel.Please Help

$

0

0

Good day,

I have an issue regarding Outlook rules that I'm struggling with, and I'm curious if you have any tips!

I have a scenario concerning rules in Outlook.

I want outgoing emails that I send with a question to receive a blue label. I've managed to set this up using rules, which works perfectly.

Subsequently, I'd like for the blue label to disappear when I receive a reply to these emails, and for the new email to appear green in my inbox. (The green coloring upon reply in the inbox works fine, but the blue category label remains in my sent items.)

The goal is to have a clear overview in my sent items of which emails I still need to follow up on because I haven't received a response. Manually removing the label is an option, but it's prone to being forgotten.

If there's a rule available for achieving this, it would provide a perfect overview of unanswered emails that still need follow-up.


After adjusting some settings (Regedit) I can find 'Run a script' in my Rules Wizard again so now I can post choose the script for this and select the needs and then it works.

But now I need to choose the script but it doesn't show any. The script I use was made by ChatGPT because I don't know how that works.

But my question, how can I make the correct script/macro in VB so that it shows in my Rules Wizard if I click scripts.

The script I want to use is underneath.


Looking forward to your response! Would be amazing and everybody in my company would be so happy. But I would be the one that's the most happy.



Sub RemoveWaitingForResponseCategoryOnReply(Item As Outlook.MailItem)
Dim objSentFolder As Outlook.Folder
Dim objInbox As Outlook.Folder
Dim objSentItem As Outlook.MailItem
Dim objReceivedItem As Outlook.MailItem

Set objSentFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
Set objInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

' Check if the received email is a reply to a sent email
If Item.Parent = objInbox Then
Set objReceivedItem = Item
' Find the corresponding sent email
For Each objSentItem In objSentFolder.Items
If objSentItem.ConversationID = objReceivedItem.ConversationID Then
' Remove the category "Waiting for response from other party" from the sent email
objSentItem.Categories = Replace(objSentItem.Categories, "Waiting for response from other party", "")
objSentItem.Save
Exit For
End If
Next objSentItem
End If
End Sub

Random-Depth Tree Creator/Editor

April 18, 2024, 5:18 am

≫ Next: VS 2022 Spawn Default Application

≪ Previous: Inquiry Regarding Outlook Rules

$

0

0

Tree.zip

This is a Tool I built to create random events in a game I'm writing.

The idea is to create a Tree having Random-Depth Branches.

Each Branch can branch off into different directions so that when an Event happens it can go multiple ways.

The "real" way to do this is to probably just create branches as you need them but I wanted something to kind of push me along.

Hopefully what I end up with content-wise isn't too contrived just to force-fill the Nodes.

It's a one-and-done kind of tool. Once the Tree is created that's it for that game. You never use it again.

Unless you want to create multiple databases or put multiple tables in the same database and each time you run the Tree Creator you have it fill a different table. You'll have to change the Table Name in the code every time you do this.

--------------

Edit: You could pretty easily add another textbox to the Tree Creator and have it create an empty copy of the Table with whatever name you enter into the textbox and then have the Tree fill that new table. I should have done that and probably will.

--------------

That would allow you to use the same game engine (you gotta write that) but have multiple versions of it: Steampunk, Cyberpunk, Post-Apocalypse, etc.

This applet is very bare-bones. It is fully functional though.

I added in the quality-of-life stuff I know I'll want. I'll probably make some tweaks to it here and there as I'm using it more extensively and find things I'd like to work better or easier or more efficiently or whatever.

But really it's just to get me the content for my game without spending any more time than necessary making the tools to make the game.

If you download the attached file then be sure to check out the Tree Editor *BEFORE* you create any Trees.

Every time you create a New Tree it wipes out the existing Tree. All of it.

So the first thing to do is fire it up, go to the Tree Editor, go to the "Branch to Node" Combobox and scroll down a few entries.

There are Nine entries filled in this so you can see how it works.

Also too, if there's an entry missing in the middle of a branch it will tell you. In fact, it will tell you ALL missing nodes.

But if you see something like:

"You walk into the forest."
"You see a bear."
"[Content is Missing]"
"YOU DIED!"

Then there's a missing bit that needs to be fixed.

Anyway, this is doing everything I need it to do (I think) and it doesn't choke.

I will caution you against putting in huge numbers for the Tree Creator.

I put in 999 for Starting Seed and 99 for Target Depth. Hours later it was in the 300's. That was when it was only writing to a text file. I hadn't done the db bit yet. That's on a Threadripper 3960x with very fast NVMe drives.

Because it's Random, you might end up with the largest tree possible for the numbers input or something very small.

For example, if you enter 50 for Starting Seed, that doesn't mean it won't roll a one and give you one branch with two nodes.

So you might have to do it a few times to get something you like which is exactly what I wanted.

I just roll until I get about the right balance between number of Branches and total number of Nodes.

I was looking for Nodes in the 3K to 5K range. Starting Seed of 75 with a Target Depth of 6 got me what I wanted after a couple rolls.

===============

About the game and why I'm doing it this way. And before I go there, this IS NOT the game. This is to create content for the game in case that wasn't clear.

This game isn't a "story". It picks Events at random and the player responds to them.

So one event might have the player in her office and the next Event might be the player in a dungeon with no coherant path from office to dungeon.

That's not driven by the Tree though. If you were to use this to build a game you could easily set it up so it doesn't pick events at random and events have to follow each other in a logical way.

I'm just having fun. :)

Lastly, I have "Tech Savvy" and "Booksmarts" that seem to be pretty much the same thing. I want six stats so before I go creating a bunch of content I need to think about that some more and figure out a stat that would be better to replace one of the two.

Attached Files

• Tree.zip (188.7 KB)

VS 2022 Spawn Default Application

April 18, 2024, 8:03 am

≫ Next: Merge several OCX files ? (or extract them to get ctl/ctx and recompile another OCX)

≪ Previous: Random-Depth Tree Creator/Editor

$

0

0

Hitting a roadblock with my latest challenge:

On the main, I know I can use Process.Start() to spawn an external application and believe I have a grasp on that. But I have two bits that are not working as-is.

1. I've read and seen examples that work 100% correctly if the call is invoked in a certain way (i.e. executable + optional parameter[s]). What I haven't seen is something that applies if the preconditions can't be met directly; in this case, declaring an executable.
2. I cannot get .WaitForExit() to work because it generates a Null Exception error. Unusual for me, I know why it happens: It's because of the first bit I'm having difficulties with.

I'm not sure of the best way to fix this; either by addressing the first bit, or with some guidance on getting .WaitForExit() to work.

With that said: My issue with the first bit is that I don't know what the "executable" part should be any given time the function will be invoked. The reason for this is that in this particular instance, I'm trying to perform an agnostic invocation of the default handler for a file by passing it's FQN. For instance, calling Process.Start("sample.txt") will invoke notepad if it's the default handler, TEDNotepad if it's the one, etc. If the file is a JPG, WAV, DOC, etc. it would be treated similarly. I don't want to have a different process for each possible filetype (or mimetype).

In other words, of I call Process.Start() with a filename as the only parameter, it produces the Null Exception. If I pass an executable as the only parameter, or as the first parameter plus the filename as the second, it works as I expect it to. To whit, the skeleton is:

Code:

---

Public Sub FLBG_Spawn(ByVal _SpawnedProcess As String, Optional ByVal _ProcessArguments as String = "")
      If Len(Trim(_ProcessArguments)) > 0 Then
          Process.Start(_SpawnedProcess, _ProcessArguments).WaitForExit()
      Else
          Process.Start(_SpawnedProcess).WaitForExit()
      End If
End Sub

---

...and based on that:

Code:

---

FLBG_Spawn("D:\test.txt")                              ' I cause a Null Exception
FLBG_Spawn("notepad.exe")                              ' I work as expected
FLBG_Spawn("notepad.exe", "D:\test.txt")              ' I work as expected too

---

My dumbed-down interpretation is this: .WaitForExit() looks to the first parameter passed to .Start() as the process to watch. Passing a filename keeps the handler's "handle" in the stack, but when the "handle" is a filename, it leaves the stack as soon as the handler is started.

So... is there a way I can do this with whatever the correct default handler for the file type is?

Merge several OCX files ? (or extract them to get ctl/ctx and recompile another OCX)

April 18, 2024, 8:15 am

≫ Next: [RESOLVED] Help finding old code sample here on VBF

≪ Previous: VS 2022 Spawn Default Application

$

0

0

Hi friends,

I finally got good result with manifest files to embed OCX files in the app directory instead of registering them in the OS.

Some minor question, is it possible to :
- Create one OCX file, including several OCX files ?
- Extracte each OCX file (in view to recreate one OCX file from ctl/ctx files of each extracter OCX files) ?

The goal is having for exeample "myapp.ocx" and that's all :D

Thanks :thumb:
:duck:

[RESOLVED] Help finding old code sample here on VBF

April 18, 2024, 8:35 am

≫ Next: [RESOLVED] [GDI+] Draw Text With Outline Not Lining Up

≪ Previous: Merge several OCX files ? (or extract them to get ctl/ctx and recompile another OCX)

$

0

0

Hi everyone!

I've searched the forums here for several days and can't find this. I had it in my own personal use codebank but I went through a hard drive crash and lost lots of things :(.



There was posted a simple example of using IStream and GDI+ in order to retrieve and save video file thumbnails. Not sure but I think that the author was either dilettante or fafalone. Not sure if it was in the codebank here or just in a post.

I would love to find that again because it was great code and I have a need. Any help appreciated. Thank you :).

[RESOLVED] [GDI+] Draw Text With Outline Not Lining Up

April 18, 2024, 9:31 am

≫ Next: Windows INI Reader and Writer

≪ Previous: [RESOLVED] Help finding old code sample here on VBF

$

0

0

Hello

I am trying to outline GDI+ text with a path, but the two are not lining up.



Any ideas as to why not?

It will be important as I will be doing hittesting on path.

Code:

---

Option Explicit


Dim gdiplusToken As Long


Private Sub Form_Load()

    Form1.Caption = "GDI+"
    Form1.Width = Screen.TwipsPerPixelX * 600
    Form1.Height = Screen.TwipsPerPixelY * 465
    Form1.BackColor = &H8000000F
    Form1.ScaleMode = vbPixels

    Picture1.Appearance = 0
    Picture1.Left = 16
    Picture1.Top = 16
    Picture1.Height = 366
    Picture1.Width = 552
    'Picture1.Font = "courier new"
    Picture1.AutoRedraw = True
   
    Command1.Width = Picture1.Width
    Command1.Height = 25
    Command1.Left = Picture1.Left
    Command1.Top = Picture1.Top + Picture1.Height + 10
    Command1.Caption = "Draw Text"
   
    ' Initialize Windows GDI+
    Dim GdiplusStartupInput As GdiplusStartupInput
    GdiplusStartupInput.GdiplusVersion = 1
    GdiplusStartupInput.DebugEventCallback = 0
    GdiplusStartupInput.SuppressBackgroundThread = False
    GdiplusStartupInput.SuppressExternalCodecs = False
    Dim status As GpStatus
    status = GdiplusStartup(gdiplusToken, GdiplusStartupInput, 0)
    If status <> Ok Then
        MsgBox "Error loading GDI+!", vbCritical
        Call GdiplusShutdown(gdiplusToken)
    End If

End Sub


Private Sub Form_Unload(Cancel As Integer)
   
    ' Clean up resources used by Windows GDI+
    Call GdiplusShutdown(gdiplusToken)
   
End Sub


Private Sub Command1_Click()

    Picture1.Cls
    Call DrawTextOutline(Picture1.hdc, "My Text", 75, 125, 400, 200)
    Picture1.Refresh
   
End Sub


Function DrawTextOutline(ByVal hdc As Long, _
                        ByVal sText As String, _
                        ByVal x As Single, ByVal y As Single, _
                        ByVal Width As Single, ByVal Height As Single) As Boolean
   
    Dim graphics As Long
    Dim brushBlack As Long
    Dim penRed As Long
    Dim fontFamily As Long
    Dim font As Long
    Dim fontSize As Long
    Dim StringFormat As Long
    Dim path As Long
    Dim rect As RECTF

    Dim stat As Long
   
    fontSize = 96
 
    stat = GdipCreateFromHDC(hdc, graphics)
    stat = GdipCreateSolidFill(&HFF000000, brushBlack)
    stat = GdipCreatePen1(&HFFFF0000, 1, UnitPixel, penRed)
    stat = GdipCreateFontFamilyFromName(StrPtr("Calibri"), 0, fontFamily)
    stat = GdipCreateFont(fontFamily, fontSize, 0&, 0, font)
    stat = GdipCreateStringFormat(0, 0, StringFormat)
    stat = GdipCreatePath(FillModeAlternate, path)
   
    stat = GdipSetStringFormatAlign(StringFormat, StringAlignmentCenter)
    stat = GdipSetTextRenderingHint(graphics, TextRenderingHintAntiAlias)

    rect.Left = x
    rect.Top = y
    rect.Bottom = Height
    rect.Right = Width

    stat = GdipAddPathString(path, _
                StrPtr(sText), -1, fontFamily, FontStyleRegular, fontSize, rect, StringFormat)
               
    stat = GdipDrawString(graphics, StrPtr(sText), -1, font, rect, StringFormat, brushBlack)
    stat = GdipDrawPath(graphics, penRed, path)

    stat = GdipDeletePath(path)
    stat = GdipDeleteStringFormat(StringFormat)
    stat = GdipDeleteFont(font)
    stat = GdipDeleteFontFamily(fontFamily)
    stat = GdipDeletePen(penRed)
    stat = GdipDeleteBrush(brushBlack)
    stat = GdipDeleteGraphics(graphics)
   
End Function

---

Attached Images

 

Windows INI Reader and Writer

April 18, 2024, 12:02 pm

≪ Previous: [RESOLVED] [GDI+] Draw Text With Outline Not Lining Up

$

0

0

Hi here is an update of my ini reader and writer I made a few years back, anyway I been working on a new project and needed a few other things from my ini so I added them in hope you like it Comments welcome.

INI Class

Code:

---

/* Simple INI file reading and writing class.
 * Version 1.0
 * By Ben a.k.a DreamVB
 * Please use this class as you want.
 *
 * Update v1.2 18/4/2024
 * Added support to read and write Multiline Strings
 * Added support to read and write integer
 * Added support to read and write bool
 * Added support to read and write double
 * Added SelectionExists
 * Added KeyExists
 */

using System;
using System.Collections.Generic;
using System.Text;
using System.Runtime.InteropServices;
using System.IO;

namespace inidemo
{
    class inifile
    {
        private static FileInfo fi;

        [DllImport("kernel32")]
        static extern long WritePrivateProfileString(string Section, string Key, string Value, string FilePath);

        [DllImport("kernel32")]
        static extern int GetPrivateProfileString(string Section, string Key, string Default, StringBuilder RetVal, int Size, string FilePath);

        public void WriteString(string selection, string Key, string Value)
        {
            WritePrivateProfileString(selection, Key, Value, fi.FullName);
        }

        public string ReadString(string selection, string Key, string vDefault = "")
        {
            StringBuilder sb = new StringBuilder(2048);
            //Get INI file.
            GetPrivateProfileString(selection, Key, vDefault, sb, 2048, fi.FullName);
            //Return value.
            return sb.ToString();
        }

        public void WriteMultilineString(string selection,string Key, string Value)
        {
            string S = Value.Replace(Environment.NewLine, "\\n");
            WriteString(selection, Key, S);
        }

        public void WriteInteger(string selection,string Key, int Value)
        {
            WriteString(selection, Key, Value.ToString());
        }

        public void WriteBool(string selection, string Key, bool Value)
        {
            WriteString(selection, Key, Value.ToString());
        }

        public void WriteDouble(string selection, string Key, double Value)
        {
            WriteString(selection, Key, Value.ToString());
        }

        public int ReadInteger(string selection, string Key, int vDefault)
        {
            int v;

            try
            {
                v = int.Parse(ReadString(selection, Key, vDefault.ToString()));
            }
            catch (Exception e)
            {
                throw new Exception(e.Message);
            }
            return v;
        }

        public string ReadMultilineString(string selection, string Key, string vDefault)
        {
            string v;

            try
            {
                v = ReadString(selection, Key, vDefault.ToString()).Replace("\\n", Environment.NewLine);
            }catch (Exception e)
            {
                throw new Exception(e.Message);
            }
            return v;
        }

        public bool ReadBool(string selection, string Key, bool vDefault)
        {
            bool v;

            try
            {
                v = bool.Parse(ReadString(selection, Key, vDefault.ToString()));
            }
            catch (Exception e)
            {
                throw new Exception(e.Message);
            }
            return v;
        }
        public double ReadDouble(string selection, string Key, double vDefault)
        {
            double v;

            try
            {
                v = double.Parse(ReadString(selection, Key, vDefault.ToString()));
            }
            catch (Exception e)
            {
                throw new Exception(e.Message);
            }
            return v;
        }

        public void DeleteSelection(string selection)
        {
            WritePrivateProfileString(selection, null, null, fi.FullName);
        }

        public void DeleteKey(string selection, string key)
        {
            WritePrivateProfileString(selection, key, null, fi.FullName);
        }

        public List<string> ReadSelections()
        {
            List<string> temp = new List<string>();
            string sLine;
           
            if (!fi.Exists)
            {
                return temp;
            }

            using (StreamReader sr = new StreamReader(fi.FullName))
            {
                while (!sr.EndOfStream)
                {
                    //Get and trim line
                    sLine = sr.ReadLine();
                    //Check for opening and closing tags
                    if (sLine.StartsWith("[") && (sLine.EndsWith("]")))
                    {
                        //Add to collection.
                        temp.Add(sLine.Substring(1, sLine.Length - 2));
                    }
                }
                //close file
                sr.Close();
            }
            return temp;
        }

        public bool SelectionExists(string selection)
        {
            List<string> Temp;
            bool Found = false;
            try
            {
                Temp = ReadSelections();
                foreach(string s in Temp)
                {
                    if (s.ToLower().Equals(selection.ToLower()))
                    {
                        Found = true;
                        break;
                    }
                }
            }catch (Exception e)
            {
                throw new Exception(e.Message);
            }
            Temp.Clear();
            return Found;
        }

        public bool KeyExists(string selection, string Key)
        {
            List<string> Temp;
            bool Found = false;
            try
            {
                Temp = ReadSelectionKeys(selection);
                foreach (string s in Temp)
                {
                    if (s.ToLower().Equals(Key.ToLower()))
                    {
                        Found = true;
                        break;
                    }
                }
            }
            catch (Exception e)
            {
                throw new Exception(e.Message);
            }
            Temp.Clear();
            return Found;
        }

        public List<string> ReadSelectionKeys(string selection)
        {
            List<string> temp = new List<string>();
            string sLine;
            string SelName = string.Empty;

            if (!fi.Exists)
            {
                return temp;
            }

            using (StreamReader sr = new StreamReader(fi.FullName))
            {
                while (!sr.EndOfStream)
                {
                    //Get and trim line
                    sLine = sr.ReadLine();
                    //Check for opening and closing tags
                    if (sLine.StartsWith("[") && (sLine.EndsWith("]")))
                    {
                        //Add to collection.
                        SelName = sLine.Substring(1,sLine.Length - 2);

                        if (!sr.EndOfStream)
                        {
                            //Get next line
                            sLine = sr.ReadLine();
                        }
                    }

                    //Compare selection names.
                    if (SelName.ToUpper() == selection.ToUpper())
                    {
                        if (sLine.Length > 0)
                        {
                            int pos = sLine.IndexOf("=");
                            //Check for equals sign
                            if (pos > 0)
                            {
                                //Extract key
                                temp.Add(sLine.Remove(pos, sLine.Length - pos));
                            }
                        }
                    }
                }
                //Close file.
                sr.Close();
            }
            return temp;
        }

        public inifile(string Filename)
        {
            fi = new FileInfo(Filename);
        }

    }
}

---

---