lazarus：用上下左右键控制一个图层的位移

最新推荐文章于 2024-02-16 15:11:09 发布

老狼8848

最新推荐文章于 2024-02-16 15:11:09 发布

阅读量275

点赞数

分类专栏： Lazarus

本文链接：https://blog.csdn.net/bq_cui/article/details/105925386

版权

Lazarus 专栏收录该内容

169 篇文章 21 订阅

订阅专栏

用键盘的上下左右键控制一个图层的位移。

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, BGRABitmap, BGRABitmapTypes;

type

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormPaint(Sender: TObject);
  private

  public
    ix, iy: integer;
  end;

var
  Form1: TForm1;

implementation

{$R *.frm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  ix := 0;
  iy := 0;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
  );
begin
  // up
  If Key =  $26 Then
    iy -= 1
  // right
  else If Key =  $27 Then
    ix += 1
  // down
  else If Key =  $28 Then
    iy += 1
  // left
  else If Key =  $25 Then
    ix -= 1;


  form1.Caption := '  ix:' + intToStr(ix) + '  iy:' + intToStr(iy) ;
  FormPaint(self);
end;

procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
    size: single;

  procedure DrawMoon;
  var layer: TBGRABitmap;
  begin
    layer := TBGRABitmap.Create(image.Width,image.Height);
    layer.FillEllipseAntialias(layer.Width/2,layer.Height/2,size*0.4,size*0.4,BGRA(224,224,224,128));
    layer.EraseEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,size*0.3,size*0.3,255);
    image.PutImage(0,0,layer,dmDrawWithTransparency);
    layer.Free;
  end;

  procedure DrawSun;
  var layer,mask: TBGRABitmap;
  begin
    layer := TBGRABitmap.Create(image.Width,image.Height);
    layer.GradientFill(0,0,layer.Width,layer.Height,
                       BGRA(255,255,0),BGRA(255,0,0),
                       gtRadial,
                       PointF(layer.Width/2,layer.Height/2-size*0.15),PointF(layer.Width/2 + size*0.45,layer.Height/2-size*0.15),
                       dmSet);
    mask := TBGRABitmap.Create(layer.Width,layer.Height, BGRABlack);
    mask.FillEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,size*0.25,size*0.25,BGRAWhite);
    layer.ApplyMask(mask);
    mask.Free;
    image.PutImage(ix,iy,layer,dmDrawWithTransparency);
    layer.Free;
  end;

  procedure ApplyLight;
  var layer: TBGRABitmap;
  begin
    layer := TBGRABitmap.Create(image.Width,image.Height);
    layer.GradientFill(0,0,layer.Width,layer.Height,
                       BGRA(255,255,255),BGRA(64,64,64),
                       gtRadial,PointF(layer.Width*5/6,layer.Height/2),PointF(layer.Width*1/3,layer.Height/4),
                       dmSet);
    image.BlendImage(0,0,layer,boMultiply);
    layer.Free;
  end;

begin
  image := TBGRABitmap.Create(ClientWidth,ClientHeight);

  if image.Height < image.Width then
    size := image.Height
  else
    size := image.Width;

  image.GradientFill(0,0,image.Width,image.Height,
                     BGRA(128,192,255),BGRA(0,0,255),
                     gtLinear,PointF(0,0),PointF(0,image.Height),
                     dmSet);

  DrawMoon;
  DrawSun;
  ApplyLight;

  image.Draw(Canvas,0,0,True);
  image.free;

end;

end.