Advertisement
4_2005-2006 VB function enhancement #161132

Create Font List Like Office 2000, NO BUGS unlike OTHERS VOTE NOW

To Make a font list like Microsoft Office 2000 does.....PLEASE VOTE FOR IT...it is 100% compatible and it works perfectly... if you have any sorta comments send them over.. or any sorta critics too

AI

KI-Zusammenfassung: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Quellcode
original-source
Dim FocusedFont As Double
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 40 Then
 FocusedFont = FocusedFont + 1
 If FocusedFont <= Screen.FontCount Then
 Lbl(FocusedFont - 1).ForeColor = &H0&
 Lbl(FocusedFont - 1).FontBold = False
 Lbl(FocusedFont - 1).BackStyle = 0
 Lbl(FocusedFont).BackStyle = 1
 Lbl(FocusedFont).FontBold = True
 Lbl(FocusedFont).ForeColor = &HFFFFFF
 Lbl(FocusedFont).BackColor = &H0&
 Else
 FocusedFont = FocusedFont - 1
 End If
 If Lbl(FocusedFont).Top > Form1.Height Then
 Dim UpMovement As Integer
 UpMovement = Lbl(FocusedFont).Height
 Dim A As Double
 A = 1
 Do Until A >= Lbl.Count
  Lbl(A).Top = Lbl(A).Top - UpMovement
  A = A + 1
 Loop
 End If
ElseIf KeyCode = 38 Then
 FocusedFont = FocusedFont - 1
 If FocusedFont >= 0 Then
 Lbl(FocusedFont + 1).ForeColor = &H0&
 Lbl(FocusedFont + 1).FontBold = False
 Lbl(FocusedFont + 1).BackStyle = 0
 Lbl(FocusedFont).BackStyle = 1
 Lbl(FocusedFont).FontBold = True
 Lbl(FocusedFont).ForeColor = &HFFFFFF
 Lbl(FocusedFont).BackColor = &H0&
 Else
 FocusedFont = FocusedFont + 1
 End If
 If Lbl(FocusedFont).Top < 0 Then
 Dim DownMovement As Integer
 DownMovement = Lbl(FocusedFont).Height
 A = 1
 Do Until A >= Lbl.Count
  Lbl(A).Top = Lbl(A).Top + DownMovement
  A = A + 1
 Loop
 End If
End If
End Sub
Private Sub Form_Load()
Dim A As Double
Lbl(A).Top = 0
Lbl(A).Left = 0
Lbl(A).Height = 0
Lbl(A).Caption = ""
Form1.BackColor = &HFFFFFF
Lbl(A).BackStyle = 0
Do Until A = Screen.FontCount
 Load Lbl(A + 1)
 With Lbl(A + 1)
 .Visible = True
 .Top = Lbl(A).Top + Lbl(A).Height
 .AutoSize = True
 .FontName = Screen.Fonts(A)
 .FontSize = 16
 .FontBold = False
 .Caption = Screen.Fonts(A)
 End With
 A = A + 1
Loop
FocusedFont = 0
End Sub
Private Sub Lbl_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim A As Double
A = 1
FocusedFont = Index
Do Until A = Lbl.Count
 If A = Index Then
 Lbl(A).BackStyle = 1
 Lbl(A).FontBold = True
 Lbl(A).ForeColor = &HFFFFFF
 Lbl(A).BackColor = &H0&
 Else
 If Lbl(A).BackStyle = 1 Then
  Lbl(A).FontBold = False
  Lbl(A).ForeColor = &H0&
  Lbl(A).BackStyle = 0
 End If
 End If
 A = A + 1
Loop
End Sub
Originalkommentare (3)
Wiederhergestellt von der Wayback Machine