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.