-
VisualFreeBasic控件_WinHook 系统钩子 系统钩子（System Hooks）在编程中，特别是在Windows操作系统环境下，是一种强大的机制，允许应用程序拦截、监视或修改系统级事件。这些事件可以包括键盘和鼠标输入、消息传递、窗口创建和销毁等。通过使用钩子，开发者可以创建出功能强大的应用程序，如键盘记录器、屏幕捕获工具、游戏作弊软件等，但同时也需要谨慎使用，以避免侵犯用户隐私或违反软件许可协议。 钩子类型 Windows提供了多种类型的钩子，根据你想要拦截的事件类型来选择： WH_CALLWNDPROC 和 WH_CALLWNDPROCRET：这些钩子允许你监视发送到窗口过程的消息。前者在消息被处理前调用，后者在消息被处理后调用。 WH_CBT：CBT（Callback to Task Window）钩子允许你监视Windows的各种系统级操作，如窗口的创建和销毁。 WH_DEBUG：调试钩子，主要用于调试目的，允许你监视和记录系统级事件。 WH_FOREGROUNDIDLE：当系统前台线程处于空闲状态时，此钩子被调用。它允许应用程序执行后台任务而不影响用户界面的响应性。 WH_GETMESSAGE 和 WH_JOURNALRECORD：这两个钩子与消息队列有关。WH_GETMESSAGE在消息从消息队列中检索之前被调用，而WH_JOURNALRECORD用于记录输入事件（如键盘和鼠标事件）到日志文件中。 WH_KEYBOARD 和 WH_KEYBOARD_LL：键盘钩子，用于监视键盘输入。WH_KEYBOARD是低级钩子，它在系统级别拦截键盘事件，而WH_KEYBOARD_LL是更底层的钩子，它在Windows的底层键盘驱动程序中拦截事件。 WH_MOUSE 和 WH_MOUSE_LL：鼠标钩子，与键盘钩子类似，但用于监视鼠标输入。 WH_MSGFILTER 和 WH_SYSMSGFILTER：这两个钩子允许应用程序在消息到达窗口过程之前过滤掉某些消息。WH_MSGFILTER仅适用于与钩子安装线程相关联的窗口，而WH_SYSMSGFILTER则适用于系统中的所有线程。 WH_SHELL：外壳钩子，用于监视与外壳相关的通知，如窗口的激活和最小化。 使用钩子的注意事项 性能影响：安装钩子可能会对系统性能产生负面影响，尤其是全局钩子（如WH_KEYBOARD_LL和WH_MOUSE_LL），因为它们会影响整个系统的输入事件。 权限要求：某些类型的钩子需要管理员权限才能安装。 安全性和隐私：由于钩子可以监视和修改用户的输入，因此它们可能被用于恶意目的。确保你的应用程序尊重用户的隐私和安全。 兼容性：随着Windows版本的更新，钩子的行为可能会发生变化。确保你的应用程序与目标操作系统版本兼容。 卸载钩子：在应用程序退出或不再需要钩子时，应确保卸载钩子以避免资源泄漏或意外行为。 钩子控件的使用方法 使用方法非常简单，无需你写任何代码，只要选择相关事件即可。没选择的事件并不会去钩操作系统里的东西，也不影响系统速度。钩子会影响操作系统性能。只要你创建了事件，那么就创建了钩子。没创建就没钩子。 为了不影响系统性能，你需要在事件中执行代码尽量简单。 -
-
VisualFreeBasic控件_Network 网络通信 实现 UDP 和 TCP 通信，用于写服务器和客户端，广域网和局域网通信。 本控件已经封装复杂的通信操作，让我们能简单的方便的使用通信。而且都提供了源码，可以打开控件工程查看那些复杂的封装代码。 本控件没有显示内容，只有事件和属性。 为了能顺利使用本控件，建议先恶补“ UDP和TCP”“广域网和局域网”的相关知识体系，本文档不再阐述这些基础知识。 获取本机IP 通信的首要条件，IP地址，这里的IP地址是局域网的IP print Network1.LocalIP 获取广域网IP 我们自己电脑是无法获知自己电脑广域网IP地址的，需要访问外网，外网反馈给我们IP地址才可以得知。此IP地址是由宽带服务商提供，而且是动态的，一天可能变好几次。已经有一些服务器提供这样的功能，只要访问它的域名，就返回我们的IP地址。 print Http_Get("http://ip.3322.net/") UDP通信 启动UDP接收 首先，必须开启接收，就是让软件监听UDP Network1.UdpPort =999 '每台电脑有很多UDP通信，用此端口号区分，如同电话的分机号 If Network1.UdpOpen() = 0 Then Print "开启失败，请注意防火墙提示时，需要允许。或者端口号被占用" Else Print "开启成功" End If 收到数据事件 当其它电脑发来数据，就会触发事件 Sub Form1_Network1_UdpNewData(hWndForm As hWnd, nn As Network_Data) Print "接收数据，内容：" , nn.Dat '非文本数据不要打印 End Sub 发送数据到目标IP（IP就是上面获取的IP地址，局域网IP和广域网IP都可以） 其它电脑把数据发送到接收方 Network1.UdpPostData(IP地址,端口号,"要发送的数据") 端口号就是开启接收时，设置的号码。 广域网互相通信（服务器电脑和家庭电脑通信） 两台电脑都启动UDP接收，那么就可以实现相互通信了 局域网时，双方都知道对方的IP和端口，互相发数据即可，要是广域网，2台电脑都有独立外网IP地址，也没问题，和局域网一样操作。 要是2台电脑，全部是家庭电脑，就无法实现广域网通信。当1台电脑有独立IP（比方服务器），1台家庭电脑，先由家庭电脑发UDP数据给服务器电脑，服务器电脑收到后，可以直接返回数据发送给家庭电脑 Sub Form1_Network1_UdpNewData(hWndForm As hWnd, nn As Network_Data) Print "接收数据，内容：" , nn.Dat '非文本数据不要打印 Network1.UdpPostData(nn.ip,nn.Port,"数据") '发给家庭电脑数据 End Sub 此时的 nn.ip,nn.Port IP 和端口，端口是一个伪端口，和真实的家庭电脑中的端口会不同（具体原理我们不需要懂，好奇的可以网上搜索原理）。有网上教程说此为：打洞 广域网互相通信（家庭电脑和家庭电脑通信） 家庭电脑和家庭电脑通信，是无法直接广域通信的，因此我们必须有一个服务器电脑，实现中转 上面服务器电脑收到 家庭电脑的 “IP和端口”伪数据，A家庭电脑和B家庭电脑，都发送数据到服务器电脑，然后由服务器电脑，把 AB家庭电脑“IP和伪端口”返回。那么A家知道B家，B家知道A家，AB两家就可以脱离服务，自己互相发数据了。但是家庭电脑随时可能会发生IP地址和端口改变，为了保持长久连接，就需要每隔一定时间，和服务器通信来更新AB家庭电脑“IP和伪端口” TCP通信（获取网页代码） 网站都是使用TCP通信，要是获取网页代码，其实不需要本控件，直接一个函数搞定 print Http_Get("http://ip.3322.net/") 还有一个函数：Http_Post 可以向服务发送大量数据，比方上传文件等等。 其实这个一个基于 HTTP协议的 TCP 通信，HTTP协议已经被自动处理，而后面要说的，都是原始通信数据，包括HTTP协议部分。 TCP通信（服务端） TCP需区分服务端和客户端，服务端，一般都用在服务器电脑上，就是有独立外网IP的电脑，假如是家用电脑，需要路由器设置端口转发，而且IP随时会变，需要路由器设置DDNS（花生壳之类的服务，以前有免费免流量，现在到处是收费限制流量） 只是在局域网中使用，使用局域网IP，那么直接上，没任何限制。 开启服务端 Network1.TcpServerPort =999 '每台电脑有很多TCP通信，用此端口号区分，如同电话的分机号 If Network1.TcpServerOpen() = 0 Then Print "开启失败，请注意防火墙提示时，需要允许。或者端口号被占用" Else Print "开启成功" End If 当客户端发送数据过来，触发事件 Sub Form1_Network1_TcpServerNewData(hWndForm As hWnd, nn As Network_Data) Print "服务端收到数据：" ,Len(nn.Dat) '这里开始才正式处理数据--- 'Network1.TcpServerSend(nn.SOCKET,"返回给客户端数据，可以是任意数据，不单单是文本") 'Network1.TcpServerCloseClient nn.SOCKET '主动断开客户端连接，并非立即断开，控件会自动等返回给客户端数据发送完成后才会断开。 End Sub 还有 “客户端连接请求” 和 “客户端断开连接” 事件 基本流程是，客户端请求连接-->连接成功-->互相发数据（只要不断开，双方可以一直连接，可以互相发数据，也可以不发）-->断开连接（客户端主动断开和服务端主动断开） TCP通信（客户端） 客户端，不管是家庭电脑，服务器电脑，都可以用。 一次性连接 就是连接服务端，发送数据，服务端返回数据，就断开连接，一次完成。 返回数据 = Network1.TcpClientSendGet( IP , 端口 , "发送数据" ) 网站一般都是如此，比方要获取网页代码，下面例题就是获取网页代码的 Dim 域名 As String= "www.baidu.com" Dim 路径 As String = "index.html" Dim http请求 As String '构造HTTP协议 http请求 = "GET /" + 路径 + !" HTTP/1.1\r\n" + "Host: " + 域名 + !" \r\n" + _ "Pragma: no-cache" + !"\r\n" + _ "User-Agent: Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/96.0.4664.55 Safari/537.36 Edg/96.0.1054.34" + !"\r\n" + _ "Referer: https://www.baidu.com/" + !"\r\n" + _ "Connection: close" + !"\r\n" + _ "Accept-Language: zh-CN,zh;q=0.9,en;q=0.8,en-GB;q=0.7,en-US;q=0.6" + !"\r\n\r\n" Dim 网页 As String = Network1.TcpClientSendGet( 域名 , 80 , http请求 ) '网站端口是 80 长时间连接通信 服务端和客户端一直连接着，随时随地互相发数据（注意：服务端连接数量有限制，超过限制，新连接就无法连接了，具体多少请网上搜索） 先启动客户端 Dim 域名 As String = "88.88.88.88" '可以是域名，可以是IP地址，要是域名，控件会自动转换成IP的。 Dim 端口 As Long = 999 '服务端开发的端口 If Network1.TcpClientOpen(域名, 端口) =0 Then Print "TCP连接到服务失败，请检查！！" End If 连接成功，向服务端发数据 Network1.TcpClientSend(“发数据”) 客户端收到服务端发来的数据，触发事件 Sub Form1_Network1_TcpClientNewData(hWndForm As hWnd, nn As Network_Data) Print "客户端收到数据：" ,nn.Dat '假如是文本，非文本不要打印 End Sub 通信协议 网络通信中，一台电脑到另一台电脑经过很多设备，存在很多不确定因素。 在UDP和TCP通信中，双方只是发送数据，系统则是以数据包的形式传送到其它电脑。但是会存在各种问题。 UDP 通信问题，只管发数据包，不管对方是否接收到，因此存在丢包问题，无法保障数据完整性，一般解决方法，制造一个协议，校对数据CRC值，不正确可以通知对方重新发送。 TCP 通信问题，虽然是安全通信，不会丢包，但存在粘包和拆包问题。 拆包：发送数据大，系统会拆分成 N个小包，接收方，收到的是一个一个小包 粘包：发送数据小，系统会把小的合成一个合适的包发送。接收方收到的可能是多个数据。 你永远无法知道是接收到的数据，是拆包还是粘包？还无法确定数据是否全部接收，等了好久，也不知道对方网卡了还是太忙来不及发送。 因此，大家都各自创造了各自的协议来处理这些问题，比方网络游戏，各自保密还加密，网页则使用HTTP协议，可以网上搜索到，可以搜索HTTP协议，可以参考这些成熟的协议，来解决自己的问题。 协议，只存在你写的服务端和客户端软件中，没有固定方法。 我的做法是：发数据时，添加一个头标记，表示开始，然后头标记后面是长度 '发送方 ----------------- Dim 数据 As String = "要发送的内容" Dim 长度 As Long = Len(数据) + 4 + 4 数据 = "<yf>" & MKL(长度) & 数据 '接收方 ---------------- Sub Form1_Network1_TcpServerNewData(hWndForm As hWnd ,nn As Network_Data) 'TCP服务器接收到新数据 If Left(nn.dat ,4) <> "<yf>" Then Network1.TcpServerCloseClient nn.SOCKET Return '自己创建协议头，不对就不处理。 End If Dim 总长度 As Long = CVL(Mid(nn.Dat,5,4)) If Len(nn.dat) < 总长度 Then '总长度=头部+数据 nn.nLen = 总长度 '（根据自己搞的协议获取总长度赋值，然后 nn.Dat 就累积收到的数据） Return End If Dim bb As String =mid(nn.dat,9,总长度-8) bb 就是完整的数据 End Sub 以上简单的协议，仅供参考 -
VisualFreeBasic控件_WinInet 互联网访问 这是WIn操作系统提供的网页访问功能，由VFB封装成控件使用。 这是一个功能性控件，无界面。 使用方法 使用方法很简单，就是访问一个网页，返回网页代码 Dim bb As String = WinInet1.HttpGet("http://www.yfvb.com") Dim bb As String = WinInet1.HttpPost("http://www.yfvb.com") WinInet1.HttpGetThread("http://www.yfvb.com") WinInet1.HttpPostThread("http://www.yfvb.com") 前一个是直接获取，后一个是多线程方式，当网络有卡顿，或者是下载文件时，需要比较长的时间，直接获取会发生软件假死，无反应。需要用多线程处理。 不管是多线程还是直接，接收文件时，都会产生事件 标头数据、下载开始、下载完成、文件下载中 等事件 利用事件，可以在下载文件时，提示文件进度等人性化操作 关于GET和POST 在HTTP（Hypertext Transfer Protocol，超文本传输协议）网页访问中，GET和POST是两种最常用的HTTP方法（也称为请求方法或动作），用于向服务器发送请求以获取或提交数据。尽管它们都能达到与服务器交换数据的目的，但它们在使用场景、安全性、数据传输量等方面存在差异。 GET 方法 用途：主要用于请求访问已经被URI（统一资源标识符）识别的资源，即发送一个请求来取得服务器上的某一资源。这里的资源可以是网页、图片、文档等。 特点： 数据在URL中：GET请求的数据会附加在URL之后（通过?分隔URL和传输数据，参数之间以&相连），发送的信息对所有人都是可见的（包括服务器日志、浏览器历史记录等），因此隐私性较差，且不适合用于传输敏感信息。 缓存：GET请求是可以被缓存的，而POST请求则不会。 长度限制：由于URL长度的限制，GET请求传输的数据量有限制。 无副作用：GET请求通常不会对服务器上的数据产生影响（即不会改变数据状态），仅仅是获取数据。 POST 方法 用途：主要用于向服务器提交数据，如提交表单或上传文件。POST请求的数据包含在请求体中，而不是附加在URL之后。 特点： 数据在请求体中：POST请求的数据不会附加在URL之后，而是放在HTTP请求的消息体中，对用户来说是不可见的，因此适合用于传输敏感信息。 无缓存：POST请求不会被缓存。 无长度限制：理论上POST请求的数据量没有限制，但实际应用中会受到服务器和客户端的限制。 有副作用：POST请求通常会导致服务器上的数据发生改变（例如，提交表单后数据被保存到数据库中）。 使用场景 GET：通常用于请求服务器发送资源，如请求网页、图片等，或者搜索查询等不需要修改服务器数据的场景。 POST：通常用于提交数据到服务器，如用户注册、提交表单、文件上传等需要修改服务器数据的场景。 安全性 由于GET请求的数据是明文显示在URL中的，所以不适合传输敏感信息（如密码）。而POST请求的数据在请求体中，对用户来说是不可见的，相对更安全。然而，无论是GET还是POST，都应当使用HTTPS来确保数据传输的安全性，因为HTTP本身并不加密数据。 -
VisualFreeBasic控件_MyDrawWin 窗口外框 这个是改变窗口外框的控件，放上控件后，运行才效 运行后的效果 可以在窗口属性中增加阴影，效果更好（注意：是主窗口的设计属性，不是控件的） 运行效果 可以修改窗口外壳颜色已经高度 还增加2个常用的窗口按钮，已经可以设置更多小按钮 注意： 按钮ID 设置大点，不然可能被其它控件占用，发生重叠错误 MyDrawWin1.nButID(0 到 9 共10个) = 10001 MyDrawWin1.nButTxt(0 到 9 共10个) = "按钮文字" 按钮点击事件，在主窗口的事件中 Sub Form1_WM_Command(hWndForm As hWnd, hWndControl As hWnd, wNotifyCode As Long, wID As Long) Select Case wID '命令ID，设计菜单和工具栏的设置的值。 Case 10001 ‘和 MyDrawWin1.nButID 设置的相同 Case 10002 End Select End Sub 假如你窗口上设置了窗口菜单，运行后，菜单也会在窗口外框上面 -
VisualFreeBasic控件_mCtrlTreeList 目录树列表 一个目录树和列表组合控件，如同：TreeView和ListView 这两个控件合并在一起的效果。 使用方法 也是TreeView和ListView控件的组合方式 添加“列” mCtrlTreeList1.AddColumn("列0", 100) mCtrlTreeList1.AddColumn("列1", 100) mCtrlTreeList1.AddColumn("列2", 100) 添加“行”数据 Dim aa As MC_HTREELISTITEM = mCtrlTreeList1.AddItem(MC_TLI_ROOT, "列0数据") mCtrlTreeList1.SetItemText(aa, 1, "列1数据") mCtrlTreeList1.SetItemText(aa, 2, "列2数据") 假如添加子项目 Dim bb As MC_HTREELISTITEM = mCtrlTreeList1.AddItem(aa, "列0数据") 其它功能 功能同 TreeView和ListView 一样类似，可以参考它们，这里不再相信阐述。 图标显示 没一个行头都可以显示一个图标，使用方法和TreeView一样。 先添加一个图像列表控件，然后选择绑定。添加图像 在添加行数据时，设置图像索引 mCtrlTreeList1.AddItem(MC_TLI_ROOT, "列0数据",用户自定义数据,图像索引) -
VisualFreeBasic控件_mCtrlHtml IE浏览器 这是对IE浏览器简单封装，主要用来显示一些简单的 HTIM 页面。 显示页面 网页 mCtrlHtml1.GotoUrl("http://www.baidu.com") 本地文件 mCtrlHtml1.GotoUrl("file:///c:/文件.html") 执行页面中的JS函数 mCtrlHtml1.CallScriptFunc(JS函数名,参数1,参数2,.... 可以没参数，也可以最多4个参数，传给JS函数 修改网页中的代码 没有提供任何方法可以设置全部网页，只能根据ID设置部分 Dim bb As String bb = "<html>" & vbCrLf & _ " <head>" & vbCrLf & _ " <title>网页标题 </title>" & vbCrLf & _ " <body id='zzz'>" & vbCrLf & _ " 这是一个网页" & vbCrLf & _ " </body>" & vbCrLf & _ "</html>" SaveFileStr App.Path & "1.htm", bb mCtrlHtml1.GotoUrl "file:///" & App.Path & "1.htm" mCtrlHtml1.SetTagContents "zzz","<a href='#2'>设置代码</a>" -
VisualFreeBasic控件_mCtrlGrid 表格 类似办公软件的表格功能，只是简化很多。支持虚表。 使用方法 先创建表格大小（例：创建5列10行的表，不包括列名和行名，会自动增加） mCtrlGrid1.ReSize(5,10) 给表格单元设置数据 mCtrlGrid1.SetCell(0,0,"1,1") mCtrlGrid1.SetCell(1,1,"2,2") 注意，左上角第一个是 0,0 , 参数是：列,行 获取表格单元数据 获取的文字= mCtrlGrid1.GetCellText(0,1) 单元格修改更新 当用户在单元格修改数据后，需要在“结束标签编辑”事件里，设置单元格 Function Form1_mCtrlGrid1_MC_GN_EndLabelEditW(hWndForm As hWnd, hWndControl As hWnd, NMG As MC_NMGDISPINFOW)As Long mCtrlGrid1.SetCell(NMG.wColumn,NMG.wRow,*NMG.cell.pszText) Function = FALSE ' 返回 TRUE 禁止编辑 End Function 修改列标题和行标题 标题必须在设计属性里设置，运行时，不可以改变。 当列标题设计属性设置为“自定义标题”，才可以自己设置列标题 mCtrlGrid1.SetCell(0,MC_TABLE_HEADER,"列表名1") mCtrlGrid1.SetCell(1,MC_TABLE_HEADER,"列表名2") mCtrlGrid1.SetCell(2,MC_TABLE_HEADER,"列表名2") 当行标题设计属性设置为“自定义标题”，才可以自己设置行标题 mCtrlGrid1.SetCell(MC_TABLE_HEADER,0,"行表名1") mCtrlGrid1.SetCell(MC_TABLE_HEADER,1,"行表名2") mCtrlGrid1.SetCell(MC_TABLE_HEADER,2,"行表名2") 常用功能 mCtrlGrid1.TableClear(0) '清除全部表格中的文字 mCtrlGrid1.GetColumnCount '获取表格的列数。 mCtrlGrid1.GetRowCount '获取表格的行数。 mCtrlGrid1.GetFocusedCell '获取单元格焦点 mCtrlGrid1.GetSelection '获取选择。 mCtrlGrid1.SetFocusedCell '设置单元格焦点 mCtrlGrid1.SetFocusedCell '设置单元格焦点 虚表模式 假如表格的数量很大时，设置单元格将会消耗很大的时间，因此可以直接用一个二维数组，不用设置单元格，速度就是你写代码处理二维数组的速度了。 首先，在设计属性里，必须勾选虚表模式 每次需要显示内容时，会触发事件“检索单元格数据”，然后你设置相关的数据即可 Sub Form1_mCtrlGrid1_MC_GN_GetDispInfoW(hWndForm As hWnd, hWndControl As hWnd, NMG As MC_NMGDISPINFOW) ' NMG.wColumn As WORD 列 ' NMG.wRow As WORD 行 ' NMG.cell.pszText As WString Ptr 单元格文本 ' NMG.cell.cchTextMax As Integer 文本字符数 ' NMG.cell.lParam As LPARAM 用户数据 ' NMG.cell.dwFlags As DWORD 单元格标志 (对齐标记) End Sub -
VisualFreeBasic控件_mCtrlButton 按钮 mCtrl 出品的增强按钮，它多了一个下拉按钮和可以设置图标 常用事件 点击按钮 Sub Form1_mCtrlButton1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd) End Sub 点击下拉 Sub Form1_mCtrlButton1_BCN_DropDown(hWndForm As hWnd, hWndControl As hWnd, NMB As MC_NMBCDROPDOWN) End Sub 常用属性 mCtrlButton1.Caption 设置或返回标题 mCtrlButton1.Enabled 设置或返回是后禁用 mCtrl系列有些控件存在问题，已经剔除，等以后看看能否解决。 mCtrlChart 图表显示控件 mCtrlExpand 折叠控件 mCtrlImgView 图像显示 mCtrlMDItab 标签 -
VisualFreeBasic控件_Scintilla 火花代码编辑器 Scintilla是一个免费、跨平台、支持语法高亮的编辑控件。它完整支持源代码的编辑和调试，包括语法高亮、错误指示、代码完成（code completion）和调用提示(call tips)。能包含标记（marker）的页边（margin）可用于标记断点、折叠和高亮当前行。 VFB 里的代码编辑，就是使用这个控件。功能非常多，非常强大。 编译成软件后，会在软件文件夹产生一个 支持库DLL，发行软件需要带这个DLL。 主要事件 文本或样式已更改 Sub Form1_Scintilla1_SCN_Updateui(hWndForm As hWnd, hWndControl As hWnd, sN As SCNOTIFICATION ) End Sub 主要属性 Scintilla1.GetLineCount 总行数 Scintilla1.Text 获取或设置文本,UTF8编码 Scintilla1.SendMessage 发送消息 Scintilla 设置非常多，都是通过 Scintilla1.SendMessage 来处理，具体设置需要到官网查看编程文档。这里控件已经给你处理好了事件和消息。后面就按编程文档说明，发送消息即可。 点此打开火花编辑器官方网址 常用设置参考 SciMsg 函数是Scintilla 内部定义的函数和 Scintilla1.SendMessage 是一样的功能，可以按照自己喜欢的方式写。 Dim pSci As Any Ptr = Scintilla1.pSci SciMsg(pSci, SCI_STYLESETFORE, STYLE_DEFAULT, 窗体文字) SciMsg(pSci, SCI_STYLESETBACK, STYLE_DEFAULT, 窗体底色) Dim tStr As ZString * 1024 = "Microsoft YaHei Mono" SciMsg(pSci, SCI_STYLESETFONT, STYLE_DEFAULT, Cast(lParam, @tStr)) SciMsg(pSci, SCI_STYLESETSIZE, STYLE_DEFAULT, 10) SciMsg(pSci, SCI_STYLESETCHARACTERSET, STYLE_DEFAULT, SC_CHARSET_DEFAULT) SciMsg(pSci, SCI_STYLECLEARALL, 0, 0) ' 将全局样式复制到所有其他样式 '行号宽度 tStr = "_9" Dim nPixels As Long = SciMsg(pSci, SCI_TEXTWIDTH, 0, Cast(lParam, @tStr)) SciMsg(pSci, SCI_SETMARGINWIDTHN, 0, nPixels) ' 书签 SciMsg(pSci, SCI_SETMARGINWIDTHN, 1, 2) '行号颜色 SciMsg(pSci, SCI_SETMARGINTYPEN, 0, SC_MARGIN_NUMBER) SciMsg(pSci, SCI_STYLESETFORE, STYLE_LINENUMBER, 窗体文字) SciMsg(pSci, SCI_STYLESETBACK, STYLE_LINENUMBER, 窗体亮度15) '' TABS 作为空格处理 SciMsg(pSci, SCI_SETUSETABS, CTRUE, 0) '' TAB 宽度 SciMsg(pSci, SCI_SETTABWIDTH, 3, 0) SciMsg(pSci, SCI_SETINDENT, 3, 0) ' 显示缩进参考线 SciMsg(pSci, SCI_SETINDENTATIONGUIDES, CTRUE, 0) '' 当前行颜色 SciMsg(pSci, SCI_SETCARETLINEBACK, 窗体亮度10, 0) SciMsg(pSci, SCI_SETHOTSPOTACTIVEUNDERLINE, CTRUE, 0) '允许 ''' 选择颜色 'SciMsg(pSci, SCI_SETSELFORE, CTRUE, op.Themes(0).colors(CLR_SELECTION).nFg) 'SciMsg(pSci, SCI_SETSELBACK, CTRUE, op.Themes(0).colors(CLR_SELECTION).nBg) 'SciMsg(pSci, SCI_SETHOTSPOTACTIVEUNDERLINE, CTRUE, 0) '允许 '' 始终保持插入符号行可见 SciMsg(pSci, SCI_SETCARETLINEVISIBLEALWAYS, CTRUE, 0) '' 标识要在单词中使用的字符 tStr = "&~_abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" SciMsg(pSci, SCI_SETWORDCHARS, 0, Cast(lParam, @tStr)) '为了在编辑器中显示，utf8或utf16将被转换为utf8。 SciMsg(pSci, SCI_SETCODEPAGE, SC_CP_UTF8, 0) 'SciMsg(pSci, SCI_SETSCROLLWIDTHTRACKING, True, 0) '滚动宽度跟踪，则调整滚动宽度以确保当前显示的所有行都可以完全滚动。 SciMsg(pSci, SCI_SETSCROLLWIDTH, 10000, 10000) SciMsg(pSci, SCI_SETVSCROLLBAR, 0, 0) SciMsg(pSci, SCI_SETHSCROLLBAR, 0, 0) SciMsg(pSci, SCI_SETLEXER, SCLEX_VB, 0) '设置FreeBASIC关键字 If Len(FreeBASIC关键字)=0 Then FreeBASIC关键字 = "abs abstract access acos add alias allocate alpha and and and andalso any append as asc asin asm assert assertwarn atan2 atn bload bsave base bin " FreeBASIC关键字 &= "binary bit bitreset bitset byref byval byref byte callocate cbyte cdbl cint clng clngint cptr cshort csign csng cubyte cuint culng culngint cushort " FreeBASIC关键字 &= "cunsg cvd cvi cvl cvlongint cvs cvshort call case cast chdir chain chartoutf chr circle class clear close cls color command common condbroadcast " FreeBASIC关键字 &= "condcreate conddestroy condsignal condwait const const const constructor constructor continue cos csrlin curdir custom data date dateadd datediff " FreeBASIC关键字 &= "datepart dateserial datevalue day deallocate declare defbyte defdbl defint deflng defshort defsng defstr defubyte defuint defushort deflongint defulongint " FreeBASIC关键字 &= "delete destructor destructor dim dir do double draw draw dylibfree dylibload dylibsymbol eof else elseif encoding end end end if endif enum...end " FreeBASIC关键字 &= "environ eqv eqv erase erfn erl ermn error event exepath exec exit exp export extends extern field fileattr filecopy filedatetime fileexists filelen " FreeBASIC关键字 &= "fix flip for for format frac fre freefile function function get getjoystick getkey getmouse gosub goto hex hibyte hiword hour iif if imageconvertrow " FreeBASIC关键字 &= "imagecreate imagedestroy imp imp implements import instr instrrev inkey inp input int integer is isdate isredirected kill lbound lcase loc lof lprint " FreeBASIC关键字 &= "lset ltrim left len let let lib line lobyte loword locate lock log long longint loop lpos mkd mki mkl mklongint mks mkshort mid mid minute mkdir " FreeBASIC关键字 &= "mod mod month monthname multikey mutexcreate mutexdestroy mutexlock mutexunlock naked name namespace new next next not now object oct offsetof on " FreeBASIC关键字 &= "once open operator option or orelse out output overload override pcopy pmap preset pset pset paint palette peek placement point pointcoord pointer " FreeBASIC关键字 &= "poke pos preserve print print print private private: procptr property protected: ptr public put put rgb rgba rset rtrim random randomize redim read " FreeBASIC关键字 &= "reallocate rem reset restore resume return right rmdir rnd run sadd scope screen screencontrol screencopy screenevent screenglproc screeninfo screenlist " FreeBASIC关键字 &= "screenlock screenptr screenres screenset screensync screenunlock second seek seek select setdate setenviron setmouse settime sgn shared shell shl " FreeBASIC关键字 &= "shl short shr shr sin single sizeof sleep space spc sqr static static step step stick stop str strptr strig string sub sub swap system tab tan then " FreeBASIC关键字 &= "this threadcreate threadwait threadcall threaddetach time timeserial timevalue timer to trans trim type typeof ubound ubyte ucase uinteger ulong " FreeBASIC关键字 &= "ulongint ushort union unlock unsigned until using val valint vallng valuint valulng var varptr view virtual wbin wchr whex woct wspace wstr wstring " FreeBASIC关键字 &= "wait weekday weekdayname wend while width window windowtitle winput with write wstring xor year zstring cdecl defined pascal stdcall va_arg va_first " FreeBASIC关键字 &= "va_next " End If 'If Len(op.FBKeywordsC) Then SciMsg(pSci, SCI_SETKEYWORDS, 0, Cast(lParam, StrPtr(FreeBASIC关键字))) 'End If 'If Len(op.APIKeywordsC) Then ' SciMsg(pSci, SCI_SETKEYWORDS, 1, Cast(lParam, StrPtr(op.APIKeywordsC))) 'End If '设置多行注释样式 SciMsg(pSci, SCI_STYLESETFORE, SCE_B_MULTILINECOMMENT, BGR(77, 153, 0)) 'SciMsg(pSci, SCI_STYLESETBACK, SCE_B_MULTILINECOMMENT, op.Themes(0).colors(CLR_COMMENTS).nBg) '设置注释样式 SciMsg(pSci, SCI_STYLESETFORE, SCE_B_COMMENT, BGR(77, 153, 0)) 'SciMsg(pSci, SCI_STYLESETBACK, SCE_B_COMMENT, op.Themes(0).colors(CLR_COMMENTS).nBg) '设置关键字样式 SciMsg(pSci, SCI_STYLESETFORE, SCE_B_KEYWORD, BGR(0, 0, 229)) 'SciMsg(pSci, SCI_STYLESETBACK, SCE_B_KEYWORD, op.Themes(0).colors(CLR_KEYWORD).nBg) '设置标识符样式 'SciMsg(pSci, SCI_STYLESETBACK, SCE_B_IDENTIFIER, op.Themes(0).colors(CLR_TEXT).nBg) '设置数字样式 SciMsg(pSci, SCI_STYLESETFORE, SCE_B_NUMBER, BGR(0, 178, 178)) 'SciMsg(pSci, SCI_STYLESETBACK, SCE_B_NUMBER, op.Themes(0).colors(CLR_TEXT).nBg) '设置运算符样式 SciMsg(pSci, SCI_STYLESETFORE, SCE_B_OPERATOR, BGR(178, 0, 178)) 'SciMsg(pSci, SCI_STYLESETBACK, SCE_B_OPERATOR, op.Themes(0).colors(CLR_OPERATORS).nBg) '设置预处理样式 SciMsg(pSci, SCI_STYLESETFORE, SCE_B_PREPROCESSOR, BGR(102, 0, 204)) 'SciMsg(pSci, SCI_STYLESETBACK, SCE_B_PREPROCESSOR, op.Themes(0).colors(CLR_PREPROCESSOR).nBg) '设置字符串样式 SciMsg(pSci, SCI_STYLESETFORE, SCE_B_STRING, BGR(178, 0, 89)) 'SciMsg(pSci, SCI_STYLESETBACK, SCE_B_STRING, op.Themes(0).colors(CLR_STRINGS).nBg)