⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 123_clock.bas

📁 一个很漂亮的日历
💻 BAS
字号:
Attribute VB_Name = "Module2"
Public color1 As Integer
Public fhHour As Integer, fhMin As Integer, fhSec As Integer
Public fhHour1 As Integer, fhHour2 As Integer
Public fhMin1 As Integer, fhMin2 As Integer
Public fhSec1 As Integer, fhSec2 As Integer, fhSec3 As Integer
'设置窗体总在最前端
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)
Private Const SWP_NOMOVE = 2
Private Const SWP_NOSIZE = 1
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2

'
Public Sub ShowNum(source As PictureBox, Target As PictureBox, Digit As Integer, color1 As Integer, position As Integer)
  Target.PaintPicture source.Picture, (position - 1) * 16, 0, 16, 25, 16 * (Digit), 25 * (color1 - 1), 16, 25, vbSrcCopy
  Target.Refresh
End Sub
Public Sub ShowMaoHao(source As PictureBox, Target As PictureBox, Digit As Integer, color1 As Integer)
  Target.PaintPicture source.Picture, (3 - 1) * 9, 0, 9, 15, 9, 15 * (color1 - 1), 9, 15, vbSrcCopy
  Target.PaintPicture source.Picture, (6 - 1) * 9, 0, 9, 15, 9 * (Digit), 15 * (color1 - 1), 9, 15, vbSrcCopy
End Sub
Public Sub ShowNumW(source As PictureBox, Target As PictureBox, Digit As Integer, color1 As Integer, position As Integer)
  Target.PaintPicture source.Picture, (position - 1) * 16, 0, 16, 14, 16 * (Digit), 14 * (color1 - 1), 16, 14, vbSrcCopy
  Target.Refresh
End Sub

Public Sub ShowNumS(source As PictureBox, Target As PictureBox, Digit As Integer, color1 As Integer, position As Integer)
  Target.PaintPicture source.Picture, (position - 1) * 9, 0, 9, 15, 9 * (Digit), 15 * (color1 - 1), 9, 15, vbSrcCopy
  Target.Refresh
End Sub
Public Sub ShowNumWs(source As PictureBox, Target As PictureBox, Digit As Integer)
  Target.PaintPicture source.Picture, 0, 0, 55, 11, 55 * (Digit), 0, 55, 11, vbSrcCopy
  Target.Refresh
End Sub

Public Sub ShowNumGz(source As PictureBox, Target As PictureBox, Digit As Integer, color1 As Integer, position As Integer)
  Target.PaintPicture source.Picture, 0, 0, 33, 23, 33 * (Digit), 23 * (color1 - 1), 33, 23, vbSrcCopy
  Target.Refresh
End Sub
Public Sub ShowNumC(source As PictureBox, Target As PictureBox, Digit As Integer, color1 As Integer, position As Integer)
  Target.PaintPicture source.Picture, (position - 1) * 16 + 5, 15, 16, 25, 16 * (Digit), 25 * (color1 - 1), 16, 25, vbSrcCopy
  Target.Refresh
End Sub
Public Sub ShowNumC2(source As PictureBox, Target As PictureBox, Digit As Integer, color1 As Integer, position As Integer)
  Target.PaintPicture source.Picture, (position - 1) * 16 + 5, 45, 16, 25, 16 * (Digit), 25 * (color1 - 1), 16, 25, vbSrcCopy
  Target.Refresh
End Sub
Public Sub ShowNumSam(source As PictureBox, Target As PictureBox, Digit As Integer, color1 As Integer, position As Integer)
  Target.PaintPicture source.Picture, (position - 1) * 9 + 20, 81, 9, 15, 9 * (Digit), 15 * (color1 - 1), 9, 15, vbSrcCopy
  Target.Refresh
End Sub
Public Sub Show_b(Target As PictureBox, source As PictureBox, label_Box As Label)
  Target.PaintPicture source.Picture, label_Box.Left - 1, label_Box.Top - 1, label_Box.Width + 2, label_Box.Height + 2, label_Box.Left - 1, label_Box.Top - 1, label_Box.Width + 2, label_Box.Height + 2, vbSrcCopy
  'Target.Refresh
End Sub
Public Sub ShowNumFun(Target As PictureBox, source As PictureBox, Digit As Integer)
  Target.PaintPicture source.Picture, 3, 45, 32, 25, 32 * (Digit - 1), 0, 32, 25, vbSrcCopy
  'Target.Refresh
End Sub
Public Sub ShowNumARG(Target As PictureBox, source As PictureBox, Digit As Integer)
  Target.PaintPicture source.Picture, 36, 45, 32, 25, 32 * (Digit - 1), 0, 32, 25, vbSrcCopy
  'Target.Refresh
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -