unit updatealert;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Buttons, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TFadeDirection=(dfIn, dfOut);
  TOnStep=procedure(Sender: TObject) of object;
  TOnFinished=procedure(Sender: TObject) of object;

  TThDisplayUpdateInformation=class(TThread)
  private
    FCaption: String;
    FTitle: string;
    FDuration: Integer;
    FWorkarea: TRect;
  public
    constructor Create(Suspended: Boolean; Caption, Title: string; Duration: Integer; WorkArea: TRect);
  protected
    procedure Execute; override;
  end;

  TThFadeIn=class(TThread)
  private
    FOnStep: TOnStep;
    FOnFinished: TOnFinished;
    FCancel: Boolean;
    FDirection: TFadeDirection;
    FForm: TForm;
    procedure DoStep;
    procedure DoFinished;
    procedure SetCancel(const Value: Boolean);
  published
    property OnStep: TOnStep read FOnStep write FOnStep;
    property OnFinished: TOnFinished read FOnFinished write FOnFinished;
    property Cancel: Boolean read FCancel write SetCancel;
  public
    constructor Create(Suspended: Boolean; Form: TForm; Direction: TFadeDirection = dfIn);
  protected
    procedure Execute; override;
  end;

  TOnStartUpdate=procedure(sender: TObject) of object;

  Tfrm_updatealert = class(TForm)
    pnl1: TPanel;
    lbl_title: TLabel;
    lbl_message: TLabel;
    btn1_close: TSpeedButton;
    btn_download: TSpeedButton;
    tmr1Duration: TTimer;
    procedure pnl1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure btn1_closeClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure tmr1DurationTimer(Sender: TObject);
    procedure DoStartUpdate;
    procedure btn_downloadClick(Sender: TObject);
  private
    thIn: TThFadeIn;
    thOut: TThFadeIn;
    FOnStartUpdate: TOnStartUpdate;
    procedure OnStepFadeIn(Sender: TObject);
    procedure OnFinishedFadeIn(Sender: TObject);
    procedure OnStepFadeOut(Sender: TObject);
    procedure OnFinishedFadeOut(Sender: TObject);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  published
    property OnStartUpdate: TOnStartUpdate read FOnStartUpdate write FOnStartUpdate;
  end;

var
  frm_updatealert: Tfrm_updatealert;

implementation

{$R *.dfm}

procedure Tfrm_updatealert.btn1_closeClick(Sender: TObject);
begin
  thOut:=TThFadeIn.Create(True, self, dfOut);
  thOut.OnStep:=OnStepFadeOut;
  thOut.OnFinished:=OnFinishedFadeOut;
  thOut.Resume;
end;

procedure Tfrm_updatealert.btn_downloadClick(Sender: TObject);
begin
  DoStartUpdate;
end;

procedure Tfrm_updatealert.DoStartUpdate;
begin
  if Assigned(FOnStartUpdate) then
    FOnStartUpdate(Self);
end;

procedure Tfrm_updatealert.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure Tfrm_updatealert.FormShow(Sender: TObject);
begin
  thIn:=TThFadeIn.Create(True, self, dfIn);
  thIn.OnStep:=OnStepFadeIn;
  thIn.OnFinished:=OnFinishedFadeIn;
  thIn.Resume;
end;

procedure Tfrm_updatealert.OnFinishedFadeIn(Sender: TObject);
begin
  thIn:=nil;
  tmr1Duration.Enabled:=True;
end;

procedure Tfrm_updatealert.OnFinishedFadeOut(Sender: TObject);
begin
  thOut:=nil;
  Self.Close;
end;

procedure Tfrm_updatealert.OnStepFadein(Sender: TObject);
begin
  if Self.Left>(Screen.WorkAreaRect.Right-Self.Width) then
  begin
    self.Left:=self.Left-1;
  end else begin
    Self.Left:=Screen.WorkAreaRect.Right-self.Width;
    if TThFadeIn(Sender)<>nil then TThFadeIn(Sender).Cancel:=True;
  end;
end;

procedure Tfrm_updatealert.OnStepFadeOut(Sender: TObject);
begin
  if Self.Left<Screen.WorkAreaRect.Right then
  begin
    self.Left:=self.Left+1;
  end else begin
    Self.Left:=Screen.WorkAreaRect.Right;
    if TThFadeIn(Sender)<>nil then TThFadeIn(Sender).Cancel:=True;
  end;
end;

procedure Tfrm_updatealert.pnl1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    releasecapture;
    sendmessage(self.Handle, WM_NCLBUTTONDOWN, 2, 0);
end;

procedure Tfrm_updatealert.tmr1DurationTimer(Sender: TObject);
begin
  btn1_closeClick(self);
end;

{ TThFadeIn }

constructor TThFadeIn.Create(Suspended: Boolean; Form: TForm; Direction: TFadeDirection);
begin
  inherited Create(Suspended);
  self.NameThreadForDebugging('AlertFadeIn');
  self.FreeOnTerminate:=True;
  FCancel:=False;
  FDirection:=Direction;
  FForm:=Form;
end;

procedure TThFadeIn.DoFinished;
begin
  if Assigned(FOnFinished) then
    Synchronize(procedure
      begin
        FOnFinished(Self);
      end);
end;

procedure TThFadeIn.DoStep;
begin
  if FForm<>nil then
  begin
    case FDirection of
      dfIn:
        begin
          if FForm.Left>(Screen.WorkAreaRect.Right-FForm.Width) then
          begin
            FForm.Left:=FForm.Left-1;
          end else begin
            FForm.Left:=Screen.WorkAreaRect.Right-FForm.Width;
            FCancel:=True;
          end;
        end;
      dfOut:
        begin
          if FForm.Left<Screen.WorkAreaRect.Right then
          begin
            FForm.Left:=FForm.Left+1;
          end else begin
            FForm.Left:=Screen.WorkAreaRect.Right;
            FCancel:=True;
          end;
        end;
    end;
  end else
  begin
  if Assigned(FOnStep) then
    Synchronize(procedure
      begin
        FOnStep(Self);
      end);
  end;
end;

procedure TThFadeIn.Execute;
begin
  Try
    while (not FCancel) and (not Terminated) do
    begin
      DoStep;
      Sleep(2);
    end;
  Finally
    DoFinished;
  End;
end;

procedure TThFadeIn.SetCancel(const Value: Boolean);
begin
  FCancel := Value;
end;

{ TThDisplayUpdateInformation }

constructor TThDisplayUpdateInformation.Create(Suspended: Boolean; Caption, Title: string; Duration: Integer; WorkArea: TRect);
begin
  inherited Create(Suspended);
  self.FCaption:=Caption;
  self.FTitle:=Title;
  self.FDuration:=Duration;
  self.FWorkarea:=WorkArea;
end;

procedure TThDisplayUpdateInformation.Execute;
  function CalculateTextHeight(value: String; can: TCanvas): Integer;
  var
    lRect : TRect;
    lText : string;
  begin
    lRect.Left := 0;
    lRect.Right := 300;
    lRect.Top := 0;
    lRect.Bottom := 0;

    lText := value;

    Can.TextRect(
              {var} lRect, //will be modified to fit the text dimensions
              {var} lText, //not modified, unless you use the "tfModifyingString" flag
              [tfCalcRect, tfWordBreak] //flags to say "compute text dimensions with line breaks"
            );
    ASSERT( lRect.Top = 0 ); //this shouldn't have moved
    Result := lRect.Bottom;
  end;
var
  updateform: Tfrm_updatealert;
begin
  updateform:=Tfrm_updatealert.Create(nil);
  updateform.lbl_title.Caption:=FTitle;
  updateform.lbl_message.Caption:=FCaption;
  updateform.tmr1Duration.Interval:=FDuration;
  updateform.Height:=163+CalculateTextHeight(updateform.lbl_message.Caption, updateform.Canvas);
  updateform.Top:=FWorkarea.Top;
  updateform.Left:=FWorkarea.Right;
  //updateform.OnStartUpdate:=StartUpdate;
  updateform.Show;
  while updateform.Showing and (not Terminated) do
  begin
    Sleep(100);
  end;
end;

end.

  UpdateCaption:='';
  for i:=0 to Update.UpdateFiles.Count-1 do
  begin
     UpdateCaption:=UpdateCaption+'- '+Update.UpdateFiles[i].Filename+' Version: '+Update.UpdateFiles[i].NewVersion+#10#13;
  end;
  thDisplayUpdate:=TThDisplayUpdateInformation.Create(False, UpdateCaption, 'Es liegen Updates zum Download bereit', 10000, Screen.WorkAreaRect, self);