Заставка\скринсейвер "движущиеся иконки"

program IconsMoves;

uses
  KolibriOS;

var
  WndWidth, WndHeight: LongWord;

const
  WS_NO_DRAW = $1000000;
  DEFAULT_STEP = 6;
  BACK_COLOR = $00555555;

type
  TBuf2DBuffer = packed record
    Img:    Pointer;
    Left:   SmallInt;
    Top:    SmallInt;
    Width:  LongWord;
    Height: LongWord;
    Color:  LongWord;
    BPP:    Byte;
  end;

var
  Buf2D: Pointer;
  Buf2DLibInit:         procedure;
  buf2d_create:         procedure(var Buffer: TBuf2DBuffer); stdcall;
  buf2d_draw:           procedure(var Buffer: TBuf2DBuffer); stdcall;
  buf2d_clear:          procedure(var Buffer: TBuf2DBuffer; Color: LongWord); stdcall;
  buf2d_bit_blt_transp: procedure(var DstBuffer: TBuf2DBuffer; X, Y: LongInt; const SrcBuffer: TBuf2DBuffer); stdcall;

function MemoryAllocate(Bytes: LongWord): Pointer; stdcall;
asm
        push ecx
        push ebx
        mov eax, 68
        mov ebx, 12
        mov ecx, Bytes
        int 64
        pop ebx
        pop ecx
end;

function MemoryReallocate(MemPtr: Pointer; Bytes: LongWord): Pointer; stdcall;
asm
        push ebx
        push ecx
        push edx
        mov eax, 68
        mov ebx, 20
        mov ecx, Bytes
        mov edx, MemPtr
        int 64
        pop edx
        pop ecx
        pop ebx
end;

function MemoryFree(MemPtr: Pointer): LongWord; stdcall;
asm
        push ecx
        push ebx
        mov eax, 68
        mov ebx, 13
        mov ecx, MemPtr
        int 64
        pop ebx
        pop ecx
end;

type
  Proc = procedure;

procedure InitLibrary(LibInit: Proc); stdcall;
const
  LIB_PATH = '/sys/lib/';

type
  PNameAddr = ^TNameAddr;
  TNameAddr = packed record
    Name: PAnsiChar;
    Addr: Pointer;
  end;

  PAddrName = ^TAddrName;
  TAddrName = packed record
    Addr: Pointer;
    Name: PAnsiChar;
  end;

  procedure StrCopy(StrFrom, StrTo: PAnsiChar);
  begin
    repeat
      StrTo^ := StrFrom^;
      Inc(StrFrom);
      Inc(StrTo);
    until PAnsiChar(StrFrom - 1)^ = #0;
  end;

  function StrEqual(Str1, Str2: PAnsiChar): Boolean;
  begin
    while (Str1^ = Str2^) and (Str1^ <> #0) do
    begin
      Inc(Str1);
      Inc(Str2);
    end;
    Result := Str1^ = Str2^;
  end;

  function DLLLoad(ImportTable: PAddrName): LongInt; stdcall;
  var
    ExportTable: PNameAddr;
    ProcAddr: Pointer;
    Name: PPAnsiChar;
    LibPath: array [0..32] of AnsiChar;
  begin
    Result := 1;
    StrCopy(LIB_PATH, LibPath);
    while ImportTable.Addr <> nil do
    begin
      StrCopy(ImportTable.Name, Pointer(LongInt(@LibPath) + Length(LIB_PATH)));
      ExportTable := LoadLibrary(LibPath);
      if ExportTable = nil then
        Exit;
      Name := PPAnsiChar(ImportTable.Addr);
      while Name^ <> nil do
      begin
        ProcAddr := GetProcAddress(ExportTable, Name^);
        if ProcAddr <> nil then
          Pointer(Name^) := ProcAddr
        else
          Exit;
        Inc(Name);
      end;
      if StrEqual(ExportTable.Name, 'lib_init') then
        InitLibrary(ExportTable.Addr);
      Inc(ImportTable);
    end;
    Result := 0;
  end;
asm
  pushad
  mov eax, offset MemoryAllocate
  mov ebx, offset MemoryFree
  mov ecx, offset MemoryReallocate
  mov edx, offset DLLLoad
  call LibInit
  popad
end;

type
  PImage = ^TImage;
  TImage = packed record
    Checksum: LongWord; // ((Width ROL 16) OR Height) XOR Data[0] ; ignored so far
    Width:    LongWord;
    Height:   LongWord;
    Next:     PImage;
    Previous: PImage;
    BPP:      LongWord; // one of IMAGE_BPP
    Data:     Pointer;
    Palette:  Pointer;  // used if BPP = (IMAGE_BPP1 or IMAGE_BPP2 or IMAGE_BPP4 or IMAGE_BPP8I)
    Extended: LongWord;
    Flags:    LongWord; // bitfield
    Delay:    LongWord; // used if Image.IsAnimated is set in Flags
  end;

var
  FileAttributes: TFileAttributes;
  BytesRead: LongWord;
  FilePath: PAnsiChar = '/sys/ICONS32.PNG';

  imgFile: Pointer;
  imgFileSize: LongWord;
  imgData: PImage;
  ImgWidth, ImgHeight: LongWord;

  LibImg: Pointer;
  LibImgLibInit: procedure;

  img_decode:  function(Data: Pointer; Length, Options: LongWord): PImage; stdcall;

type
  PElements = ^TElements;

  PElement = ^TElement;
  TElement = object
    Left: LongInt;
    Top: LongInt;
    Width: LongWord;
    Height: LongWord;
    ImgBuf: TBuf2DBuffer;
    Direction: Byte;
    Step: LongInt;
    Parent: PElements;
    procedure Init(aLeft, aTop: LongInt; aWidth, aHeight: LongWord; aImg: Pointer; aParent: PElements; aStep: LongInt; aDirection: Byte);
    procedure Move;
    procedure Draw;
  end;

  TArrayOfElements = array [0..0] of TElement;
  PArrayOfElements = ^TArrayOfElements;

  TElements = object
    Elements: PArrayOfElements;
    Width: LongWord;
    Height: LongWord;
    Count: LongInt;
    ImgBuf: TBuf2DBuffer;
    procedure Init(aCount: LongInt; Image: Pointer);
    procedure Move;
    procedure Draw;
  end;

procedure TElements.Init(aCount: LongInt; Image: Pointer);
var
  i: LongInt;
begin
  Randomize;
  GetMem(Elements, SizeOf(TElement) * aCount);
  Count := aCount;
  with ImgBuf do
  begin
    Left   := 0;
    Top    := 0;
    Width  := WndWidth;
    Height := WndHeight;
    Color  := BACK_COLOR;
    BPP    := 24;
  end;
  Width  := ImgBuf.Width;
  Height := ImgBuf.Height;
  buf2d_create(ImgBuf);
  for i := 0 to Pred(Count) do
    Elements[i].Init(Random(Width - ImgWidth), Random(Height - ImgWidth),
      ImgWidth, ImgWidth,
      Pointer(LongInt(ImgWidth) * LongInt(ImgWidth) * 4 * i  + LongInt(Image)),
      @Self, Random(DEFAULT_STEP) + 1, Random(4) + 1);
end;

procedure TElements.Move;
var
  i: LongInt;
begin
  for i := 0 to Pred(Count) do
    Elements[i].Move;
  Draw;
end;

procedure TElements.Draw;
begin
  buf2d_draw(ImgBuf); // выводим на экран
  buf2d_clear(ImgBuf, ImgBuf.Color); // закрашиваем буфер цветом фона
end;

procedure TElement.Init(aLeft, aTop: LongInt; aWidth, aHeight: LongWord; aImg: Pointer; aParent: PElements; aStep: LongInt; aDirection: Byte);
begin
  Left   := aLeft;
  Top    := aTop;
  Width  := aWidth;
  Height := aHeight;
  Parent := aParent;
  Step   := aStep;
  Direction := aDirection;
  with ImgBuf do
  begin
    Width  := aWidth;
    Height := aHeight;
    BPP    := 32;
    Img    := aImg;
  end;
end;

procedure TElement.Move;
var
  LastDirection: Byte;
begin
  LastDirection := Direction;
  case Direction of
    1:
      Begin
        Left := Left - Step;
        Top := Top - Step;
        If Left <= 0 Then
          Direction := 2
        Else
          If Top <= 0 Then
            Direction := 4;
      End;
    2:
      Begin
        Left := Left + Step;
        Top := Top - Step;
        If Left >= LongInt(Parent.Width - Width) Then
          Direction := 1
        Else
          If Top <= 0 Then
            Direction := 3;
      End;
    3:
      Begin
        Left := Left + Step;
        Top := Top + Step;
        If Left >= LongInt(Parent.Width - Width) Then
          Direction := 4
        Else
          If Top >= LongInt(Parent.Height - Height) Then
            Direction := 2;
      End;
    4:
      Begin
        Left := Left - Step;
        Top := Top + Step;
        If Left <= 0 Then
          Direction := 3
        Else
          If Top >= LongInt(Parent.Height - Height) Then
            Direction := 1;
      End;
  end;
  if LastDirection <> Direction then
    Step := Random(DEFAULT_STEP) + 1;
  Draw;
end;

procedure TElement.Draw;
begin
  buf2d_bit_blt_transp(Parent.ImgBuf, Left, Top, ImgBuf);
end;

var
  Elements: TElements;

procedure Idle;
begin
  Elements.Move;
end;

type
  TRGBQuad = packed record
    Blue:  Byte;
    Green: Byte;
    Red:   Byte;
    Alpha: Byte;
  end;

  TRGBQuadArray = array [0..0] of TRGBQuad;

procedure PrepareAlpha(Img: Pointer; W, H: LongWord);
var
  X, Y: LongWord;
begin
  for Y := 0 to Pred(H) do
    for X := 0 to Pred(W) do
      with TRGBQuadArray(Img^)[Y * W + X] do
        if Alpha = 0 then // приходится инвертировать альфа-канал
          Alpha := 255    // потому что buf2d работает только с инвертированным
        else
          Alpha := 255 - Alpha * 2 div 3;
end;

begin
  Buf2D                := LoadLibrary('/sys/lib/buf2d.obj');
  buf2dLibInit         := GetProcAddress(Buf2D, 'lib_init');
  buf2d_create         := GetProcAddress(Buf2D, 'buf2d_create');
  buf2d_draw           := GetProcAddress(Buf2D, 'buf2d_draw');
  buf2d_clear          := GetProcAddress(Buf2D, 'buf2d_clear');
  buf2d_bit_blt_transp := GetProcAddress(Buf2D, 'buf2d_bit_blt_transp');

  LibImg        := LoadLibrary('/sys/lib/libimg.obj');
  LibImgLibInit := GetProcAddress(LibImg, 'lib_init');
  img_decode    := GetProcAddress(LibImg, 'img_decode');

  InitLibrary(LibImgLibInit);
  InitLibrary(Buf2DLibInit);

  GetFileAttributes(FilePath, FileAttributes);
  imgFileSize := FileAttributes.Size;
  imgFile := HeapAllocate(imgFileSize);
  ReadFile(FilePath, imgFile^, imgFileSize, 0, BytesRead);
  imgData := img_decode(imgFile, imgFileSize, 0);
  HeapFree(imgFile);
  ImgWidth := imgData.Width;
  ImgHeight := imgData.Height;

  PrepareAlpha(imgData.Data, ImgWidth, ImgHeight);

  with GetScreenSize do
  begin
    WndWidth := Width;
    WndHeight := Height;
  end;

  Elements.Init(ImgHeight div ImgWidth, imgData.data);

  while True do
    case WaitEventByTime(3) of
      REDRAW_EVENT:
        begin
          BeginDraw;
          DrawWindow(0, 0, WndWidth, WndHeight, nil, 0, WS_NO_DRAW, CAPTION_NONMOVABLE);
          EndDraw;
        end;
      KEY_EVENT:
        Break;
      BUTTON_EVENT:
        if GetButton.ID = 1 then
          Break;
    else
      Idle;
    end;
end.