Unit uTEST;
{$MODE OBJFPC}{$H+}
Interface
USES
Windows, Classes, SysUtils,
Forms, Controls, Graphics;
Type
TForm1 = Class(TForm)
Procedure FormCreate (Sender: TObject);
Procedure FormClose (Sender: TObject; Var CloseAction: TCloseAction);
Procedure FormKeyDown (Sender: TObject; Var Key: Word; Shift: TShiftState);
PRIVATE
arrPics: Array[1..180] Of TPicture;
arrWnds: Array[1..180] Of TForm;
bfBlend: TBlendFunction;
pPos : TPoint;
size : TSize;
dwStyle: DWORD;
End;
VAR
Form1: TForm1;
Function UpdateLayeredWindow(
hWnd: HWND; hdcDst: HDC; pptDst: PPoint; pSize: PSize;
hdcSrc: HDC; pptSrc: PPoint; crKey: TColor; pBlend:
PBlendFunction; dwFlags: DWORD): BOOL;
StdCall; External 'user32';
Implementation
{$R *.LFM}
Procedure TForm1.FormCreate(Sender: TObject);
Var
iCount, i,
myTop, myLeft,
countLeft, countTop,
wndWidth, wndHeight: Integer;
pic: TPicture;
Begin
Height:= 360;
Width := 360;
wndWidth := 360;
wndHeight:= 360;
countLeft:= 0;
countTop := 0;
myTop := 0;
myLeft :=-360;
iCount:= 0;
For i:= 1 To 180
Do
Begin
Inc(iCount);
arrPics[i]:= TPicture.Create;
If iCount = 2
Then
Begin
arrPics[i].LoadFromFile('I:\(Downloads)\OK2.png');
iCount:= 0;
End
Else arrPics[i].LoadFromFile('I:\(Downloads)\OK.png');
End;
pic:= TPicture.Create;
Try
pic.LoadFromFile('I:\(Downloads)\OK(pre).png');
For i:= 1 To 180
Do
Begin
myLeft:= myLeft+wndWidth;
If (Screen.WorkAreaWidth-(countLeft*wndWidth)) < wndWidth
Then
Begin
myLeft := 0;
myTop := myTop+wndHeight;
countLeft:= 0;
countTop := countTop+1;
End;
arrWnds[i]:= TForm.Create(Application);
arrWnds[i].SetBounds(myLeft, myTop, wndWidth, wndHeight);
arrWnds[i].Show;
dwStyle:= GetWindowLongA(arrWnds[i].Handle, GWL_EXSTYLE);
If (dwStyle And WS_EX_LAYERED = 0)
Then
Begin
SetWindowLong(arrWnds[i].Handle, GWL_EXSTYLE, dwStyle Or
WS_EX_LAYERED);
pPos:= Point(0, 0);
size.cx:= pic.Width;
size.cy:= pic.Height;
bfBlend.BlendOp := AC_SRC_OVER;
bfBlend.BlendFlags := 0;
bfBlend.SourceConstantAlpha:= 255;
bfBlend.AlphaFormat := AC_SRC_ALPHA;
UpdateLayeredWindow(
arrWnds[i].Handle, 0, Nil, @size, pic.Bitmap.Canvas.Handle,
@pPos, 0, @bfBlend, ULW_ALPHA);
End;
countLeft:= countLeft+1;
End;
Finally
pic.Free;
End;
End;
Procedure TForm1.FormClose(Sender: TObject; Var CloseAction: TCloseAction);
Var
i: Integer;
Begin
For i:= Low(arrPics) To High(arrPics)
Do arrPics[i].Free;
End;
Procedure TForm1.FormKeyDown(Sender: TObject; Var Key: Word;
Shift : TShiftState);
Var
i: Integer;
Begin
If Key = VK_UP
Then
Begin
For i:= Low(arrWnds) To High(arrWnds)
Do arrWnds[i].Top:= arrWnds[i].Top-20;
End;
If Key = VK_DOWN
Then
Begin
For i:= Low(arrWnds) To High(arrWnds)
Do arrWnds[i].Top:= arrWnds[i].Top+20;
End;
End;
End.