[es] - Malo o fontovima

deepwhite

Član broj: 92996
Poruke: 559
212.200.70.*

+3 Profil

^{21.03.2008. u 12:44 - pre 196 meseci}

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?

Odgovor na temu

goranvuc
Goran Vucicevic
Novi Sad

Član broj: 4934
Poruke: 1846
79.101.86.*

+41 Profil

Re: Malo o fontovima

^{21.03.2008. u 13:21 - pre 196 meseci}

Code:

Private Sub UcitajFontove()
   Dim lngCounter As Long

   Combo1.Clear

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

End Sub

Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net

+44 Profil

Re: Malo o fontovima

^{21.03.2008. u 13:22 - pre 196 meseci}

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: [email protected]
    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]}

rafforum.rs - Forum Računarskog Fakulteta

Odgovor na temu

deepwhite

Član broj: 92996
Poruke: 559
*.beobug.com.

+3 Profil

Re: Malo o fontovima

^{21.03.2008. u 21:56 - pre 196 meseci}

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]}

Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net

+44 Profil

Re: Malo o fontovima

^{22.03.2008. u 16:22 - pre 195 meseci}

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.

rafforum.rs - Forum Računarskog Fakulteta

Odgovor na temu

deepwhite

Član broj: 92996
Poruke: 559
*.beobug.com.

+3 Profil

Re: Malo o fontovima

^{22.03.2008. u 19:03 - pre 195 meseci}

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

Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net

+44 Profil

Re: Malo o fontovima

^{22.03.2008. u 21:45 - pre 195 meseci}

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)

rafforum.rs - Forum Računarskog Fakulteta

Odgovor na temu

deepwhite

Član broj: 92996
Poruke: 559
*.beobug.com.

+3 Profil

Re: Malo o fontovima

^{23.03.2008. u 00:27 - pre 195 meseci}

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

Odgovor na temu

Aleksandar Ružičić
Software Architect, Appricot d.o.o.
Beograd

Član broj: 26939
Poruke: 2881

Jabber: krckoorascic@gmail.com
Sajt: krcko.net

+44 Profil

Re: Malo o fontovima

^{23.03.2008. u 09:31 - pre 195 meseci}

pa da je lep i nije :)

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

rafforum.rs - Forum Računarskog Fakulteta

Odgovor na temu