Je suis parvenu à faire fonctionner AddFontResource_() et à ajouter une font ttf, mais le RemoveFontResource ne la fait plus disparaître de la liste.
Du coup je n'arrive pas à valider un modèle de test convenable.
Par contre je me suis amusé avec le reste des fonctions API pour voir ce que l'on peut tirer comme parti supplémentaire :
Code : Tout sélectionner
Enumeration
#Window_Main
#Gadget_Button
#Gadget_String
#Gadget_ListIcon
#Gadget_Image
#Image
EndEnumeration
#AW_HOR_POSITIVE = $1 ; Animates the window from left to right. This flag can be used with roll or slide animation.
#AW_HOR_NEGATIVE = $2 ; Animates the window from right to left. This flag can be used with roll or slide animation.
#AW_VER_POSITIVE = $4 ; Animates the window from top to bottom. This flag can be used with roll or slide animation.
#AW_VER_NEGATIVE = $8 ; Animates the window from bottom to top. This flag can be used with roll or slide animation.
#AW_CENTER = $10 ; Makes the window appear to collapse inward if AW_HIDE is used or expand outward if the AW_HIDE is not used.
#AW_HIDE = $10000 ; Hides the window. By default, the window is shown.
#AW_ACTIVATE = $20000 ; Activates the window.
#AW_SLIDE = $40000 ; Uses slide animation. By default, roll animation is used.
#AW_BLEND = $80000 ; Uses a fade effect. This flag can be used only if hwnd is a top-level window.
;
; All returned values are accessible but few are used here to fill the ListIcon gadget
;
Procedure EnumFontFamProc(lpelf.l, lpntm.l, FontType.l, lParam.l)
Static FontCounter.l
*lpelf.ENUMLOGFONT = lpelf
sFontType.s = ""
TrueType = #False
If FontType & #DEVICE_FONTTYPE
sFontType.s + "Device "
EndIf
If FontType & #RASTER_FONTTYPE
sFontType.s + "Raster "
EndIf
If FontType & #TRUETYPE_FONTTYPE
sFontType.s + "TrueType "
TrueType = #True
EndIf
FontHeight = *lpelf\elfLogFont\lfHeight
FontWidth = *lpelf\elfLogFont\lfWidth
FontEscapement = *lpelf\elfLogFont\lfEscapement
FontOrientation = *lpelf\elfLogFont\lfOrientation
FontWeight = *lpelf\elfLogFont\lfWeight
FontItalic = *lpelf\elfLogFont\lfItalic
FontUnderline = *lpelf\elfLogFont\lfUnderline
FontStrikeOut = *lpelf\elfLogFont\lfStrikeOut
FontCharSet = *lpelf\elfLogFont\lfCharSet
FontOutPrecision = *lpelf\elfLogFont\lfOutPrecision
FontClipPrecision = *lpelf\elfLogFont\lfClipPrecision
FontQuality = *lpelf\elfLogFont\lfQuality
FontPitchAndFamily = *lpelf\elfLogFont\lfPitchAndFamily
FontName.s = ""
i = 0
While *lpelf\elfFullName[i] <>0
FontName + Chr(*lpelf\elfFullName[i])
i + 1
Wend
FontStyle.s = ""
i = 0
While *lpelf\elfStyle[i] <>0
FontStyle + Chr(*lpelf\elfStyle[i])
i + 1
Wend
If TrueType
*lpntm1.NEWTEXTMETRIC = lpntm
MetricHeight = *lpntm1\tmHeight
MetricAscent = *lpntm1\tmAscent
MetricDescent = *lpntm1\tmDescent
MetricInternalLeading = *lpntm1\tmInternalLeading
MetricExternalLeading = *lpntm1\tmExternalLeading
MetricAveCharWidth = *lpntm1\tmAveCharWidth
MetricMaxCharWidth = *lpntm1\tmMaxCharWidth
MetricWeight = *lpntm1\tmWeight
MetricOverhang = *lpntm1\tmOverhang
MetricDigitizedAspectX = *lpntm1\tmDigitizedAspectX
MetricDigitizedAspectY = *lpntm1\tmDigitizedAspectY
MetricFirstChar = *lpntm1\tmFirstChar
MetricLastChar = *lpntm1\tmLastChar
MetricDefaultChar = *lpntm1\tmDefaultChar
MetricBreakChar = *lpntm1\tmBreakChar
MetricItalic = *lpntm1\tmItalic
MetricUnderlined = *lpntm1\tmUnderlined
MetricStruckOut = *lpntm1\tmStruckOut
MetricPitchAndFamily = *lpntm1\tmPitchAndFamily
MetricCharSet = *lpntm1\tmCharSet
MetricFlags = *lpntm1\ntmFlags
MetricSizeEM = *lpntm1\ntmSizeEM
MetricCellHeight = *lpntm1\ntmCellHeight
MetricAveWidth = *lpntm1\ntmAveWidth
Else
*lpntm2.TEXTMETRIC = lpntm
MetricHeight = *lpntm2\tmHeight
MetricAscent = *lpntm2\tmAscent
MetricDescent = *lpntm2\tmDescent
MetricInternalLeading = *lpntm2\tmInternalLeading
MetricExternalLeading = *lpntm2\tmExternalLeading
MetricAveCharWidth = *lpntm2\tmAveCharWidth
MetricMaxCharWidth = *lpntm2\tmMaxCharWidth
MetricWeight = *lpntm2\tmWeight
MetricOverhang = *lpntm2\tmOverhang
MetricDigitizedAspectX = *lpntm2\tmDigitizedAspectX
MetricDigitizedAspectY = *lpntm2\tmDigitizedAspectY
MetricFirstChar = *lpntm2\tmFirstChar
MetricLastChar = *lpntm2\tmLastChar
MetricDefaultChar = *lpntm2\tmDefaultChar
MetricBreakChar = *lpntm2\tmBreakChar
MetricItalic = *lpntm2\tmItalic
MetricUnderlined = *lpntm2\tmUnderlined
MetricStruckOut = *lpntm2\tmStruckOut
MetricPitchAndFamily = *lpntm2\tmPitchAndFamily
MetricCharSet = *lpntm2\tmCharSet
EndIf
sFontAttributes.s = ""
If FontItalic
sFontAttributes + "I"
EndIf
If FontUnderline
sFontAttributes + "U"
EndIf
If FontStrikeOut
sFontAttributes + "S"
EndIf
If sFontAttributes <> ""
sFontAttributes = "(" + sFontAttributes + ")"
EndIf
If lParam
If FindString(LCase(FontName), LCase(PeekS(lParam)), 1)
AddGadgetItem(#Gadget_ListIcon, -1, FontName + Chr(10) + Str(FontWidth) + Chr(10) + Str(FontHeight) + Chr(10) + Str(FontWeight) + Chr(10) + FontStyle + " " + sFontAttributes + Chr(10) + sFontType)
EndIf
Else
AddGadgetItem(#Gadget_ListIcon, -1, FontName + Chr(10) + Str(FontWidth) + Chr(10) + Str(FontHeight) + Chr(10) + Str(FontWeight) + Chr(10) + FontStyle + " " + sFontAttributes + Chr(10) + sFontType)
EndIf
While WindowEvent()
Wend
FontCounter + 1
ProcedureReturn 1
EndProcedure
Procedure DrawRotatedText(Image.l, Text.s, x.l, y.l, FontName.s, Size.l, Angle.l, Weight.l, Italic.l, Underline.l, StrikeOut.l, BackgroundColor.l, ForegroundColor.l, DrawingMode.l)
UseImage(Image)
ImageDC.l = StartDrawing(ImageOutput())
hFont.l = CreateFont_(Size * GetDeviceCaps_(ImageDC, #LOGPIXELSY) / 72, 0, Angle * 10, 0, Weight, Italic, Underline, StrikeOut, #ANSI_CHARSET, #OUT_TT_PRECIS, #CLIP_LH_ANGLES, #PROOF_QUALITY, #DEFAULT_PITCH |#FF_DONTCARE, FontName)
PreviousFont.l = SelectObject_(ImageDC, hFont)
Locate(x, y)
DrawingMode(DrawingMode)
BackColor(Red(BackgroundColor), Green(BackgroundColor), Blue(BackgroundColor))
FrontColor(Red(ForegroundColor), Green(ForegroundColor), Blue(ForegroundColor))
DrawText(Text)
StopDrawing()
SelectObject_(ImageDC, PreviousFont)
DeleteObject_(hFont)
EndProcedure
Procedure DrawBackgroundImage(ImageWidth, ImageHeight, Text.s, BackgroundColor.l, TextColor.l, Spacing.l, FontName.s, FontSize.l, Angle.l)
Static ImageNumber
If ImageNumber
FreeImage(ImageNumber)
EndIf
ImageNumber = CreateImage(#PB_Any, ImageWidth, ImageHeight)
ImageID = UseImage(ImageNumber)
StartDrawing(ImageOutput())
Box(0, 0, ImageWidth, ImageHeight, BackgroundColor)
StopDrawing()
For x = 0 To ImageWidth
For y = 0 To ImageHeight
DrawRotatedText(ImageNumber, Text, x, y, FontName, FontSize, Angle, 100, #False, #False, #False, #Black, TextColor, 1)
y + Spacing - 1
Next
x + Spacing - 1
Next
ProcedureReturn ImageID
EndProcedure
WindowWidth = 640
WindowHeight = 480
WindowTitle.s = "MyWindow"
ImageWidth = WindowWidth - 20
ImageHeight = 120
ImageID = CreateImage(#Image, ImageWidth, ImageHeight)
StartDrawing(ImageOutput())
Box(0, 0, ImageWidth, ImageHeight, $B0B0B0)
StopDrawing()
If OpenWindow(#Window_Main, 0, 0, WindowWidth, WindowHeight, #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered | #PB_Window_Invisible, WindowTitle)
SetWinBackgroundImage(WindowID(#Window_Main), DrawBackgroundImage(WindowWidth, WindowHeight, WindowTitle, WindowBackgroundColor = $300000, WindowFiligreeColor = $600000, Spacing = 60, "Verdana", 14, -30))
AnimateWindow_(WindowID(#Window_Main), 1000, #AW_BLEND | #AW_ACTIVATE)
AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Escape, #PB_Shortcut_Escape)
AddKeyboardShortcut(#Window_Main, #PB_Shortcut_Return, #Gadget_Button)
If CreateGadgetList(WindowID(#Window_Main))
StringGadget(#Gadget_String, 10, 10, 180, 20, "")
GadgetToolTip(#Gadget_String, "Enter a font name to search and click OK")
ButtonGadget(#Gadget_Button, 200, 10, 60, 20, "OK")
ListIconGadget(#Gadget_ListIcon, 10, 40, WindowWidth - 20, WindowHeight - 180, "Name", 240)
AddGadgetColumn(#Gadget_ListIcon, 1, "Width", 50)
AddGadgetColumn(#Gadget_ListIcon, 2, "Height", 50)
AddGadgetColumn(#Gadget_ListIcon, 3, "Weight", 50)
AddGadgetColumn(#Gadget_ListIcon, 4, "Style & Attr.", 80)
AddGadgetColumn(#Gadget_ListIcon, 5, "Type", 70)
ImageGadget(#Gadget_Image, 10, WindowHeight - 130, ImageWidth, ImageHeight, ImageID, #PB_Image_Border)
GadgetToolTip(#Gadget_Image, "Font sample display with basic width and forced 32 width")
EndIf
EnumFontFamilies_(GetDC_(WindowID(#Window_Main)), #Null, @EnumFontFamProc(), 0)
Quit = #False
Repeat
WindowEvent = WindowEvent()
EventType = EventType()
Select WindowEvent
Case #PB_Event_CloseWindow
Quit = #True
Case #PB_Event_Menu
Select EventMenuID()
Case #PB_Shortcut_Escape
Quit = #True
Case #PB_Shortcut_F1
Statistics = 1 - Statistics
Case #Gadget_Button
ClearGadgetItemList(#Gadget_ListIcon)
EnumFontFamilies_(GetDC_(WindowID(#Window_Main)), #Null, @EnumFontFamProc(), GetGadgetText(#Gadget_String))
EndSelect
Case #PB_Event_Gadget
Select EventGadgetID()
Case #Gadget_Button
ClearGadgetItemList(#Gadget_ListIcon)
EnumFontFamilies_(GetDC_(WindowID(#Window_Main)), #Null, @EnumFontFamProc(), GetGadgetText(#Gadget_String))
Case #Gadget_ListIcon
FontName.s = GetGadgetItemText(#Gadget_ListIcon, GetGadgetState(#Gadget_ListIcon), 0)
FontSize.l = Val(GetGadgetItemText(#Gadget_ListIcon, GetGadgetState(#Gadget_ListIcon), 1))
FontHeight.l = Val(GetGadgetItemText(#Gadget_ListIcon, GetGadgetState(#Gadget_ListIcon), 2))
FontID1 = UseFont(LoadFont(#PB_Any, FontName, FontSize, #PB_Font_HighQuality))
If FontHeight <= 24
FontHeight2 = 32
Else
FontHeight2 = FontHeight * 3 / 2
EndIf
FontID2 = UseFont(LoadFont(#PB_Any, FontName, 32, #PB_Font_HighQuality))
ImageID1 = DrawBackgroundImage(ImageWidth, ImageHeight, FontName, $E0E0E0, $D0D0D0, FontSize * 5, FontName, FontSize, -45)
UseImage(#Image)
StartDrawing(ImageOutput())
DrawImage(ImageID1, 0, 0)
DrawingFont(FontID1)
DrawingMode(1)
BackColor($E0, $E0, $E0)
FrontColor(0, 0, 0)
Locate(5, 5)
DrawText("ABCDEFghijkl PureBasic Font display")
Locate(5, FontHeight + 20)
DrawingFont(FontID2)
DrawText("ABCDEFghijkl PureBasic Font display")
StopDrawing()
SetGadgetState(#Gadget_Image, ImageID)
EndSelect
Case #PB_Event_SizeWindow
WindowWidth = WindowWidth()
WindowHeight = WindowHeight()
If WindowWidth < 100
WindowWidth = 100
EndIf
If WindowHeight < 100
WindowHeight = 100
EndIf
SetWinBackgroundImage(WindowID(#Window_Main), DrawBackgroundImage(WindowWidth, WindowHeight, WindowTitle, WindowBackgroundColor = $300000, WindowFiligreeColor = $600000, Spacing = 60, "Verdana", 14, -30))
EndSelect
Until Quit
AnimateWindow_(WindowID(#Window_Main), 1000, #AW_BLEND | #AW_HIDE)
EndIf
End