VB Classic VB.NET ADO.NET VBA C# |
 |
|
HOME
 Gesamtübersicht Neuzugänge Suchen[273 User online]  |
1. Zunächst einmal: Was ist Unicode? Unicode wurde eingeführt, um die verschiedenen länderspezifischen Kodierungen für 1-Byte-Zeichensätze abzulösen. Der unter Windows verwendete ANSI-Zeichensatz (windows-1252 in westeuropäischen Ländern) verwendet ja für jedes Zeichen 1 Byte, es lassen sich also nur 256 Zeichen darstellen. Damit man aber auch internationale Zeichen in anderen Ländern darstellen kann, sind nur die Bytes 0-127 eindeutig festgelegt. Die Bytes 128-255 variieren, je nach länderspezifischem Code. Das heißt, wenn man eine Textdatei auf einem deutschsprachigen Windows mit einigen Sonderzeichen speichert, kann dies auf russischen Windows ganz anders aussehen. Auf einem deutschsprachigen Windows wird z. B. der "ä"-Umlaut durch das Byte 228 dargestellt; auf einem russischen Windows stellt das Byte 228 dagegen den kyrillischen Buchstaben "д" dar. Es gibt auch noch andere Varianten von Unicode, wie UTF-8, welche vor allem bei Websites eine Rolle spielt. UTF-8 verwendet eine variable Anzahl von Bytes für die Darstellung eines Zeichens, so verwendet es für die Unicode-Werte 0-127 jeweils nur 1 Byte und ist damit "abwärtskompatibel" zum ANSI-Zeichensatz. Gegenüber dem "normalen" Unicode (UTF-16 LE) spart dies somit erheblich Speicherplatz, wenn vor allem lateinische Buchstaben und nur vereinzelt landesspezifische Sonderzeichen vorkommen. Um eine UTF-8 Textdatei in VB einzulesen und mit dem unten beschriebenen, unicodefähigen Label darzustellen, muss man aber selbst eine Konvertierungsfunktion für VB schreiben (diese finden Sie ganz unten). Damit Text auf internationalen Windows-Versionen (inkl. Sonderzeichen) gleich aussieht und Sie auch verschiedene, länderspezifische Zeichen (z. B. deutsche Umlaute und chinesische Zeichen) in einem Programm verwenden können, sollten Sie Unicode verwenden. VB6 hat zwar leider nur eine geringe Unicode-Unterstützung (intern zwar schon, aber die Steuerelemente nicht), aber mit Hilfe geeigneter API-Funktionen können Sie ihr Programm unicodefähig machen. 2. Verwendung von Unicode in VB6 Tatsächlich unterstützt VB6 bei Strings aber Unicode. Wenn Sie im Code einem String Textzuweisen, z. B. durch Dim sText as String sText = "Hallo, das kostet 5,00 €." dann konvertiert VB6 diesen Text intern nach Unicode. Um genauer zu sein: Beim Erstellen einer EXE-Datei wird dieser Text schon als Unicode gespeichert. Theoretisch müsste dann doch der Text, wenn er einem Label zugewiesen wird, auch auf ausländischen Systemen so aussehen? Das würde er auch, wenn der VB-6 Label Unicode unterstützen würde. Leider unterstützt er es nicht, und deswegen konvertiert VB6 bei der Übergabe eines Strings an die .Caption-Eigenschaft eines Labels den String wieder in den lokalen ANSI-Zeichensatz zurück. Das macht sich u. a. daran bemerkbar, dass deutsche Umlaute wie ä, ö und ü, dann z. B. auf einem russischen Windows nur als a, o und u dargestellt werden. Es kann aber auch passieren, dass plötzlich kyrillische Zeichen statt den Umlauten dargestellt werden. Wie kommt das? Label1.Caption = "Hier stehen viele Häuser." Bei der ersten Variante speichert der Label selbst den String, und da dieser kein Unicode unterstützt, speichert er (der Label) ihn von vornherein im ANSI-Zeichensatz (Anzeige auf russischem Windows: "Hier stehen viele Hдuser."). Bei der 2. Variante speichert VB6 dagegen erst den Unicode-String, und konvertiert ihn dann bei der Übergabe an den Label in den lokalen ANSI-Zeichensatz zurück (Anzeige auf russischem Windows: "Hier stehen viele Hauser."). Sehen wir uns einmal die Funktionen an, die VB6 für den Umgang mit Strings bereitstellt. Sie kennen sicherlich die Funktionen Chr() und Asc(). Chr() erstellt ein Zeichen anhand des übergebenen Wertes, und Asc() gibt den Wert eines Zeichens zurück. Aber um welchen Wert handelt es sich hier, wenn VB6 Strings ja in Unicode speichert? Die Chr()- und Asc()-Funktionen arbeiten mit dem ANSI-Zeichensatz. So erstellt Chr(128) das Euro-Zeichen. Da das Euro-Zeichen dann aber in einem Unicode-String ist, bedeutet dies: Es gibt aber nicht nur die Chr()- und Asc()-Funktion, sondern auch ChrW(), AscW(), ChrB() und AscB(). Aber was machen diese Funktionen? MsgBox AscW("€") dann ergibt das 8364, ein ganz anderer Wert als den, den die Asc()-Funktion zurückgibt (128). 8364 ist der Unicode-Wert des Euro-Zeichens, und den hat es auf jedem anderssprachigen Windows auch. Zum Vergleich: MsgBox Chr(128) ergibt auf einem deutschen Windows "€", auf einem russischen "Ђ". MsgBox ChrW(8364) ergibt auf einem deutschen Windows "€", auf einem russischen sogar auch "€"! Im russichen ANSI-Zeichensatz kommt das Euro-Zeichen nämlich auch vor, hat aber einen anderen Wert (136) als im deutschen (128). Um das zu veranschaulichen, öffnen Sie einmal die Zeichentabelle von Windows (Start, Ausführen, "charmap.exe"). Als Schriftart nehmen Sie am besten Arial. Setzten Sie unten einen Haken bei "Erweiterte Ansicht". Bei "Zeichensatz" können Sie nun die verschiedenen ANSI-Zeichensätze von Windows auswählen, nehmen Sie zuerst "Windows: Westlich". Es erscheinen jetzt alle Zeichen, die im ANSI-Zeichensatz westlicher Windows-Versionen enthalten sind. Wenn Sie jetzt das €-Zeichen suchen und auf dieses klicken, steht ganz unten in der Zeile "U+20AC (0x80): Euro-Zeichen". Die Zahlen 20AC und 80 sind Hex-Werte, im Dezimalsystem (das können Sie z. B. schnell mit dem Windows Rechner umrechen) ist 20AC -> 8364 und 80 -> 128. Das sind genau die Werte, die wir bei der ChrW()-Funktion und bei der Chr()-Funktion verwendet haben. Der Wert 8364 ist der Unicode-Wert für das Euro-Zeichen und auf jedem beliebigsprachigen Windows eindeutig. Der Wert 128 ist der ANSI-Wert dieses Zeichens, welcher nur auf westlichen Windows-Versionen das Euro-Zeichen darstellt; auf einem russischen Windows ergibt dieser Wert ein anderes Zeichen. 3. Unicode-Konvertierung VB enthält aber die StrConv-Funktion, mit der sich Strings von ANSI nach Unicode konvertieren lassen und umgekehrt. Schreiben Sie einmal MsgBox StrConv(ChrB(128), vbUnicode) dann ergibt das tatsächlich wieder das €-Zeichen. Auch Msgbox Asc(StrConv(ChrB(128), vbUnicode)) ergibt dann 128, da die Asc-Funktion ja das Zeichen vorher wieder nach ANSI zurückkonvertiert. Msgbox AscW(StrConv(ChrB(128), vbUnicode)) ergibt dagegen 8364, den Unicode-Wert des Zeichens. Unicode-Strings werden (in VB) im UTF-16 LE-Format gespeichert, was bedeutet, dass niederwertige Byte kommt zuerst, dann kommt das höherwertige Byte. Der Wert 8364 ist in Hex 20AC, das bedeutet, ein Byte hat den Hex-Wert 20 (in Dez 32), das andere Byte hat den Hex-Wert AC (in Dez 172). Wir können uns also unser Unicode-€-Zeichen auch selber zusammenbasteln, indem wir die ChrB()-Funktion verwenden. Da das höherwertige Byte den Hex-Wert 20 hat (also das Byte, das dargestellt im Hex-Zahlensystem die höhere Wertigkeit hat), muss es als letztes kommen. Versuchen Sie, MsgBox ChrB(172) & ChrB(32) dann ergibt das wieder das €-Zeichen. Unicode ist für Bytewerte < 128 auch abwärtskompatibel. Ein Byte mit dem Wert 97 (Kleinbuchstabe "a") steht sowohl in anderen ANSI-Zeichensätzen als auch in Unicode für den Buchstaben "a". So ergeben Chr(97) und ChrW(97) das gleiche Zeichen. Wenn wir das Zeichen mit den ChrB-Funktionen darstellen, müssen wir MsgBox ChrB(97) & ChrB(0) verwenden, den der Zeichencode (mit führenden Nullen) ist in Hex ja 0061, und da das höherwertige Byte danach kommt, muss ChrB(0) am Schluss stehen. 4. Verwendung von Byte-Arrays und Strings Private Sub Command1_Click() Dim Dateiinhalt As String Open "C:\Datei.txt" For Binary As 1 Dateiinhalt = Space(LOF(1)) Get 1, , Dateiinhalt Close 1 Text1 = Dateiinhalt End Sub Nun fragen Sie sich vielleicht, warum Sie den Text ganz normal anzeigen können, wenn VB6 doch Strings in Unicode speichert, Sie aber die Textdatei ganz normal in ANSI gespeichert haben. Auch hier ist der Fall, dass VB6 den ausgelesenen Dateiinhalt automatisch nach Unicode konvertiert. Vielleicht öffnen Sie auch eine Bild-Datei oder irgendwas anderes, was keinen Text enthält, und Sie aber den Byte-Wert an einer bestimmten Stelle brauchen. Dann machen Sie das vielleicht mit MsgBox Asc(Mid(Dateiinhalt, 40, 1)) um den Wert des Bytes anzuzeigen, das an der 40. Stelle steht. Das funktioniert zwar auf westlichen Windows-Versionen, hat aber zuerst mal einen großen Nachteil: Da der Dateiinhalt ja nach Unicode konvertiert wird, braucht das Einlesen einer 1 MB-Datei dann 2 MB an Arbeitsspeicher, da Unicode ja 2 Bytes pro Zeichen verwendet. Dazu kommt, dass dies auf chinesischen und japanischen Windows-Versionen ein ziemlich unerwartetes Verhalten hervorrufen wird (dazu später mehr). Sie müssen dem Get-Verb aber keinen String übergeben. Es geht auch mit einer Array-Variable. Dim Dateiinhalt() As Byte Open "C:\Datei.txt" For Binary As 1 ReDim Dateiinhalt(LOF(1) - 1) As Byte Get 1, , Dateiinhalt Close 1 Jetzt können Sie den Wert des Bytes an der 40. Stelle mit "MsgBox Dateiinhalt(40)" ausgeben, aber vielleicht brauchen Sie dann doch einen String? Sie wissen wahrscheinlich auch, dass man einem String ein Byte-Array zuweisen kann und umgekehrt. Wenn Sie jetzt mal versuchen: Dim tmpArray() As Byte, Dateiinhalt as String Open "C:\Datei.txt" For Binary As 1 ReDim tmpArray(LOF(1) - 1) As Byte Get 1, , tmpArray Close 1 Dateiinhalt = tmpArray dann haben Sie wieder einen String, jedoch wurde der Dateiinhalt hier nicht nach Unicode konvertiert. Sie können jetzt also "MsgBox AscB(MidB(Dateiinhalt, 40, 1))" verwenden, um den Wert des 40. Bytes auszugeben. Dies hat vor allem mal den Vorteil, dass der Inhalt einer 1 MB großen Datei auch nur 1 MB (statt 2 MB) für den String-Inhalt braucht. 5. Weitere Funktionen im Zusammenhang mit Unicode-Strings So gibt auch die LenB-Funktion die genaue Anzahl der Bytes aus, die Len()-Funktion dagegen die Anzahl der Unicode-Zeichen. MsgBox Len("a") ist (natürlich) 1, MsgBox LenB("a") dagegen 2, da das "a"-Zeichen ja in Unicode aus 2 Bytes besteht. Wenn Sie also mit einem binären String arbeiten, muss immer die binäre Variante der String-Funktionen (mit einem B am Schluss) verwendet werden. Leider gibt es keine InStrRevB-, StringB- und SplitB-Funktion, sodass man diese selbst nachbauen muss. 6. Probleme auf japanischen / chinesischen Windows-Versionen Nicht immer bedeutet der ANSI-Zeichensatz, dass 1 Zeichen immer durch 1 Byte dargestellt wird. Auf einem japanischen Windows enthält auch der ANSI-Zeichensatz 2-Byte-Zeichen. Dies sehen Sie, wenn sie wieder die Zeichentabelle öffnen, als Schrift "MS Gothic" auswählen (dies setzt aber voraus, dass sie die asiatischen Schriften installiert haben) und unten bei Zeichensatz "Windows: Japanisch" auswählen. Ganz oben finden Sie wieder die lateinischen Buchstaben, bei denen als Beschreibung sowas wie "U+0065 (0x65): Kleiner lateinischer Buchstabe E" steht. Also "0065" ist wieder der Hex-Unicodewert (2 Bytes) und "65" der Hex-ANSI-Wert (1 Byte). Wenn Sie aber einmal etwas runter scrollen, finden Sie haufenweise japanische Zeichen. Wenn Sie davon eins auswählen, steht dort sowas wie "U+8515 (0xE4F6): Einheitliches CJK-Ideogramm", also erst wieder der 2-Byte-Unicode-Wert, aber hier besteht auf einmal auch das ANSI-Zeichen aus 2 Bytes (E4 und F6). Das gilt natürlich auch für VB, und wenn Sie jetzt VB auf einem japanischen Windows ausführen und wie oben beschrieben eine Datei in einen String einlesen, wird dieses ja von VB nach Unicode konvertiert. Wenn jetzt zufällig in einer Stelle der Datei so eine Bytefole aus 2 Bytes für ein ANSI-Zeichen wie E4 und F6 vorkommt, wird das dann natürlich auch von VB als 1 Zeichen interpretiert. Wenn Sie jetzt wieder den Wert des 40. Bytes mit MsgBox Asc(Mid(Dateiinhalt, 40, 1)) auslesen wollen, haben Sie ein Problem, da entweder 0 herauskommt oder der Wert eines Zeichens, das aber weiter hinten liegt als in der Stelle 40. Nehmen wir an, Sie haben eine Datei, die 2 Bytes mit den Werten E4 und F6 enthält. Wenn Sie diese Datei in einen String einlesen und mit der Chr- und Mid-Funktion die Werte der 2 Bytes ermitteln, kommt auf einem deutschen Windows 228 für das 1. und 246 für das 2. Byte heraus. Nachstellen können Sie dies mit Dim Dateiinhalt as String Dateiinhalt = StrConv(ChrB(228) & ChrB(246), vbUnicode) Len(Dateiinhalt) ergibt hier auch 2. Wenn Sie das gleiche auf einem japanischen Windows machen, interpretiert VB aufgrund des japanischen Zeichensatzes diese 2 Bytes dagegen als 1 Zeichen. Versuchen Sie jetzt Len(Dateiinhalt), ergibt das 1! (aber nur wenn Sie nicht wirklich eine Datei einlesen (wie ganz oben), denn dann erstellen Sie ja mit Space(LOF(1)) einen String mit der Länge 2, dann ist das 2. Zeichen ein einfaches Leerzeichen). Wenn Sie dann eingeben, MsgBox Asc(StrConv(ChrB(228) & ChrB(246), vbUnicode)) ergibt das -6922 (Die Funktion gibt einen Wert vom Typ Integer (16 Bit-Ganzzahl) zurück, wobei die negativen Werte durch den Komplementärwert dargestellt werden). Umgerechnet (2^16 + (-6922)) ergibt das 58614, in Hex E4F6, also wieder den 2-Byte-ANSI-Wert. Da das Byte 228 hier auch Bestandteil eines 2-Byte-Zeichens ist, können Sie mit der Chr-Funktion kein Zeichen mit dem ANSI-Wert 228 erstellen. Wenn Sie das folgende auf einem japanischen Windows versuchen: MsgBox Asc(Chr(228)) werden Sie feststellen, dass 0 herauskommt, statt 228 (wie auf einem deutschen Windows). Wenn Sie dagegen MsgBox AscB(ChrB(228)) verwenden, wird hier auch auf einem japanischen Windows 228 herauskommen. Sie können das wieder selbst ausprobieren, indem Sie bei den Regions- und Sprachoptionen bei Erweitert für die nicht unicodefähigen Programme "Japanisch" auswählen und den PC neustarten. Wenn Sie also vorhaben, ein Programm zu schreiben (auch wenn es nur eine englische Benutzeroberfläche haben soll und Sie eigentlich keinen unicodefähigen Label brauchen), das auf einmal auf japanischen oder chinesischen Systemen laufen soll, kann eine Nichtbeachtung des oben beschriebenen Verhaltens Fehlfunktionen verursachen. Dies gilt insbesondere auch für die Datenübertragung mit dem Winsock-Control. Denn auch das Winsock-Control konvertiert einen der SendData-Methode übergebenen String zurück nach ANSI, und die GetData-Methode des empangenden Winsocks konvertiert den String dann wieder nach Unicode. Das führt einerseits dazu, dass Text, der versendet wird, auf dem anderen PC dann anders aussehen kann, und dass die Verwendung von Paketabgrenzungsmethoden, die die Länge der Daten vor den eigentlichen Daten senden, nicht mehr richtig funktionieren. Ich muss zugeben, dass ich das auch bei dem von mir erstellten Tipp Wie bei der Funktion zum Einlesen von Dateien macht es auch hier einen Unterschied, ob man den Winsock-Methoden einen String oder ein Byte-Array übergibt. Wenn man beispielsweise der SendData-Methode einen String übergibt, wird der String zurück nach ANSI konvertiert und dann versendet. Wenn man dagegen den String einem Byte-Array zuweist un dieses dann versendet, dann sendet das Winsock auch genau den Unicode-String (Wenn der String "Hallo" ist, dann sendet es 10 Bytes). Vergleich: Public Sub WSockSenden(Text As String) Winsock1.SendData Len(Text) & " " & Text End Sub Private Sub Winsock1_OnDataArrival(ByVal bytesTotal As Long) Dim strTemp As String Winsock1.GetData strTemp ' ... (Weiterverarbeitung) Diese Vorgehensweise verwende ich in meinem Tipp, aber das führt dazu, dass auf japanischen Windows-Versionen die Längenangaben nicht mehr stimmen, wenn 2-Byte-Zeichen (wie oben beschrieben) vorkommen. Um das zu verhindern, müsste man verwenden: Public Sub WSockSenden(Text As String) Dim arrTemp() as Byte arrTemp = StrConv(LenB(Text) & " ", vbFromUnicode) & Text Winsock1.SendData arrTemp End Sub Private Sub Winsock1_OnDataArrival(ByVal bytesTotal As Long) Dim strTemp As String, arrTemp() As Byte Winsock1.GetData arrTemp, vbArray + vbByte strTemp = arrTemp ' ... (Weiterverarbeitung) Zur Weiterverarbeitung (z. B. Ermitteln der Länge) muss man dann aber auch die binären Funktionen wie LenB, MidB usw. verwenden. Das führt zum einen dazu, dass ein versendeter Unicode-String auf dem anderen PC (inkl. Sonder-/chinesischen Zeichen usw.) auch genau so ankommt, und die Fehlfunktionen bezüglich der Lägenangaben nicht mehr auftreten. Wenn man damit jetzt nur eine Datei versenden will, müsste man diese auch binär einlesen (also mit einem Byte-Array und dieses dann einem String zuweisen), und so der WSockSenden-Funktion übergeben. Somit braucht das empfangende Programm (unter Verwendung des Winsock-Tipps) nicht mehr 100 MB an Arbeitsspeicher, wenn es eine 50 MB-Datei empfängt, sondern eben auch nur 50 MB. Zu erwähnen sei hier noch, dass auch größere VB-Projekte, wie beispielsweise CSocketMaster, eine API-/Subclassing-Implementation des Winsock-Steuerelements, den beschriebenen Sachverhalt nicht beachten. Wenn man bei diesem der SendData Methode ein Byte-Array zum binären Senden übergibt, wird dies mit der StrConv-Methode nach Unicode konvertiert und einem String zugewiesen und später die Länge dieses Strings für Pufferzwecke mit der Len-Funktion ausgelesen bzw. der String mit der Mid-Funktion geteilt. Das führt dazu, dass der Code dann auf z. B. japanischen Systemen nicht funktioniert. Stattdessen müsste das Byte-Array einfach direkt einem String zugewiesen und dann die Länge mit der LenB-Funktion ermittelt bzw. der String mit der MidB-Funktion geteilt werden. 7. Unicodefähige Print-Funktion ' Standardschrift MS Sans Serif eignet sich nicht für Sonderzeichen Label1.Font.Name = "Tahoma" Label1.Caption = ChrW(&H263A) Leider machen Ihnen dann die VB6-Steuerelemente einen Strich durch die Rechnung, da sie, wie oben beschrieben, kein Unicode unterstützen und VB6 deswegen den String zurück nach ANSI konvertiert. Alle nichtdarstellbare Zeichen werden dann in Fragezeichen umgewandelt oder in Zeichen, die im ANSI-Zeichensatz vorhanden sind und den ursprünglichen ähneln (z. b. "a", wenn ein "ä" auf einem russischen Windows dargestellt werden soll). Auch Form1.Print ChrW(&H263A) ergibt nur ein Fragezeichen. Da die Möglichkeiten der VB6-Bordmittel erschöpft sind, muss man sich also nach geeigneten API-Funktionen umsehen, die diese Funktionalität bieten. So gibt es die "TextOut"-Funktion in der gdi32.dll, die die Funktionalität der Print-Funktion bietet, man kann damit Text zeichen. Der VB6 API-Viewer gibt folgende Deklaration an: Public Declare Function TextOut Lib "gdi32" _ Alias "TextOutA" ( _ ByVal hdc As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal lpString As String, _ ByVal nCount As Long) As Long Ein Aufruf mit Dim Result As Long, AnzeigeText As String Me.AutoRedraw = True Me.Font.Name = "Tahoma" AnzeigeText = "Häuser. " & ChrW(&H263A) Result = TextOut(Me.hdc, 0, 0, AnzeigeText, Len(AnzeigeText)) bringt allerdings auch nur ein Fragezeichen am Schluss. Das liegt daran, dass hier die ANSI-Variante verwendet wird, deshalb der Alias "TextOutA". Es gibt aber auch eine unicodefähige Variante mit dem Alias "TextOutW". Allerdings kann dieser dann kein normaler String mehr übergeben werden, sondern ein Unicode-String. Nun ist es so, dass VB6 intern ja Unicode-Strings hat, diese aber bei der Übergabe an API-Funktionen wieder nach ANSI zurückkonvertiert. Man könnte nun also den String bei der Übergabe mit StrConv(AnzeigeText, vbUnicode) "nochmal" nach Unicode konvertieren (also dass jedes Unicode-Zeichen zurückkonvertiert nach ANSI den Wert der einzelnen Bytes des ursprünglichen Unicode-Strings ergäbe), aber das kann auf japanischen Windows-Versionen wieder zu einem Fehlverhalten führen, wegen der 2-Byte-ANSI-Zeichen. Man muss stattdessen die Deklarierung "ByVal lpString As String" nach "ByRef lpString As Any" ändern, damit man auch ein Array übergeben kann. Allerdings muss man den ersten Array-Wert der Funktion übergeben, in dem Beispiel also: Private Declare Function TextOut Lib "gdi32" _ Alias "TextOutW" ( _ ByVal hdc As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByRef lpString As Any, _ ByVal nCount As Long) As Long Private Sub Form_Load() Dim Result As Long, AnzeigeText As String, arrTemp() As Byte Me.AutoRedraw = True Me.Font.Name = "Tahoma" AnzeigeText = "Häuser. " & ChrW(&H263A) arrTemp = AnzeigeText Result = TextOut(Me.hdc, 0, 0, arrTemp(0), Len(AnzeigeText)) End Sub Es gibt auch API-Funktionen, um eine unicodefähige Alternative zur TextHeight- und TextWidth-Funktion zu bauen. Im Folgenden finden Sie einen Code, der eine PrintW-, TextHeightW- und TextWidthW-Funktion enthält und den Sie in ein Modul einfügen können: Private Type Size cx As Long cy As Long End Type Private Declare Function TextOut Lib "gdi32" _ Alias "TextOutW" ( _ ByVal hDC As Long, _ ByVal X As Long, _ ByVal Y As Long, _ ByRef lpString As Any, _ ByVal nCount As Long) As Long Private Declare Function GetTextExtentPoint32 Lib "gdi32" _ Alias "GetTextExtentPoint32W" ( _ ByVal hDC As Long, _ ByRef lpsz As Any, _ ByVal cbString As Long, _ lpSize As Size) As Long Public Sub PrintW(hDC As Long, Text As String, X As Long, Y As Long) Dim arrbty() As Byte, retVal As Long If Text <> "" Then arrbty = Text retVal = TextOut(hDC, X / Screen.TwipsPerPixelX, _ Y / Screen.TwipsPerPixelY, arrbty(0), Len(Text)) If retVal = 0 Then Err.Raise 1, "Fehler in PrintW Funktion." End If End Sub Public Function TextWidthW(hDC As Long, Text As String) As Long Dim arrbty() As Byte, retVal As Long, ergebnis As Size If Text = "" Then TextWidthW = 0 Else arrbty = Text retVal = GetTextExtentPoint32(hDC, arrbty(0), Len(Text), ergebnis) If retVal = 0 Then Err.Raise 1, "Fehler in TextWidthW Funktion." TextWidthW = ergebnis.cx * Screen.TwipsPerPixelX End If End Function Public Function TextHeightW(hDC As Long, Text As String) As Long Dim arrbty() As Byte, retVal As Long, ergebnis As Size If Text = "" Then Text = ChrW(32) arrbty = Text retVal = GetTextExtentPoint32(hDC, arrbty(0), Len(Text), ergebnis) If retVal = 0 Then Err.Raise 1, "Fehler in TextHeightW Funktion." TextHeightW = ergebnis.cy * Screen.TwipsPerPixelY End Function Diese Funktionen lassen sich wie die normalen Print, TextHeight und TextWidth-Funktionen benutzen, allerdings nicht als Methode des Zeichnungsobjekts. Stattdessen muss der Gerätekontext (hDC) übergeben werden, und bei der PrintW-Funktion muss noch die Position mit angegeben werden, z. B. Private Sub Command1_Click() Form1.AutoRedraw = True Me.Font.Name = "Tahoma" PrintW Form1.hDC, "Häuser. " & ChrW(&H263A), 0, 0 Form1.Refresh End Sub Dies funktioniert übrigens mit allen API-Funktionen, die neben der A-Variante (ANSI/ASCII) eine W-Variante (Wide) besitzen, um Unicode-Text zu übergeben. 8. Unicodefähiges Label Option Explicit Public Event Click() Public Event DblClick() Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Private Type Size cx As Long cy As Long End Type Private Declare Function TextOut Lib "gdi32" _ Alias "TextOutW" ( _ ByVal hDC As Long, _ ByVal X As Long, _ ByVal Y As Long, _ ByRef lpString As Any, _ ByVal nCount As Long) As Long Private Declare Function GetTextExtentPoint32 Lib "gdi32" _ Alias "GetTextExtentPoint32W" ( _ ByVal hDC As Long, _ ByRef lpsz As Any, _ ByVal cbString As Long, _ lpSize As Size) As Long Private CaptionInt As String Private AutoSizeInt As Boolean Private ZeilenumbruchInt As Boolean Public Property Get Zeilenumbruch() As Boolean Zeilenumbruch = ZeilenumbruchInt End Property Public Property Let Zeilenumbruch(Wert As Boolean) ZeilenumbruchInt = Wert End Property Public Property Get Picture() As IPictureDisp Set Picture = UserControl.Picture End Property Public Property Set Picture(Bild As IPictureDisp) If Not UserControl.Picture Is Bild Then Set UserControl.Picture = Bild TextZeichnen End If End Property Public Property Get AutoSize() As Boolean AutoSize = AutoSizeInt End Property Public Property Let AutoSize(zeich As Boolean) AutoSizeInt = zeich If AutoSizeInt Then TextZeichnen End Property Private Sub UserControl_Click() RaiseEvent Click End Sub Private Sub UserControl_DblClick() RaiseEvent DblClick End Sub Private Sub UserControl_Initialize() UserControl.AutoRedraw = True UserControl.Font.Name = "Tahoma" CaptionInt = UserControl.Name ZeilenumbruchInt = True End Sub Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) RaiseEvent MouseDown(Button, Shift, X, Y) End Sub Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, _ X As Single, Y As Single) RaiseEvent MouseMove(Button, Shift, X, Y) End Sub Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, _ X As Single, Y As Single) RaiseEvent MouseUp(Button, Shift, X, Y) End Sub Private Sub UserControl_Resize() TextZeichnen End Sub Public Property Get Caption() As String Caption = CaptionInt End Property Public Property Let Caption(Wert As String) CaptionInt = Wert TextZeichnen End Property Public Property Get Font() As Font Set Font = UserControl.Font End Property Public Property Set Font(Wert As Font) Set UserControl.Font = Wert TextZeichnen End Property Public Property Get BackColor() As Long BackColor = UserControl.BackColor End Property Public Property Let BackColor(Wert As Long) UserControl.BackColor = Wert TextZeichnen End Property Public Property Get ForeColor() As Long ForeColor = UserControl.ForeColor End Property Public Property Let ForeColor(Wert As Long) UserControl.ForeColor = Wert TextZeichnen End Property Private Sub UserControl_WriteProperties(PropBag As PropertyBag) PropBag.WriteProperty "Font", UserControl.Font PropBag.WriteProperty "BackStyle", UserControl.BackStyle PropBag.WriteProperty "Caption", CaptionInt PropBag.WriteProperty "BackColor", Me.BackColor PropBag.WriteProperty "ForeColor", UserControl.ForeColor PropBag.WriteProperty "AutoSize", AutoSizeInt PropBag.WriteProperty "Picture", UserControl.Picture PropBag.WriteProperty "Zeilenumbruch", ZeilenumbruchInt End Sub Private Sub UserControl_ReadProperties(PropBag As PropertyBag) Set UserControl.Font = PropBag.ReadProperty("Font", UserControl.Font) UserControl.BackStyle = PropBag.ReadProperty("BackStyle", UserControl.BackStyle) AutoSizeInt = PropBag.ReadProperty("AutoSize", AutoSizeInt) UserControl.BackColor = PropBag.ReadProperty("BackColor", UserControl.BackColor) UserControl.ForeColor = PropBag.ReadProperty("ForeColor", UserControl.ForeColor) Set UserControl.Picture = PropBag.ReadProperty("Picture", UserControl.Picture) ZeilenumbruchInt = PropBag.ReadProperty("Zeilenumbruch", ZeilenumbruchInt) Caption = PropBag.ReadProperty("Caption", CaptionInt) ' Picture1.Cls ' PrintW Picture1.hDC, CaptionTemp, 0, 0 End Sub Private Sub PrintW(hDC As Long, Text As String, X As Long, Y As Long) Dim arrbty() As Byte Dim retVal As Long If Text <> "" Then arrbty = Text retVal = TextOut(hDC, X / Screen.TwipsPerPixelX, _ Y / Screen.TwipsPerPixelY, arrbty(0), Len(Text)) If retVal = 0 Then Err.Raise 1, "Fehler in PrintW Funktion." End If End Sub Private Function TextWidthW(hDC As Long, Text As String) As Long Dim arrbty() As Byte Dim retVal As Long Dim ergebnis As Size If Text = "" Then TextWidthW = 0 Else arrbty = Text retVal = GetTextExtentPoint32(hDC, arrbty(0), Len(Text), ergebnis) If retVal = 0 Then Err.Raise 1, "Fehler in TextWidthW Funktion." TextWidthW = ergebnis.cx * Screen.TwipsPerPixelX End If End Function Private Function TextHeightW(hDC As Long, Text As String) As Long Dim arrbty() As Byte Dim retVal As Long Dim ergebnis As Size If Text = "" Then Text = ChrW(32) arrbty = Text retVal = GetTextExtentPoint32(hDC, arrbty(0), Len(Text), ergebnis) If retVal = 0 Then Err.Raise 1, "Fehler in TextHeightW Funktion." TextHeightW = ergebnis.cy * Screen.TwipsPerPixelY End Function Private Sub TextZeichnen() Dim Zeilen() As String Dim ZeilenHoehe() As Long Dim temp1 As Long Dim Temp2 As Long Dim TempArbeitsCaption As String Dim ZlUmbrMethode As String TempArbeitsCaption = Replace(CaptionInt, vbCrLf, vbLf) ' Alle Zeilenumbruchvarianten in ein einheitliches Format verwandeln TempArbeitsCaption = Replace(TempArbeitsCaption, vbCr, vbLf) ZlUmbrMethode = vbLf If ZeilenumbruchInt And Not AutoSizeInt Then ' Zeilenumbrüche nach Leerzeichen erstellen Dim LetzteBrLfPos As Long Dim TempZeile As String LetzteBrLfPos = 1 - Len(ZlUmbrMethode) temp1 = -1 ReDim Zeilen(20) As String Do temp1 = temp1 + 1 ' Eine Zeile (durch die durch Zeilenumbrüche abgegrenzt ist) hernehmen If InStr(LetzteBrLfPos + Len(ZlUmbrMethode), _ TempArbeitsCaption, ZlUmbrMethode) = 0 Then TempZeile = Mid(TempArbeitsCaption, LetzteBrLfPos + Len(ZlUmbrMethode)) Else TempZeile = Mid(TempArbeitsCaption, LetzteBrLfPos + Len(ZlUmbrMethode), _ InStr(LetzteBrLfPos + Len(ZlUmbrMethode), _ TempArbeitsCaption, ZlUmbrMethode) - LetzteBrLfPos - Len(ZlUmbrMethode)) End If If TextWidthW(UserControl.hDC, TempZeile) > UserControl.Width And _ InStr(1, TempZeile, Chr(32)) > 0 Then ' Es sind Leerzeichen in der Zeile und sie ist länger als das UserControl, ' daher nach Leerzeichen Zeile umbrechen Dim LetzteLeerzeichenPos(1) As Long, TempNochVorhZeile As String TempNochVorhZeile = TempZeile temp1 = temp1 - 1 Do temp1 = temp1 + 1 LetzteLeerzeichenPos(1) = 0 If InStr(1, TempNochVorhZeile, Chr(32)) > 0 Then Do LetzteLeerzeichenPos(0) = LetzteLeerzeichenPos(1) LetzteLeerzeichenPos(1) = InStr(LetzteLeerzeichenPos(1) + 1, _ TempNochVorhZeile, Chr(32)) Loop While LetzteLeerzeichenPos(1) > 0 And _ TextWidthW(UserControl.hDC, Mid(TempNochVorhZeile, 1, _ IIf(LetzteLeerzeichenPos(1) > 0, LetzteLeerzeichenPos(1), _ Len(TempNochVorhZeile) + 1) - 1)) <= UserControl.Width If LetzteLeerzeichenPos(1) = 0 And TextWidthW(UserControl.hDC, _ Mid(TempNochVorhZeile, 1, IIf(LetzteLeerzeichenPos(1) > 0, _ LetzteLeerzeichenPos(1), Len(TempNochVorhZeile) + 1) - 1)) <= _ UserControl.Width Then ' Kein Leerzeichen mehr, aber Text passt noch rein LetzteLeerzeichenPos(0) = Len(TempNochVorhZeile) + 1 End If If LetzteLeerzeichenPos(0) = 0 Then ' Text enthält erst später ein Leerzeichen, sodass ein ' Überschreiten der Breite nicht verhindert werden kann LetzteLeerzeichenPos(0) = InStr(1, TempNochVorhZeile, Chr(32)) End If ' Die längste, mögliche Textlänge, ohne dass der Text über das ' Usercontrol hinausgeht (außer es sind keine Leerzeichen mehr vorhanden) Else LetzteLeerzeichenPos(0) = Len(TempNochVorhZeile) + 1 End If If temp1 > UBound(Zeilen) Then ReDim Preserve Zeilen(UBound(Zeilen) + 20) As String End If Zeilen(temp1) = Mid(TempNochVorhZeile, 1, LetzteLeerzeichenPos(0) - 1) TempNochVorhZeile = Mid(TempNochVorhZeile, LetzteLeerzeichenPos(0) + 1) Loop While Len(TempNochVorhZeile) > 0 Else If temp1 > UBound(Zeilen) Then ReDim Preserve Zeilen(UBound(Zeilen) + 20) As String End If Zeilen(temp1) = TempZeile End If LetzteBrLfPos = InStr(LetzteBrLfPos + Len(ZlUmbrMethode), _ TempArbeitsCaption, ZlUmbrMethode) Loop While LetzteBrLfPos > 0 ReDim Preserve Zeilen(temp1) As String Else Dim TempHoehe As Long, TempBreite As Long Zeilen = Split(TempArbeitsCaption, ZlUmbrMethode) End If ReDim ZeilenHoehe(UBound(Zeilen)) As Long For temp1 = 0 To UBound(Zeilen) ZeilenHoehe(temp1) = TextHeightW(UserControl.hDC, Zeilen(temp1)) TempHoehe = TempHoehe + ZeilenHoehe(temp1) Next If AutoSizeInt Then For temp1 = 0 To UBound(Zeilen) Temp2 = TextWidthW(UserControl.hDC, Zeilen(temp1)) If Temp2 > TempBreite Then TempBreite = Temp2 Next UserControl.Width = TempBreite UserControl.Height = TempHoehe End If UserControl.Cls Dim AktHoehe As Long For temp1 = 0 To UBound(Zeilen) If Not Zeilen(temp1) = "" Then PrintW UserControl.hDC, Zeilen(temp1), 0, AktHoehe End If AktHoehe = AktHoehe + ZeilenHoehe(temp1) Next End Sub 9. Konvertierungsfunktionen für UTF-8 nach UTF-16 LE und umgekehrt Option Explicit Public Function UTF8nachUTF16B(Text As String) As String Dim temp1 As Long Dim Ausgabestr As String Dim TempBytes(2) As Byte Dim TempBytesUnicode(1) As Byte Dim TempArrayB() As Byte Dim VorhLaenge As Long Dim AktLaenge As Long Dim TempLngTextOrg As Long TempArrayB = Text TempLngTextOrg = LenB(Text) / 2 Ausgabestr = String(TempLngTextOrg, Chr(0)) VorhLaenge = TempLngTextOrg For temp1 = 0 To UBound(TempArrayB) If TempArrayB(temp1) < 128 Then If AktLaenge + 1 > VorhLaenge Then Ausgabestr = Ausgabestr & String(4 + Int(TempLngTextOrg / 4), Chr(0)) VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4) End If Mid(Ausgabestr, AktLaenge + 1) = ChrW(TempArrayB(temp1)) AktLaenge = AktLaenge + 1 ' 2-Utf8-zeichen ElseIf TempArrayB(temp1) >= 192 And TempArrayB(temp1) < 224 Then TempBytes(0) = TempArrayB(temp1) TempBytes(1) = TempArrayB(temp1 + 1) TempBytesUnicode(1) = Int(TempBytes(0) / &H4) And &H7 TempBytesUnicode(0) = (TempBytes(0) And &H3) * &H40 + (TempBytes(1) And &H3F) If AktLaenge + 1 > VorhLaenge Then Ausgabestr = Ausgabestr & String(4 + Int(TempLngTextOrg / 4), Chr(0)) VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4) End If Mid(Ausgabestr, AktLaenge + 1) = ChrW(CLng(TempBytesUnicode(1)) * 256& + _ CLng(TempBytesUnicode(0))) AktLaenge = AktLaenge + 1 ' Ausgabestr = Ausgabestr & ChrW(CLng(TempBytesUnicode(1)) * 256 + _ ' CLng(TempBytesUnicode(0))) temp1 = temp1 + 1 ' 3 utf8-zeichen ElseIf TempArrayB(temp1) >= 224 And TempArrayB(temp1) < 240 Then TempBytes(0) = TempArrayB(temp1) TempBytes(1) = TempArrayB(temp1 + 1) TempBytes(2) = TempArrayB(temp1 + 2) TempBytesUnicode(1) = (TempBytes(0) And &HF) * &H10 + _ (Int(TempBytes(1) / &H4) And &HF) TempBytesUnicode(0) = (TempBytes(1) And &H3) * &H40 + _ (TempBytes(2) And &H3F) If AktLaenge + 1 > VorhLaenge Then Ausgabestr = Ausgabestr & String(4 + Int(TempLngTextOrg / 4), Chr(0)) VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4) End If Mid(Ausgabestr, AktLaenge + 1) = ChrW(CLng(TempBytesUnicode(1)) * 256& + _ CLng(TempBytesUnicode(0))) AktLaenge = AktLaenge + 1 temp1 = temp1 + 2 End If Next UTF8nachUTF16B = Mid(Ausgabestr, 1, AktLaenge) End Function Public Function UTF16NachUTF8B(Text As String) As String Dim temp1 As Long Dim Ausgabestr As String Dim TempBytes(2) As Byte Dim TempBytesUnicode(1) As Byte Dim TempArrayB() As Byte Dim VorhLaenge As Long Dim AktLaenge As Long Dim TempLngTextOrg As Long TempArrayB = Text TempLngTextOrg = Len(Text) Ausgabestr = StringB(TempLngTextOrg, ChrB(0)) VorhLaenge = TempLngTextOrg For temp1 = 0 To UBound(TempArrayB) Step 2 TempBytesUnicode(0) = TempArrayB(temp1) TempBytesUnicode(1) = TempArrayB(temp1 + 1) ' 1-Byte-Zeichn If CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) <= &H7F& Then If AktLaenge + 1 > VorhLaenge Then Ausgabestr = Ausgabestr & StringB(4 + Int(TempLngTextOrg / 4), ChrB(0)) VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4) End If MidB(Ausgabestr, AktLaenge + 1) = ChrB(TempBytesUnicode(0)) AktLaenge = AktLaenge + 1 ' 2-Byte-Zeichn ElseIf CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) > &H7F& And _ CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) <= &H7FF& Then If AktLaenge + 2 > VorhLaenge Then Ausgabestr = Ausgabestr & StringB(4 + Int(TempLngTextOrg / 4), ChrB(0)) VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4) End If TempBytes(0) = &HC0 + TempBytesUnicode(1) * &H4 + Int(TempBytesUnicode(0) / 2 ^ 6) TempBytes(1) = &H80 + (TempBytesUnicode(0) And &H3F) MidB(Ausgabestr, AktLaenge + 1) = ChrB(TempBytes(0)) MidB(Ausgabestr, AktLaenge + 2) = ChrB(TempBytes(1)) AktLaenge = AktLaenge + 2 ' 3-Byte-Zeichn ElseIf CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) > &H7FF& And _ CLng(TempBytesUnicode(1)) * 256& + CLng(TempBytesUnicode(0)) <= &HFFFF& Then If AktLaenge + 3 > VorhLaenge Then Ausgabestr = Ausgabestr & StringB(4 + Int(TempLngTextOrg / 4), ChrB(0)) VorhLaenge = VorhLaenge + 4 + Int(TempLngTextOrg / 4) End If TempBytes(0) = &HE0 + Int(TempBytesUnicode(1) / 2 ^ 4) TempBytes(1) = &H80 + (TempBytesUnicode(1) And &HF) * 2 ^ 2 + _ Int(TempBytesUnicode(0) / 2 ^ 6) TempBytes(2) = &H80 + (TempBytesUnicode(0) And &H3F) MidB(Ausgabestr, AktLaenge + 1) = ChrB(TempBytes(0)) MidB(Ausgabestr, AktLaenge + 2) = ChrB(TempBytes(1)) MidB(Ausgabestr, AktLaenge + 3) = ChrB(TempBytes(2)) AktLaenge = AktLaenge + 3 End If Next UTF16NachUTF8B = MidB(Ausgabestr, 1, AktLaenge) End Function Private Function StringB(Number As Long, Character As String) Dim CharInt As String CharInt = MidB$(Character, 1, 1) StringB = String(Int(Number / 2), CharInt & CharInt) If Number Mod 2 = 1 Then StringB = StringB & CharInt End Function Zu beachten ist, dass die UTF8nachUTF16B-Funktion einen binären String als Argument erwartet und die UTF16NachUTF8B-Funktion einen binären String ausgibt. Wenn Sie damit beispielsweise eine UTF-8 Textdatei in dem unicodefähigen Label anzeigen wollen, können Sie folgende Funktion verwenden, die automatisch überprüft, ob die Datei ein UTF-8-, UTF-16 LE- oder kein BOM (ANSI) enthält und die Datei entsprechend konvertiert und den Dateiinhalt dann zurückgibt: Public Function OeffneUnicodeDatei(Dateiname As String) As String Dim arrTemp() As Byte, DateiBinaerInhalt As String Open Dateiname For Binary As 1 ReDim arrTemp(LOF(1) - 1) As Byte Get 1, , arrTemp Close 1 DateiBinaerInhalt = arrTemp ' UTF-8-BOM, daher von UTF-8 nach UTF-16 LE konvertieren If MidB(DateiBinaerInhalt, 1, 3) = ChrB(239) & ChrB(187) & ChrB(191) Then OeffneUnicodeDatei = UTF8nachUTF16B(MidB(DateiBinaerInhalt, 4)) ' UTF-16 LE-BOM, daher Datei nicht konvertieren, da sie ja schon in Unicode ist ElseIf MidB(DateiBinaerInhalt, 1, 2) = ChrB(255) & ChrB(254) Then OeffneUnicodeDatei = MidB(DateiBinaerInhalt, 3) ' Keine BOM, daher wird angenommen, dass es sich um eine normale Textdatei im ANSI-Format handelt Else OeffneUnicodeDatei = StrConv(DateiBinaerInhalt, vbUnicode) End If End Function Testen können Sie diesse Funktion, indem Sie mit dem Windows Editor einen Text mit ein paar Sonderzeichen (z. B. chinesische Zeichen) schreiben und diese Datei dann als "Unicode" oder "UTF-8" speichern. Dieser Workshop wurde bereits 24.391 mal aufgerufen.
 Anzeige
 Diesen und auch alle anderen Workshops finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6(einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
TOP! Unser Nr. 1  Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats April 2024Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 Access-Tools Vol.1  Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||
|
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |
||||||||||||||
Unicodefähiges Label / Unicodefähige Print-Funktion für VB6
Druckansicht