RealICQClient/Client/Views/UserViews/UserCardView.pas

unit UserCardView;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RealICQSkinFrm, cefvcl, UserCardWebApp, ExtCtrls, ceflib, BaseWebApp;

type
  TUserCardViewForm = class(TRealICQSkinForm)
    chrm1: TChromium;
    tmrForClose: TTimer;
    tmrForGoTop: TTimer;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure tmrForGoTopTimer(Sender: TObject);
    procedure tmrForCloseTimer(Sender: TObject);
    procedure chrm1KeyEvent(Sender: TObject; const browser: ICefBrowser; const event: PCefKeyEvent; osEvent: PMsg; out Result: Boolean);
    procedure chrm1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
  private
    FWebApp: TUserCardWebApp;
    FLoginName: string;
    FTargetTop: Integer;
    procedure SetTargetTop(const Value: Integer);
    { Private declarations }

  public
    procedure ChangeUIColor(AColor: TColor); override;
    procedure Update(ALoginName: string);
    property LoginName: string read FLoginName write FLoginName;
    property TargetTop: Integer read FTargetTop write SetTargetTop;
  end;

var
  UserCardViewForm: TUserCardViewForm;

implementation

uses
  MainFrm, DevToolChromeFrm, ConditionConfig;

{$R *.dfm}

{ TUserCardViewForm }


procedure TUserCardViewForm.ChangeUIColor(AColor: TColor);
begin
  inherited ChangeUIColor(AColor);

end;

procedure TUserCardViewForm.chrm1BeforeContextMenu(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const params: ICefContextMenuParams; const model: ICefMenuModel);
begin
  model.Clear;
  model.AddItem(Integer(MENU_ID_COPY), '¸´ÖÆ');
end;

procedure TUserCardViewForm.chrm1KeyEvent(Sender: TObject; const browser: ICefBrowser; const event: PCefKeyEvent; osEvent: PMsg; out Result: Boolean);
begin
  if (TConditionConfig.GetConfig.Dev) and (event^.windows_key_code = VK_F12) then
    ShowDevTool(Self, chrm1);
end;

procedure TUserCardViewForm.FormCreate(Sender: TObject);
begin
  FWebApp := TUserCardWebApp.Create(chrm1);
end;

procedure TUserCardViewForm.FormDestroy(Sender: TObject);
begin
  FreeAndNil(FWebApp);
end;

procedure TUserCardViewForm.FormShow(Sender: TObject);
var
  URL: string;
begin
  ChangeUIColor(MainForm.FormColor);
  if TConditionConfig.GetConfig.RemoteUI then
  begin
    URL := Format('%s/userview/index.html', [TConditionConfig.GetConfig.RemoteUIHost]);
  end
  else
    URL := ExtractFilePath(paramstr(0)) + 'html/userview/index.html';

  chrm1.Load(URL);
end;

procedure TUserCardViewForm.SetTargetTop(const Value: Integer);
var
  P: TPoint;
begin
  FTargetTop := Value - 30;
  if FTargetTop < 0 then
    FTargetTop := 0;
  if FTargetTop + Height > Screen.WorkAreaHeight then
    FTargetTop := Screen.WorkAreaHeight - Height;

  P.X := 0;
  P.Y := 0;
  P := MainForm.pnlAll.ClientToScreen(P);

  if Width > P.X then
    Left := P.X + MainForm.pnlAll.Width + 2
  else
    Left := P.X - Width - 2;

  if not Visible then
  begin
    Top := FTargetTop;
    Show;
  end
  else
  begin
    tmrForGoTop.Enabled := True;
  end;
end;

procedure TUserCardViewForm.tmrForCloseTimer(Sender: TObject);
begin
  tmrForClose.Enabled := False;
  if (Mouse.CursorPos.X >= Left) and (Mouse.CursorPos.X <= Left + Width) and (Mouse.CursorPos.Y >= Top) and (Mouse.CursorPos.Y <= Top + Height) then
  begin
    tmrForClose.Enabled := True;
  end
  else
  begin
    MainForm.HideUserCardForm;
  end;
end;

procedure TUserCardViewForm.tmrForGoTopTimer(Sender: TObject);
begin
  if abs(Top - FTargetTop) < 15 then
    Top := FTargetTop;
  tmrForGoTop.Enabled := Top <> FTargetTop;
  if Top < FTargetTop then
  begin
    Top := Top + 15;
  end
  else if Top > FTargetTop then
  begin
    Top := Top - 15;
  end;
end;

procedure TUserCardViewForm.Update(ALoginName: string);
begin
  if ALoginName = '' then
    Exit;
  FWebApp.LoginName := ALoginName;
end;

initialization

finalization
  if UserCardViewForm <> nil then
    FreeAndNil(UserCardViewForm);

end.