【VB开源代码栏目提醒】:网学会员--在 VB开源代码编辑为广大网友搜集整理了:Matrix1.frm绩等信息,祝愿广大网友取得需要的信息,参考学习。
VERSION 5.00
Begin VB.Form frmScreenSaver
BorderStyle = 0 'None
ClientHeight = 5670
ClientLeft = 2370
ClientTop = 1575
ClientWidth = 6585
ControlBox = 0 'False
BeginProperty Font
Name = "Courier New"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "Matrix1.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 378
ScaleMode = 3 'Pixel
ScaleWidth = 439
ShowInTaskbar = 0 'False
Begin VB.Timer tmrUpdate
Interval = 75
Left = 2925
Top = 2070
End
End
Attribute VB_Name = "frmScreenSaver"
Attribute
VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
DefInt A-Z
Private LastX As Single
Private LastY As Single
Private ScrW%, ScrH%
Private TxtHght%, TxtWdth%
Private hMemDc&, hBmp&, hBmpOld&
Private hFont&, hFontOld&
Private MaxHeight
Private MinHeight
Private Type RECT
rLeft As Long
rTop As Long
rRight As Long
rBottom As Long
End Type
Private Rct As RECT
Private Type StringData
CurX As Integer
CurY As Integer
Dy As Integer
NumChars As Integer
End Type
Private Mtrx(1 To 100) As StringData ' One Hundred Output Strings.
Private Declare Function BitBlt& Lib "gdi32" (ByVal hDestDC&, ByVal x1&, ByVal y1&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)
Private Declare Function CreateCompatibleBitmap& Lib "gdi32" (ByVal hDC&, ByVal nWidth&, ByVal nHeight&)
Private Declare Function CreateCompatibleDC& Lib "gdi32" (ByVal hDC&)
Private Declare Function CreateSolidBrush& Lib "gdi32" (ByVal crColor As Long)
Private Declare Function DeleteDC& Lib "gdi32" (ByVal hDC&)
Private Declare Function DeleteObject& Lib "gdi32" (ByVal hObject&)
Private Declare Function FillRect& Lib "user32" (ByVal hDC&, lpRect As RECT, ByVal hBrush&)
Private Declare Function GetSystemMetrics& Lib "user32" (ByVal nIndex&)
Private Declare Function SelectObject& Lib "gdi32" (ByVal hDC&, ByVal hObject&)
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal wMsg&, ByVal wParam&, lParam As Any)
Private Declare Function SetBkMode& Lib "gdi32" (ByVal hDC&, ByVal nBkMode&)
Private Declare Function SetRect& Lib "user32" (lpRect As RECT, ByVal x1&, ByVal y1&, ByVal x2&, ByVal y2&)
Private Declare Function SetTextColor& Lib "gdi32" (ByVal hDC&, ByVal crColor&)
Private Declare Function TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal x1&, ByVal y1&, ByVal lpString$, ByVal nCount&)
Private Const TRANSPARENT = 1
Private Const WM_GETFONT = &H31
'--------------------------------------------------
'Name : UpdateFont
'Created : 07/07/2000 08:07
'--------------------------------------------------
'Author : Richard James Moss
'Organisation: Ariad Software
'--------------------------------------------------
'Description : Updates the font of the back buffer
'--------------------------------------------------
'Updates :
'
'--------------------------------------------------
' Ariad Procedure Builder Add-In 1.00.0036
Public Sub UpdateFont()
Attribute UpdateFont.VB_Description = "Updates the font of the back buffer"
'##BD Updates the font of the back buffer
If hFontOld Then
DeleteObject SelectObject(hMemDc, hFontOld)
End If
' Get The Form's Font (Courier, Regular, 15)... (Just Call Me Spock!).
hFont = SendMessage(hWnd, WM_GETFONT, 0, 0&)
' Select It Into Our Back Buffer So We Can Output Text.
hFontOld = SelectObject(hMemDc, hFont)
End Sub '(Public) Sub UpdateFont ()
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Form_KeyPress KeyCode
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If PreviewMode = 0 Then
Unload Me
End If
End Sub
Private Sub Form_Load()
Dim Cols
Dim K
'setup values
BackColor = BackgroundClr
tmrUpdate.Interval = Speed
Set Font = StringToFont(FontData$)
'now screensaver
' Aquire The Screen Width And Height In Pixels.
ScrW = GetSystemMetrics(0)
ScrH = GetSystemMetrics(1)
' Setup A RECT Structure The Size Of The Screen.
' This Will Be Used Later With The API Function "FillRect"
' To Clear The Back Buffer.
SetRect Rct, 0, 0,