最近需要用一个IP输入控件，网上找了几个，都不符合效果，有些还有一些奇怪的Bug。后来发现原来系统已经提供了IP地址编辑控件，只是系统提供的控件不能设置只读效果。网上找了下资料，封装了一下，自己迂回一下实现了只读效果。

源码下载

  1. unit ueIPEdit;
  2. interface
  3. uses
  4. System.SysUtils, System.Classes, Vcl.Controls, Winapi.Windows, Winapi.Messages,
  5. Vcl.ComCtrls, Winapi.CommCtrl;
  6. type
  7. TFieldChangeEvent = procedure(Sender: TObject; OldField, OldValue: Byte) of object;
  8. TUeIPEdit = class(TWinControl)
  9. private
  10. FState: Integer; //Internal use
  11. FBakIP: Longint; //Internal use
  12. FMinIP: Longint;
  13. FMaxIP: Longint;
  14. FOnChange: TNotifyEvent;
  15. FOnFieldChange: TFieldChangeEvent;
  16. procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
  17. procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  18. protected
  19. procedure CreateParams(var Params: TCreateParams); override;
  20. function  GetMinIP: String;
  21. function  GetMaxIP: String;
  22. procedure SetMinIP(const Value: String);
  23. procedure SetMaxIP(const Value: String);
  24. procedure UpdateRange;
  25. function  GetIP: String;
  26. procedure SetIP(const Value: String);
  27. function  GetEmpty: Boolean;
  28. function GetReadOnly: Boolean;
  29. procedure SetReadOnly(Value: Boolean);
  30. function IPToString(const AIp: Longint): String;
  31. function StringToIP(const Value: String): Longint;
  32. public
  33. constructor Create(AOwner: TComponent); override;
  34. procedure Clear;
  35. procedure SetActiveField(const Value: Integer);
  36. property Empty: Boolean read GetEmpty;
  37. property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
  38. property IP: String read GetIP write SetIP;
  39. property MinIP: String read GetMinIP write SetMinIP;
  40. property MaxIP: String read GetMaxIP write SetMaxIP;
  41. property OnChange: TNotifyEvent read FOnChange write FOnChange;
  42. property OnIPFieldChange: TFieldChangeEvent read FOnFieldChange write FOnFieldChange;
  43. property Font;
  44. property ParentColor;
  45. property ParentFont;
  46. property ParentShowHint;
  47. property PopupMenu;
  48. property ShowHint;
  49. property TabOrder;
  50. property TabStop;
  51. property Tag;
  52. property DragCursor;
  53. property DragMode;
  54. property HelpContext;
  55. end;
  56. implementation
  57. uses Vcl.Graphics;
  58. constructor TUeIPEdit.Create(AOwner: TComponent);
  59. const
  60. EditStyle = [csClickEvents, csSetCaption, csDoubleClicks, csFixedHeight, csPannable];
  61. begin
  62. inherited Create(AOwner);
  63. if NewStyleControls then
  64. ControlStyle := EditStyle else
  65. ControlStyle := EditStyle + [csFramed];
  66. ParentColor := False;
  67. Color := clWindow;
  68. Width:= 130;
  69. Height:= 20;
  70. TabStop:= True;
  71. FState := 0;
  72. FBakIP := -1;
  73. FMinIP:= 0;
  74. FMaxIP:= $0FFFFFFFF;
  75. FOnChange:= nil;
  76. FOnFieldChange:= nil;
  77. end;
  78. procedure TUeIPEdit.CreateParams(var Params: TCreateParams);
  79. begin
  80. InitCommonControl(ICC_INTERNET_CLASSES);
  81. inherited CreateParams(Params);
  82. CreateSubClass(Params, WC_IPADDRESS);
  83. with Params do
  84. begin
  85. Style := WS_VISIBLE or WS_BORDER or WS_CHILD;
  86. if NewStyleControls and Ctl3D then
  87. begin
  88. Style := Style and not WS_BORDER;
  89. ExStyle := ExStyle or WS_EX_CLIENTEDGE;
  90. end;
  91. end;
  92. end;
  93. procedure TUeIPEdit.CNNotify(var Message: TWMNotify);
  94. begin
  95. if (FState=0) and Assigned(FOnFieldChange) and
  96. (Message.NMHdr^.code=IPN_FIELDCHANGED) then
  97. FOnFieldChange(Self, PNMIPAddress(Message.NMHdr)^.iField,
  98. PNMIPAddress(Message.NMHdr)^.iValue);
  99. end;
  100. procedure TUeIPEdit.CNCommand(var Message: TWMCommand);
  101. begin
  102. if (Message.NotifyCode = EN_CHANGE) then
  103. begin
  104. case FState of
  105. 0: if Assigned(FOnChange) then FOnChange(Self);
  106. 1: begin
  107. FState := 2;
  108. PostMessage(Handle, IPM_SETADDRESS, 0, FBakIP);
  109. end;
  110. 2: FState := 1;
  111. end;
  112. end;
  113. end;
  114. function TUeIPEdit.IPToString(const AIp: Longint): String;
  115. begin
  116. Result:= Format('%d.%d.%d.%d',[FIRST_IPADDRESS(AIp),SECOND_IPADDRESS(AIp),
  117. THIRD_IPADDRESS(AIp),FOURTH_IPADDRESS(AIp)]);
  118. end;
  119. function TUeIPEdit.StringToIp(const Value: String): Longint;
  120. var
  121. B: array[0..3] of Byte;
  122. Strs: TArray<string>;
  123. i, Cnt : Integer;
  124. begin
  125. B[0]:= 0;
  126. B[1]:= 0;
  127. B[2]:= 0;
  128. B[3]:= 0;
  129. if Value<>'' then
  130. begin
  131. Strs := Value.Split(['.'],TStringSplitOptions.ExcludeEmpty);
  132. try
  133. Cnt := Length(Strs);
  134. if Cnt>4 then Cnt := 4;
  135. for i := 0 to Cnt-1 do
  136. B[i] := StrToInt(Strs[i]);
  137. finally
  138. Strs := nil;
  139. end;
  140. end;
  141. Result:= MakeIPAddress(b[0], b[1], b[2], b[3]);
  142. end;
  143. function TUeIPEdit.GetIP: String;
  144. var
  145. AIp: Longint;
  146. begin
  147. SendMessage(Handle, IPM_GETADDRESS, 0, Longint(@AIp));
  148. Result:= IPToString(AIp);
  149. end;
  150. procedure TUeIPEdit.SetIP(const Value: String);
  151. begin
  152. SendMessage(Handle, IPM_SETADDRESS, 0, StringToIp(Value));
  153. end;
  154. function TUeIPEdit.GetMinIP: String;
  155. begin
  156. Result:= IPToString(FMinIP);
  157. end;
  158. procedure TUeIPEdit.SetMinIP(const Value: String);
  159. var
  160. AMin: LongInt;
  161. begin
  162. AMin := StringToIp(Value);
  163. if FMinIP<>AMin then
  164. begin
  165. FMinIP := AMin;
  166. UpdateRange;
  167. end;
  168. end;
  169. procedure TUeIPEdit.UpdateRange;
  170. begin
  171. SendMessage(Handle, IPM_SETRANGE, 0, MAKEIPRANGE(FIRST_IPADDRESS(FMinIP), FIRST_IPADDRESS(FMaxIP)));
  172. SendMessage(Handle, IPM_SETRANGE, 1, MAKEIPRANGE(SECOND_IPADDRESS(FMinIP), SECOND_IPADDRESS(FMaxIP)));
  173. SendMessage(Handle, IPM_SETRANGE, 2, MAKEIPRANGE(THIRD_IPADDRESS(FMinIP), THIRD_IPADDRESS(FMaxIP)));
  174. SendMessage(Handle, IPM_SETRANGE, 3, MAKEIPRANGE(FOURTH_IPADDRESS(FMinIP), FOURTH_IPADDRESS(FMaxIP)));
  175. end;
  176. procedure TUeIPEdit.SetMaxIP(const Value: String);
  177. var
  178. AMax: LongInt;
  179. begin
  180. AMax := StringToIp(Value);
  181. if FMaxIP<>AMax then
  182. begin
  183. FMaxIP := AMax;
  184. UpdateRange;
  185. end;
  186. end;
  187. function TUeIPEdit.GetMaxIP: String;
  188. begin
  189. Result:= IPToString(FMaxIP);
  190. end;
  191. function TUeIPEdit.GetReadOnly: Boolean;
  192. begin
  193. Result := FState<>0;
  194. end;
  195. procedure TUeIPEdit.SetReadOnly(Value: Boolean);
  196. begin
  197. if Value <> GetReadOnly then
  198. begin
  199. if Value then
  200. begin
  201. SendMessage(Handle, IPM_GETADDRESS, 0, Longint(@FBakIP));
  202. FState := 1;
  203. end else begin
  204. FState := 0;
  205. end;
  206. end;
  207. end;
  208. function TUeIPEdit.GetEmpty: Boolean;
  209. begin
  210. Result:= Boolean(SendMessage(Handle, IPM_ISBLANK, 0, 0));
  211. end;
  212. procedure TUeIPEdit.Clear;
  213. begin
  214. SendMessage(Handle, IPM_CLEARADDRESS, 0, 0);
  215. end;
  216. procedure TUeIPEdit.SetActiveField(const Value: Integer);
  217. begin
  218. if (Value < 4) then
  219. begin
  220. SendMessage(Handle, IPM_SETFOCUS, wParam(Value), 0);
  221. end;
  222. end;
  223. end.

http://blog.csdn.net/tht2009/article/details/50623816

IP编辑控件（因为封装的是系统自带控件，所以也使用了CreateSubClass，不过为啥要封装CN_COMMAND和CN_NOTIFY不是很明白）的更多相关文章

  1. 基于wke封装的duilib的webkit浏览器控件，可以c++与js互交，源码及demo下载地址

    转载请说明原出处,谢谢~~ 前些日子用wke内核封装了duilib的webkit浏览器控件,好多群里朋友私聊我希望可以我公布源码,今天把这个控件的源码和使用demo公布.其实这个控件封装起来没什么难度 ...

  2. 示例：WPF中Slider控件封装的缓冲播放进度条控件

    原文:示例:WPF中Slider控件封装的缓冲播放进度条控件 一.目的:模仿播放器播放进度条,支持缓冲任务功能 二.进度: 实现类似播放器中带缓存的播放样式(播放区域.缓冲区域.全部区域等样式) 实现 ...

  3. 使用 WebView2 封装一个生成 PDF 的 WPF 控件

    使用 WebView2 封装一个生成 PDF 的 WPF 控件 最近在迁移项目到 .net6,发现项目中用的 PDF 库不支持 .net6,于是想着换一个库.结果找了一大圈,发现不是版本不支持,就是收 ...

  4. Winform----自定义控件之半透明遮罩（蒙版遮盖指定控件）

    先贴运行效果图,源码点击这里下载 1.新建自定义控件 2.实现功能   namespace UserControlLib   {   [ToolboxBitmap(typeof(ZhLoading)) ...

  5. 《ASP.NET1200例》解决母版页报错“内容控件必须是内容页中的顶级控件，或是引用母版页的嵌套母版页。”

    VS2005下,添加了母版页这个控件,我们可以讲N个页面中共同的部分放在母版页来实现,并让WEB窗体集成自我们的母版页,就可以让我们的站点具有统一的风格了.在VS2005SP1之前的版本中,我们只能创 ...

  6. <Win32_14>__win32控件(2)__教你自学掌握所有控件的玩法

    学习win32 API 编程,我们应该善于利用微软给我们提供的一些辅助工具,例如大家都知道的MSDN.SPY++等等. 今天在讲述之前呢,先给大家介绍一个很有用的工具——Control Spy——它的 ...

  7. android 给LinearLayout中添加一定数量的控件，并让着一定数量的控件从右到左移动，每隔若干秒停顿一下，最后一个view链接第一个view，然后继续移动循环往复，形成一个死循环简单动画效果

    主类:IndexAnimationLinearLayout.java package com.yw.sortlistview; import java.util.ArrayList; import j ...

  8. FileUpload控件实现单按钮图片自动上传并带预览显示

    FileUpload控件实现单按钮图片自动上传并带预览显示 1.实现原理:   FileUpload控件默认不支持服务端的ONCHANGE事件,此时用一种变通的方法借用客户端的onchange事件,调 ...

  9. Android系统UI交互控件Action Bar初探

    过年期间,Google正式宣布取消Android系统中MENU键的使用,也就是基于Android 4.0系统的手机都应没有MENU这一固定按键.这无疑是个变革性的改动,在我眼中,这似乎把Android ...

随机推荐

  1. [LeetCode]题解（python）：027-Remove Element

    题目来源: https://leetcode.com/problems/remove-element/ 题意分析: 给定一个数组和一个数值val,将数组中数值等于val的数去除.不能申请额外空间,超过 ...

  2. JQuery 实现返回顶部效果

    首先要里了解一下几个知识 $(window).scrollTop() ---滚动条距顶部距离 fadeIn() 方法使用淡入效果来显示被选元素,假如该元素是隐藏的. fadeOut() 方法使用淡出效 ...

  3. 查找最小的k个元素

    题目:输入n个整数,输出其中最小的k个. 例如输入1,2,3,4,5,6,7和8这8个数字,则最小的4个数字为1,2,3和4. 两种思路,无非就是时间与空间的妥协. 限制空间的时候要对原数组进行排序, ...

  4. HDFS写入和读取流程

    HDFS写入和读取流程 一.HDFS HDFS全称是Hadoop Distributed System.HDFS是为以流的方式存取大文件而设计的.适用于几百MB,GB以及TB,并写一次读多次的场合.而 ...

  5. VC++中的DDX和DDV

    DDX/DDV    通过使用ClassWizard向对话类添加成员变量,你可以利用ClassWizard所提供的高效特征,为对话数据交换和对话数据验证自动生成源代码,也就是人们所熟知的DDX/DDV ...

  6. Maven--几个需要补充的问题（三）

    <Maven--搭建开发环境(一)> <Maven--构建企业级仓库(二)> <Maven—几个需要补充的问题(三)> 前两篇由于篇幅太长,为了给读者理解方便,这篇 ...

  7. X Window System介绍

    1.概述     X Window System是1984年由麻省理工学院(MIT)和DEC公司共同开发研究的,是执行在UNIX系统上的视窗系统.严格地说,X Window System并非一个软件, ...

  8. 案例分析：java中substring引发的Full gc

    问题定位 由于应用频繁地Full gc,就dump了内存下来用MAT分析,发现有个map占用了98%的内存,于是找到这个map private ConcurrentMap<String, Str ...

  9. Word中使用代码高亮插件

    Word中使用代码高亮插件 1.下载并安装:SyntaxHighlighter4Word.zip 解压,然后双击bin\word2010\Kong.SyntaxHighlighter.Word2010 ...

  10. ubuntu安装greenplum依赖包

    ubuntu安装greenplum的过程中有两个比较难找的包,特地写出来给大家分享一下: 错误提示1:configure: error: header file <ldap.h> is r ...