Fonts

[schumarg]

Wayne,

Maybe this might help. Worth a try. I've copied the code from both Module and Switchboard.

 

[WayneRyan]

Bob,

I've got kids, I've got more patience than money ...

The functions really should be gotten rid of. If you note,
they call themselves! They will do that over and over and
over ... They should go. That's why I commented them out
in our last transmittal.

If you look at the model of your functions they are not

Public Function ... As Long

They do things, but don't return anything.

What I didn't notice was that your arguments to your
function calls (From the switchboard) were ommitted.

I don't have Access with Me, but the syntax should be:

AddFontResourceA("c:\winnt\fonts\bgothm.ttf")

This might be prefaced with CALL, but I don't think so.

So in brief, you have a public module with 2 declarations only.
You have some calls to them in the switchboard.

Wayne

ps, I just saw your ZIP, I'll look at that. Have to leave for a
while.

 

[WayneRyan]

Bob,

I just looked at your code in Word. Great.

Just add the fonts and we should be real close.

Wayne

 

[schumarg]

Wayne,

Could I be missing a reference?

 

[schumarg]

Wayne,

Added the font to the code, now getting 'Sub or Function not defined' error on compile.

Option Compare Database
Option Explicit

Private Sub Command28_Click()
AddFontResourceA ("c:\winnt\fonts\bookos.ttf")
End Sub

Private Sub Form_Close()
AddFontResourceA ("c:\winnt\fonts\bookos.ttf")
End Sub

Private Sub Form_Open(Cancel As Integer)
AddFontResourceA ("c:\winnt\fonts\bookos.ttf")
Me.Filter = "[ItemNumber] = 0 AND [Argument] = 'Default' "
Me.FilterOn = True
DoCmd.Maximize
End Sub

Getting 'Sub or Function not defined.

 

[WayneRyan]

Bob,

I went over to one of my Access machines. It has some API
calls in one of the apps.

The name that is called is NOT the Alias, it is the
function name ... AddFontResource&

but, Access is gonna hate the "&" as that is its contatenation
character. Here's our plan:

Access obviously knows that you are trying to call a Function,
we just can't agree on the name. You experiment with the
names, I'd try AddFontResource first.

I'll look for an example of this function ...

Wayne

 

[WayneRyan]

Bob,

I found this on Google ...


''API declarations
Private Declare Function AddFontResource Lib “gdi32” Alias
“AddFontResourceA” (ByVal lpFileName As String) As Long

NOTE: see the "As Long" above, we need that!


Private Declare Function RemoveFontResource Lib “gdi32” Alias
“RemoveFontResourceA” (ByVal lpFileName As String) As Long

We call it as:

Dim retval As long
retval = AddFontRFesource("somefont")
MsgBox("Added " & retval & " fonts.")

retval is the # of fonts installed/removed

I have no idea why the ampersand is in our model, or where our
return value went.

Wayne

 

[schumarg]

Wayne,

Well, it was a long night and a longer day.

Getting message "Added 1 fonts"

Seems to be doing something. Now will have to test at work and see if a machine I know that does not have the font will display the new font.

I'm sure 'Thanks' is not sufficient. Just wish I could shake your hand.

Big smile here!!

Thanks,
Bob

 

[WayneRyan]

Bob,

No problem, happy to help. We both learned something out
of this. I have used many APIs before, just not fonts.

see ya,
Wayne

 

[schumarg]

Wayne,

Found this bit on a site:

you can use AddFontResource()/RemoveFontResource() to add/remove fonts to the system font table for displaying it.

To make the font installation permanent, the program should add the font name and filename to the registry by writing both of these values to the following registry location:

HKeyLocalMachine\Software\Microsoft\Windows\CurrentVersion\Fonts

See MSDN article "Installing Fonts".

 

[schumarg]

This will be the last, also found but very confusing:

Call fontAdd("MSGothic", "MSGothic")

Private Function fontAdd(vsFontName As String, vsFileName As String) As Boolean
Dim sTmp As String, sSysPath As String
Dim lResult As Long
Const COPY_TO_FONTS_FOLDER = False
#If Win32 Then
sTmp = vsFileName & ".TTF"
If COPY_TO_FONTS_FOLDER Then
lResult = GetSystemFolderPath(Me.hwnd, CSIDL_FONTS, sSysPath)
If (Right$(sSysPath, 1) <> "\") Then sSysPath = sSysPath & "\"
FileCopy AppPath & sTmp, sSysPath & sTmp
fontAdd = lResult
Exit Sub
End If
sTmp = AppPath & sTmp
lResult = CLng(True)
#Else
sSysPath = Space$(MAX_PATH)
sSysPath = Left$(sSysPath, GetSystemDirectory(sSysPath, MAX_PATH)) & "\"
sTmp = sSysPath & vsFileName & ".FOT"
If COPY_TO_FONTS_FOLDER Then
' Create the font resource file:
lResult = CreateScalableFontResource%(0, sTmp, vsFileName & ".TTF", AppPath)
FileCopy AppPath & vsFileName & ".TTF", sSysPath & vsFileName & ".TTF"
Else
lResult = CreateScalableFontResource(0, sTmp, AppPath & vsFileName & ".TTF", 0&)
End If
#End If
If lResult Then
' Add resource to Windows font table:
lResult = AddFontResource(sTmp)
If lResult Then
' Make changes to WIN.INI to reflect new font:
lResult = WriteProfileString("Fonts", vsFontName, sTmp)
If lResult Then
' Let other applications know of the change:
lResult = SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0&)
' Else
' ' Debug.Print "Error"
End If
' Else
' ' Debug.Print "Error"
End If
' Else
' ' Debug.Print "Error"
End If
fontAdd = lResult
End Function

GetSystemFolderPath function is from Common\Tools\VB\Unsupprt\Shelllnk
Comment from Starman Date: 10/26/1999 04:59AM PDT
Sorry, I forgot to replace code: AppPath is source font path.

 

[WayneRyan]

Bob,

No wonder that I never messed with fonts.

Let me do some research. I know there are some examples
here for writing to the registry.

I will get some additional documentation. I was feeling
good about our progress ... but there's always something else.

I'll get back to you.

Wayne

 

[WayneRyan]

Bob,

VBScript from TEK-TIPS:

http://groups.google.com/groups?q=i...tf-8&selm=#obzr71yBHA.2376@tkmsftngp02&rnum=4

The above will do the whole thing and is easy. My research
did not go too well otherwise.

Wayne

 

[Autoeng]

I had the same issue (fonts on my machine not on users).

1) Don't do it again. No matter how great you think your font looks it's not good practice to put something together for a shared app that doesn't stand alone or use the system fonts.

2) Copy the fonts to a shared resource, create a batch file that copies the fonts from the shared resource to the font directory on the users pc, send the batch file via email and have the users run it. Problem solved and took 2 minutes and no coding or messing with the db.

 

[schumarg]

Hi,

I agree. However it was a good learning experience. Don't regret that part.

After all that work and time, especially from Wayne, I wound up coping the fonts to the users desktop. Less than a minutes work.

But I do appreciate Wayne's time, but again it was a learning experience.


"Something learned is not a waste of time." --rgs--

 

[WayneRyan]

Bob,

Everything's a learning experience ...

So what's next?

Wayne

 

[schumarg]

Wayne,

Since you mentioned it, I'm also working on a Notes app,
interested?

 

[WayneRyan]

Bob,

SURE! I don't know anything about it, you drive
this time.

Wayne

 

[schumarg]

Wayne,

Currently I'm very happy that I got the app to where it's at now.

The only drawback is it opens a Notes session if not open already. But is very clean and quick if a Notes is already open on the user's desktop. What I would like to accomplish is for it to pull info from the Notes db and send the email without opening a session or user interface, want it transparent to the user.

Some help is forthcoming from my brother (Notes guru) and another programmer here. They just have to free up some time.

Once I get it going, will let you know, should you ever have interest in the code.