?? public.bas
字號:
Attribute VB_Name = "公用函數(shù)"
Public MyPath As String
Public MName As String
Public MyStr As String
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Declare Function BitBlt Lib "GDI" (ByVal hDestDC As Integer, ByVal x As Integer, ByVal y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal hSrcDC As Integer, ByVal xSrc As Integer, ByVal ySrc As Integer, ByVal dwRop As Long) As Integer
Const ERROR_SUCCESS = &H0
Const COPY_PUT = &HCC0020
'------------------------------------------------------------------
Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Any) As Long
Global Const HELP_QUIT = 2
Global Const HELP_INDEX = 3
Global Const HELP_HELPONHELP = 4
Global Const HELP_PARTIALKEY = &H105
'-------------------------------
'使窗體始終保持在最前面
Public Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Public Function PutWindowOnTop(pFrm As Form)
Dim lngWindowPosition As Long
lngWindowPosition = SetWindowPos(pFrm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
End Function
' WindowOnTop.bas
'-----------------
'
' Use the following code in the form_load event of the form you
' want put onto of all the other forms on the screen.
'
' Call PutWindowOnTop ( Me )
'
Function TeShuFont(FormName, WenBen As String, XiaoGuo As String, x, y, FontColor As Integer)
'程序說明:
'FormName 為窗體名稱
'WenBen 為所要顯示的文字
'XiaoGuo 為效果標志
'當XiaoGuo 為D、F、Y時對應(yīng)為雕刻、浮雕及陰影效果
'x , y為文字顯示的位置
'函數(shù)調(diào)用示例:
'在窗口Me中200,390處顯示具有雕刻效果的文字“北京勘測設(shè)計研究院".
'Private Sub Form_Load()
' Me.Show
' Me.BackColor = QBColor(6)
' Me.FontName = "隸書"
' Me.FontSize = 20
' TeShuFont Me, "北京勘測設(shè)計研究院", "F", 200, 390,5
'End Sub
FormName.CurrentX = x
FormName.CurrentY = y
If Left(XiaoGuo, 1) = "d" Or Left(XiaoGuo, 1) = "D" Then
X1 = -18: Y1 = -20
ElseIf Left(XiaoGuo, 1) = "f" Or Left(XiaoGuo, 1) = "F" Then
X1 = 10: Y1 = 20
ElseIf Left(XiaoGuo, 1) = "y" Or Left(XiaoGuo, 1) = "Y" Then
X1 = 50: Y1 = -20
End If
FormName.ForeColor = QBColor(15)
FormName.Print WenBen
FormName.CurrentX = x + X1
FormName.CurrentY = y + Y1
FormName.ForeColor = QBColor(FontColor)
FormName.Print WenBen
End Function
Sub HelpFunction(lhWnd As Long, HelpCmd As Integer, HelpKey As String)
Dim lRtn As Long 'declare the needed variables
If HelpCmd = HELP_PARTIALKEY Then
lRtn = WinHelp(lhWnd, App.Path + "\help.hlp", HelpCmd, HelpKey)
Else
lRtn = WinHelp(lhWnd, App.Path + "\help.hlp", HelpCmd, 0&)
End If
End Sub
Function FileExist(FileName As String) As Boolean
'判斷文件是否存在的函數(shù)
FileExist = IIf(Dir(FileName) <> "", True, False)
End Function
Public Function SetFormPic(Tform As Object, TPic As Object) As Variant
'用時在Private Sub Form_Paint()下寫入“SetFormPic Me, Picture2”,即將Picture2充滿窗體
Dim II, JJ As Integer
For II = 0 To Tform.ScaleWidth \ TPic.Width
For JJ = 0 To Tform.ScaleHeight \ TPic.Height
Tform.PaintPicture TPic, i * TPic.Width, j * TPic.Height
Next JJ
Next II
End Function
Sub delay(ByVal n As Single)
Dim tm1 As Single, tm2 As Single
tm1 = Timer
Do
tm2 = Timer
If tm2 < tm1 Then tm2 = tm2 + 86400
If tm2 - tm1 > n Then Exit Do
DoEvents
Loop
End Sub
Sub Main()
' 顯示"標志",并且等待 2 秒
' Form3.Show
' delay 2
' MDIFrmMain.Show
' 顯示"登錄"窗體,采取強制響應(yīng)方式
' delay 2
' Unload Form3
'******************************原來的
' 顯示"標志",并且等待 2 秒
Form3.Show
delay 1
FrmHY.Show
' 顯示"登錄"窗體,采取強制響應(yīng)方式
delay 2
Unload Form3
frmLogin.Show vbModal
' If Not frmLogin.cmdOK Then
' MsgBox "未完成用戶名稱和密碼輸入", vbCritical
' End
' End If
Unload frmLogin
Unload FrmHY
' 顯示"主"窗體
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -