Verfasst: 05.07.2007 09:16
Knowledge Base 84132
GetFontSizeFromGadget haette zwar nicht so gross sein muessen,
war nur zu faul es wieder umzuschreiben.
Beispiel :
Damit das Ganze nicht ganz so einfach ist, funktioniert das nur mit
Truetype Fonts.
Code: Alles auswählen
Procedure.s GetFontNameFromGadget(gadget)
Protected *otm.OUTLINETEXTMETRIC
Protected bsize.l,Font.l,hWnd.l
Protected FontName.s
hWnd = GadgetID(gadget)
Font = GetGadgetFont(gadget)
hdc = GetDC_(hWnd)
Font = SelectObject_(hdc,Font)
bsize = GetOutlineTextMetrics_(hdc,0,0)
If bsize = 0
SelectObject_(hdc,Font)
ReleaseDC_(hWnd,hdc)
ProcedureReturn
EndIf
*otm = AllocateMemory(bsize)
*otm\otmSize = bsize
GetOutlineTextMetrics_(hdc,bsize,*otm)
FontName = PeekS(*otm+*otm\otmpFamilyName)
FreeMemory(*otm)
SelectObject_(hdc,Font)
ReleaseDC_(hWnd,hdc)
ProcedureReturn FontName
EndProcedure
Procedure.s GetFontStyleFromGadget(gadget)
Protected *otm.OUTLINETEXTMETRIC
Protected bsize.l,Font.l,hWnd.l
Protected FontStyle.s
hWnd = GadgetID(gadget)
Font = GetGadgetFont(gadget)
hdc = GetDC_(hWnd)
Font = SelectObject_(hdc,Font)
bsize = GetOutlineTextMetrics_(hdc,0,0)
If bsize = 0
SelectObject_(hdc,Font)
ReleaseDC_(hWnd,hdc)
ProcedureReturn
EndIf
*otm = AllocateMemory(bsize)
*otm\otmSize = bsize
GetOutlineTextMetrics_(hdc,bsize,*otm)
FontStyle = PeekS(*otm+*otm\otmpStyleName)
FreeMemory(*otm)
SelectObject_(hdc,Font)
ReleaseDC_(hWnd,hdc)
ProcedureReturn FontStyle
EndProcedure
Procedure.l GetFontSizeFromGadget(gadget)
Protected *otm.OUTLINETEXTMETRIC
Protected bsize.l,Font.l,hWnd.l
Protected FontSize.l , val.f
hWnd = GadgetID(gadget)
Font = GetGadgetFont(gadget)
hdc = GetDC_(hWnd)
Font = SelectObject_(hdc,Font)
bsize = GetOutlineTextMetrics_(hdc,0,0)
If bsize = 0
SelectObject_(hdc,Font)
ReleaseDC_(hWnd,hdc)
ProcedureReturn
EndIf
*otm = AllocateMemory(bsize)
*otm\otmSize = bsize
GetOutlineTextMetrics_(hdc,bsize,*otm)
val.f = (*otm\otmTextMetrics\tmHeight-*otm\otmTextMetrics\tmInternalLeading)
FontSize = Int(Round((val * 72 / GetDeviceCaps_(hdc,#LOGPIXELSY)),1))
FreeMemory(*otm)
SelectObject_(hdc,Font)
ReleaseDC_(hWnd,hdc)
ProcedureReturn FontSize
EndProcedure
war nur zu faul es wieder umzuschreiben.
Beispiel :
Code: Alles auswählen
hWnd = OpenWindow(0,#PB_Ignore,#PB_Ignore,240,140,"leer")
CreateGadgetList(hWnd)
ButtonGadget(0,10,10,100,100,"sfsdfs")
ButtonGadget(1,110,10,100,100,"sfsdfs")
f = LoadFont(0,"Arial",10,#PB_Font_Italic|#PB_Font_Bold)
SetGadgetFont(0,f)
f = LoadFont(1,"Tahoma",15)
SetGadgetFont(1,f)
Debug GetFontNameFromGadget(0)
Debug GetFontStyleFromGadget(0)
Debug GetFontSizeFromGadget(0)
Debug "-----"
Debug GetFontNameFromGadget(1)
Debug GetFontStyleFromGadget(1)
Debug GetFontSizeFromGadget(1)
Repeat
event = WaitWindowEvent()
Until event = #PB_Event_CloseWindowTruetype Fonts.