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
Riepilogo AI: 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.
Codice sorgente
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
Commenti originali (3)
Recuperato da Wayback Machine