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

最近需要用一个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