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] 下一页