时间管理小工程(一)

最近一直在做一个小软件,这个是关于时间管理的。最开始的初衷是因为每天要写日报,然后发邮件给相关人员,整理日报发邮件很费时间所以决定开发一款节省时间的小软件。软件主要功能是实现任务提醒,任务记录,整理好后发送邮件,并能及时在钉钉上发送提醒信息。
我主要的工作是负责前端和主要功能的实现,经过几天的不懈努力现在终于有点小成果了。界面如下图所示:
相关代码如下:

Dim Task As String  '单项任务内容
Dim T1, T2, T3, T4, T5 As String '定义单项任务时间
Dim n001, n002, n003, n004, n005 As String '定义单项任务的名称
Dim m As String ' 暂停时间
Dim E As String '开始时间
Dim i As Long  'list1中的任务清单循环变量
Dim c As String   '生成的log文件名成
Dim times As Integer '定义开始按钮的次数,用于判断是否写入暂停数据
Dim d As Integer
Dim a9 As Integer '定义随机数更换皮肤

Private Declare Function SkinH_SetAero Lib "SkinH.dll" (ByVal hwnd As Long) As Long
Private Declare Function SkinH_Attach Lib "SkinH.dll" () As Long
Private Declare Function SkinH_AttachEx Lib "SkinH.dll" (ByVal lpSkinFile As String, ByVal lpPasswd As String) As Long

Private Sub Command1_Click()
    FrmRemind.Show '打开提醒对话框
End Sub

Private Sub Command2_Click()
    '判断列表框是否只有一个项目被选中
    If List1.SelCount = 1 Then
        List1.RemoveItem List1.ListIndex
    ElseIf List1.SelCount = 0 Then
        MsgBox "请选择要删除的任务!", vbOKOnly, "提示"
        Exit Sub
    ElseIf List1.ListCount > 1 Then
    '删除列表框中的所选中的多个项目
        For i = List1.ListCount - 1 To 0 Step -1
        '判断该项目是否被选中,Selected()返回布尔值
        If List1.Selected(i) Then
            '删除索引号为i的项目
            List1.RemoveItem i
        End If
        Next
    End If
End Sub

Private Sub Command4_Click()
    '记录按钮按下的次数
    times = times + 1
    If List1.ListCount = 0 Then
        MsgBox "任务列表为空!", vbOKOnly, "提示"
        Exit Sub
    End If
    If Text2.Text = "" Then
        MsgBox "请输入任务时间!", vbOKOnly, "提示"
        Exit Sub
    End If
    '开始时间
    E = Date & Time
    '暂停之后将暂停时间和开始时间写入表格中
    If Timer1.Enabled = False And times > 1 Then
        Open App.Path & "\c.log" For Append As #1 '同一个文件多次添加文本内容
        Randomize
         Print #1, "<tr align='center'>" & vbCrLf & _
        "<tr align='center'>" & vbCrLf & _
        "<td>" & "暂停" & "</td>" & vbCrLf & _
        "<td>" & m & "</td>" & vbCrLf & _
        "<td>" & E & "</td>"
        Close #1
    End If
    '时间控件开启
    Timer1.Enabled = True
End Sub

Private Sub Command3_Click()
    '进行中的任务暂停
    Timer1.Enabled = False
    '记录暂停时间
    m = Date & Time
End Sub

Private Function Rndz(a1 As Long, b1 As Long)
    Rndz = Int((a1 - b1 + 1) * Rnd() + b1)
End Function

Private Sub Form_Load()
    
    Randomize
    
    a9 = Rndz(1, 10)
    '皮肤初始化
    On Error Resume Next
    File1.Path = App.Path & "\SkinSharp"
    SkinH_Attach
    SkinH_SetAero 1
    SkinH_AttachEx App.Path & "\skin" & "\" & a9 & ".she", ""
    SkinH_AttachEx Command, ""
    '时间控件暂停
    Timer1.Enabled = False
    Timer4.Enabled = False
    c = Format(Now, "yyyymmdd") '把当前系统时间(年月日)赋给c,
    Open App.Path & "\c.log" For Append As #1 '同一个文件多次添加文本内容
    Randomize
    Print #1, "<p align='center'></p>" & vbCrLf & _
    "<table border='1px'align='center'" & vbCrLf & _
    "bordercolor='blue' width='600px' height='100px'>" & vbCrLf & _
    "<tr align='center'>" & vbCrLf & _
    "<td>内容</td>" & vbCrLf & _
    "<td >开始时间</td>" & vbCrLf & _
    "<td >结束时间</td>"
    Close #1
    '皮肤文件路径读取
    SkinH_AttachEx App.Path & "\skin" & "\" & a9 & ".she", ""
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     Dim da() As Byte, da1() As String
     Dim ix&, issame As Boolean '定义各种变量
     issame = False
     Open App.Path & "\c.log" For Binary As #1
     ReDim da(LOF(1) - 1) As Byte
     Get #1, , da   '取得文件的数据
     Close #1
     da1 = Split(StrConv(da, vbUnicode), vbCrLf) '将数据转换并以回车分割
     '你也可以用其他方法获取文件的每行数据。不过这个方法可能比较快
     For ix = 0 To UBound(da1) '将每行数据和text的内容做对比
        If da1(ix) = "<p align='center'></p>" Then '& vbCrLf & _
           "<table border='1px'align='center'" & vbCrLf & _
           "bordercolor='blue' width='600px' height='100px'>" & vbCrLf & _
           "<tr align='center'>" & vbCrLf & _
           "<td>内容</td>" & vbCrLf & _
           "<td >开始时间</td>" & vbCrLf & _
           "<td >结束时间</td>" Then '如果有相同的内容就做个标记并退出循环
           issame = True: Exit For
        End If
     Next ix
     If issame = False Then   '如果不相同就写入text的内容
        Open App.Path & "\c.log" For Append As #1
        Print #1, "<p align='center'></p>"  '& vbCrLf & _
        "<table border='1px'align='center'" & vbCrLf & _
        "bordercolor='blue' width='600px' height='100px'>" & vbCrLf & _
        "<tr align='center'>" & vbCrLf & _
        "<td>内容</td>" & vbCrLf & _
        "<td >开始时间</td>" & vbCrLf & _
        "<td >结束时间</td>"
        Close #1
     'Else '否则给提示
        'MsgBox "已有相同记录"
     End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

End Sub

评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值