Malo o fontovima

deepwhite @ 21.03.2008. 12:44

Potrebno mi je da postavim mogucnost da korisnik izabere odgovarajuci font za svoj napisani tekst u tekst boksu i koji bi se prikazivao na nekom drugom mestu. Pruzio bi opciju da izaberu jedan od instaliranih fontova koje bi pokazivao u combo boxu, ali kako da procitam spisak instaliranih fontova u windowsu?

goranvuc @ 21.03.2008. 13:21

Code:

Private Sub UcitajFontove()
   Dim lngCounter As Long

   Combo1.Clear

   For lngCounter = 0 To Screen.FontCount
      Combo1.AddItem Screen.Fonts(lngCounter)
   Next

End Sub

Aleksandar Ružičić @ 21.03.2008. 13:22

Skini API-Guide i pogledaj funkciju EnumFonts

evo primera iz API-Guide-a:

Code:

'in a form
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Me.AutoRedraw = True
    EnumFonts Me.hDC, vbNullString, AddressOf EnumFontProc, 0
End Sub
'in a module
Private Const LF_FACESIZE = 32
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
Declare Function EnumFonts Lib "gdi32" Alias "EnumFontsA" (ByVal hDC As Long, ByVal lpsz As String, ByVal lpFontEnumProc As Long, ByVal lParam As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
Function EnumFontProc(ByVal lplf As Long, ByVal lptm As Long, ByVal dwType As Long, ByVal lpData As Long) As Long
    Dim LF As LOGFONT, FontName As String, ZeroPos As Long
    CopyMemory LF, ByVal lplf, LenB(LF)
    FontName = StrConv(LF.lfFaceName, vbUnicode)
    ZeroPos = InStr(1, FontName, Chr$(0))
    If ZeroPos > 0 Then FontName = Left$(FontName, ZeroPos - 1)
    Form1.Print FontName
    EnumFontProc = 1
End Function

_{[edit]

Goran me je pretekao za 30ak sekundi :)

Moze i sa Screen.Fonts, sto je sigurno jednostavnije od direktnog pristupa EnumFonts API funkciji.

[/edit]}

deepwhite @ 21.03.2008. 21:56

hvala, i ja sam sam provalio, ali imam jos jedan problem. da li je moguce da tekst VB-a bude preko activex objekta? kako god sam postavio active x objekat, preko njega ne moze da se vidi nista drugo. napominjem da active x koristi direct x, tj. 3d grafiku. razlog: laksa manipulacija tekstom u vb nego u directx :)

_{[Ovu poruku je menjao deepwhite dana 22.03.2008. u 11:15 GMT+1]}

Aleksandar Ružičić @ 22.03.2008. 16:22

pa kad vec koristis dx onda moras i text u njemu da radis :)

a u cemu ti se nalazi taj text? ako je u pitajnu Label-a onda zaboravi, jer ona ne moze ni preko PictureBoxa (na primer) jer je Label kontrola windowless, tj nema hwnd.

deepwhite @ 22.03.2008. 19:03

bas me nisi obradovao. jos nesto: kako izvuci najveci broj iz grupe od desetak brojeva sa sto kracom procedurom?

Aleksandar Ružičić @ 22.03.2008. 21:45

iz kakve grupe? sortirani niz, binarno stablo, nesortiran niz...

sa nesortiranim nizom ides sa obicnim For Next, sto moze da bude "sporo". Ako ti je vec bitna brzina odabiranja najveceg broja onda ti je najbolje da te brojeve drzis u sortiranom nizu (tako ce ti najveci broj uvek biti sa indexom 0)

deepwhite @ 23.03.2008. 00:27

nasao sam na netu, ako nekome bude trebalo - primer je lep i veoma upotrebljiv a i radi:

Code:

Option Explicit
Dim A(20), num, i, j, max As Integer

Private Sub Command1_Click()
Print "Your array contains:"
For i = 0 To num - 1
    Print A(i)
Next i
Print "Maximum Value= "; max
End Sub
Private Sub Form_Load()
num = InputBox("Initialize your array [1-20]:")

For i = 0 To num - 1
    A(i) = InputBox("Enter your array:")
Next i

'find maximum
max = A(0)
For i = 0 To num - 1
    If max < A(i) Then
        max = A(i)
    End If
Next
End Sub

Aleksandar Ružičić @ 23.03.2008. 09:31

pa da je lep i nije :)

al dobro, vidi se logika pa kome treba nek optimizuje...