vb农历公历转换系统设计 第7页
L2.X2 = 234 + 15 * Sin(6 * Minute(Time) * Pi / 180)
L2.Y2 = 21 - 15 * Cos(6 * Minute(Time) * Pi / 180)
ss = Hour(Time)
If ss > 12 Then ss = ss - 12
L3.X1 = 234 - 2 * Sin(ss * 30 * Pi / 180 + Minute(Time) / 2 * Pi / 180)
L3.Y1 = 21 + 2 * Cos(ss * 30 * Pi / 180 + Minute(Time) / 2 * Pi / 180)
L3.X2 = 234 + 11 * Sin(ss * 30 * Pi / 180 + Minute(Time) / 2 * Pi / 180)
L3.Y2 = 21 - 11 * Cos(ss * 30 * Pi / 180 + Minute(Time) / 2 * Pi / 180)
End Sub
Public Sub disPlay(kDay As Date)
Dim mY1 As Integer, mY2 As Integer, dY1 As Integer, dY2 As Integer, wY As Integer
Dim temP As String, temP1 As Integer, temP2 As String, temP3 As String, temP4 As String, temP5 As String
ShowNum wPw1(color_index), G_y, Val(Mid(Trim(Str(Year(kDay))), 1, 1)), 1, 1
ShowNum wPw1(color_index), G_y, Val(Mid(Trim(Str(Year(kDay))), 2, 1)), 1, 2
ShowNum wPw1(color_index), G_y, Val(Mid(Trim(Str(Year(kDay))), 3, 1)), 1, 3
ShowNum wPw1(color_index), G_y, Val(Mid(Trim(Str(Year(kDay))), 4, 1)), 1, 4
If Month(kDay) < 10 Then
mY1 = 0
mY2 = Month(kDay)
Else
mY1 = Int(Month(kDay) / 10)
mY2 = Int(Month(kDay) Mod 10)
End If
ShowNum wPw1(color_index), G_m, mY1, color1, 1
ShowNum wPw1(color_index), G_m, mY2, 1, 2
If Day(kDay) < 10 Then
dY1 = 0
dY2 = Day(kDay)
Else
dY1 = Int(Day(kDay) / 10)
dY2 = Int(Day(kDay) Mod 10)
End If
ShowNum wPw1(color_index), G_d, dY1, 1, 1
ShowNum wPw1(color_index), G_d, dY2, 1, 2
Gl_j.Caption = "今日是:" + ssFtv(Month(kDay), Day(kDay))
J_q.Caption = seaSonYx(kDay)
'----------------------------------------------------------------------
temP = sdayF(Year(kDay), Month(kDay), Day(kDay))
Ljf.Caption = seaSonYxr(kDay)
temP1 = Val(Trim(Mid(temP, 1, 4)))
temP2 = Trim(Mid(temP, 10, 2))
temP3 = Trim(Mid(temP, 20, 2))
temP4 = Trim(Mid(temP, 9, 1))
temP5 = Trim(Mid(temP, 17, 3))
If temP5 = "Big" Then
temP5 = "大 "
Else
temP5 = "小 "
End If
If temP4 = "Y" Then
ziShi = yTGDZ(temP1) + "年 润" + nStr1(Val(temP2)) + "月" + temP5 + sdayF_gzr(kDay) + "日 "
Else
ziShi = yTGDZ(temP1) + "年 " + sdayF_gzm(temP1, Val(temP2)) + "月" + temP5 + sdayF_gzr(kDay) + "日 "
End If
ShowNum wPw1(color_index), N_y, Val(Mid(Trim(Str(temP1)), 1, 1)), 1, 1
ShowNum wPw1(color_index), N_y, Val(Mid(Trim(Str(temP1)), 2, 1)), 1, 2
ShowNum wPw1(color_index), N_y, Val(Mid(Trim(Str(temP1)), 3, 1)), 1, 3
ShowNum wPw1(color_index), N_y, Val(Mid(Trim(Str(temP1)), 4, 1)), 1, 4
ShowNumGz wPw1(6), Gz, ((temP1 - 1900) Mod 12), 1, 1
mY1 = Val(Left(temP2, 1))
mY2 = Val(Right(temP2, 1))
ShowNum wPw1(color_index), N_m, mY1, color1, 1
ShowNum wPw1(color_index), N_m, mY2, 1, 2
dY1 = Val(Left(temP3, 1))
dY2 = Val(Right(temP3, 1))
ShowNum wPw1(color_index), N_d, dY1, 1, 1
ShowNum wPw1(color_index), N_d, dY2, 1, 2
Nl_j.Caption = "今日是:" + llFtv(Val(temP2), Val(temP3))
Label2.Caption = Str(Len(Trim(temP))) + "" + Str(LenB(Trim(temP))) + " " + temP + vbCrLf + Str(temP1) + " " + Str(temP2) + " " + Str(temP3)
'---------------------------------------------------------------------------
wY = Weekday(kDay)
Select Case wY
Case 2, 3, 4, 5, 6, 7
ShowNumW wPw1(0), Week_p, wY - 1, 1, 1
ShowNumWs wPw1(2), wWeekP, wY - 2
Case 1
ShowNumW wPw1(0), Week_p, 0, 1, 1
ShowNumWs wPw1(2), wWeekP, 6
End Select
End Sub
Private Sub RunMain(picScroll As PictureBox)
' 滚动字幕
Dim LastFrameTime As Long
Const IntervalTime As Long = 40
Dim rt As Long
Dim DrawingRect As RECT
Dim UpperX As Long, UpperY As Long 'Upper left point of drawing rect
Dim RectHeight As Long
Form1.Refresh
rt = DrawText(picScroll.hdc, ScrollText, -1, DrawingRect, DT_CALCRECT)
If rt = 0 Then 'err
MsgBox "Error scrolling text", vbExclamation
EndingFlag = True
Else
DrawingRect.Top = picScroll.ScaleHeight
DrawingRect.Left = 0
DrawingRect.Right = picScroll.ScaleWidth
RectHeight = DrawingRect.Bottom
DrawingRect.Bottom = DrawingRect.Bottom + picScroll.ScaleHeight
End If
Do While Not EndingFlag
If GetTickCount() - LastFrameTime > IntervalTime Then
picScroll.Cls
DrawText picScroll.hdc, ScrollText, -1, DrawingRect, DT_CENTER 'Or DT_WORDBREAKDT_SINGLELINE And
DrawingRect.Top = DrawingRect.Top - 1
DrawingRect.Bottom = DrawingRect.Bottom - 1
If DrawingRect.Top < -(RectHeight) Then 'time to reset
DrawingRect.Top = picScroll.ScaleHeight
DrawingRect.Bottom = RectHeight + picScroll.ScaleHeight
End If
picScroll.Refresh
LastFrameTime = GetTickCount()
End If
DoEvents
Loop
End Sub
Private Sub Timer3_Timer()
Dim hei As Integer
tiAo = False
Form1.Height = Form1.Height - 50
hei = ScaleY(Form1.Height, vbTwips, vbPixels) - Picture4.Height ', vbTwips, vbPixels)
Picture4.Top = hei - 2 ' Picture4.Top + 1
If Form1.Height < 2745 Then
Timer3.Enabled = False
Label4.Enabled = True
cmdT.Enabled = True
上一页 [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] 下一页
vb农历公历转换系统设计 第7页下载如图片无法显示或论文不完整，请联系qq752018766
