Nicht druckbare/darstellbare Zeichen 2

Hallo Wissende,

inzwischen habe ich mir eine Lösung in Excel-Vba zusammengebastelt, mit deren Hilfe man herausfinden kann, ob eines der Zeichen 0 - 65536 jeder Schriftart druckbar/darstellbar ist oder nicht.

Leider ist die Lösung sehr langsam, ca. eine Sekunde pro Zeichen, also 18 Stunden pro Schriftart :frowning:

Deshalb meine Hoffnung, daß eine gleichwertige VB-Lösung schneller ist:smile:

Die Vba-Lösung macht folgendes, alle 65536 Zeichen stehen in einer Spalte untereinander, diese Spalte wird durchlaufen und

a) jeder Zellinhalt (=Zeichen) wird als jpg-Bild gespeichert

b) alle nicht druckbaren/darstellbaren Zeichen werden von Excel als
Quadrat dargestellt, alle als Bild gespeicherten Quadrate haben
die gleiche Dateigröße.

c) Diese Zellen/Zeichen werden in der Nachbarzelle rechts gekennzeichnet

d) Wenn ich nun nach dieser Nachbarzelle die fertige Tabelle sortiere
habe ich sauber als Block alle darstellbaren Zeichen.

Vb müßte jetzt was adäquates tun, alle Zeichen von 0 - 65535 einzeln als jpg-Datei abspeichern, die Dateigröße ermitteln, vergleichen mit einem festen Vorgabewert und dann die darstellbaren Zeichen irgendwie in einer Liste sammeln und ausgeben/abspeichern.

Andere, schnellere ösungsansätze sind natürlich auch sehr gerne gesehen *gg*

Im Anhang ist der Vba-Code, der ist frisch zusammengebastelt und bietet noch Tuning-Pontial, das kriege ich schon hin, mir geht es um eine VB-Lösung.

Danke ^ Gruß
Reinhard

Option Explicit
'
Sub Nichtdruckbar()
Dim N As Long
Call Liste
If Dir("H:\Buchstaben", vbDirectory) = "" Then MkDir "h:\Buchstaben"
Application.ScreenUpdating = False
Worksheets("Tabelle1").Columns("B:smiley:").ClearContents
For N = 32 To 65535
 Call prcExportTablecopy(N, "H:\Buchstaben")
 Application.StatusBar = N & "/65536"
Next N
Application.ScreenUpdating = True
End Sub
'
Public Sub prcExportTablecopy(ByVal N As Long, Pfad As String)
Dim objChart As Chart, PfadDatei As String
Dim objChartObject As ChartObject
Dim objShape As Shape
Application.ScreenUpdating = False
With Worksheets("Tabelle1")
 .Select
 .Cells(N, 1).Select
 .Cells(N, 1).Copy
 .Pictures.Paste Link:=True
 Set objShape = .Shapes(.Shapes.Count)
End With
Application.CutCopyMode = False
objShape.CopyPicture Appearance:=2, Format:=-4147
Set objChart = Charts.Add
Set objChartObject = objChart.ChartObjects.Add(0, 0, \_
 objShape.Width \* 0.85, objShape.Height \* 0.85)
PfadDatei = Pfad & "\" & Right("00000" & N, 5) & ".jpg"
With objChartObject.Chart
 .Paste
 .Export Filename:=PfadDatei, FilterName:="JPG", Interactive:=False
End With
'Worksheets("Tabelle1").Cells(N, 3) = FileLen(PfadDatei)
If FileLen(PfadDatei) = 1007 Then Worksheets("Tabelle1").Cells(N, 2) = "nix"
Kill PfadDatei
Application.DisplayAlerts = False
objChart.Delete
objShape.Delete
Application.DisplayAlerts = True
'Set objChart = Nothing
'Set objChartObject = Nothing
'Set objShape = Nothing
' With UserForm1
' .Image1.Picture = LoadPicture(ThisWorkbook.Path & \_
' "\Bild.jpg")
' .Show
' End With
End Sub
'
Sub Liste()
Dim N As Long
Application.ScreenUpdating = False
For N = 32 To 65535
 Cells(N, 1) = ChrW(N)
Next N
Application.ScreenUpdating = True
End Sub

Hallo Reinhard,

ein alternativer Lösungsansatz:

Zwei Pictureboxen auf die Form.
In eine der Pictureboxen wird Chr(0) geprintet, das wird ja wohl immer ein nicht darstellbares Zeichen sein?

Der Inhalt dieser Picturebox wird in einen String transferiert.
… 1.) GetBitmapBits 2.) CopyMomory

Dann wird in einer Schleife die zweite Picturebox erst geleert, dann das Zeichen da hin geprintet, dann der Inhalt in einen String transferiert, der Inhalt dieses Strings mit dem anderen verglichen.

Ich denke, das wird um einiges schneller.

Gruß Rainer

Nachtrag, Code
Hallo Reinhard,

ich habe die Grundlage meines Vorschlags mal in einen Code pepackt …

Gruß Rainer

Private Type BITMAP
 bmType As Long
 bmWidth As Long
 bmHeight As Long
 bmWidthBytes As Long
 bmPlanes As Integer
 bmBitsPixel As Integer
 bmBits As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long

Private Sub Command1\_Click()
 Dim txt As String
 txt = PicToString(Picture1)
End Sub

Private Function PicToString(ByVal Pic As Control) As String
 Dim Bt As Long
 GetObject Pic.Image, Len(PicInfo), PicInfo
 BytesPerLine = (PicInfo.bmWidth \* 3 + 3) And &HFFFFFFFC
 ReDim PicBits(1 To BytesPerLine \* PicInfo.bmHeight \* 3) As Byte
 GetBitmapBits Pic.Image, UBound(PicBits), PicBits(1)
 Bt = UBound(PicBits) - LBound(PicBits)
 PicToString = Space((Bt) / 2)
 CopyMemory ByVal StrPtr(PicToString), PicBits(LBound(PicBits)), Bt
End Function

Halllo Rainer,

Zwei Pictureboxen auf die Form.
In eine der Pictureboxen wird Chr(0) geprintet, das wird ja
wohl immer ein nicht darstellbares Zeichen sein?

ja, soweit ich weiß sind 0 - 31 immer nicht darstellbar bei normalen Scriftarten.

Der Inhalt dieser Picturebox wird in einen String
transferiert.
… 1.) GetBitmapBits 2.) CopyMomory
Dann wird in einer Schleife die zweite Picturebox erst
geleert, dann das Zeichen da hin geprintet, dann der Inhalt in
einen String transferiert, der Inhalt dieses Strings mit dem
anderen verglichen.

Klingt gut, wie „printe“ ich denn ein Zeichen als Bild in eine Picturebox?

Auf der Suche nach GetBitmapsBits stiess ich auf nachfolgenden Code von Dir bei w-w-w.
Der geht aber von einem Bild aus in der Picturebox.
Wenn ich den Code richtig deute müßte ich das Umwandeln der Bildpunkte in Text hinkriegen in einer Schleife.

Die Intellisense bei
Picture1.
half mir bislang noch nicht weiter.

Danke und Gruß
Reinhard

Option Explicit
'
Private Type BITMAP
 bmType As Long
 bmWidth As Long
 bmHeight As Long
 bmWidthBytes As Long
 bmPlanes As Integer
 bmBitsPixel As Integer
 bmBits As Long
End Type
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long
'
Private Sub Command2\_Click()
Dim tm As Long
tm = Timer
GetObject Picture1.Image, Len(PicInfo), PicInfo
BytesPerLine = (PicInfo.bmWidth \* 3 + 3) And &HFFFFFFFC
ReDim PicBits(1 To BytesPerLine \* PicInfo.bmHeight \* 3) As Byte
GetBitmapBits Picture1.Image, UBound(PicBits), PicBits(1)
'Auswertung
For Cnt = 1 To UBound(PicBits) Step 4
 If PicBits(Cnt) \> 100 Then
 PicBits(Cnt) = 255
 PicBits(Cnt + 1) = 255
 PicBits(Cnt + 2) = 255
 End If
Next Cnt
SetBitmapBits Picture1.Image, UBound(PicBits), PicBits(1)
Picture1.Refresh
Me.Caption = Round(Timer - tm, 2)
End Sub
'
Private Sub Command1\_Click()
CommonDialog1.ShowOpen
Picture1.Picture = LoadPicture(CommonDialog1.filename)
End Sub
'
Private Sub Command3\_Click()
CommonDialog1.ShowSave
SavePicture Picture1.Image, CommonDialog1.filename
End Sub
'
Private Sub Form\_Load()
Picture1.AutoSize = True
Picture1.AutoRedraw = True
Command1.Caption = "laden"
Command2.Caption = "bearbeiten"
Command3.Caption = "sichern"
End Sub

Hallo Reinhard,

Klingt gut, wie „printe“ ich denn ein Zeichen als Bild in eine
Picturebox?

Picture1.Cls
Picture1.Print „A“;

Auf der Suche nach GetBitmapsBits stiess ich auf nachfolgenden
Code von Dir bei w-w-w.

Sieh mal eine Zeile weiter oben, da habe ich den Code so zusammengebastelt, daß du ihn in ein Modul packen kannst und dann einfach die Funktion aufrufen:

Text = PicToString(Steuerelement)

Gruß Rainer

Hallo Reinhard,

der Code noch einmal, um die Schleife erweitert. Nicht daß Du daran abstürzt, weil Du .Autoredraw = True vergisst. :smile:

Gruß Rainer

Option Explicit

Private Type BITMAP
 bmType As Long
 bmWidth As Long
 bmHeight As Long
 bmWidthBytes As Long
 bmPlanes As Integer
 bmBitsPixel As Integer
 bmBits As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long

Private Sub Command1\_Click()
 Dim txt As String, cmp As String, i As Integer
 Picture1.Print Chr(1)
 txt = PicToString(Picture1)
 For i = 0 To 255
 Picture1.Cls
 Picture1.Print Chr(i)
 cmp = PicToString(Picture1)
 If cmp txt Then
 List1.AddItem Chr(i)
 End If
 Next
End Sub

Private Function PicToString(ByVal Pic As Control) As String
 Dim Bt As Long
 GetObject Pic.Image, Len(PicInfo), PicInfo
 BytesPerLine = (PicInfo.bmWidth \* 3 + 3) And &HFFFFFFFC
 ReDim PicBits(1 To BytesPerLine \* PicInfo.bmHeight \* 3) As Byte
 GetBitmapBits Pic.Image, UBound(PicBits), PicBits(1)
 Bt = UBound(PicBits) - LBound(PicBits)
 PicToString = Space((Bt) / 2)
 CopyMemory ByVal StrPtr(PicToString), PicBits(LBound(PicBits)), Bt
End Function

Private Sub Form\_Load()
 Picture1.AutoRedraw = True
End Sub

der Code noch einmal, um die Schleife erweitert. Nicht daß Du
daran abstürzt, weil Du .Autoredraw = True vergisst. :smile:

Hallo Rainer,

danke dir für den Code. In Excel-Zellen werden alle nicht druckbaren Zeichen als Rechtecke dargestellt.

In VB-Listboxen und Pictureboxen, werden die nicht druckbaren Zeichen von 0-31 als senkrechte schwarz gefüllte Rechtecke dargestellt, alle anderen nicht druckbaren Zeichen als Fragezeichen.

D.h., mit der winzigen Änderung der einen Codezeile in

Picture1.Print ChrW(5000)
(5000 ist ein rein zufällig gewähltes Fragezeichen-Zeichen)

funtionierte dein Code bestens.

Gruß
Reinhard

Hallo Reinhard,

D.h., mit der winzigen Änderung der einen Codezeile in

Picture1.Print ChrW(5000)
(5000 ist ein rein zufällig gewähltes Fragezeichen-Zeichen)

funtionierte dein Code bestens.

schön. :smile:

Aber Excel? Da wird der Code gar nicht funktionieren. In Excel hat die Picturebox kein Handle, deshalb kann man da GetBitmapBits nicht verwenden …

Gruß Rainer

funtionierte dein Code bestens.

schön. :smile:

Aber Excel? Da wird der Code gar nicht funktionieren. In Excel
hat die Picturebox kein Handle, deshalb kann man da
GetBitmapBits nicht verwenden …

Hallo Rainer,

noch schlimmer, ich fand zumindest erstmal keine Picturebox, da gibt es wohl ein Image, aber das ist was anderes.

Was ging, ich habe noch zwei Commandbutton in die Form gepackt, dann ging ein Teil deines Codes.
Aber der Teil, der ein Zeichen als Bild in die Commandbutton bringt fehlt.

Private Sub Commandbutton1\_Click()
 Dim txt As String, cmp As String, i As Integer
 CommandButton2.Picture = LoadPicture("h:\kwquadrat.jpg")
 CommandButton3.Picture = LoadPicture("h:\kwbuchstabe.jpg")
cmp = PicToString(CommandButton2.Picture)
txt = PicToString(CommandButton3.Picture)
MsgBox cmp
MsgBox txt
End Sub

Aber es hat keine Priorität mehr es in Vba auch zu lösen.
Letzlich wollte ich ja nur Listen haben, wo die druckbaren Zeichen pro Schriftart, Arial, MS-Unicode u.v.m. aufgelistet sind. Dies Liste kann ja eine Textdatei sein und die kann ich mir ja mit VB5 und deinem Code leicht selbst erstellen.

Danke nochmal dafür
Gruß
Reinhard

Hallo Reinhard,

noch schlimmer, ich fand zumindest erstmal keine Picturebox,
da gibt es wohl ein Image, aber das ist was anderes.

Was ging, ich habe noch zwei Commandbutton in die Form
gepackt, dann ging ein Teil deines Codes.
Aber der Teil, der ein Zeichen als Bild in die Commandbutton
bringt fehlt.

was in VBA funktionieren könnte, ist auf die Form selbst zu printen.
Die Form hat als Einzige ein Handle, ist grafikfähig und der Print-Befehl funktioniert. Statt Picture1 einfach Me. Das geht in VB5/6 auch. Sieht nur dumm aus weil das flimmern wird, Das Bild ist zu groß, deshalb wird es langsam … Mit einem kleinen Picture, gerade so groß wie nötig geht das am Besten/Schnellsten.

Gruß Rainer

was in VBA funktionieren könnte, ist auf die Form selbst zu
printen.
Die Form hat als Einzige ein Handle, ist grafikfähig und der
Print-Befehl funktioniert. Statt Picture1 einfach Me. Das geht
in VB5/6 auch. Sieht nur dumm aus weil das flimmern wird, Das
Bild ist zu groß, deshalb wird es langsam … Mit einem
kleinen Picture, gerade so groß wie nötig geht das am
Besten/Schnellsten.

Hallo Rainer,

auf die Form zu printen kriege ich nicht hin, weder in VB5 oder Vba.

Me.Print Chr(5000)
Me.Picture.Print Chr(5000)

klappt nicht, was habe ich falsch verstanden?

Gruß
Reinhard

Hallo Reinhard,

auf die Form zu printen kriege ich nicht hin, weder in VB5
oder Vba.

Me.Print Chr(5000)
Me.Picture.Print Chr(5000)

klappt nicht, was habe ich falsch verstanden?

nein, Du hast nichts falsch verstanden, aber dich vertippt! :smile:

Chr(5000) geht nie, Du wolltest ChrW(5000) schreiben und dann geht es auch.

Gruß Rainer

Hallo Rainer,

Me.Print Chr(5000)

nein, Du hast nichts falsch verstanden, aber dich vertippt!

-)

Okay, hast Recht :smile:

Jetzt hängt es aber an unverträglichen Typen in

txt = PicToString(Me.Picture)

Gruß
Reinhard

Option Explicit
'
Private Type BITMAP
 bmType As Long
 bmWidth As Long
 bmHeight As Long
 bmWidthBytes As Long
 bmPlanes As Integer
 bmBitsPixel As Integer
 bmBits As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Dim PicBits() As Byte, PicInfo As BITMAP
Dim Cnt As Long, BytesPerLine As Long
'
Private Sub Form\_Load()
'Me.Print ChrW(65)
End Sub
'
Private Sub Command1\_Click()
 Dim txt As String, cmp As String, i As Integer
 Me.Print ChrW(5000)
 txt = PicToString(Me.Picture)
 For i = 0 To 255
 Me.Picture.Cls
 Me.Print Chr(i)
 cmp = PicToString(Me.Picture)
 If cmp txt Then
 List1.AddItem Chr(i)
 End If
 Next
End Sub
'
Private Function PicToString(ByVal Pic As Control) As String
 Dim Bt As Long
 GetObject Pic.Image, Len(PicInfo), PicInfo
 BytesPerLine = (PicInfo.bmWidth \* 3 + 3) And &HFFFFFFFC
 ReDim PicBits(1 To BytesPerLine \* PicInfo.bmHeight \* 3) As Byte
 GetBitmapBits Pic.Image, UBound(PicBits), PicBits(1)
 Bt = UBound(PicBits) - LBound(PicBits)
 PicToString = Space((Bt) / 2)
 CopyMemory ByVal StrPtr(PicToString), PicBits(LBound(PicBits)), Bt
End Function
'
'Private Sub Form\_Load()
' Picture1.AutoRedraw = True
'End Sub

Hallo Reinhard,

Okay, hast Recht :smile:

Jetzt hängt es aber an unverträglichen Typen in

txt = PicToString(Me.Picture)

ja, hast Recht, ich hab’ mich geirrt. Es geht nicht mit der Form.

Gemeint war … txt = PicToString(Me)

Ich hab’s jetzt mal getestet, ich hab’ mich geirrt, auf der Form funktioniert es nicht. Läuft jetzt zwar, aber nicht mit dem gewünschten Ergebnis. Ich fürchte, mit VBA wird das nichts. :frowning:

Gruß Rainer

Ich hab’s jetzt mal getestet, ich hab’ mich geirrt, auf der
Form funktioniert es nicht. Läuft jetzt zwar, aber nicht mit
dem gewünschten Ergebnis. Ich fürchte, mit VBA wird das
nichts. :frowning:

Hallo Rainer,

ist okay, ich bin ja hochzufrieden mit VB durch dich eine Lösung zu haben.

Der Hintergrund ist simpel, in einer Exceltabelle kann ich bequem pro Spalte alle 65536 Zeichen einer Schriftart darstellen lassen. Aber selbst bei der MS.Unicode Schriftart sind da noch sehr viele nicht darstellbar, wohl für später geplant wenn die Marsmenschen da noch ihre Zeichen unterbringen wollen im Unicode :smile:)

Bei Arial o.ä. gibt es noch gewaltigere „Lücken“ in den Zeichen, da sieht man dann 3000 Zeilen lang nur Quadrate usw.
Und da macht es echt keinen Spass mal zu schauen welche Zeichen es denn so überhaupt gibt, oder man sucht mal ein Zeichen o.ä.

Jetzt, mittels deiner VB-Variante, kann ich mir in Excel nur die Zeichen darstellen lassen die man auch drucken kann.

Kennst du http://www.wotsit.org/ ?
Da schaute ich nach ttf Dateiformat, habe mir da auch alles was da stand zu ttf runtergeladen/angeschaut, half mir nicht weiter.

Denn sicher wäre es am schnellsten wenn man direkt die arial.ttf oder msunicod.ttf oder xyz.ttf auslesen könnte, welche Zeichen denn dort darstellbar sind. Weil anders macht das VB oder Excel auch nicht, es liest di Info in der ttf aus, stellt dann das Zeichen dar, und wenn keine Info zu dem Zeichen existiert, malt es halt ein Quadrat oder ein Fragezeichen.
Leider fand ich da nix dazu, abgesehen davon, daß es mir wieder zuviel Englishc war.

Gruß
Reinhard

Hallo Reinhard,

Der Hintergrund ist simpel, in einer Exceltabelle kann ich
bequem pro Spalte alle 65536 Zeichen einer Schriftart
darstellen lassen.

wozu war schon klar, es hat mich nur mal interessiert, ob wir das mit VBA auch schaffen. Wenn es sein muss, bekommen wir das vermutlich mit VBA auch noch hin, aber nicht so flink wie mit VB5/6. Me.Point funktioniert doch auch in VBA, oder? Wenn ja … wollen wir den Versuch wagen? Oder ist nur das Ergebnis interessant, das wir mit VB schon haben? *gg*

Aber selbst bei der MS.Unicode Schriftart
sind da noch sehr viele nicht darstellbar, wohl für später
geplant wenn die Marsmenschen da noch ihre Zeichen
unterbringen wollen im Unicode :smile:)

Ich glaube, wenn Chinesisch und Japanisch drin sind, wird es voll.

Bei Arial o.ä. gibt es noch gewaltigere „Lücken“ in den
Zeichen, da sieht man dann 3000 Zeilen lang nur Quadrate usw.
Und da macht es echt keinen Spass mal zu schauen welche
Zeichen es denn so überhaupt gibt, oder man sucht mal ein
Zeichen o.ä.

Jetzt, mittels deiner VB-Variante, kann ich mir in Excel nur
die Zeichen darstellen lassen die man auch drucken kann.

Kennst du http://www.wotsit.org/ ?

Nein kenne ich nicht.

Da schaute ich nach ttf Dateiformat, habe mir da auch alles
was da stand zu ttf runtergeladen/angeschaut, half mir nicht
weiter.

Ach so, direkt in der Datei nachsehen … das wäre auch noch einen Versuch wert. Einen Font habe ich mir noch nie mit einem Hexeditor angesehen.

Denn sicher wäre es am schnellsten wenn man direkt die
arial.ttf oder msunicod.ttf oder xyz.ttf auslesen könnte,
welche Zeichen denn dort darstellbar sind. Weil anders macht
das VB oder Excel auch nicht, es liest di Info in der ttf aus,
stellt dann das Zeichen dar, und wenn keine Info zu dem
Zeichen existiert, malt es halt ein Quadrat oder ein
Fragezeichen.
Leider fand ich da nix dazu, abgesehen davon, daß es mir
wieder zuviel Englishc war.

Nein, das macht sicher das Betriebssystem. Windows wollen wir nun nicht gleich nachempfinden. :smile:

Gruß Rainer

Hallo Rainer,

wozu war schon klar, es hat mich nur mal interessiert, ob wir
das mit VBA auch schaffen. Wenn es sein muss, bekommen wir das
vermutlich mit VBA auch noch hin, aber nicht so flink wie mit
VB5/6. Me.Point funktioniert doch auch in VBA, oder?

weiß ich nicht, kenne Pint o.ä. nur in Vervindung von irgendwelchen API-Funktionen die die Mauszeigerposition beobachten, Pointx o.ä., muß ich schauen.

Wenn ja
… wollen wir den Versuch wagen? Oder ist nur das Ergebnis
interessant, das wir mit VB schon haben? *gg*

Gute Frage, ich mache bei beidem gerne mit :smile:

Aber selbst bei der MS.Unicode Schriftart
sind da noch sehr viele nicht darstellbar, wohl für später
geplant wenn die Marsmenschen da noch ihre Zeichen
unterbringen wollen im Unicode :smile:)

Ich glaube, wenn Chinesisch und Japanisch drin sind, wird es
voll.

Unicode dafür braucht sicher 16 Bytes für all die Bildchen *gg*

Kennst du http://www.wotsit.org/ ?

Nein kenne ich nicht.

Ist nicht schlecht an sich, bei ttf war ich enttäuscht aber vielleicht ist auch ttf anders aufgebaut als eine bmp-Datei, die ist recht einfach auszulesen um dann das Bild zu spiegeln, invertieren o.ä., natürlich kann man das nur wenn man das genaue Dateiformat kennt.

Da schaute ich nach ttf Dateiformat, habe mir da auch alles
was da stand zu ttf runtergeladen/angeschaut, half mir nicht
weiter.

Ach so, direkt in der Datei nachsehen … das wäre auch noch
einen Versuch wert. Einen Font habe ich mir noch nie mit einem
Hexeditor angesehen.

Ohne kenntnis des Dateiformates ist das schwierigst zu deuten, aber wenn ich in arial.ttf runterscrolle sehe ich schon viele „Punkt“-Anzeigen im Eidtor, ich mutmaße das sind die Zeichen die nicht dargestellt werden können.

Andererseits irritiert mich, daß andere ttf-Dateinen eine bedeutend andere dateigröße haben. Bei Unicode überrascht mch das nicht, aber ich sehe ja wenn ich mir in Excel eine Spalte mit Arial und eine mit New Roman bastle, daß beide in etwa gleichviel nicht druckbare Zeichen haben, warum sich da die Dateigrößen so gewaltig unterscheiden its mir schleierhaft.

Denn sicher wäre es am schnellsten wenn man direkt die
arial.ttf oder msunicod.ttf oder xyz.ttf auslesen könnte,
welche Zeichen denn dort darstellbar sind. Weil anders macht
das VB oder Excel auch nicht, es liest di Info in der ttf aus,
stellt dann das Zeichen dar, und wenn keine Info zu dem
Zeichen existiert, malt es halt ein Quadrat oder ein
Fragezeichen.
Leider fand ich da nix dazu, abgesehen davon, daß es mir
wieder zuviel Englishc war.

Nein, das macht sicher das Betriebssystem. Windows wollen wir
nun nicht gleich nachempfinden. :smile:

Ansichtssache, ein Auto zu bauen das unter allen Umständen auch fährt zu bauen ist schwierig, aber eines zu bauen, was laufend nicht anspringt, tausend Fehler hat, das kriegen wir zwei aber auch hin :smile:))

Gruß
Reinhard

Hallo Reinhard,

weiß ich nicht, kenne Pint o.ä. nur in Vervindung von
irgendwelchen API-Funktionen die die Mauszeigerposition
beobachten, Pointx o.ä., muß ich schauen.

erster Ansatz:

Private Sub Command1\_Click()
 Dim cx As Integer, cy As Integer, f(100) As Long
 Me.Cls
 Me.Print "A"
 For cx = 0 To 9
 For cy = 0 To 0
 f(cx + (cy \* 10)) = Me.Point(cx, cy)
 Next
 Next
End Sub

Private Sub Form\_Load()
 Me.ScaleMode = vbPixels
End Sub

In VB6 ist dann das Zeichen schon mal als Array mit 100 Long-werten im Speicher. Dann halt das Array wieder in einen String kopieren, der wäre dann 200 Zeichen Lang, weil ein Long ja vier Bytes hat, ein Zeichen im String 2. Wenn das läuft, kann ich es ja komplettieren.

Wenn ja
… wollen wir den Versuch wagen? Oder ist nur das Ergebnis
interessant, das wir mit VB schon haben? *gg*

Gute Frage, ich mache bei beidem gerne mit :smile:

OK, dann erzähl mal ob der Minicode in Excel läuft. Wenn ja ist es nicht mehr weit, wenn nein wird das auf diesem Weg auch nichts.

Aber selbst bei der MS.Unicode Schriftart
sind da noch sehr viele nicht darstellbar, wohl für später
geplant wenn die Marsmenschen da noch ihre Zeichen
unterbringen wollen im Unicode :smile:)

Ich glaube, wenn Chinesisch und Japanisch drin sind, wird es
voll.

Unicode dafür braucht sicher 16 Bytes für all die Bildchen
*gg*

ähhmmmmm, ttf sind keine Bildchen! Das ist ein Schwarm aus relativen Koordinaten, ttf ist Verktorgrafik! Die Linien der Zeichen werden ‚gemalt‘ (Line-Befehle).

Kennst du http://www.wotsit.org/ ?

Nein kenne ich nicht.

Ist nicht schlecht an sich, bei ttf war ich enttäuscht aber
vielleicht ist auch ttf anders aufgebaut als eine bmp-Datei,
die ist recht einfach auszulesen um dann das Bild zu spiegeln,
invertieren o.ä., natürlich kann man das nur wenn man das
genaue Dateiformat kennt.

Ja, BMP ist noch gut zu verstehen. Ich habe mir die Erklärung bei Wiki geholt, war recht gut.

Da schaute ich nach ttf Dateiformat, habe mir da auch alles
was da stand zu ttf runtergeladen/angeschaut, half mir nicht
weiter.

Ach so, direkt in der Datei nachsehen … das wäre auch noch
einen Versuch wert. Einen Font habe ich mir noch nie mit einem
Hexeditor angesehen.

Ohne kenntnis des Dateiformates ist das schwierigst zu deuten,
aber wenn ich in arial.ttf runterscrolle sehe ich schon viele
„Punkt“-Anzeigen im Eidtor, ich mutmaße das sind die Zeichen
die nicht dargestellt werden können.

Andererseits irritiert mich, daß andere ttf-Dateinen eine
bedeutend andere dateigröße haben. Bei Unicode überrascht mch
das nicht, aber ich sehe ja wenn ich mir in Excel eine Spalte
mit Arial und eine mit New Roman bastle, daß beide in etwa
gleichviel nicht druckbare Zeichen haben, warum sich da die
Dateigrößen so gewaltig unterscheiden its mir schleierhaft.

Weil da keine Bilder abgelegt sind. Für ein Quadrat braucht man nur vier Wertepaare, für kompliziertere Zeichen viel mehr. Die datei für eine Frakturschrift muss deshalb viel größer sein, als eine für Arrial.

Denn sicher wäre es am schnellsten wenn man direkt die
arial.ttf oder msunicod.ttf oder xyz.ttf auslesen könnte,
welche Zeichen denn dort darstellbar sind. Weil anders macht
das VB oder Excel auch nicht, es liest di Info in der ttf aus,
stellt dann das Zeichen dar, und wenn keine Info zu dem
Zeichen existiert, malt es halt ein Quadrat oder ein
Fragezeichen.
Leider fand ich da nix dazu, abgesehen davon, daß es mir
wieder zuviel Englishc war.

Nein, das macht sicher das Betriebssystem. Windows wollen wir
nun nicht gleich nachempfinden. :smile:

Ansichtssache, ein Auto zu bauen das unter allen Umständen
auch fährt zu bauen ist schwierig, aber eines zu bauen, was
laufend nicht anspringt, tausend Fehler hat, das kriegen wir
zwei aber auch hin :smile:))

*gg* Das kriegen wir sogar richtig gut hin, ich habe in der Lehre 'Wartburg’s gebaut. :smile: Was Windows angeht, das ist besser als sein Ruf, finde ich. Mein Unix hat mehr Bugs.

Gruß Rainer

Hallo Reinhard,

ich hab’s mal für VB6 getippt, ob Excel das auch tut, erzählst Du. :smile:

Gruß Rainer

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" \_
 Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, \_
 ByVal ByteLen As Long)

Private Sub Command1\_Click()
 Dim cx As Integer, cy As Integer, f(100) As Long
 Dim txt As String, cmp As String, i As Integer
 txt = Space(200)
 cmp = Space(200)
 List1.Clear
 Me.Cls
 Me.Print Chr(0)
 For cx = 0 To 9
 For cy = 0 To 9
 f(cx + (cy \* 10)) = Me.Point(cx, cy)
 Next
 Next
 CopyMemory ByVal StrPtr(txt), f(0), 400
 For i = 0 To 255
 Me.Cls
 Me.Print Chr(i)
 DoEvents
 For cx = 0 To 9
 For cy = 0 To 9
 f(cx + (cy \* 10)) = Me.Point(cx, cy)
 Next
 Next
 CopyMemory ByVal StrPtr(cmp), f(0), 400
 If cmp txt Then
 List1.AddItem Chr(i)
 End If
 Next
 Command1.Caption = "OK"
End Sub

Private Sub Form\_Load()
 Me.ScaleMode = vbPixels
End Sub

ich hab’s mal für VB6 getippt, ob Excel das auch tut, erzählst
Du. :smile:

Hallo Rainer,

so wie der Code unten steht läuft er problemlos durch :smile:))
Me in Vba scheint weniger und/oder andere Eigenschaften zu kennen als in VB. „vbPixel“ ist wohl auch unbekannt.

Gruß
Reinhard

Private Declare Sub CopyMemory Lib "kernel32" \_
 Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, \_
 ByVal ByteLen As Long)

Private Sub Commandbutton1\_Click()
 Dim cx As Integer, cy As Integer, f(100) As Long
 Dim txt As String, cmp As String, i As Integer
 txt = Space(200)
 cmp = Space(200)
 ListBox1.Clear
' Me.Cls
' Me.Print Chr(0)
 For cx = 0 To 9
 For cy = 0 To 9
' f(cx + (cy \* 10)) = Me.Point(cx, cy)
 Next
 Next
 CopyMemory ByVal StrPtr(txt), f(0), 400
 For i = 0 To 255
' Me.Cls
' Me.Print Chr(i)
 DoEvents
 For cx = 0 To 9
 For cy = 0 To 9
' f(cx + (cy \* 10)) = Me.Point(cx, cy)
 Next
 Next
 CopyMemory ByVal StrPtr(cmp), f(0), 400
 If cmp txt Then
 ListBox1.AddItem Chr(i)
 End If
 Next
 CommandButton1.Caption = "OK"
End Sub


Private Sub UserForm\_Initialize()
' Me.ScaleMode = vbPixels
End Sub