hxpopup.pas

一个基于Socket的在线更新程序

unit hxPopup;

interface

uses
  Windows, SysUtils, Types, Classes, Controls, Graphics, frmPopup;

type
  ThxPopup = class(TComponent)
  private
    FPopupForm: TPopupForm;
    FAnimateTime: Integer;
    FStayTime: Integer;
    FPositionX: Integer;
    FPositionY: Integer;
    FAutoPosition: Boolean;
    FClickHide: Boolean;
    FTitle: TCaption;
    FText: string;
    FTextFont: TFont;
    FTitleFont: TFont;
    FOnTitleClick: TNotifyEvent;
    FOnClick: TNotifyEvent;
    FOnLink: TNotifyEvent;

    procedure InternalOnTitleClick(Sender: TObject);
    procedure InternalOnClick(Sender: TObject);
    procedure SetTextFont(const Value: TFont);
    procedure SetTitleFont(const Value: TFont);
    procedure SetOnLink(const Value: TNotifyEvent);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;

    procedure Popup();
    procedure Close();

  published
    property AnimateTime: Integer read FAnimateTime write FAnimateTime;
    property StayTime: Integer read FStayTime write FStayTime;
    property PositionX: Integer read FPositionX write FPositionX;
    property PositionY: Integer read FPositionY write FPositionY;
    property AutoPosition: Boolean read FAutoPosition write FAutoPosition;
    property ClickHide: Boolean read FClickHide write FClickHide;
    property Title: TCaption read FTitle write FTitle;
    property Text: string read FText write FText;

    property TitleFont: TFont read FTitleFont write SetTitleFont;
    property TextFont: TFont read FTextFont write SetTextFont;

    property OnTitleClick: TNotifyEvent read FOnTitleClick write FOnTitleClick;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnLink: TNotifyEvent read FOnLink write SetOnLink;
  end;
  
  procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Hornson', [ThxPopup]);
end;

function GetWorkAreaRect(): TRect;
begin
  {$WARNINGS OFF}
  SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
  {$WARNINGS ON}
end;

procedure ThxPopup.Close;
begin
  FPopupForm.Timer1.Enabled := false;
  FPopupForm.Hide();
end;

constructor ThxPopup.Create(AOwner: TComponent);
begin
  inherited;

  FAnimateTime := 400;
  FStayTime := 2000;
  FPositionX := 0;
  FPositionY := 0;
  FAutoPosition := true;
  FClickHide := false;
  FText := '';
  FTitle := '';
  FTitleFont := TFont.Create();
  FTitleFont.Color := clNavy;
  FTextFont := TFont.Create();
  FTextFont.Color := clNavy;
  FPopupForm := TPopupForm.Create(self);
  FPopupForm.OnClick := InternalOnClick;
  if Assigned(FPopupForm.lblTitle) then
    FPopupForm.lblTitle.OnClick := InternalOnTitleClick;
  if Assigned(FPopupForm.lblText) then
    FPopupForm.lblText.OnClick := InternalOnClick;
  FPopupForm.AnimateTime := FAnimateTime;
  FPopupForm.Hide();
end;

destructor ThxPopup.Destroy;
begin
  FPopupForm.Free();
  FPopupForm := nil;

  inherited;
end;

procedure ThxPopup.InternalOnClick(Sender: TObject);
begin
  if Assigned(FOnClick) then
    FOnClick(self);
end;

procedure ThxPopup.InternalOnTitleClick(Sender: TObject);
begin
  if Assigned(FOnTitleClick) then
    FOnTitleClick(self)
end;

procedure ThxPopup.Popup;
begin
  FPopupForm.AnimateTime := FAnimateTime;
  FPopupForm.StayTime := FStayTime;
  FPopupForm.ClickHide := FClickHide;
  FPopupForm.lblTitle.Caption := FTitle;
  FPopupForm.lblTitle.Font.Assign(FTitleFont);
  FPopupForm.lblText.Caption := FText;
  FPopupForm.lblText.Font.Assign(FTextFont);

  if FAutoPosition then
  begin
    FPopupForm.Left := GetWorkAreaRect().Right - FPopupForm.Width - 18;
    FPopupForm.Top := GetWorkAreaRect().Bottom - FPopupForm.Height;
  end
  else
  begin
    FPopupForm.Left := FPositionX;
    FPopupForm.Top := FPositionY;
  end;

  FPopupForm.Show();
  FPopupForm.Timer1.Enabled := true;
end;

procedure ThxPopup.SetOnLink(const Value: TNotifyEvent);
begin
  FOnLink := Value;
  FPopupForm.OnLink:= Value;
end;

procedure ThxPopup.SetTextFont(const Value: TFont);
begin
  FTextFont.Assign(Value);
end;

procedure ThxPopup.SetTitleFont(const Value: TFont);
begin
  FTitleFont.Assign(Value);
end;

end.