RealICQUserCardMore.pas 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422
  1. unit RealICQUserCardMore;
  2. interface
  3. uses
  4. SysUtils, Classes, Controls, ExtCtrls, StdCtrls, Graphics, Forms,ShellAPI, Windows,
  5. RealICQUIColor, RealICQColors, RealICQRoundBorderPanel, RealICQModel;
  6. type
  7. TRealICQUserCardMore = class(TRealICQRoundBorderPanel)
  8. private
  9. FEdPos,
  10. FEdTrueName,
  11. FEdCompany,
  12. FEdBranch,
  13. FEdDuty,
  14. FEdTel,
  15. FEdMobile,
  16. FEdShortMobile,
  17. FEdEmail: TEdit;
  18. FLblCompany,
  19. FLblBranch,
  20. FLblDuty,
  21. FLblTel,
  22. FLblMobile,
  23. FLblShortMobile,
  24. FLblEmail: TLabel;
  25. FShowMore: Boolean;
  26. FIsSecret: Boolean;
  27. FProductType: TRealICQProductType;
  28. FUserType: TRealICQUserType;
  29. FRealICQUser: TRealICQUser;
  30. procedure SetControl(LB: TLabel; ED: TEdit; Value: String);
  31. procedure SetCaption;
  32. procedure Caption_Default;
  33. procedure Caption_NXSQ;
  34. procedure Caption_LBZQ;
  35. procedure SetContent;
  36. procedure Content_Default;
  37. procedure Content_NXSQ;
  38. procedure Content_LBZQ;
  39. procedure SetRealICQUser(Value: TRealICQUser);
  40. function GetCopyRight: String;
  41. public
  42. constructor Create(AOwner: TComponent); override;
  43. destructor Destroy; override;
  44. procedure ChangeUIColor(AColor: TColor);
  45. property ProductType: TRealICQProductType read FProductType write FProductType;
  46. property IsSecret: Boolean read FIsSecret write FIsSecret;
  47. property RealICQUser: TRealICQUser read FRealICQUser write SetRealICQUser;
  48. published
  49. property CopyRight: String read GetCopyRight;
  50. property Font;
  51. property Align;
  52. property Anchors;
  53. end;
  54. procedure Register;
  55. implementation
  56. var
  57. IsInit: Boolean;
  58. VS, HS: Integer;
  59. function TRealICQUserCardMore.GetCopyRight: String;
  60. begin
  61. Result := '版权所有(C) 2002-2016 浙江万赛软件科技有限公司 保留所有权利。';
  62. end;
  63. constructor TRealICQUserCardMore.Create(AOwner: TComponent);
  64. var
  65. i: Integer;
  66. begin
  67. inherited Create(AOwner);
  68. DoubleBuffered := True;
  69. BevelInner := bvNone;
  70. BevelOuter := bvNone;
  71. ParentColor := True;
  72. //放置光标
  73. FEdPos := TEdit.Create(Self);
  74. FEdPos.BorderStyle := bsNone;
  75. FEdPos.Font := Font;
  76. FEdPos.Font.Size := 9;
  77. FEdPos.Left := -9;
  78. FEdPos.Top := -9;
  79. FEdPos.Width := 9;
  80. FEdPos.Height := 9;
  81. Width := 96;
  82. VS := 5;
  83. HS := 3;
  84. FEdTrueName := TEdit.Create(Self);
  85. FEdTrueName.BorderStyle := bsNone;
  86. FEdTrueName.Font := Font;
  87. FEdTrueName.Font.Color := clBlack;
  88. FEdTrueName.Font.Size := 9;
  89. FEdTrueName.Font.Style := [fsBold];
  90. FEdTrueName.Anchors := [akLeft, akTop, akRight];
  91. FEdTrueName.AutoSize:= True;
  92. FEdTrueName.ReadOnly := True;
  93. FEdTrueName.ShowHint := True;
  94. FEdTrueName.ParentColor := True;
  95. FEdTrueName.Color := BackColor;
  96. FEdTrueName.Left := VS;
  97. FEdTrueName.Top := HS;
  98. FEdTrueName.Width := Width - 10;
  99. HS := FEdTrueName.Height + 3;
  100. FLblCompany := TLabel.Create(Self);
  101. FEdCompany := TEdit.Create(Self);
  102. FLblBranch := TLabel.Create(Self);
  103. FEdBranch := TEdit.Create(Self);
  104. FLblDuty := TLabel.Create(Self);
  105. FEdDuty := TEdit.Create(Self);
  106. FLblTel := TLabel.Create(Self);
  107. FEdTel := TEdit.Create(Self);
  108. FLblMobile := TLabel.Create(Self);
  109. FEdMobile := TEdit.Create(Self);
  110. FLblShortMobile := TLabel.Create(Self);
  111. FEdShortMobile := TEdit.Create(Self);
  112. FLblEmail := TLabel.Create(Self);
  113. FEdEmail := TEdit.Create(Self);
  114. for i := 0 to Self.Componentcount - 1 do
  115. begin
  116. if (Self.Components[i] is TEdit) then
  117. begin
  118. (Self.Components[i] as TEdit).Parent := Self;
  119. end;
  120. if (Self.Components[i] is TLabel) then
  121. begin
  122. (Self.Components[i] as TLabel).Parent := Self;
  123. end;
  124. end;
  125. IsInit := True;
  126. FProductType := ptBGZS;
  127. FUserType := utUnknown;
  128. SetCaption;
  129. Height := HS + 3;
  130. IsInit := False;
  131. end;
  132. procedure TRealICQUserCardMore.SetControl(LB: TLabel; ED: TEdit; Value: String);
  133. begin
  134. if IsInit then
  135. begin
  136. LB.AutoSize := True;
  137. LB.Transparent := True;
  138. LB.Font := Font;
  139. LB.Font.Color := clGray;
  140. LB.Font.Size := 9;
  141. LB.Anchors := [akLeft, akTop];
  142. LB.Caption := Value;
  143. LB.Color := BackColor;
  144. LB.Left := VS;
  145. LB.Top := HS;
  146. ED.BorderStyle := bsNone;
  147. ED.Font := Font;
  148. ED.Font.Color := clBlack;
  149. ED.Font.Size := 9;
  150. ED.Anchors := [akLeft, akTop, akRight];
  151. ED.ParentColor := True;
  152. ED.Color := BackColor;
  153. ED.ReadOnly := True;
  154. ED.Left := LB.Left + LB.Width + 3;
  155. ED.Top := LB.Top;
  156. ED.Width := Width - LB.Width - 10;
  157. HS := HS + LB.Height + 6;
  158. end
  159. else
  160. begin
  161. LB.Caption := Value;
  162. ED.Left := LB.Left + LB.Width + 3;
  163. ED.Width := Width - LB.Width - 10;
  164. end;
  165. end;
  166. procedure TRealICQUserCardMore.SetCaption;
  167. begin
  168. case FProductType of
  169. ptBGZS:
  170. Caption_Default;
  171. ptNXSQ:
  172. if (FUserType = utUnknown) OR (FUserType = utCompany) then
  173. Caption_NXSQ
  174. else
  175. Caption_Default;
  176. ptLBZQ:
  177. if (FUserType = utUnknown) OR (FUserType = utCompany) then
  178. Caption_LBZQ
  179. else
  180. Caption_Default;
  181. end;
  182. end;
  183. procedure TRealICQUserCardMore.Caption_Default;
  184. begin
  185. SetControl(FLblCompany, FEdCompany, '单位:');
  186. SetControl(FLblBranch, FEdBranch, '处室:');
  187. SetControl(FLblDuty, FEdDuty, '职务:');
  188. SetControl(FLblTel, FEdTel, '电话:');
  189. SetControl(FLblMobile, FEdMobile, '手机:');
  190. SetControl(FLblShortMobile, FEdShortMobile, '短号:');
  191. SetControl(FLblEmail, FEdEmail, '邮箱:');
  192. end;
  193. procedure TRealICQUserCardMore.Caption_NXSQ;
  194. begin
  195. SetControl(FLblCompany, FEdCompany, '代码:');
  196. SetControl(FLblBranch, FEdBranch, '行业:'); //Industry
  197. SetControl(FLblDuty, FEdDuty, '主管:'); //TaxOffices
  198. SetControl(FLblTel, FEdTel, '涉税:'); //TaxAgent
  199. SetControl(FLblMobile, FEdMobile, '办公:'); //OfficePhone
  200. SetControl(FLblShortMobile, FEdShortMobile, '财务:'); //FinancialPhone
  201. SetControl(FLblEmail, FEdEmail, '法人:'); //LegalPersonPhone
  202. end;
  203. procedure TRealICQUserCardMore.Caption_LBZQ;
  204. begin
  205. SetControl(FLblCompany, FEdCompany, '代码:');
  206. SetControl(FLblBranch, FEdBranch, '行业:'); //Industry
  207. SetControl(FLblDuty, FEdDuty, '主管:'); //TaxOffices
  208. SetControl(FLblTel, FEdTel, '联络:'); //TaxAgent
  209. SetControl(FLblMobile, FEdMobile, '办公:'); //OfficePhone
  210. SetControl(FLblShortMobile, FEdShortMobile, '财务:'); //FinancialPhone
  211. SetControl(FLblEmail, FEdEmail, '法人:'); //LegalPersonPhone
  212. end;
  213. procedure TRealICQUserCardMore.SetContent;
  214. begin
  215. case FProductType of
  216. ptBGZS:
  217. Content_Default;
  218. ptNXSQ:
  219. if (FUserType = utUnknown) OR (FUserType = utCompany) then
  220. Content_NXSQ
  221. else
  222. Content_Default;
  223. ptLBZQ:
  224. if (FUserType = utUnknown) OR (FUserType = utCompany) then
  225. Content_LBZQ
  226. else
  227. Content_Default;
  228. end;
  229. end;
  230. procedure TRealICQUserCardMore.Content_Default;
  231. begin
  232. FEdBranch.ShowHint := False;
  233. FEdDuty.ShowHint := False;
  234. FEdEmail.ShowHint := True;
  235. if Trim(FRealICQUser.TrueName) = '' then
  236. FEdTrueName.Text := FRealICQUser.DisplayName
  237. else
  238. FEdTrueName.Text := FRealICQUser.TrueName;
  239. FEdTrueName.ShowHint := True;
  240. FEdTrueName.Hint := FEdTrueName.Text;
  241. FEdCompany.Text := FRealICQUser.Company;
  242. FEdBranch.Text := FRealICQUser.Branch;
  243. FEdDuty.Text := FRealICQUser.Duty;
  244. if FIsSecret then
  245. begin
  246. FEdTel.Text := FRealICQUser.Tel;
  247. FEdMobile.Text := FRealICQUser.Mobile;
  248. FEdShortMobile.Text := FRealICQUser.ShortMobile;
  249. FEdEmail.Text := FRealICQUser.Email;
  250. FEdEmail.Hint := FEdEmail.Text;
  251. end
  252. else
  253. begin
  254. FEdEmail.ShowHint := False;
  255. if Trim(FEdTel.Text) <> '' then FEdTel.Text :='******';
  256. if Trim(FEdMobile.Text) <> '' then FEdMobile.Text := '******';
  257. if Trim(FEdShortMobile.Text) <> '' then FEdShortMobile.Text := '******';
  258. if Trim(FEdEmail.Text) <> '' then FEdEmail.Text := '******';
  259. end;
  260. end;
  261. procedure TRealICQUserCardMore.Content_NXSQ;
  262. begin
  263. FEdBranch.ShowHint := True;
  264. FEdDuty.ShowHint := True;
  265. FEdEmail.ShowHint := False;
  266. if Trim(FRealICQUser.Enterprise) = '' then
  267. FEdTrueName.Text := FRealICQUser.DisplayName
  268. else
  269. FEdTrueName.Text := FRealICQUser.Enterprise;
  270. FEdTrueName.ShowHint := True;
  271. FEdTrueName.Hint := FEdTrueName.Text;
  272. FEdCompany.Text := FRealICQUser.SocialCreditCode;
  273. FEdBranch.Text := FRealICQUser.Industry;
  274. FEdBranch.Hint := FEdBranch.Text;
  275. FEdDuty.Text := FRealICQUser.TaxOffices;
  276. FEdDuty.Hint := FEdDuty.Text;
  277. if FIsSecret then
  278. begin
  279. FEdTel.Text := FRealICQUser.TaxAgent;
  280. FEdMobile.Text := FRealICQUser.OfficePhone;
  281. FEdShortMobile.Text := FRealICQUser.FinancialPhone;
  282. FEdEmail.Text := FRealICQUser.LegalPersonPhone;
  283. end
  284. else
  285. begin
  286. if Trim(FEdTel.Text) <> '' then FEdTel.Text := '******';
  287. if Trim(FEdMobile.Text) <> '' then FEdMobile.Text := '******';
  288. if Trim(FEdShortMobile.Text) <> '' then FEdShortMobile.Text := '******';
  289. if Trim(FEdEmail.Text) <> '' then FEdEmail.Text := '******';
  290. end;
  291. end;
  292. procedure TRealICQUserCardMore.Content_LBZQ;
  293. begin
  294. FEdBranch.ShowHint := True;
  295. FEdDuty.ShowHint := True;
  296. FEdEmail.ShowHint := False;
  297. if Trim(FRealICQUser.Enterprise) = '' then
  298. FEdTrueName.Text := FRealICQUser.DisplayName
  299. else
  300. FEdTrueName.Text := FRealICQUser.Enterprise;
  301. FEdTrueName.Hint := FEdTrueName.Text;
  302. FEdCompany.Text := FRealICQUser.SocialCreditCode;
  303. FEdBranch.Text := FRealICQUser.Industry;
  304. FEdBranch.Hint := FEdBranch.Text;
  305. FEdDuty.Text := FRealICQUser.TaxOffices;
  306. FEdDuty.Hint := FEdDuty.Text;
  307. if FIsSecret then
  308. begin
  309. FEdTel.Text := FRealICQUser.TaxAgent;
  310. FEdMobile.Text := FRealICQUser.OfficePhone;
  311. FEdShortMobile.Text := FRealICQUser.FinancialPhone;
  312. FEdEmail.Text := FRealICQUser.LegalPersonPhone;
  313. end
  314. else
  315. begin
  316. if Trim(FEdTel.Text) <> '' then FEdTel.Text := '******';
  317. if Trim(FEdMobile.Text) <> '' then FEdMobile.Text := '******';
  318. if Trim(FEdShortMobile.Text) <> '' then FEdShortMobile.Text := '******';
  319. if Trim(FEdEmail.Text) <> '' then FEdEmail.Text := '******';
  320. end;
  321. end;
  322. procedure TRealICQUserCardMore.SetRealICQUser(Value: TRealICQUser);
  323. begin
  324. FRealICQUser := Value;
  325. if Assigned(FRealICQUser) then
  326. begin
  327. if FUserType <> FRealICQUser.UserType then
  328. begin
  329. FUserType := FRealICQUser.UserType;
  330. SetCaption;
  331. end;
  332. SetContent;
  333. end;
  334. end;
  335. procedure TRealICQUserCardMore.ChangeUIColor(AColor: TColor);
  336. var
  337. i: Integer;
  338. begin
  339. inherited ChangeUIColor(AColor);
  340. BackColor := AColor;
  341. BorderColor := AColor;
  342. for i := 0 to Self.Componentcount - 1 do
  343. begin
  344. if Self.Components[i] is TEdit then
  345. begin
  346. (Self.Components[i] as TEdit).Color := AColor;
  347. end;
  348. end;
  349. end;
  350. destructor TRealICQUserCardMore.Destroy;
  351. begin
  352. try
  353. FreeAndNil(FEdTrueName);
  354. FreeAndNil(FEdBranch);
  355. FreeAndNil(FEdDuty);
  356. FreeAndNil(FEdCompany);
  357. FreeAndNil(FEdTel);
  358. FreeAndNil(FEdMobile);
  359. FreeAndNil(FEdShortMobile);
  360. FreeAndNil(FEdEmail);
  361. FreeAndNil(FLblBranch);
  362. FreeAndNil(FLblDuty);
  363. FreeAndNil(FLblCompany);
  364. FreeAndNil(FLblTel);
  365. FreeAndNil(FLblMobile);
  366. FreeAndNil(FLblShortMobile);
  367. FreeAndNil(FLblEmail);
  368. except
  369. end;
  370. inherited Destroy;
  371. end;
  372. procedure Register;
  373. begin
  374. RegisterComponents('RealICQ UI', [TRealICQUserCardMore]);
  375. end;
  376. end.