×

学习

自定义鼠标点击器

陈燮函 陈燮函 发表于2023-07-27 浏览239 评论0

自定义鼠标点击器

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (IpPoint As POINTAPI) As Long
Option Explicit
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wflags As Long) As Long
Private Const HWND_TOPMOST& = -1
Private Const SWP_NOMOVE = &H1
Private Const SWP_NOSIZE = &H2
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10

Private Function getmouse_x_y() As POINTAPI
    GetCursorPos getmouse_x_y
End Function

'插入一个command一个timer两个label
Private Sub Command1_Click()
    AutoPressMouse 1000, 530
    Sleep 100
    AutoPressMouse 1000, 530
    Sleep 100
    AutoPressMouse 630, 460
    Sleep 100
    AutoPressMouse 888, 675
    Sleep 3000
    AutoPressMouse 640, 470
    Sleep 100
    SetCursorPos 40, 50
    RIGHTMOUSE
End Sub
Private Sub AutoPressMouse(X As Long, Y As Long)
    SetCursorPos X, Y
    mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub
Private Sub RIGHTMOUSE()
    mouse_event MOUSEEVENTF_RIGHTDOWN Or MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub

Private Sub Form_Load()
    SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
    Me.Left = 0
    Me.Top = 0
    Timer1.Enabled = True
    Timer1.Interval = 50
End Sub

Private Sub Timer1_Timer()
    'GetCursorPos position
    Label1.Caption = getmouse_x_y.X
    Label2.Caption = getmouse_x_y.Y
End Sub
强迫症折腾照片

生活

强迫症折腾照片

陈燮函 陈燮函 发表于2023-07-25 浏览280 评论0

最近整理了下个人相片,共计差不多2W张。想着更新下错误exif信息,并重新按拍摄日期重命名。需要解决的主要问题如下:

  • 格式混乱,除jpg、mp4外还有png、3gp、tif、wmv、vob、tts等其他格式,不包含Exif信息;

  • 部分微信相片视频是13、10位和其他混乱的时间戳命名;

  • 部分照片和视频用数码相机拍摄日期时间设置错误。

用R画图

工作

用R画图

陈燮函 陈燮函 发表于2023-07-25 浏览207 评论0

不同类型格式图形合并到一个图形

需要使用ggpubr包的ggarrange功能

library(ggplot2)

library(ggpubr)

data1=read.csv("d:\\2.csv")

p1=ggplot(data1)+geom_point(aes(year,C.UV.),colour="red")

p2=ggplot(data1)+geom_point(aes(year,C.UW.),colour="blue")

学习

学习过的软件

陈燮函 陈燮函 发表于2023-07-25 浏览195 评论0

C

读书时,接触的第一门计算机语言。

Spss\Matlab

SPSS是读书时的必修课,Matlab是选修课,专业统计、数学类软件。

VB.net

刚工作时用来制作过几个小软件,但制作的软件依赖 .NET Framework,后来就转用移植难度较小的VB了。

贫困调查录入★综合数据处理★住户处Framework20

VB

入门非常简单的软件,可视化界面。随随便便就能生成一个exe程序。用它作过许多工作辅助小程序。

学习

vba操作VCF、有效性等

陈燮函 陈燮函 发表于2023-07-25 浏览208 评论0

VCF导入、精简:

Sub inputVcf() '放在sheet1用于导入
    Application.ScreenUpdating = False
    Sheet1.Select
    Cells.Delete
    s = InputBox("输入vcf文件路径", "导入vcf")
    
    If s = "" Then Exit Sub
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & s, Destination:=Range("$A$1"))
        .Name = "00001"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 65001
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierNone
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    For i = UsedRange.Rows.Count To 1 Step -1
        If Left(Cells(i, 1), 2) = "EN" Or Left(Cells(i, 1), 2) = "BE" Or Left(Cells(i, 1), 2) = "N:" Or Left(Cells(i, 1), 2) = "VE" Then
            Rows(i & ":" & i).Delete
        End If
    Next
    UsedRange.Replace "*:", ""
    m = 0
    n = 3
    j = 1
    For i = 1 To UsedRange.Rows.Count
        If IsNumeric(Left(Cells(i, 1), 1)) = False Then
            m = m + 1
            Cells(m, 2) = Cells(i, 1)
            n = 3
        Else
            Cells(m, n) = Cells(i, 1)
            n = n + 1
        End If
    Next
End Sub

Sub setVcf() '放在sheet2用于生成
    Application.ScreenUpdating = False
    s = ""
    For i = 1 To UsedRange.Rows.Count
        s = s & "BEGIN:VCARD" & vbCrLf & "VERSION:3.0" & vbCrLf & "FN:" & Cells(i, 1) & vbCrLf
        For j = 2 To 4
            If Cells(i, j) = "" Then
                
            ElseIf Left(Cells(i, j), 1) = "1" Then
                s = s & "TEL;TYPE=手机:" & Cells(i, j) & vbCrLf
            Else
                s = s & "TEL;TYPE=固话:" & Cells(i, j) & vbCrLf
            End If
        Next j
        s = s & "END:VCARD"
    Next i
    Open "D:\1.txt" For Output As #1
    Print #1, s
    Close #1
End Sub

学习

vb读写xls、数据库文件

陈燮函 陈燮函 发表于2023-07-25 浏览190 评论0

引用ADO Library对xls文件进行修改。

可以在xls文件打开的情况下直接操作,并在Excel或Wps中直接更新。

Private Sub Command1_Click()
    
    On Error Resume Next
    Dim adoConn As New ADODB.Connection
    Dim adoReco As New ADODB.Recordset
    Set adoConn = New ADODB.Connection
    
    adoConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=D:/1.xls;Extended Properties='Excel 8.0;HDR=Yes'"
    Sql = "Num int, Name char(20)"
    adoConn.Execute "Create table [D:/1.xls].Sheet1" & "(" & Sql & ")"
    adoConn.Execute "insert into [sheet1$]  values (999,'zichu')"
    adoConn.Execute "insert into [sheet1$]  values (888,'jingyi')"
    adoConn.Execute "UPDATE [sheet1$]  Set  Name='JingYi'  Where Num=888"
    adoConn.Close
    Set adoConn = Nothing
    
End Sub