Bitmap to Sprites and Move

Dieses Beispiel zeigt, wie man Bitmaps als Sprite berechnen und einsetzen kann.

Wem der Begriff Sprite nicht bekannt ist, sollte sich hier ein wenig kundig machen: https://de.wikipedia.org/wiki/Sprite_(Computergrafik)

Die Bitmaps lassen sich flackerfrei über ein JPG-Image mit der Maus ziehen oder können auch berechnet bewegt werden.

uses ExtCtrls, jpeg

type
  TSprite = record
    Img : TImage;
    Mask : TBitmap;
    sX, sY : Integer;
    layer : Integer;
    locked : Boolean;
end;

type
  PTSprite = ^TSprite;
  
Procedure CreateMsk(PSprite: PTSprite);
Procedure SimpleDrawSprite(PSprite: PTSprite);

var
    Form1: TForm1;
    LeSprite : array[0..2] of TSprite;
    NbSprite : Integer;
    Selected : Integer;
    hdcSave: Hdc;
    bmSave: HBitmap;
    HdcWork: Hdc;
    bmWork: HBitmap;
    OldMouseX, OldMouseY: Integer;
    OkDepl: Boolean;
    
//

procedure TForm1.Close(Sender: TObject; var Action: TCloseAction);
var
  i : Integer;
begin
  for I := 0 to NBSprite  do
  Begin
    LeSprite[i].img.Free;
    LeSprite[i].Mask.Free;
  End;
  DeleteDC(HdcWork);
  DeleteObject(SelectObject(HdcWork, bmWork));
  DeleteObject(SelectObject(hdcSave, bmSave));
  DeleteDC(hdcSave);
end;

procedure TForm1.GetMouseXY(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    OkDepl := False;
    With LeSprite[Selected] do
    Begin
      if (X > sX) AND (X < sX + img.Width) AND (Y > sY) AND (Y < sY + img.Height) then
      Begin
          OldMouseX := X;
          OldMouseY := Y;
          OkDepl := True;
      end;
    End;
end;

procedure TForm1.Init(Sender: TObject);
var
  Jpg: TJPEGImage;
begin
    Jpg := TJPEGImage.Create;
    Jpg.LoadFromFile('bgr.jpg');
    Image1.Picture.Bitmap.Assign(Jpg);
    Jpg.Free;
    DoubleBuffered := True; 
    NbSprite := -1;
    with Image1 do
    Begin
        hdcSave := CreateCompatibleDC(Canvas.Handle);
        bmSave := CreateCompatibleBitmap(Canvas.Handle, Picture.Width, Picture.Height);
        SelectObject(hdcSave, bmSave);
        BitBlt(hdcSave, 0, 0, Width, Height, Canvas.Handle, 0, 0, SrcCopy);
        HdcWork := CreateCompatibleDC(Canvas.Handle);
        bmWork := CreateCompatibleBitmap(Canvas.Handle, Picture.Width, Picture.height);
        SelectObject(HdcWork, bmWork);
    End;
     With LeSprite[0] do
     Begin
         img := TImage.Create(self);
         img.AutoSize := True;
         img.Picture.LoadFromFile('Sprite1.bmp');  // Bild Nr.1
         layer := 0;
         locked := False;
     End;
     CreateMsk(@LeSprite[0]);
     Inc(NbSprite);
     With LeSprite[1] do
     Begin
         img := TImage.Create(self);
         img.AutoSize := True;
         img.Picture.LoadFromFile('Sprite2.bmp');  // Bild Nr.2
         layer := 1;
         locked := False;
     End;
     CreateMsk(@LeSprite[1]);
     Inc(NbSprite);
     With LeSprite[2] do
     Begin
         img := TImage.Create(self);
         img.AutoSize := True;
         img.Picture.LoadFromFile('Sprite3.bmp');  // Bild Nr.3
         layer := 2;
         locked := False;
     End;
     CreateMsk(@LeSprite[2]);
     Inc(NbSprite);
     SimpleDrawSprite(@LeSprite[0]);
     SimpleDrawSprite(@LeSprite[1]);
     SimpleDrawSprite(@LeSprite[2]);
     Selected := NbSprite;
end;

procedure TForm1.MoveTheSprite(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Var
    i,dx, dy: Integer;
begin
    if (Shift = [ssLeft]) AND OkDepl then    
    begin
        dx := X - OldMouseX;
        dy := Y - OldMouseY;
        LeSprite[selected].sX := LeSprite[selected].sX + dx;
        LeSprite[selected].sY := LeSprite[selected].sY + dy;
        BitBlt(HdcWork, 0, 0, Image1.Picture.Width, Image1.Picture.height, HdcSave, 0, 0, SrcCopy);
        for i := 0 to NBSprite do
        begin
            With LeSprite[i] do
            Begin
                MaskBlt(HdcWork, sX, sY, img.Width, img.Height, img.Canvas.Handle, 0, 0, Mask.Handle, 0, 0, MAKEROP4(SrcCopy, $00AA0029));
            end;
        end;
        BitBlt(Image1.Canvas.Handle, 0, 0, Image1.Picture.Width, Image1.Picture.height, hdcWork, 0, 0, SrcCopy);
        Invalidate;
        OldMouseX := X;
        OldMouseY := Y;
    end;
end;

Procedure SimpleDrawSprite(PSprite: PTSprite);
Begin
    With PSprite^ do
    Begin
        sX := (Form1.Image1.Width div 2) - (img.width div 2);
        sY := (Form1.Image1.Height div 2) - (img.height div 2);
        MaskBlt(Form1.Image1.Canvas.Handle, sX, sY, img.Width, img.Height, img.Canvas.Handle, 0, 0, Mask.Handle, 0, 0, MAKEROP4(SrcCopy, $00AA0029));
    End;
End;

Procedure CreateMsk(PSprite: PTSprite);
var
    X, Y: Integer;
    cl: TColor;
begin
    With PSprite^ do
    Begin
      Mask := TBitmap.Create;
      With Mask do
      begin
          Width := img.Width;
          Height := img.Height;
          pixelFormat := pf1bit;
          Canvas.Brush.Color := clWhite; 
          Canvas.FillRect(Canvas.ClipRect);
      end;
      for Y := 0 to img.Height - 1 do
      begin
          for X := 0 to img.Width - 1 do
          begin
              cl := img.Canvas.pixels[X, Y];
              if cl = clWhite then Mask.Canvas.pixels[X, Y] := clBlack;
          end;
      end;
    End;
end;

Sprites mit der Maus wählen :

procedure TForm1.Button1Click(Sender: TObject);
begin
    Selected := 0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    Selected := 1;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
    Selected := 2;
end;