Normann Strübli | Hab mich la fois avec Funktionen zur Textausgabe et Fomatierung un peu auseinandergesetzt. Rausgekommen ist dabei un kleines Beispiel dans dem un beliebiger Text dans einer beliebigen Schriftart sur einem bekannten DC ausgegeben, et qui Formatierung eingestellt volonté peux. Is pas parfait hat alors kleine Schönheitsfehler qui alors Lust hat peux là oui la fois quoi dolles de faire.
PS: Is nich so compliqué wies peut-être aussieht. KompilierenMarqueSéparationWIN32 API
THEMA: Einfache Textformatierung
Autor: Normann Strübli
$H windows.ph
$H messages.ph
Declare Text$,Text#,Text2#,Size#,Size.cx&,Space&,Mempos&,findpos&,Startpos&,Space&
Declare Textwidth&,Textheight&,maxpos&,Ystart&,ystart2&,Xstart&,Xstart2&
declare test%,textlen&,Format%,merker&
Declare links&,mitte&,rechts&,Block&
*** Festlegung der Größe des Textfeldes
Textwidth& = 400 Max Breite des Textes
Textheight& = 300 Max Höhe des Textes
Xstart& = 20
Ystart& = 50
Text$ = "Dies ist ein Beispiel, wie man mit einfachen Funktionen zur Textausgabe
einen komplexen Text Formatieren kann um ihn z.B. auf einem Drucker auszugeben
. Der dargestellte Text ist nur durch einen String definiert, der außer einem
abschließenden NUL keine Steuerzeichen enthält. Bei jedem Leerzeichen wird mittels
GetTextExtendetPoint32 geprüft ob in eine neue Zeile verschoben werden muß -
falls ja wird das vorangehende Leerzeichen als Zeilenende benutzt. Diese Suche
und Berechnung findet für alle vier möglichen Formatierungsarten statt. Will man
allerdings Formatierungen erreichen wie z.B. Wordpad es tut (mit mehreren
Schriftarten und größen in einer Zeile) wird es Richtig komplex und macht
bestimmt keinen Spaß mehr ;-)"
text$ = @Trim$(text$)
textlen& = @len(text$)
Dim Text# ,textlen&
Dim Text2# ,textlen&
String Text#,0= text$
Dim Size#,8
Windowtitle "Einfache Textformatierung"
window 0,0-450,400
links& = @Create("Button",%hwnd,"Linksbündig",20,20,90,25)
mitte& = @Create("Button",%hwnd,"Mittig",120,20,60,25)
rechts& = @Create("Button",%hwnd,"Rechtsbündig",190,20,100,25)
Block& = @Create("Button",%hwnd,"Blocksatz",300,20,90,25)
UseBrush 1,@RGB(220,220,220)
Rectangle xstart&,Ystart&-Textwidth&+xstart&,Textheight&
Proc Showtext Gibt den Text aus
~GetTextExtentPoint32A(%hDC,Text2#,@MemPos(Text2#,0,@chr$(0)),Size#)
Size.cx& = @Long(Size#,0)
~SetBkMode(%hdc, ~TRANSPARENT)
if Format% = 1
Xstart2& = Xstart& + Textwidth& / 2 -size.cx& / 2 Rechtsbündig
elseif Format% = 2
Xstart2& = Xstart& + Textwidth& -size.cx& Mittig
Elseif Format% = 3
~SetTextJustification(%hdc,Textwidth& - Size.cx&,space&) Blocksatz
Xstart2& = Xstart&
else
Xstart2& = Xstart& Linksbündig
endif
~TextOut(%hdc,Xstart2&,YStart&,Text2#,@MemPos(Text2#,0,@chr$(0))) Text ausgeben.
~SetTextJustification(%hdc,0,0)
~SetBkMode(%hdc2, ~TRANSPARENT)
~TextOut(%hdc2,Xstart2&,YStart&,Text2#,@MemPos(Text2#,0,@chr$(0))) damits auch neugezeichnet wird
~SetTextJustification(%hdc2,0,0)
Endproc
Proc Formattext Bearbeitet Zeilenumbrüche und Trennzeichen
Findpos& = 0
Ystart& = 50
mempos& = 0
startpos& = 0
UseBrush 1,@RGB(220,220,220)
Rectangle xstart&,50-Textwidth&+xstart&,Textheight&
Space& = -1
Whilenot findpos&=-1
findpos& = @MemPos(Text#,Mempos&," ") Ab Position Mempos& nach Leerzeichen suchen
if findpos& > -1 Solange was gefunden wird
findpos& = findpos& + mempos&
Mempos& = findpos& +1
inc Space&
String Text2#,0=@Char$(text#,startpos&,findpos&-startpos&)
~GetTextExtentPoint32A(%hDC,Text2#,@MemPos(Text2#,0,@chr$(0)),Size#)
if @Long(Size#,0) > Textwidth& Wenn der Text nicht mehr in die Zeile Passt > Zeilenumbruch
dec space& letzte Leerzeichen ignorieren
String Text2#,0=@Char$(text#,startpos&,maxpos&-startpos&) Aktuelle Zeile in Text2# schreiben
Showtext Aktuelle Zeile anzeigen
Ystart& = Ystart& +@Long(Size#,4) Y-Startposition für nächste Zeile (einfach Texthöhe addieren)
startpos& = maxpos& +1
space& = 0
else
maxpos& = findpos&
endif
endif
wend
inc space&
String Text2#,0=@Char$(text#,startpos&,@len(@String$(text#,0))-startpos&)
Showtext
EndProc
*** Hauptprogramm
UseFont "Arial",16,0,0,0,0
While 1
waitinput
if @getfocus(links&)
format% = 0
Formattext
elseif @getfocus(mitte&)
format% = 1
Formattext
elseif @getfocus(rechts&)
format% = 2
Formattext
elseif @getfocus(Block&)
format% = 3
Formattext
endif
@SetFocus(%hwnd)
wend
'./../../funktionsreferenzen/XProfan/dispose/'>Dispose Text#
Dispose Text2#
|
|