Deklaration: Declare Function ChooseFont Lib "comdlg32.dll" _ Alias "ChooseFontA" ( _ lpcf As CHOOSEFONT_TYPE) As Long Beschreibung: Parameter:
Rückgabewert: Beispiel: Private Declare Function ChooseFont Lib "comdlg32.dll" _ Alias "ChooseFontA" ( _ lpcf As CHOOSEFONT_TYPE) As Long Private Type LOGFONT lfHeight As Long lfWidth As Long lfEscapement As Long lfOrientation As Long lfWeight As Long lfItalic As Byte lfUnderline As Byte lfStrikeOut As Byte lfCharSet As Byte lfOutPrecision As Byte lfClipPrecision As Byte lfQuality As Byte lfPitchAndFamily As Byte lfFaceName As String * 32 End Type Private Type CHOOSEFONT_TYPE lStructSize As Long hwndOwner As Long hDC As Long lpLogFont As Long iPointSize As Long Flags As Long rgbColors As Long lCustData As Long lpfnHook As Long lpTemplateName As String hInstance As Long lpszStyle As String nFontType As Integer MISSING_ALIGNMENT As Integer nSizeMin As Long nSizeMax As Long End Type ' Zeigt nur Windows- oder Unicode-Fonts Private Const CF_ANSIONLY = &H400 ' Zeigt einen "Übernehmen" Button an Private Const CF_APPLY = &H200 ' Listet Drucker- und Bildschirm-Fonts Private Const CF_BOTH = &H3 ' Erlaubt Font-Besonderheiten wie ' Unterstreichen, Farbe und Durchgestrichen Private Const CF_EFFECTS = &H100 ' Aktiviert die Callback-Funktion Private Const CF_ENABLEHOOK = &H8 ' Der Dialog benutzt Template's die von ' TemplateNames festgelegt sind Private Const CF_ENABLETEMPLATE = &H10 ' Verwendet den durch hInstance festgelegten Dialog Private Const CF_ENABLETEMPLATEHANDLE = &H20 ' Listet nur Fixed-Pitch Fonts Private Const CF_FIXEDPITCHONLY = &H4000 ' Verweigert die Eingabe nicht aufgeführter Fonts Private Const CF_FORCEFONTEXIST = &H10000 ' Setzt die Startwerte, welche über die ' LOGFONT-Struktur angegeben wurden Private Const CF_INITTOLOGFONTSTRUCT = &H40 ' Erlaubt nur Schriftgrößen im Bereich "nSizeMin" und "nSizeMax" Private Const CF_LIMITSIZE = &H2000 ' Zeigt keine OEM Fonts Private Const CF_NOOEMFONTS = &H800 ' Kein Standard Facenamen selektieren Private Const CF_NOFACESEL = &H80000 ' Kein Standard Script selektieren Private Const CF_NOSCRIPTSEL = &H800000 ' keine Standardgröße setzen Private Const CF_NOSIZESEL = &H200000 ' Kein Beispiel (Vorschau) anzeigen Private Const CF_NOSIMULATIONS = &H1000 ' kein Standard-Stil setzen Private Const CF_NOSTYLESEL = &H100000 ' keine Vector-Fonts anzeigen Private Const CF_NOVECTORFONTS = &H800 ' keine vertikal ausgerichtete Fonts anzeigen Private Const CF_NOVERTFONTS = &H1000000 ' Listet Drucker-Fonts Private Const CF_PRINTERFONTS = &H2 ' Listet nur skalierbare Fonts Private Const CF_SCALABLEONLY = &H20000 ' Listet Bildschirm-Fonts Private Const CF_SCREENFONTS = &H1 ' Listet nur Windows- oder Unicode-Fonts Private Const CF_SCRIPTSONLY = &H400 ' Listet nur Script-Fonts Private Const CF_SELECTSCRIPT = &H400000 ' Zeigt den Hilfe-Button an Private Const CF_SHOWHELP = &H4 ' Listet nur TrueType-Schriftarten Private Const CF_TTONLY = &H40000 ' Verwendet die in "lpStyle" angegebenen Werte Private Const CF_USESTYLE = &H80 ' Listet nur Fonts, die Drucker- und Bildschirm-Fonts gleichzeitig sind ' (muss benutzt werden mit CF_BOTH und CF_SCALABLEONLY) Private Const CF_WYSIWYG = &H8000 <br><br> ' nFontType Konstanten ' ==================== Private Const BOLD_FONTTYPE = &H100 ' fett Private Const ITALIC_FONTTYPE = &H200 ' kursiv Private Const PRINTER_FONTTYPE = &H4000 ' Drucker-Fonts Private Const REGULAR_FONTTYPE = &H400 ' reguläre Fonts Private Const SCREEN_FONTTYPE = &H2000 ' Bildschirm-Fonts ' Fonts, die in der Dialogbox simuliert werden können Private Const SIMULATED_FONTTYPE = &H8000 <br><br> ' lfWeight Konstanten ' =================== Private Const FW_DONTCARE = 0 ' Standard Private Const FW_THIN = 100 ' super dünn Private Const FW_EXTRALIGHT = 200 ' extra dünn Private Const FW_LIGHT = 300 ' dünn Private Const FW_NORMAL = 400 ' normal Private Const FW_MEDIUM = 500 ' mittel Private Const FW_SEMIBOLD = 600 ' etwas dicker Private Const FW_BOLD = 700 ' fett Private Const FW_EXTRABOLD = 800 ' extra fett Private Const FW_HEAVY = 900 ' super fett ' lfCharSet Konstanten ' ==================== Private Const ANSI_CHARSET = 0 ' Ansi Zeichensatz Private Const ARABIC_CHARSET = 178 ' Arabisch (NT/2000) Private Const BALTIC_CHARSET = 186 ' Baltisch (Win 9x) Private Const CHINESEBIG5_CHARSET = 136 ' Chinesisch Private Const DEFAULT_CHARSET = 1 ' Standard Private Const EASTEUROPE_CHARSET = 238 ' Osteuropäisch (Win 9x) Private Const GB2312_CHARSET = 134 ' Englisch Private Const GREEK_CHARSET = 161 ' Griechisch (Win 9x) Private Const HANGEUL_CHARSET = 129 ' Handgeul Private Const HEBREW_CHARSET = 177 ' Hebräisch (NT/2000) Private Const JOHAB_CHARSET = 130 ' Johab (Win 9x) Private Const MAC_CHARSET = 77 ' Mac (Win 9x) Private Const OEM_CHARSET = 255 ' OEM Private Const RUSSIAN_CHARSET = 204 ' Russisch (Win 9x) Private Const SHIFTJIS_CHARSET = 128 ' ShiftJis Private Const SYMBOL_CHARSET = 2 ' Symbolisch Private Const THAI_CHARSET = 222 ' Thailändisch (NT/2000) Private Const TURKISH_CHARSET = 162 ' Türkisch (Win 9x) ' lfOutPrecision Konstanten ' ========================= ' Verwendet die Standard-Font Private Const OUT_DEFAULT_PRECIS = 0 ' Verwendet eine Device-Font wenn mehrere ' Dateien mit dem selben Namen existieren Private Const OUT_DEVICE_PRECIS = 5 ' (NT/2000) Verwendet eine TureType Schriftart ' oder Outline-Based Fonts. Private Const OUT_OUTLINE_PRECIS = 8 ' Verwendet ein Raster-Font, wenn mehrere ' Dateien mit dem selben Namen existieren Private Const OUT_RASTER_PRECIS = 6 ' Raster-Font für die Enumeration Private Const OUT_STRING_PRECIS = 1 ' (Win 9x) Vector-Font für die Enumeration ' (NT/2000) TrueType, Outline-Based oder VectorFont für die Enumeration Private Const OUT_STROKE_PRECIS = 3 ' Verwendet eine TrueType-Schriftart Private Const OUT_TT_ONLY_PRECIS = 7 ' Verwendet eine TrueType-Font, wenn mehrere ' Dateien mit dem selben Namen existieren Private Const OUT_TT_PRECIS = 4 ' lfClipPrecision Konstanten ' ========================== ' Standard Private Const CLIP_DEFAULT_PRECIS = 0 ' wird benutzt für eingebettete schreibgeschützte Fonts Private Const CLIP_EMBEDDED = 128 ' die Richtung von irgendwelchen Rotationen wird vom ' Koordinatensystem festgelegt (gegen den Uhrzeigersinn) Private Const CLIP_LH_ANGLES = 16 ' Raster-Vector oder TrueType-Fonts für die Enumeration Private Const CLIP_STROKE_PRECIS = 2 ' lfQuality Konstanten ' ==================== ' (Win 9x, NT 4.0, 2000) Schriftart wird wenn möglich ' immer mit Anitialisierung gezeichnet Private Const ANTIALIASED_QUALITY = 4 ' Standard Qualität Private Const DEFAULT_QUALITY = 0 ' entspricht "Schnelldruck" bei Druckausgaben Private Const DRAFT_QUALITY = 1 ' (Win 9x, NT 4.0, 2000) Schriftart wird nicht mit ' Anitialisierung gezeichnet Private Const NONANTIALIASED_QUALITY = 3 ' entspricht "Schöndruck" bei Druckausgaben Private Const PROOF_QUALITY = 2 ' lfPitchAndFamily Konstanten ' =========================== Private Const DEFAULT_PITCH = 0 ' Standard Private Const FIXED_PITCH = 1 ' Fest Private Const VARIABLE_PITCH = 2 ' Variabel Private Const FF_DECORATIVE = 80 ' Dekoriert Private Const FF_DONTCARE = 0 ' Egal Private Const FF_MODERN = 48 ' Modern Private Const FF_ROMAN = 16 ' Roman Private Const FF_SCRIPT = 64 ' Script Private Const FF_SWISS = 32 ' Swiss Private Sub Command1_Click() Dim Retval As Long, TmpFName As String Static LFnt As LOGFONT, CF_T As CHOOSEFONT_TYPE ' Dialog-Eigenschaften setzen With CF_T .Flags = CF_SCREENFONTS Or CF_EFFECTS Or CF_INITTOLOGFONTSTRUCT .hwndOwner = Me.hWnd .lStructSize = Len(CF_T) .lpLogFont = VarPtr(LFnt) .hInstance = App.hInstance .hDC = Printer.hDC .nFontType = SCREEN_FONTTYPE .rgbColors = 0 End With If Trim$(LFnt.lfFaceName) = "" Then ' Nur zum Initialisieren Leerzeichen setzen LFnt.lfFaceName = Space(31) & vbNullChar Else ' ansonsten "alte Font" als Standard setzen LFnt.lfFaceName = Left$(LFnt.lfFaceName, Len(LFnt.lfFaceName) - 1) & vbNullChar End If ' Dialog aufrufen Retval = ChooseFont(CF_T) If Retval = 0 Then MsgBox "Es ist ein Fehler im Dialog aufgetreten, " & _ "oder Sie haben Abbrechen gewählt.", vbCritical, "Fehler" Exit Sub End If ' Struktur auswerten und dem Bildfeld zuweisen ' ============================================ ' Fontnamen in Unicode konvertieren TmpFName = StrConv(LFnt.lfFaceName, vbUnicode) With Picture1 With .Font .Name = Left$(TmpFName, InStr(1, TmpFName, vbNullChar) - 1) .Bold = CBool(LFnt.lfWeight >= FW_BOLD) .Italic = CBool(LFnt.lfItalic) .Underline = CBool(LFnt.lfUnderline) .Strikethrough = CBool(LFnt.lfStrikeOut) .Size = CF_T.iPointSize / 10 End With .ForeColor = CF_T.rgbColors ' Ausgabe starten .Cls If .ScaleWidth < .TextWidth(.FontName) Then .CurrentX = 5 .CurrentY = 5 Else .CurrentX = (.ScaleWidth - .TextWidth(.FontName)) / 2 .CurrentY = (.ScaleHeight - .TextHeight(.FontName)) / 2 End If End With Picture1.Print .FontName End Sub Diese Seite wurde bereits 10.829 mal aufgerufen. |
sevISDN 1.0 Überwachung aller eingehender Anrufe! Die DLL erkennt alle über die CAPI-Schnittstelle eingehenden Anrufe und teilt Ihnen sogar mit, aus welchem Ortsbereich der Anruf stammt. Weitere Highlights: Online-Rufident, Erkennung der Anrufbehandlung u.v.m. Buchempfehlung Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. |
||||||||||||
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. |