vb农历公历转换系统设计 第2页
三、主程序部分代码：
Option Explicit
'***************************************
'拖动无标题窗体
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
'=============================================================================
Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) www.751com.cn
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private Const RGN_OR = 2
Dim bmByte() As Byte
'***************************************
'滚动字幕
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long
Const DT_BOTTOM As Long = &H8
Const DT_CALCRECT As Long = &H400
Const DT_CENTER As Long = &H1
Const DT_EXPANDTABS As Long = &H40
Const DT_EXTERNALLEADING As Long = &H200
Const DT_LEFT As Long = &H0
Const DT_NOCLIP As Long = &H100
Const DT_NOPREFIX As Long = &H800
Const DT_RIGHT As Long = &H2
Const DT_SINGLELINE As Long = &H20
Const DT_TABSTOP As Long = &H80
Const DT_TOP As Long = &H0
Const DT_VCENTER As Long = &H4
Const DT_WORDBREAK As Long = &H10
Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Const ScrollText As String = "1901-2049" & vbCrLf & _
                               "多功能电子日历 "
'***********************************************
Dim EndingFlag As Boolean, jS As Integer
Dim e As String
Dim f As String
Dim g As Double
Dim S_mem As Double
Dim op As String
Dim chk As Integer
Const Pi = 3.14159265358979
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
Dim flAge As Boolean, color_index As Integer, tiAo As Boolean, jiSuan As Boolean
Dim s_mem_B As Boolean, tip As Integer, ziShi As String
'**************************************************
   '数字按下、松开
Private Sub cmdNum_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
   Show_b Picture5, P8, cmdNum(Index)
End Sub
Private Sub cmdNum_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
   Show_b Picture5, P9, cmdNum(Index)
End Sub
'**************************************************
   '角度、弧度
Private Sub cmdOp_1_Click(Index As Integer)
  MPl.Play
 Select Case Index
   Case 0
     If g = 1 Then
        If op = "" Then
            e = Str((Val(e) * 180 / Pi))
            txtDisp.Text = e
        Else

上一页  [1] [2] [3] [4] [5] [6] [7] [8] [9] [10] 下一页