Neko / Kat implemented using Free Pascal and Lazarus IDE (d-_-b 2024)

// Neko / Kat implemented using Free Pascal and Lazarus IDE (d-_-b 2024)
// https://forum.lazarus.freepascal.org/index.php/topic,34038.msg222021.html
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Windows, Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, BGRABitmap, Dialogs ;

type

  { TForm1 }

  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    bfBlend: TBlendFunction;
    pPos: TPoint;
    sSize: TSize;
    dwStyle: DWORD;
    DeltaTime: Integer;
    Frame: Integer;
    procedure DrawImage(StateKey: String);
    procedure UpdatePosition(MouseX, MouseY: Integer; aFrame: Integer);
  public
  end;

var
  Form1: TForm1;

const
  CatStates: array [0..40] of String = (
    'awake', 'down1.png', 'down2.png', 'downclaw1.png', 'downclaw2.png',
    'downleft1.png', 'downleft2.png', 'downright1.png', 'downright2.png',
    'fp_down.png', 'fp_downleft.png', 'fp_downright.png', 'fp_left.png',
    'fp_right.png', 'fp_up.png', 'fp_upleft.png', 'fp_upright.png', 'left1.png',
    'left2.png', 'leftclaw1.png', 'leftclaw2.png', 'right1.png', 'right2.png',
    'rightclaw1.png', 'rightclaw2.png', 'scratch1.png', 'scratch2.png',
    'sleep1.png', 'sleep2.png', 'up1.png', 'up2.png', 'upclaw1.png', 'upclaw2.png',
    'upleft1.png', 'upleft2.png', 'upright1.png', 'upright2.png', 'wash1.png',
    'wash2.png', 'yawn1.png', 'yawn2.png'
  );

  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);
 Begin
  FormStyle  := fsStayOnTop;
  Borderstyle:= bsNone;
  dwStyle:= GetWindowLongA(Self.Handle, GWL_EXSTYLE);
  if (dwStyle And WS_EX_LAYERED = 0) then
  begin
    SetWindowLong(Self.Handle, GWL_EXSTYLE, dwStyle Or
                                   WS_EX_LAYERED Or
                                   WS_EX_TOPMOST);
  end;
  Frame := 1;
  DrawImage('awake');
 End;

procedure TForm1.Timer1Timer(Sender: TObject);
const
  AnimationSpeed = 200;
var
  MousePos: TPoint;
begin
  // Increment the delta time
  Inc(DeltaTime, Timer1.Interval);
  // Check if x ms has been reached or exceeded
  if DeltaTime >= AnimationSpeed then
  begin
    // Toggle the frame between 1 and 2
    Frame := (Frame mod 2) + 1;
    // Reset the delta time
    DeltaTime := 0;
  end;
  // Get the current mouse position
  GetCursorPos(MousePos);
  // Update the form position and image
  UpdatePosition(MousePos.X, MousePos.Y, Frame);
end;

procedure TForm1.DrawImage(StateKey: String);
var
  PNG: TBGRABitmap;
  ImagePath: String;
begin
  // Construct the file path
  ImagePath := 'assets\' + StateKey + '.png';
  // Check if the file exists
  if not FileExists(ImagePath) then
  begin
    ShowMessage('Image file "' + ImagePath + '" not found.');
    Exit;
  end;
  // Load and Draw
  PNG:= TBGRABitmap.Create;
  try
    // must be a premultiplied PNG
    PNG.LoadFromFile(ImagePath);
    // Setup Pos and Size
    pPos    := Point(0, 0);
    sSize.cx:= PNG.Width;
    sSize.cy:= PNG.Height;
    // Alpha Blending
    bfBlend.BlendOp            := AC_SRC_OVER;
    bfBlend.BlendFlags         := 0;
    bfBlend.SourceConstantAlpha:= 255;
    bfBlend.AlphaFormat        := AC_SRC_ALPHA;
    // Handle Window Blit
    UpdateLayeredWindow(Self.Handle, 0, Nil, @sSize,
                      PNG.Bitmap.Canvas.Handle,
                      @pPos, 0, @bfBlend, ULW_ALPHA);
  finally
    PNG.Free;
  end;
end;

procedure TForm1.UpdatePosition(MouseX, MouseY: Integer; aFrame: Integer);
const
  DistanceThreshold = 32;
  Speed = 5;
var
  DeltaX, DeltaY: Integer;
  Distance: Double;
  LeftOrRight, DownOrUp: String;
begin
  DeltaX := MouseX - (Left + Width div 2);
  DeltaY := MouseY - (Top + Height div 2);
  // Calculate the Euclidean distance safely
  Distance := Sqrt(Sqr(DeltaX) + Sqr(DeltaY));
  if (Distance > DistanceThreshold) and (Distance <> 0) then
  begin
    // Determine horizontal direction
    if DeltaX > 0 then
      LeftOrRight := 'right'
    else if DeltaX < 0 then
      LeftOrRight := 'left'
    else
      LeftOrRight := '';
    // Determine vertical direction
    if DeltaY > 0 then
      DownOrUp := 'down'
    else if DeltaY < 0 then
      DownOrUp := 'up'
    else
      DownOrUp := '';
    // Update the position
    Left := Left + Round(DeltaX / Distance * Speed);
    Top := Top + Round(DeltaY / Distance * Speed);
    // Draw Animation
    DrawImage(DownOrUp + LeftOrRight + IntToStr(aFrame));
  end else
  begin
     DrawImage('awake');
  end;
end;

end.