pic-is-big/Signal.pas

unit Signal;

interface

uses
  Windows, Forms, Messages, MMSystem, ExtCtrls, Classes, Graphics, Controls,
  StdCtrls, XiProgressBar, Vcl.Imaging.jpeg, SysUtils, Vcl.ImgList, System.ImageList, GR32,
  Vcl.Imaging.pngimage, Vcl.AppEvnts;

{$I NoRTTI.inc}

type
  TSForm = class(TForm)
    Timer1: TTimer;
    Timer2: TTimer;
    Label1: TLabel;
    Label2: TLabel;
    procbar: TXiProgressBar;
    proclb: TLabel;
    procl: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer2Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    procedure StartXTimer;
    procedure StopXTimer;
    procedure StartXTimerDie;
    procedure StopXTimerDie;
    procedure HideForm;
    { Public declarations }
  end;

var
  XXForm: TSForm;
  x: integer;
  XTimer, XTimerDie: Cardinal;
  XTimerOn: boolean = false;
  curc, allc: integer;

implementation

uses sett, Action;

{$R *.dfm}

procedure XCallBack(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
begin
  inc(x);
  if not Assigned(XXForm) then Exit;

  try
    if TipPos then
    begin
      XXForm.left := x * 5;
      if XXForm.left < 50 then
        XXForm.AlphaBlendValue := round(XXForm.left / 50 * 255);
      application.ProcessMessages;
      if XXForm.left >= 50 then
        XXForm.StopXTimer;
    end
      else
    begin
      XXForm.left := screen.DesktopWidth - XXForm.Width - x * 5;
      if XXForm.left > screen.DesktopWidth - XXForm.Width - 50 then
        XXForm.AlphaBlendValue := round((1 - (XXForm.left - (screen.DesktopWidth - XXForm.Width - 50)) / 50) * 255);
      application.ProcessMessages;
      if XXForm.left <= screen.DesktopWidth - XXForm.Width - 50 then
        XXForm.StopXTimer;
    end;
  except end;
end;

procedure XCallBackDie(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
begin
  inc(x);
  if not Assigned(XXForm) then Exit;

  try
    if TipPos then
    begin
      XXForm.left := 50 - x * 5;

      if XXForm.left > 0 then
        XXForm.AlphaBlendValue := round(XXForm.left / 50 * 255);

      application.ProcessMessages;
      if XXForm.left <= 0 then
        XXForm.StopXTimerDie;
    end
      else
    begin
      XXForm.left := screen.DesktopWidth - XXForm.Width -50 + x * 5;

      if XXForm.left < screen.DesktopWidth - XXForm.Width then
        XXForm.AlphaBlendValue := round((1 - (XXForm.left - (screen.DesktopWidth - XXForm.Width - 50)) / 50) * 255);

      application.ProcessMessages;
      if XXForm.left >= screen.DesktopWidth - XXForm.Width then
        XXForm.StopXTimerDie;
    end;
  except end;
end;

procedure TSForm.StartXTimer;
begin
  if not XTimerOn then
  begin
    XTimer := TimeSetEvent(10, 0, @XCallBack, 100, TIME_PERIODIC);
    XTimerOn := true;
  end;
end;

procedure TSForm.StopXTimer;
begin
  timeKillEvent(XTimer);
  XTimerOn := false;
  Timer1.Enabled := True;
end;

procedure TSForm.StartXTimerDie;
begin
  if not XTimerOn then
  begin
    XTimerDie := TimeSetEvent(10, 0, @XCallBackDie, 100, TIME_PERIODIC);
    XTimerOn := true;
  end;
end;

procedure TSForm.StopXTimerDie;
begin
  if Assigned(XXForm) then
    XXForm.Close;
end;

procedure TSForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  timeKillEvent(XTimer);
  timeKillEvent(XTimerDie);
  XTimerOn := false;
  Action := caFree;
end;

procedure TSForm.Timer1Timer(Sender: TObject);
begin
  if Label1.tag = 0 then
    Label1.caption := '<27><> <20><>: ' + IntToStr(Label2.tag)
  else
    Label1.caption := '<27><> <20><>: ' + IntToStr(Label2.tag) + ' <20><> ' + IntToStr(Label1.tag);
end;

procedure TSForm.Timer2Timer(Sender: TObject);
begin
  HideForm;
end;

procedure TSForm.FormCreate(Sender: TObject);
begin
  XXForm := Self;
  if HandleAllocated then
  begin
    SetWindowLong(XXForm.Handle, GWL_STYLE, GetWindowLong(XXForm.Handle, GWL_STYLE) or WS_POPUP);
    SetWindowLong(XXForm.Handle, GWL_EXSTYLE, GetWindowLong(XXForm.Handle, GWL_EXSTYLE) or WS_EX_NOACTIVATE or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
    ShowWindow(XXForm.Handle, SW_SHOWNOACTIVATE);
    SetWindowPos(XXForm.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
  end;
  XXForm.Visible := true;
end;

procedure TSForm.FormPaint(Sender: TObject);
var
  DC: HDC;
  Rgn: HRGN;
  brF : HBRUSH;
begin
  inherited;
  DC := GetDCEx(Handle, 0, DCX_PARENTCLIP);
  Rgn := CreateRectRgn(ClientRect.Left, ClientRect.Top, ClientRect.Right, ClientRect.Bottom);
  SelectClipRgn(DC, Rgn);
  DeleteObject(Rgn);

  SelectObject(DC, GetStockObject(DC_BRUSH));

  brF := CreateSolidBrush(ColorToRGB($00d3d3d3));
  FrameRect(Canvas.Handle, Rect(0, 0, Width, Height), brF);
  DeleteObject(brF);

  ReleaseDC(Handle, DC);
end;

procedure TSForm.HideForm;
begin
  if ListOfForms.count > 0 then
    ListOfForms[tag] := '';
  Timer1.Enabled := false;
  Timer2.Enabled := false;
  x := 0;
  XXForm := Self;
  StopXTimer;
  StartXTimerDie;
end;

end.