Code: Alles auswählen
;+----------------------------------------------------------------------+
;| PureBasic-QuellCode "SystemFont" mit allen ModulBody´s |
;|erstellt durch Programm "PB_Mod2Body", Vers. 11225a am 23.07.13, 15:50|
;+----------------------------------------------------------------------+
;Modul SystemFont Version 1.08 vom 25.02.2010
#PB_Vers = "4.20"
;
;Funktion: läd System-Font: 1=Titel 2=Switch/Symbol 3=Menü 4=WinText/Dialog 5=Palette 6=Quick&Status
; Es werden die System-FontDaten bestimmt, die via "SystemSteuerung/An=
; zeige/Darstellung/Eigenschaften/erweitert" auf´m Desktop eingestellt
; werden.
;
;Aufruf: FontID = SystemFont(SysFontNr.l)
; wobei: SysFontNr = der Index des gewünschten System-Font´s:
; 1 = Titelleiste des aktiven / deaktiven Fensters
; (auch für Taskleiste und Fenster-Text)
; 2 = Symbol (Desktop-Icon´s)
; 3 = Fenster-Menü, markierte Elemente
; 4 = Dialogfeld (MessageRequester)
; 5 = Paletten-Titel
; 6 = QuickInfo, auch StatusZeile
; Sofern eine gültige SysFontNr (1..6) angegeben wurde, so wird
; dieser Font geladen und dessen Handle als FunktionsWert geliefert.
; Auch die folgenden Global´s sind belegt:
Global SystemFont_Name$ ;Schriftart-Name
Global SystemFont_Size ;Schriftart-Größe
Global SystemFont_Style ;Schriftart-Attribute
Global SystemFont_FontNr ;FontNr des geladenen Font´s
;
;
;Aufruf: FontName$ = SystemFontName(SysFontNr.l) - liefert SystemFont-Bezeichnung
; wobei: SysFontNr = der Index des gewünschten System-Font´s, siehe oben
;========== Begin Modul "Wort.PBI" ==========
;Modul Wort Version 1.14 vom 05.03.2013 (PB_V3.73)
#PB_Vers = "4.20"
; (Basis: THEOS-Modul SYSTEM.MODLIB.WORT V 3.03 vom 11.05.1997)
;
;Funktion: liefert erstes Wort in einem String und verkürzt Diesen entsprechend
; entspricht prinzipell der PB-Funktion "StringField()", benötigt jedoch
; keinen Wort-Index und erkennt Wort aufgrund diverser Trenn- / Klammerungs=
; zeichen. Außerdem wird die Wort-Basis (Eingangs-String-Parameter) wie
; eine Queue gehandhabt und nach FunktionsEnde ist das erkannte Wort am
; Anfang dieses Strings entfernt...
;
;Aufruf: Wort$ = Wort(@String$) - liefert nächstes Wort von String$ (bis Leerzeichen bzw. geklammert)
; wobei: String$ = Text-Variable !!!, in der ggf. mehrere Worte enthalten sind.
; Ein Wort ist:
; - alle Zeichen bis zum nächsten Blank(führende Blank´s werden ignoriert) oder
; - geklammert durch " (^34), ' (^39), ´(^180), " " (^160) oder ^255 oder
; - bis zum nächsten Zeichen lt. Global ´Wort_Ende$´ oder
; - geklammter durch Zeichen lt. Global ´Wort_Klammer$´
; Die Global´s Wort_Ende$ und Wort_Klammer$ sind nach Funktions-Rückkehr resetet
; (=leer!!), müßen also -sofern erforderlich- _vor jedem Aufruf_ dieser Funktion
; entsprechend gesetzt werden !!!!
;
; Diese Funktion liefert das 1. Wort im String (führende Leerzeichen werden ignoriert)
; und der String wird entsprechend verkürzt
; Beispiel:
; A$ = "hallo ´du da´ alles klar"
; B$ = Wort(@A$) ;1. Aufruf
; (--> B$ ist "hallo", A$ ist nun "´du da´ alles klar")
; B$ = Wort(@A$) ;2. Aufruf
; (--> B$ ist "du da", A$ ist nun "alles klar") (wg. ´´-Klammerung)
; B$ = Wort(@A$) ;3. Aufruf
; (--> B$ ist "alles", A$ ist nun "klar")
; B$ = Wort(@A$) ;4. Aufruf
; (--> B$ ist "klar", A$ ist nun leer)
;
Global Wort_Ende$ ;Zeichen(kette) für Wort-Ende, GROSS-/klein-Schrift egal
;!!! ist nach Funktionsausführung resettet (=leer) !!!
Global Wort_Klammer$ ;Klammerungs-Zeichen: alle Zeichen, die als Wort-Anfangs- oder Ende-Kennung
;beim folgenden Aufruf zulässig sein sollen
Global Wort_EndKz$ ;Rückgabe: gefundenes/benutztes Wort-Ende-Zeichen
;bzw. Zeichenkette bei Einsatz von Wort_Ende$
#Wort_BlankReplace = Chr(28);siehe Modul "WortForm()"...
;#jaPBeExt exit
Procedure.s Wort(*Param)
Protected Param$, Wort$
If *Param>1
Param$ = LTrim(PeekS(*Param))
If Wort_Ende$ = ""
If Wort_Klammer$ = ""
Wort_Klammer$ = #DQUOTE$ + Chr(39) + Chr(180) + Chr(255) + Chr(160);", ', ´ oder ^255
EndIf
If FindString(Wort_Klammer$, Left(Param$, 1), 1)And Param$>""
Wort_Ende$ = Left(Param$, 1)
Param$ = Right(Param$, Len(Param$) - 1)
Else
Wort_Ende$ = " "
EndIf
EndIf
Wort_Ende$ = UCase(Wort_Ende$)
While UCase(Left(Param$, Len(Wort_Ende$)))<>Wort_Ende$ And Param$>""
Wort$ + Left(Param$, 1)
Param$ = Mid(Param$, 2)
Wend
Param$ = Mid(Param$, Len(Wort_Ende$))
Wort$ = LTrim(ReplaceString(Wort$, #Wort_BlankReplace, Chr(32)))
Wort_EndKz$ = Wort_Ende$
Wort_Ende$ = "" : Wort_Klammer$ = ""
PokeS(*Param, LTrim(Right(Param$, Len(Param$) - 1)))
EndIf
ProcedureReturn Wort$
EndProcedure
;========== Ende Modul "Wort.PBI" ==========
;#jaPBeExt exit
Procedure SystemFont(FontNr.l);- Läd einen System-Font (WinTitel, Menü, Message, Status...) und liefert dessen FontHandle
Protected RegID.l, RegKey$, RegEntry.l, *LogFont.LOGFONT, FontID.l, pos.l, Char.l, Win_DC.l
Protected MemNr
Select FontNr
Case 1 : RegKey$ = "CaptionFont" ;FensterTitel (aktiv und deaktiv)
Case 2 : RegKey$ = "IconFont" ;Symbol (Icon-Texte)
Case 3 : RegKey$ = "MenuFont" ;Menü, markierte Elemente
Case 4 : RegKey$ = "MessageFont" ;DialogFeld (MessageRequester...)
Case 5 : RegKey$ = "SmCaptionFont" ;Paletten-Titel
Case 6 : RegKey$ = "StatusFont" ;QuickInfo (auch StatusZeile)
EndSelect
SystemFont_Name$ = "" : SystemFont_Size = 0 : SystemFont_Style = 0 ;reset Global´s
If RegKey$>"" ;FontID gültig
RegOpenKeyEx_(#HKEY_CURRENT_USER, "Control Panel\Desktop\WindowMetrics", 0, #KEY_READ, @RegID)
RegQueryValueEx_(RegID, RegKey$, 0, 0, 0, @RegEntry)
*LogFont = AllocateMemory(200)
MemNr =*LogFont
RegQueryValueEx_(RegID, RegKey$, 0, 0, *LogFont, @RegEntry)
pos = 28 ;start of lfFaceName
Repeat
Char = PeekB(*LogFont + pos)
If Char : SystemFont_Name$ + Chr(Char): pos + 2 : EndIf
Until Char = 0
SystemFont_Size = PeekL(*LogFont): If SystemFont_Size<0 : SystemFont_Size * - 1 : EndIf
Win_DC = GetDC_(GetDesktopWindow_())
SystemFont_Size = Round(SystemFont_Size * 72 / GetDeviceCaps_(Win_DC, #LOGPIXELSY), 1)
If PeekL(*LogFont + 16) = 700 : SystemFont_Style = #PB_Font_Bold : EndIf
If PeekB(*LogFont + 20): SystemFont_Style + #PB_Font_Italic : EndIf
If PeekB(*LogFont + 21): SystemFont_Style + #PB_Font_Underline : EndIf
If PeekB(*LogFont + 22): SystemFont_Style + #PB_Font_StrikeOut : EndIf
If PeekB(*LogFont + 26): SystemFont_Style + #PB_Font_HighQuality : EndIf
SystemFont_FontNr = LoadFont(#PB_Any, SystemFont_Name$, SystemFont_Size, SystemFont_Style)
FontID = FontID(SystemFont_FontNr)
RegCloseKey_(RegID)
FreeMemory(MemNr)
EndIf
ProcedureReturn FontID
EndProcedure
; jaPBe Version=3.8.6.707
; Build=0
; FirstLine=0
; CursorPosition=29
; ExecutableFormat=Windows
; DontSaveDeclare
; EOF
