unit RealICQUserCard; interface uses SysUtils, Classes, Controls, ExtCtrls, StdCtrls, Graphics, Forms,ShellAPI, Windows, RealICQUIColor, RealICQColors, RealICQRoundBorderPanel, RealICQModel; type TRealICQUserCard = class(TRealICQRoundBorderPanel) private FEdPos, FEdTrueName, FEdBranch, FEdDuty, FEdTel, FEdMobile, FEdShortMobile, FEdEmail: TEdit; FLblBranch, FLblDuty, FLblTel, FLblMobile, FLblShortMobile, FLblEmail: TLabel; FIsSecret: Boolean; FProductType: TRealICQProductType; FUserType: TRealICQUserType; FRealICQUser: TRealICQUser; procedure SetControl(LB: TLabel; ED: TEdit; Value: String); procedure SetCaption; procedure Caption_Default; procedure Caption_NXSQ; procedure Caption_LBZQ; procedure SetContent; procedure Content_Default; procedure Content_NXSQ; procedure Content_LBZQ; procedure SetRealICQUser(Value: TRealICQUser); function GetCopyRight: String; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure ChangeUIColor(AColor: TColor); property ProductType: TRealICQProductType read FProductType write FProductType; property IsSecret: Boolean read FIsSecret write FIsSecret; property RealICQUser: TRealICQUser read FRealICQUser write SetRealICQUser; published property CopyRight: String read GetCopyRight; property Font; property Align; property Anchors; end; procedure Register; implementation var IsInit: Boolean; VS, HS: Integer; function TRealICQUserCard.GetCopyRight: String; begin Result := '版权所有(C) 2002-2016 浙江万赛软件科技有限公司 保留所有权利。'; end; constructor TRealICQUserCard.Create(AOwner: TComponent); var i: Integer; begin inherited Create(AOwner); DoubleBuffered := True; BevelInner := bvNone; BevelOuter := bvNone; ParentColor := True; //放置光标 FEdPos := TEdit.Create(Self); FEdPos.BorderStyle := bsNone; FEdPos.Font := Font; FEdPos.Font.Size := 9; FEdPos.Left := -9; FEdPos.Top := -9; FEdPos.Width := 9; FEdPos.Height := 9; Width := 96; VS := 5; HS := 3; FEdTrueName := TEdit.Create(Self); FEdTrueName.BorderStyle := bsNone; FEdTrueName.Font := Font; FEdTrueName.Font.Color := clBlack; FEdTrueName.Font.Size := 9; FEdTrueName.Font.Style := [fsBold]; FEdTrueName.Anchors := [akLeft, akTop, akRight]; FEdTrueName.AutoSize:= True; FEdTrueName.ReadOnly := True; FEdTrueName.ShowHint := True; FEdTrueName.ParentColor := True; FEdTrueName.Color := BackColor; FEdTrueName.Left := VS; FEdTrueName.Top := HS; FEdTrueName.Width := Width - 10; HS := FEdTrueName.Height + 3; FLblBranch := TLabel.Create(Self); FEdBranch := TEdit.Create(Self); FLblDuty := TLabel.Create(Self); FEdDuty := TEdit.Create(Self); FLblTel := TLabel.Create(Self); FEdTel := TEdit.Create(Self); FLblMobile := TLabel.Create(Self); FEdMobile := TEdit.Create(Self); FLblShortMobile := TLabel.Create(Self); FEdShortMobile := TEdit.Create(Self); FLblEmail := TLabel.Create(Self); FEdEmail := TEdit.Create(Self); for i := 0 to Self.Componentcount - 1 do begin if (Self.Components[i] is TEdit) then begin (Self.Components[i] as TEdit).Parent := Self; end; if (Self.Components[i] is TLabel) then begin (Self.Components[i] as TLabel).Parent := Self; end; end; IsInit := True; FProductType := ptBGZS; FUserType := utUnknown; SetCaption; Height := HS + 3; IsInit := False; end; procedure TRealICQUserCard.SetControl(LB: TLabel; ED: TEdit; Value: String); begin if IsInit then begin LB.AutoSize := True; LB.Transparent := True; LB.Font := Font; LB.Font.Color := clGray; LB.Font.Size := 9; LB.Anchors := [akLeft, akTop]; LB.Caption := Value; LB.Color := BackColor; LB.Left := VS; LB.Top := HS; ED.BorderStyle := bsNone; ED.Font := Font; ED.Font.Color := clBlack; ED.Font.Size := 9; ED.Anchors := [akLeft, akTop, akRight]; ED.ParentColor := True; ED.Color := BackColor; ED.ReadOnly := True; ED.Left := LB.Left + LB.Width + 3; ED.Top := LB.Top; ED.Width := Width - LB.Width - 10; HS := HS + LB.Height + 6; end else begin LB.Caption := Value; ED.Left := LB.Left + LB.Width + 3; ED.Width := Width - LB.Width - 10; end; end; procedure TRealICQUserCard.SetCaption; begin case FProductType of ptBGZS: Caption_Default; ptNXSQ: if (FUserType = utUnknown) OR (FUserType = utCompany) then Caption_NXSQ else Caption_Default; ptLBZQ: if (FUserType = utUnknown) OR (FUserType = utCompany) then Caption_LBZQ else Caption_Default; end; end; procedure TRealICQUserCard.Caption_Default; begin SetControl(FLblBranch, FEdBranch, '处室:'); SetControl(FLblDuty, FEdDuty, '职务:'); SetControl(FLblTel, FEdTel, '电话:'); SetControl(FLblMobile, FEdMobile, '手机:'); SetControl(FLblShortMobile, FEdShortMobile, '短号:'); SetControl(FLblEmail, FEdEmail, '邮箱:'); end; procedure TRealICQUserCard.Caption_NXSQ; begin SetControl(FLblBranch, FEdBranch, '所属行业:'); //Industry SetControl(FLblDuty, FEdDuty, '主管机关:'); //TaxOffices SetControl(FLblTel, FEdTel, '涉税电话:'); //TaxAgent SetControl(FLblMobile, FEdMobile, '办公电话:'); //OfficePhone SetControl(FLblShortMobile, FEdShortMobile, '财务电话:'); //FinancialPhone SetControl(FLblEmail, FEdEmail, '法人电话:'); //LegalPersonPhone end; procedure TRealICQUserCard.Caption_LBZQ; begin SetControl(FLblBranch, FEdBranch, '所属行业:'); //Industry SetControl(FLblDuty, FEdDuty, '主管机构:'); //TaxOffices SetControl(FLblTel, FEdTel, '联 系 人 :'); //TaxAgent SetControl(FLblMobile, FEdMobile, '办公电话:'); //OfficePhone SetControl(FLblShortMobile, FEdShortMobile, '财务电话:'); //FinancialPhone SetControl(FLblEmail, FEdEmail, '法人电话:'); //LegalPersonPhone end; procedure TRealICQUserCard.SetContent; begin case FProductType of ptBGZS: Content_Default; ptNXSQ: if (FUserType = utUnknown) OR (FUserType = utCompany) then Content_NXSQ else Content_Default; ptLBZQ: if (FUserType = utUnknown) OR (FUserType = utCompany) then Content_LBZQ else Content_Default; end; end; procedure TRealICQUserCard.Content_Default; begin FEdBranch.ShowHint := False; FEdDuty.ShowHint := False; FEdEmail.ShowHint := True; if Trim(FRealICQUser.TrueName) = '' then FEdTrueName.Text := FRealICQUser.DisplayName else FEdTrueName.Text := FRealICQUser.TrueName; FEdTrueName.ShowHint := True; FEdTrueName.Hint := FEdTrueName.Text; FEdBranch.Text := FRealICQUser.Branch; FEdDuty.Text := FRealICQUser.Duty; if FIsSecret then begin FEdTel.Text := FRealICQUser.Tel; FEdMobile.Text := FRealICQUser.Mobile; FEdShortMobile.Text := FRealICQUser.ShortMobile; FEdEmail.Text := FRealICQUser.Email; FEdEmail.Hint := FEdEmail.Text; end else begin FEdEmail.ShowHint := False; if Trim(FEdTel.Text) <> '' then FEdTel.Text :='******'; if Trim(FEdMobile.Text) <> '' then FEdMobile.Text := '******'; if Trim(FEdShortMobile.Text) <> '' then FEdShortMobile.Text := '******'; if Trim(FEdEmail.Text) <> '' then FEdEmail.Text := '******'; end; end; procedure TRealICQUserCard.Content_NXSQ; begin FEdBranch.ShowHint := True; FEdDuty.ShowHint := True; FEdEmail.ShowHint := False; if Trim(FRealICQUser.Enterprise) = '' then FEdTrueName.Text := FRealICQUser.DisplayName else FEdTrueName.Text := FRealICQUser.Enterprise; FEdTrueName.ShowHint := True; FEdTrueName.Hint := FEdTrueName.Text; FEdBranch.Text := FRealICQUser.Industry; FEdBranch.Hint := FEdBranch.Text; FEdDuty.Text := FRealICQUser.TaxOffices; FEdDuty.Hint := FEdDuty.Text; if FIsSecret then begin FEdTel.Text := FRealICQUser.TaxAgent; FEdMobile.Text := FRealICQUser.OfficePhone; FEdShortMobile.Text := FRealICQUser.FinancialPhone; FEdEmail.Text := FRealICQUser.LegalPersonPhone; end else begin if Trim(FEdTel.Text) <> '' then FEdTel.Text := '******'; if Trim(FEdMobile.Text) <> '' then FEdMobile.Text := '******'; if Trim(FEdShortMobile.Text) <> '' then FEdShortMobile.Text := '******'; if Trim(FEdEmail.Text) <> '' then FEdEmail.Text := '******'; end; end; procedure TRealICQUserCard.Content_LBZQ; begin FEdBranch.ShowHint := True; FEdDuty.ShowHint := True; FEdEmail.ShowHint := False; if Trim(FRealICQUser.Enterprise) = '' then FEdTrueName.Text := FRealICQUser.DisplayName else FEdTrueName.Text := FRealICQUser.Enterprise; FEdTrueName.Hint := FEdTrueName.Text; FEdBranch.Text := FRealICQUser.Industry; FEdBranch.Hint := FEdBranch.Text; FEdDuty.Text := FRealICQUser.TaxOffices; FEdDuty.Hint := FEdDuty.Text; if FIsSecret then begin FEdTel.Text := FRealICQUser.TaxAgent; FEdMobile.Text := FRealICQUser.OfficePhone; FEdShortMobile.Text := FRealICQUser.FinancialPhone; FEdEmail.Text := FRealICQUser.LegalPersonPhone; end else begin if Trim(FEdTel.Text) <> '' then FEdTel.Text := '******'; if Trim(FEdMobile.Text) <> '' then FEdMobile.Text := '******'; if Trim(FEdShortMobile.Text) <> '' then FEdShortMobile.Text := '******'; if Trim(FEdEmail.Text) <> '' then FEdEmail.Text := '******'; end; end; procedure TRealICQUserCard.SetRealICQUser(Value: TRealICQUser); begin FRealICQUser := Value; if Assigned(FRealICQUser) then begin if FUserType <> FRealICQUser.UserType then begin FUserType := FRealICQUser.UserType; SetCaption; end; SetContent; end; end; procedure TRealICQUserCard.ChangeUIColor(AColor: TColor); var i: Integer; begin inherited ChangeUIColor(AColor); BackColor := AColor; BorderColor := AColor; for i := 0 to Self.Componentcount - 1 do begin if Self.Components[i] is TEdit then begin (Self.Components[i] as TEdit).Color := AColor; end; end; end; destructor TRealICQUserCard.Destroy; begin try FreeAndNil(FEdTrueName); FreeAndNil(FEdBranch); FreeAndNil(FEdDuty); FreeAndNil(FEdTel); FreeAndNil(FEdMobile); FreeAndNil(FEdShortMobile); FreeAndNil(FEdEmail); FreeAndNil(FLblBranch); FreeAndNil(FLblDuty); FreeAndNil(FLblTel); FreeAndNil(FLblMobile); FreeAndNil(FLblShortMobile); FreeAndNil(FLblEmail); except end; inherited Destroy; end; procedure Register; begin RegisterComponents('RealICQ UI', [TRealICQUserCard]); end; end.