农历公历转换(九)

本论文在其他论文栏目，由论文格式网整理,转载请注明来源www.lwgsw.com,更多论文,请点论文格式范文查看
    hei = Int(ScaleY(Form1.Height, vbTwips, vbPixels)) - Picture5.Height ', vbTwips, vbPixels)
    Label3.Caption = Str(Picture5.Height) & Str(ScaleY(Form1.Height, vbTwips, vbPixels)) & " " & Str(hei)
    Picture5.Top = hei '- 70 ' Picture4.Top + 1
End If
End Sub
Private Sub Timer6_Timer()
    Dim hei
   Pt.Visible = False
jiSuan = False
    Form1.Height = Form1.Height - 50
    hei = Int(ScaleY(Form1.Height, vbTwips, vbPixels) - Picture5.Height) ', vbTwips, vbPixels))
   Label3.Caption = Str(Picture5.Height) & Str(ScaleY(Form1.Height, vbTwips, vbPixels)) & " " & Str(hei)
Picture5.Top = hei '- 70
If Form1.Height < 2745 Then
    Timer6.Enabled = False
    Label4.Enabled = True
    cmdT.Enabled = True
End If
End Sub
Private Sub Timer7_Timer()
If S_mem <> 0 Then
   ShowNumSam wPw2(1), Pt, 16, 1, -1
Else
   ShowNumSam wPw2(1), Pt, 17, 1, -1
End If
If tip > 0 Then
tip = tip + 1
End If
If tip > 2 Then
frmTip.Show
tip = -1
End If
End Sub
Private Sub txtDisp_Change()
Dim deLc As String, i As Integer, kL As Integer

For i = 24 To 14 Step -1
         If (i - 23 + Len(Trim(txtDisp.Text))) > 0 Then
           deLc = Mid(txtDisp.Text, i - 23 + Len(Trim(txtDisp.Text)), 1)
           Label3.Caption = Str(Len(Trim(txtDisp.Text)))
         Else
           deLc = ""
         End If
     Select Case deLc
       Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0"
            kL = Val(deLc)
               ShowNumC2 wPw1(1), Pt, kL, 1, i - 9
       Case "."
               ShowNumC2 wPw1(1), Pt, 11, 1, i - 9
       Case "E"
               ShowNumC2 wPw1(1), Pt, 13, 1, i - 9
       Case "+"
               ShowNumC2 wPw1(1), Pt, 14, 1, i - 9
       Case "-"
               ShowNumC2 wPw1(1), Pt, 15, 1, i - 9
       Case Else
               ShowNumC2 wPw1(1), Pt, 12, 1, i - 9
     End Select
Next i
For i = 13 To 1 Step -1
         If (i - 23 + Len(Trim(txtDisp.Text))) > 0 Then
           deLc = Mid(txtDisp.Text, i - 23 + Len(Trim(txtDisp.Text)), 1)
           Label3.Caption = Str(Len(Trim(txtDisp.Text)))
         Else
           deLc = " "
         End If
     Select Case deLc
       Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0"
            kL = Val(deLc)
               ShowNumC wPw1(1), Pt, kL, 1, i
       Case "."
               ShowNumC wPw1(1), Pt, 11, 1, i
       Case "E"
               ShowNumC wPw1(1), Pt, 13, 1, i
       Case "+"
               ShowNumC wPw1(1), Pt, 14, 1, i
       Case "-"
               ShowNumC wPw1(1), Pt, 15, 1, i
       Case Else
               ShowNumC wPw1(1), Pt, 12, 1, i
     End Select
Next i
'小字符显示
For i = 24 To 1 Step -1
         If (i - 23 + Len(Trim(txtDisp.Text))) > 0 Then
           deLc = Mid(txtDisp.Text, i - 23 + Len(Trim(txtDisp.Text)), 1)
           Label3.Caption = Str(Len(Trim(txtDisp.Text)))
         Else
           deLc = " "
         End If
     Select Case deLc
       Case "1", "2", "3", "4", "5", "6", "7", "8", "9", "0"
            kL = Val(deLc)
               ShowNumSam wPw2(1), Pt, kL + 1, 1, i
       Case "."
               ShowNumSam wPw2(1), Pt, 14, 1, i
       Case "E"
               ShowNumSam wPw2(1), Pt, 12, 1, i
       Case "+"
               ShowNumSam wPw2(1), Pt, 13, 1, i
       Case "-"
               ShowNumSam wPw2(1), Pt, 15, 1, i
       Case Else
               ShowNumSam wPw2(1), Pt, 0, 1, i
     End Select
Next i
End Sub
Public Sub SetAutoRgn(hForm As Form, Optional transColor As Byte = vbNull)
    Dim x As Long, y As Long
    Dim Rgn1 As Long, Rgn2 As Long
    Dim SPos As Long, EPos As Long
    Dim bm As BITMAP
    Dim hbm As Long
    Dim Wid As Long, Hgt As Long
    '获取窗体背景图片尺寸
    hbm = hForm.Picture
    GetObjectAPI hbm, Len(bm), bm
    Wid = bm.bmWidth ' ScaleX(Picture2.Width, vbTwips, vbPixels)
    Hgt = bm.bmHeight ' ScaleY(Picture2.Height, vbTwips, vbPixels)
    ReDim bmByte(1 To Wid, 1 To Hgt)
    GetBitmapBits hForm.Picture, Wid * Hgt, bmByte(1, 1) '获取图像数组
    If transColor = vbNull Then transColor = bmByte(1, 1)
    Rgn1 = CreateRectRgn(0, 0, 0, 0)
    For y = 1 To Hgt '逐行扫描
        x = 0
        Do
            x = x + 1
            While (bmByte(x, y) = transColor) And (x < Wid)
                x = x + 1 '跳过透明色的点
            Wend
            SPos = x
            While (bmByte(x, y) <> transColor) And (x < Wid)
                x = x + 1 '跳过不是透明色的点
            Wend
            EPos = x - 1
            '这一段是合并区域
            If SPos <= EPos Then
                Rgn2 = CreateRectRgn(SPos - 1, y - 1, EPos, y)
                CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
                DeleteObject Rgn2
            End If
        Loop Until x >= Wid
    Next y
    SetWindowRgn hForm.hwnd, Rgn1, True '设定窗体形状区域
    DeleteObject Rgn1
End Sub
Public Sub Ji_suan()
        f = ""
        txtDisp.Text = e
        op = ""
        chk = 1
End Sub
Public Sub txt_Sub()
       Select Case Val(Text2.Text)
         Case 1, 3, 5, 7, 8, 10, 12
            UpDown3.Max = 31
         Case 4, 6, 9, 11
            UpDown3.Max = 30
         Case 2
            If ((Val(Text1.Text) Mod 4) = 0) And ((Val(Text1.Text) Mod 100) <> 0) Or ((Val(Text1.Text) Mod 400) = 0) Then
                UpDown3.Max = 29
            Else
                UpDown3.Max = 28
            End If
       End Select
End Sub
Public Sub s_Disp()
Dim kDay1 As Date, skDay1 As String
Text4.Text = sdayF(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text))
    skDay1 = Text1.Text + "," + Text2.Text + "," + Text3.Text
    kDay1 = skDay1
    disPlay (kDay1)
End Sub

Public Sub op_Sub()
     MPl.Play
    Select Case op
        Case "+"
            e = Str(Val(e) + Val(f))
            f = ""
        Case "-"
            e = Str(Val(e) - Val(f))
            f = ""
        Case "*"
            e = Str(Val(e) * Val(f))
            f = ""

首页上一页 6 7 8 9 10 下一页尾页 9/10/10