code à tester + devinette pour SPH

[Ar-S]

Knightmare !

[Huitbit]

Gagné !

C'est bien de la saga de Konami qu'il s'agit :Majou Densetsu ( 魔 城 伝 説 , Demon Castle Legend)

Le 1 ½ c'est parce que j'ai imaginé ce qui s'est passé
entre les épisodes I et II (rappel : Knightmare II = Maze of Galious).

J'ai mélangé le tout avec un troisième jeu.

En fait, j'ai juste besoin du titre et j'aimerais bien passer par un affichage de texte
mais je ne sais pas si ces polices , (MS Mincho et/ou MS Gothic) sont courantes (elles en ont l'air).

L'idée, ça serait d'afficher les kanji si la police est présente et d'afficher
Majou Densetsu ( ou Demon Castle Legend ou knightmare) dans le cas contraire.

flaith a proposé quelque chose mais s'il y avait plus court....


Hasta la vista !

************************************************************

Remarque : pour la culture !

魔
MA : esprit malin, démon, diable
UNICODE : 9B54


城
shiro, JOO : château, forteresse
UNICODE : 57CE


伝
tsuta(eru), DEN : transmettre
UNICODE : 4F1D


説
SETSU, ZEI : opinion, vue, doctrine
UNICODE : 8AAC

[flaith]

En resume :

Code : Tout sélectionner

Structure CS_Font
  Width.i
  Height.l
  FontList.s
  FontType.i
  Monospaced.i
  List FontSize.i()
EndStructure

Structure CS_SortFont Extends CS_Font
  FontName.s
  Element.i
EndStructure

Global NewMap AllFont.CS_Font()

Procedure EnumFontFamExProcSize(*elfx.ENUMLOGFONTEX,      ; pointer to logical-font Data
                                 *ntmx.NEWTEXTMETRICEX,    ; pointer to physical-font Data
                                 FontType.i,               ; font type
                                 lParam.i)                 ; pointer to application-defined Data
  Protected.i _PointSize, _index
  Protected Dim _TrueTypeSize.i(15)
  
  _TrueTypeSize(0) = 8
  _TrueTypeSize(1) = 9
  _TrueTypeSize(2) = 10
  _TrueTypeSize(3) = 11
  _TrueTypeSize(4) = 12
  _TrueTypeSize(5) = 14
  _TrueTypeSize(6) = 16
  _TrueTypeSize(7) = 18
  _TrueTypeSize(8) = 20
  _TrueTypeSize(9) = 22
  _TrueTypeSize(10) = 24
  _TrueTypeSize(11) = 26
  _TrueTypeSize(12) = 28
  _TrueTypeSize(13) = 36
  _TrueTypeSize(14) = 48
  _TrueTypeSize(15) = 72

  If FontType <> #TRUETYPE_FONTTYPE
    _PointSize = MulDiv_(*ntmx\ntmTm\tmHeight - *ntmx\ntmTm\tmInternalLeading, 72, GetDeviceCaps_(FONT_HDC, #LOGPIXELSY))

    If FontType = #RASTER_FONTTYPE
      AddElement(AllFont()\FontSize())
        AllFont()\FontSize() = _PointSize
    Else
      For _index = 0 To 15
      AddElement(AllFont()\FontSize())
        AllFont()\FontSize() = _TrueTypeSize(_index)
      Next
    EndIf
    ProcedureReturn 1           ;Continue enumeration
  Else
    For _index = 0 To 15
      AddElement(AllFont()\FontSize())
        AllFont()\FontSize() = _TrueTypeSize(_index)
    Next
    ProcedureReturn 0           ;Stop enumeration
  EndIf
EndProcedure

;Callback function processes the enumerated fonts.
Procedure EnumFontFamExProc(*elfx.ENUMLOGFONTEX, 
                             *ntmx.NEWTEXTMETRICEX,
                             FontType.i,
                             lParam.i)
  Protected tm.NEWTEXTMETRICEX         ; receives text metrics for non-TrueType fonts
  Protected Size1.SIZE
  Protected Size2.SIZE
  Protected.i _Weight    = *ntmx\ntmTm\tmWeight
	Protected.i _Family    = *ntmx\ntmTm\tmPitchAndFamily & $F0
	Protected.s _FontName  = PeekS(@*elfx\elfLogFont\lfFaceName[0])
	Protected.i _Font, _Value
  Protected.i _MonoSpaced = #False
  Protected.LOGFONT lf
  
  FontType  = *ntmx\ntmTm\tmPitchAndFamily & $6

  ;Add to the map
  AddMapElement(AllFont(), _FontName)
  AllFont()\Width      = *ntmx\ntmTm\tmAveCharWidth
  AllFont()\Height     = *ntmx\ntmTm\tmHeight
  AllFont()\FontType   = FontType
  AllFont()\FontList   = _FontName
  AllFont()\Monospaced = #False
  
  ;Create a font
  FillMemory(@lf, SizeOf(LOGFONT))
  PokeS(@lf\lfFaceName[0], _FontName)
  lf\lfWeight   = #FW_NORMAL
  lf\lfCharSet  = #DEFAULT_CHARSET
  _Font = CreateFontIndirect_(@lf)

  If _Font
    ;Get the size of each font
    EnumFontFamiliesEx_(FONT_HDC, @lf, @EnumFontFamExProcSize(), FontType, 0)
    ;Check double value and delete if found
    ForEach AllFont()\FontSize()
      _Value = AllFont()\FontSize()
      PushListPosition(AllFont()\FontSize())
      While NextElement(AllFont()\FontSize())
        If AllFont()\FontSize() = _Value
          DeleteElement(AllFont()\FontSize())
        EndIf
      Wend
      PopListPosition(AllFont()\FontSize())
    Next

    ;Now check for monospaced
    ;-Should try with TextWidth...
    SelectObject_(FONT_HDC, _Font)
    GetTextMetrics_(FONT_HDC, @tm)
    GetTextExtentPoint32_(FONT_HDC, "W", 1, @Size1)
    GetTextExtentPoint32_(FONT_HDC, "!", 1, @Size2)
    _MonoSpaced = Bool(size1\cx = size2\cx)

    If tm\ntmTm\tmCharSet = #SYMBOL_CHARSET
  	  _MonoSpaced = #False
  	EndIf
  	DeleteObject_(_Font)

  	If _MonoSpaced
  	  If FindMapElement(AllFont(), _FontName)
  	    AllFont()\Monospaced = #True
  	  EndIf
    EndIf
  EndIf

  ; Tell EnumFontFamiliesEx to continue enumeration.
  ProcedureReturn #True
EndProcedure

Procedure.i InitEnumerateFont(List this.CS_SortFont())
  Protected logfont.LOGFONT  ; describes enumeration attributes

  ; Get the FONT_HDC of the current window
  FONT_HDC     = GetDC_(0);WindowID(__WinID))
  
  ; Initialize the structure to describe the fonts we want.
  FillMemory(@logfont, SizeOf(LOGFONT))
  logfont\lfCharSet        = #DEFAULT_CHARSET
  logfont\lfFaceName[0]    = 0
  
  ; Enumerate fonts available on window
  If EnumFontFamiliesEx_(FONT_HDC, @logfont, @EnumFontFamExProc(), 0, 0)
  Else
    ProcedureReturn #False
  EndIf
  
  ;Filling our list of font
  ForEach AllFont()
    AddElement(this())
      this()\FontName   = MapKey(AllFont())
      this()\Height     = AllFont()\Height
      this()\Width      = AllFont()\Width
      this()\FontList   = AllFont()\FontList
      this()\FontType   = AllFont()\FontType
      this()\Monospaced = AllFont()\Monospaced
      ;And each available size
      ForEach AllFont()\FontSize()
        AddElement(this()\FontSize())
          this()\FontSize() = AllFont()\FontSize()
      Next
    SortList(this()\FontSize(), #PB_Sort_Ascending)
  Next
  ; Now we add each element position (need to sort first before)
  SortStructuredList(this(), #PB_Sort_Ascending | #PB_Sort_NoCase, OffsetOf(CS_SortFont\FontName), #PB_String)
  ForEach this()
    this()\Element    = ListIndex(this())
  Next
  ProcedureReturn #True
EndProcedure

Global NewList SortFont.CS_SortFont()
InitEnumerateFont(SortFont())

ForEach SortFont()
  a$ = SortFont()\FontName
  If SortFont()\Monospaced
    a$ + " - MONO"
  EndIf
  Debug a$
Next

[SPH]

Knightmare 1 ou 2 ?

[Huitbit]

@SPH , tu as besoin de vacances ou d'air frais

Gagné !

C'est bien de la saga de Konami qu'il s'agit :Majou Densetsu ( 魔 城 伝 説 , Demon Castle Legend)

Le 1 ½ c'est parce que j'ai imaginé ce qui s'est passé
entre les épisodes I et II (rappel : Knightmare II = Maze of Galious).

J'ai mélangé le tout avec un troisième jeu.

@Flaith
C'est magique !
Au niveau longueur, j'ai le choix, soit je reprends l'image d'origine soit j'utilise ton code, on verra !

Hasta la vista !

[SPH]

J'ai eu un remake de knightmare2. Je vous le met en DL au plus vite

[salutcava]

Bonjour/bonsoir à tous.

Je suis tombé sur la question en debut de sujet à savoir comment verifier si une fonte existe sur l'os, je propose un petit code sans pretentions qui permet de repondre à la question.
je poste en premier les imperfections :
*utilisation de keybd_event_ au lieu de SendInput_
*Le pressepapier est perdu apres l'utilisation de ce code, mais je ne trouvais plus sur le msdn la fonction qui permet de simuler l'appuie sur une touche à partir d'un caractere alphabetique.

Voici :

Code : Tout sélectionner

Procedure collage(*param)
  Delay(100)
  keybd_event_(#VK_CONTROL,0,0,0)
  Delay(10)
  keybd_event_(#VK_V,0,0,0)
  Delay(10)
  keybd_event_(#VK_V,0,#KEYEVENTF_KEYUP,0)
  Delay(10)
  keybd_event_(#VK_CONTROL,0,#KEYEVENTF_KEYUP,0)
  Delay(10)
  keybd_event_(#VK_RETURN,0,0,0)
  Delay(10)
  keybd_event_(#VK_RETURN,0,#KEYEVENTF_KEYUP,0)
EndProcedure

nomFonte.s = "Arial"
;nomFonte.s = "LeChat Machine"

SetClipboardText(nomFonte)

CreateThread(@collage(),2)
FontRequester("Arial", 12, #PB_FontRequester_Effects)

If SelectedFontName() = nomFonte
  Debug nomfonte + " Existe"
Else
  Debug nomFonte +" n'existe pas"
EndIf

voila, c'est tout, code sponsorisé par FontRequester Blinking

[SPH]

Merci salutcava

Tiens, j'ai retrouvé le jeu maze of galious pc : http://www.braingames.getput.com/mog/
Il est tres interessant (changement de gfx ou de zik)

[Backup]

sinon pour lister les Fontes , Falsam avait fait ça :

http://www.purebasic.fr/french/viewtopi ... am#p122804

[SPH]

Moi, j'aurais preferer une solution simple et sure : utiliser une fonte mise dans le repertoire du programme que l'on code. Comme ca, on est sur que la fonte existe.

[Backup]

+100
c'est ce que j'aurai fait !
distribuer la fonte avec !

[salutcava]

Apres une recherche sur le msdn j'ai trouvé une fonction d'enumeration de fontes (la meme qu'utilise Flaith dans le code qu'il a posté)
Voici un code qui l'utilise mais bizarrement le code est plus court que celui de flaith, peut etre que la liste fournie par mon code n'est pas exhaustive ? je ne sais pas, mais peut etre que vous, vous savez, j'ai très peu de connaissances sur les fontes.
De plus les fontes sont listées plusieurs fois pour certaines (autant de fois qu'il y a de Script pour la fonte). Je n'en sais pas plus.
Voici le code :

Code : Tout sélectionner

hdc.l = 0
fonte.logfont
fonte\lfCharSet = #DEFAULT_CHARSET 

Procedure enumcallback(*a.LOGFONT,*b.TEXTMETRIC,fonttype.l,param.l)
  Debug PeekS(@*a\lfFaceName)
  If PeekB(@*a\lfFaceName) <> 0
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure

OpenWindow(0, 0, 0, 320, 200, "", #PB_Window_SystemMenu)
hdc = GetDC_(WindowID(0))
Repeat 
  Delay(10)
Until (EnumFontFamiliesEx_(hdc,@fonte,@enumcallback(),0,0) = 1) 

En esperant que ce sera plus utile que le code que j'ai proposé plus haut (et qui me fait rire apres coup à chaque fois que je l'execute) XD
note : pour gagner du temps j'ai repiqué la valeur \lfCharSet = #DEFAULT_CHARSET dans la source de flaith pour avoir les polices TrueType et OpenType listées.

[graph100]

sympa le petit code. Reste à comprendre les multiples apparitions des fonts, ou bien faire un petit tableau pour virer les multiples.

Code : Tout sélectionner

hdc.l = 0
fonte.logfont
fonte\lfCharSet = #DEFAULT_CHARSET

Structure LogFont_ext Extends LOGFONT
	Name.s
EndStructure


Global NewMap map_font.LogFont_ext()

Procedure enumcallback(*a.LOGFONT,*b.TEXTMETRIC,fonttype.l,param.l)
  Protected *elem.LogFont_ext
  
  
  If PeekB(@*a\lfFaceName) <> 0
  	
  	*elem = AddMapElement(map_font(), PeekS(@*a\lfFaceName))
  	
  	CopyStructure(*a, *elem, LOGFONT)
  	*elem\Name = PeekS(@*a\lfFaceName)
  	
  	ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
  
EndProcedure

OpenWindow(0, 0, 0, 320, 200, "", #PB_Window_SystemMenu | #PB_Window_Invisible)
hdc = GetDC_(WindowID(0))
Repeat
  Delay(10)
Until (EnumFontFamiliesEx_(hdc,@fonte,@enumcallback(),0,0) = 1)

Dim tab_font.LogFont_ext(MapSize(map_font()) - 1)

i = 0

ForEach map_font()
	CopyStructure(map_font(), tab_font(i), LogFont_ext)
	i + 1
Next

SortStructuredArray(tab_font(), #PB_Sort_Ascending, OffsetOf(LogFont_ext\Name), #PB_Sort_String)

For a = 0 To i - 1
	Debug tab_font(a)\Name
Next

[Backup]

peut etre comme ça

pas besoin de creer une fenetre pour avoir le Device context
seul le GetDC(0) suffit, le 0 c'est le bureau ...

il semble que "fonte\lfFaceName =0" permette de n'afficher que les fontes presentes sans les doubles

If set to an empty string, the function enumerates one font in each available typeface name. If set to a valid typeface name, the function enumerates all fonts with the specified name.

les doubles qui n'en sont pas d'ailleurs , je pense qu'ils s'agit de la meme famille mais avec un Type different, qui n'apparait pas dans le nom
comme BOLD , etc ....

Code : Tout sélectionner

fonte.logfont
;fonte\lfCharSet = #DEFAULT_CHARSET
fonte\lfFaceName =0

Procedure enumcallback(*a.LOGFONT,*b.TEXTMETRIC,fonttype.l,param.l)
	If PeekB(@*a\lfFaceName) <> 0
		Debug PeekS(@*a\lfFaceName)
		ProcedureReturn 1
		Else
		ProcedureReturn 0
	EndIf
EndProcedure


Repeat
	Delay(10)
Until (EnumFontFamiliesEx_(GetDC_(0),@fonte,@enumcallback(),0,0) = 1)
 ; EPB

[salutcava]

sympa le petit code. Reste à comprendre les multiples apparitions des fonts, ou bien faire un petit tableau pour virer les multiples.

Salut graph100.
Pour les apparitions multiples des fontes, je me suis rendu compte en verifiant si toutes les fontes installées etaient listées qu'il y avait plusieurs 'scripts' ou parfois un seul script associés à une fonte. (ouvrir notepad, aller dans le menu pour selectionner une fonte d'affichage, selectionner une fonte puis tout en bas il y a une liste deroulante sous le descriptif 'Script')
S'il y a un seul script, la fonte sera listée une seule fois par le code. s'il y a n scripts disponibles la fonte sera listée n fois par le code.
Voila pour les multiples apparitions.
Peut etre qu'en remplissant correctement la structure LOGFONT (chose que j'ai passé un peu rapidement), il est possible de ne pas avoir ces apparitions multiples d'une même fonte sans passer par un code supplémentaire. Toujours est il que ta correction en utilisant les map est astucieuse, je trouve.