lasarus_compotents/bgracontrols/test/test_bcgamegrid/umain.pas

unit umain;

{$mode objfpc}{$H+}

interface

uses
  Classes, Forms, Graphics, SysUtils, BCGameGrid, BGRABitmap,
  BGRABitmapTypes, types, Controls, Dialogs, ExtCtrls, LCLType, BCEffect;

type

  { TForm1 }

  TForm1 = class(TForm)
    BCGameGrid2: TBCGameGrid;
    Timer1: TTimer;
    procedure BCGameGrid2ClickControl(Sender: TObject; n, x, y: integer);
    procedure BCGameGrid2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure BCGameGrid2MouseEnter(Sender: TObject);
    procedure BCGameGrid2MouseLeave(Sender: TObject);
    procedure BCGameGrid2MouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: integer);
    procedure BCGameGrid2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer);
    procedure BCGameGrid2MouseWheel(Sender: TObject; Shift: TShiftState;
      WheelDelta: integer; MousePos: TPoint; var Handled: boolean);
    procedure BCGameGrid2MouseWheelDown(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: boolean);
    procedure BCGameGrid2MouseWheelUp(Sender: TObject; Shift: TShiftState;
      MousePos: TPoint; var Handled: boolean);
    procedure BCGameGrid2RenderControl(Sender: TObject; Bitmap: TBGRABitmap;
      r: TRect; n, x, y: integer);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure SetFSelected(AValue: integer);
    { private declarations }
  public
    { public declarations }
    FSelected: integer;
    Fade: TFading;
    property Selected: integer read FSelected write SetFSelected;
  end;

var
  Form1: TForm1;

const
  L1 = VK_LEFT;
  R1 = VK_RIGHT;
  U1 = VK_UP;
  D1 = VK_DOWN;
  L2 = VK_A;
  R2 = VK_D;
  U2 = VK_W;
  D2 = VK_S;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.BCGameGrid2RenderControl(Sender: TObject; Bitmap: TBGRABitmap;
  r: TRect; n, x, y: integer);
var
  cr, cg, cb, ca: byte;
  bmp: TBGRABitmap;
begin
  cr := Random(100);
  cg := Random(100);
  cb := Random(255);
  ca := Random(100);

  // selected

  if Selected = n then
  begin
    ca := 255;
    Bitmap.FillRect(r, BGRA(0, 0, 255, Fade.Execute), dmSet);
  end

  // colors

  else
  begin
    Bitmap.FillRect(r, BGRA(cr, cg, cb, ca), dmSet);
    Bitmap.Rectangle(r, BGRA(100, 100, 100, ca), dmDrawWithTransparency);
  end;

  // text

  Bitmap.TextRect(r, concat('n', IntToStr(n), ',x', IntToStr(x), ',y', IntToStr(y)),
    taCenter, tlCenter, BGRA(0, 0, 0, ca));

  // crazy effect

  if n = BCGameGrid2.GridWidth * BCGameGrid2.GridHeight -1 then { remove this if you want to see the original thing... }
  if Odd(n) then { this is for improve speed... }
  begin
    bmp := Bitmap.FilterBlurRadial(1, rbFast) as TBGRABitmap;
    Bitmap.BlendImage(Random(4), Random(4), bmp, boLinearBlend);
    bmp.Free;
  end;

end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin
  Timer1.Enabled := False;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Fade.Mode := fmFadeInOut;
  Fade.Step := 17;
  Fade.Reset;
end;

procedure TForm1.FormHide(Sender: TObject);
begin

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);

begin
  if (Key = L1) or (Key = L2) then
    Selected := Selected - 1
  else if (Key = R1) or (Key = R2) then
    Selected := Selected + 1
  else if (Key = U1) or (Key = U2) then
    Selected := Selected - BCGameGrid2.GridWidth
  else if (Key = D1) or (Key = D2) then
    Selected := Selected + BCGameGrid2.GridWidth;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  BCGameGrid2.RenderAndDrawControl;
end;

procedure TForm1.SetFSelected(AValue: integer);
begin
  if FSelected = AValue then
    Exit;
  FSelected := AValue;
end;

procedure TForm1.BCGameGrid2ClickControl(Sender: TObject; n, x, y: integer);
begin
  Selected := n;
end;

procedure TForm1.BCGameGrid2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  {if Button = mbLeft then
    ...}
end;

procedure TForm1.BCGameGrid2MouseEnter(Sender: TObject);
begin
  //ShowMessage('Enter');
end;

procedure TForm1.BCGameGrid2MouseLeave(Sender: TObject);
begin
  //ShowMessage('Leave');
end;

procedure TForm1.BCGameGrid2MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: integer);
begin
  {if ssLeft in Shift then
    ...}
end;

procedure TForm1.BCGameGrid2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
begin
  {if ssLeft in Shift then
    ...}
end;

procedure TForm1.BCGameGrid2MouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: integer; MousePos: TPoint; var Handled: boolean);
begin
  //ShowMessage('Wheeeeel!');
end;

procedure TForm1.BCGameGrid2MouseWheelDown(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: boolean);
begin
  { Decrease grid }
  BCGameGrid2.GridWidth := BCGameGrid2.GridWidth - 1;
  BCGameGrid2.GridHeight := BCGameGrid2.GridHeight - 1;
end;

procedure TForm1.BCGameGrid2MouseWheelUp(Sender: TObject; Shift: TShiftState;
  MousePos: TPoint; var Handled: boolean);
begin
  { Increase grid }
  BCGameGrid2.GridWidth := BCGameGrid2.GridWidth + 1;
  BCGameGrid2.GridHeight := BCGameGrid2.GridHeight + 1;
end;

end.