SEBPAD 2.0

Commentaire de slayer le 13/04/2003 09:47:23

Tien, je suis passer trop to le zip n'est pas encore, je repasserai plus tard testé ça !!!

Commentaire de DarthPredateur le 13/04/2003 10:17:57

une capture serait la bienvenue !

Commentaire de tex le 13/04/2003 18:50:56

Slt

g trouvé le prob avec ton bug pour le btn Copier de la toolbar :
en fait tu l'as nommé "paste" et tu as mis "past" dans le code.

Voilà, @+ tex

Commentaire de BasicInstinct le 14/04/2003 10:58:31

'lut

ca fait plaisir d'avoir son nom dans les commentaires d'une sources...
Petit defaut de la source, tu utilise l'objet printer pour lister les polices, Mais malheureusement ne possedant pas d'imprimantes parametrees, j'ai 1 zoli message d'erreur 482 : erreur d'impimante

Sinon c'est une joli source :)

Commentaire de BasicInstinct le 15/04/2003 09:16:30

Directement pompé de l'Api-GUIDE

'In a module
Public Const NTM_REGULAR = &H40&
Public Const NTM_BOLD = &H20&
Public Const NTM_ITALIC = &H1&
Public Const TMPF_FIXED_PITCH = &H1
Public Const TMPF_VECTOR = &H2
Public Const TMPF_DEVICE = &H8
Public Const TMPF_TRUETYPE = &H4
Public Const ELF_VERSION = 0
Public Const ELF_CULTURE_LATIN = 0
Public Const RASTER_FONTTYPE = &H1
Public Const DEVICE_FONTTYPE = &H2
Public Const TRUETYPE_FONTTYPE = &H4
Public Const LF_FACESIZE = 32
Public Const LF_FULLFACESIZE = 64
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(LF_FACESIZE) As Byte
End Type
Type NEWTEXTMETRIC
   tmHeight As Long
   tmAscent As Long
   tmDescent As Long
   tmInternalLeading As Long
   tmExternalLeading As Long
   tmAveCharWidth As Long
   tmMaxCharWidth As Long
   tmWeight As Long
   tmOverhang As Long
   tmDigitizedAspectX As Long
   tmDigitizedAspectY As Long
   tmFirstChar As Byte
   tmLastChar As Byte
   tmDefaultChar As Byte
   tmBreakChar As Byte
   tmItalic As Byte
   tmUnderlined As Byte
   tmStruckOut As Byte
   tmPitchAndFamily As Byte
   tmCharSet As Byte
   ntmFlags As Long
   ntmSizeEM As Long
   ntmCellHeight As Long
   ntmAveWidth As Long
End Type
Declare Function EnumFontFamiliesEx Lib "gdi32" Alias "EnumFontFamiliesExA" (ByVal hdc As Long, lpLogFont As LOGFONT, ByVal lpEnumFontProc As Long, ByVal LParam As Long, ByVal dw As Long) As Long
Function EnumFontFamProc(lpNLF As LOGFONT, lpNTM As NEWTEXTMETRIC, ByVal FontType As Long, LParam As Long) As Long
   Dim FaceName As String
  'convert the returned string to Unicode
   FaceName = StrConv(lpNLF.lfFaceName, vbUnicode)
  'print the form on Form1
   Form1.Print Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
  'continue enumeration
   EnumFontFamProc = 1
End Function
'In a form
Private Sub Form_Load()
   'KPD-Team 2000
   'URL: http://www.allapi.net/
   'E-Mail: KPDTeam@Allapi.net
   Dim LF As LOGFONT
   'set graphics mode to persistent
   Me.AutoRedraw = True
   'enumerates the fonts
   EnumFontFamiliesEx Me.hdc, LF, AddressOf EnumFontFamProc, ByVal 0&, 0
End Sub