You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
114 lines
2.7 KiB
Plaintext
114 lines
2.7 KiB
Plaintext
unit Signal;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, MMSystem, System.Classes, Vcl.Forms, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Controls, Vcl.Graphics,
|
|
Vcl.Imaging.pngimage;
|
|
|
|
{$I NoRTTI.inc}
|
|
|
|
type
|
|
TSForm = class(TForm)
|
|
Panel1: TPanel;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Image1: TImage;
|
|
Image2: TImage;
|
|
procedure FormShow(Sender: TObject);
|
|
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
private
|
|
// procedure XCallBack(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
|
|
{ Private declarations }
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
SForm: TSForm;
|
|
XXForm: TSForm;
|
|
X: Integer;
|
|
XTimer: Cardinal;
|
|
XTimerOn: boolean = false;
|
|
|
|
procedure StartXTimer;
|
|
procedure StopXTimer;
|
|
|
|
implementation
|
|
|
|
uses ExmplForm;
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure XCallBack(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
|
|
begin
|
|
inc(X);
|
|
if TipPos then
|
|
begin
|
|
XXForm.left := -XXForm.width + X * 10;
|
|
|
|
if XXForm.left < 0 then
|
|
XXForm.AlphaBlendValue := round((1 + XXForm.left / XXForm.width) * 240);
|
|
|
|
application.ProcessMessages;
|
|
if XXForm.left >= 0 then
|
|
StopXTimer;
|
|
end
|
|
else
|
|
begin
|
|
XXForm.left := screen.DesktopWidth - X * 10;
|
|
|
|
if screen.DesktopWidth - XXForm.left < XXForm.width then
|
|
XXForm.AlphaBlendValue := round((screen.DesktopWidth - XXForm.left) / XXForm.width * 240);
|
|
|
|
application.ProcessMessages;
|
|
if XXForm.left <= screen.DesktopWidth - XXForm.width then
|
|
StopXTimer;
|
|
end;
|
|
end;
|
|
|
|
procedure StartXTimer;
|
|
begin
|
|
XTimer := TimeSetEvent(10, 10000, @XCallBack, 100, TIME_PERIODIC);
|
|
XTimerOn := true;
|
|
end;
|
|
|
|
procedure StopXTimer;
|
|
begin
|
|
timeKillEvent(XTimer);
|
|
XTimerOn := false;
|
|
end;
|
|
|
|
procedure TSForm.FormShow(Sender: TObject);
|
|
var
|
|
X, Y: Integer;
|
|
SrcRect, DstRect: TRect;
|
|
bmp: TBitmap;
|
|
begin
|
|
XXForm := Sender as TSForm;
|
|
SetWindowLong(XXForm.Handle, GWL_EXSTYLE, GetWindowLong(XXForm.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
|
|
if TipPos then
|
|
begin
|
|
bmp := TBitmap.Create;
|
|
X := Image1.Picture.Bitmap.width;
|
|
Y := Image1.Picture.Bitmap.Height;
|
|
bmp.width := X;
|
|
bmp.Height := Y;
|
|
SrcRect := Rect(0, 0, X, Y);
|
|
DstRect := Rect(X, 0, 0, Y);
|
|
bmp.Canvas.CopyRect(DstRect, Image1.Picture.Bitmap.Canvas, SrcRect);
|
|
Image1.Picture.Bitmap.Canvas.FillRect(Image1.Picture.Bitmap.Canvas.cliprect);
|
|
Image1.Picture.Bitmap.Canvas.Draw(0, 0, bmp);
|
|
bmp.free;
|
|
end;
|
|
end;
|
|
|
|
procedure TSForm.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
if ListOfForms.count > 0 then
|
|
ListOfForms[Tag] := '';
|
|
close;
|
|
end;
|
|
|
|
end.
|