Seite 1 von 1

GetGadgetFont, größe, farbe und flags ermitteln

Verfasst: 03.07.2007 23:17
von persepole
Hi Leute,

irgendwie komme ich nicht drauf wie
aus einer FontID die Schriftart, größe und Farbe
ermittelt wird.

Code: Alles auswählen

 FontID = GetGadgetFont(#Gadget)
Ich möchte folgendes Realisieren:

Der User clickt auf ein Gadget, und dann auf einen Button (Font)
der den Fontrequester startet. Nun soll der Fontrequester
die Schriftart / Schriftgröße / Schriftfarbe und Flags gleich
anzeigen. Also z.B. gleich die Schriftart des Gadgets im Listview
anzeigen.

Hat da jemand ne ahnung wie das geht.

Grüsse
persepole

Verfasst: 04.07.2007 13:11
von bobobo
die Fontgröße wird nicht ermittelt, die wird beim Fontladen (loadfont(...))
gesetzt und dann HAT der Font eben die Größe, Breite, ...

Verfasst: 04.07.2007 13:57
von ts-soft
Wie bo³ sagte, merken!

Code: Alles auswählen

EnableExplicit

Global FontName.s = "Arial"
Global FontSize.l = 12
Global FontBold.l = #True
Global FontItalic.l = #False
Global FontColor.l = #Red

Enumeration ; Fenster
  #frmMain
EndEnumeration
Enumeration ; Gadgets
  #txtVorschau
  #btnWaehleFont
EndEnumeration

Procedure SetzeFont()
  Protected Flags.l
  
  If FontBold : Flags | #PB_Font_Bold : EndIf
  If FontItalic : Flags | #PB_Font_Italic : EndIf
  LoadFont(1, FontName, FontSize, Flags)
  SetGadgetFont(#txtVorschau, FontID(1))
  SetGadgetColor(#txtVorschau, #PB_Gadget_FrontColor, FontColor)
EndProcedure

Procedure WaehleFont()
  Protected Result.l = FontRequester(FontName, FontSize, #PB_FontRequester_Effects, FontColor)
  If Result
    FontName = SelectedFontName()
    FontSize = SelectedFontSize()
    If SelectedFontStyle() & #PB_Font_Bold
      FontBold = #True
    Else
      FontBold = #False
    EndIf
    If SelectedFontStyle() & #PB_Font_Italic
      FontItalic = #True
    Else
      FontItalic = #False
    EndIf
    FontColor = SelectedFontColor()
    SetzeFont()
  EndIf
EndProcedure

Define.s Text = "Franz jagt im komplett verwahrlostem Taxi quer durch Bayern"

If OpenWindow(#frmMain, #PB_Ignore, #PB_Ignore, 640, 230, "")
  If CreateGadgetList(WindowID(#frmMain))
    TextGadget(#txtVorschau, 10, 10, 620, 180, Text, #PB_Text_Border)
    SetzeFont()
    ButtonGadget(#btnWaehleFont, 240, 200, 140, 20, "Bitte Font wählen:")
  EndIf
EndIf

Repeat
  Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      Break
    Case #PB_Event_Gadget
      If EventGadget() = #btnWaehleFont
        WaehleFont()
      EndIf
  EndSelect
ForEver


Verfasst: 04.07.2007 21:20
von persepole
Oh, das ist mir jemand auf der Leitung gestanden.

Danke mal für die Hilfe. :roll:

Das Problemchen besteht aber weiterhin.
Ich ermittle nun also die FontID eines Gadgets.
Dann Lade ich die FontID.
Und nun möchte ich alle Daten (Schriftart, Größe,Farbe usw.)
ermitteln.
Folgendes möchte ich damit anstellen.
Ein Fenster auf dem sich 2 TextGadgets befinden.
Beide haben verschiedene Schriftarten. Clickt man
nun auf ein Textgadget und anschliessend auf Font-ändern
soll der Fontrequester die momentane font des Gadgets gleich
anzeigen.
Geht das überhaupt?

Danke
persepole

Verfasst: 04.07.2007 21:43
von ts-soft
>> soll der Fontrequester die momentane font des Gadgets gleich anzeigen.
Macht der obige Code doch, für 2 Button eben doppelt soviele Variablen zum
merken.

Anhand der FontID das zu errechnen ist per API wohl möglich, aber sehr
umständlich mit diversen Umrechnungen und vollkommen unnötig.

Verfasst: 05.07.2007 09:16
von edel
Knowledge Base 84132

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
GetFontSizeFromGadget haette zwar nicht so gross sein muessen,
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_CloseWindow
Damit das Ganze nicht ganz so einfach ist, funktioniert das nur mit
Truetype Fonts.

Verfasst: 05.07.2007 22:35
von persepole
Danke edel. Das ist genau das wonach ich gesucht hab.
Ist mir ne große Hilfe.
Werde versuchen den Code zu verstehen.
Danke für eure Hilfe.

Grüsse
persepole