unit SpriteControl;
{$mode objfpc}{$H+}
interface
uses {$ifdef windows}Windows,{$endif} Classes, Controls, Graphics, Fgl;
type
TSprite = class
protected
FBitmap:TBitmap;
FRect:TRect;
public
constructor Create(ABitmap:TBitmap;ACoord:TPoint);
destructor Destroy;override;
procedure Draw(ACanvas:TCanvas;ARect:TRect);
procedure Move(APoint:TPoint);
function HitTest(APoint:TPoint):Boolean;
property Bitmap:TBitmap read FBitmap;
property Rect:TRect read FRect;
end;
TSpriteList = specialize TFPGObjectList<TSprite>;
TSpriteControl = class(TCustomControl)
protected
FBitmap:TBitmap;
FSprites:TSpriteList;
FSpriteUnderCursor:TSprite;
{$ifdef windows}
FNeedUpdate:Boolean;
{$endif}
FClickedSprite:TSprite;
FClickedPoint:TPoint;
FClickedCoord:TPoint;
FDragging:Boolean;
procedure Paint;override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer);override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);override;
procedure SetSpriteUnderCursor(ASprite:TSprite);
public
BackgroundColor:TColor;
constructor Create(AOwner: TComponent);override;
destructor Destroy;override;
procedure AddSprite(ASprite:TSprite);
procedure UpdateSprite(ASprite:TSprite);
procedure DeleteSpriteUnderCursor;
property Bitmap:TBitmap read FBitmap;
property Sprites:TSpriteList read FSprites;
property SpriteUnderCursor:TSprite read FSpriteUnderCursor write SetSpriteUnderCursor;
end;
implementation
constructor TSprite.Create(ABitmap:TBitmap;ACoord:TPoint);
begin
inherited Create;
FBitmap := ABitmap;
FRect := TRect.Create(ACoord, Bitmap.Width, Bitmap.Height);
end;
destructor TSprite.Destroy;
begin
FBitmap.Free;
inherited Destroy;
end;
procedure TSprite.Draw(ACanvas:TCanvas;ARect:TRect);
begin
if not (ARect * Rect).IsEmpty then begin
ACanvas.Draw(Rect.Left, Rect.Top, Bitmap);
end;
end;
procedure TSprite.Move(APoint:TPoint);
begin
FRect := TRect.Create(APoint, Bitmap.Width, Bitmap.Height);
end;
function TSprite.HitTest(APoint:TPoint):Boolean;
begin
Result := Rect.Contains(APoint);
if Result and Bitmap.Transparent then begin
APoint := APoint - Rect.TopLeft;
Result := Bitmap.Canvas.Pixels[APoint.X, APoint.Y] <> Bitmap.TransparentColor;
end;
end;
constructor TSpriteControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBitmap := TBitmap.Create;
FSprites := TSpriteList.Create;
{$ifdef windows}
FNeedUpdate := True;
{$endif}
end;
destructor TSpriteControl.Destroy;
begin
FBitmap.Free;
FSprites.Free;
inherited Destroy;
end;
procedure TSpriteControl.AddSprite(ASprite:TSprite);
begin
Sprites.Insert(0, ASprite);
UpdateSprite(ASprite);
end;
procedure TSpriteControl.UpdateSprite(ASprite:TSprite);
begin
{$ifdef windows}
InvalidateRect(Handle, ASprite.Rect, False);
FNeedUpdate := True;
{$else}
Invalidate;
{$endif}
end;
procedure TSpriteControl.DeleteSpriteUnderCursor;
var Temp:TSprite;
begin
if Assigned(SpriteUnderCursor) then begin
Temp := SpriteUnderCursor;
if FClickedSprite = Temp then begin
FClickedSprite := nil;
FDragging := False;
end;
SpriteUnderCursor := nil;
Sprites.Remove(Temp);
end;
end;
procedure TSpriteControl.Paint;
var Rect, ClipRect, PaintRect:TRect;
I:Integer;
{$ifdef windows}
ClipRgn:HRGN;
{$endif}
begin
inherited Paint;
Rect := TRect.Create(TPoint.Create(0, 0), Bitmap.Width, Bitmap.Height);
ClipRect := Canvas.ClipRect;
PaintRect := Rect * ClipRect;
{$ifdef windows}
if FNeedUpdate then begin
{$endif}
with Bitmap.Canvas do begin
{$ifdef windows}
ClipRgn := CreateRectRgn(PaintRect.Left, PaintRect.Top, PaintRect.Right, PaintRect.Bottom);
SelectClipRgn(Handle, ClipRgn);
{$endif}
Brush.Color := BackgroundColor;
FillRect(PaintRect);
end;
for I := Sprites.Count - 1 downto 0 do begin
Sprites[I].Draw(Bitmap.Canvas, PaintRect);
end;
if Assigned(SpriteUnderCursor) and
not (SpriteUnderCursor.Rect * PaintRect).IsEmpty then
begin
with Bitmap.Canvas do begin
DrawFocusRect(SpriteUnderCursor.Rect);
end;
end;
{$ifdef windows}
with Bitmap.Canvas do begin
SelectClipRgn(Handle, 0);
DeleteObject(ClipRgn);
end;
FNeedUpdate := False;
end;
{$endif}
Canvas.CopyRect(PaintRect, Bitmap.Canvas, PaintRect);
if not PaintRect.Contains(ClipRect) then begin
Canvas.Brush.Color := Color;
Rect := ClientRect;
Rect.Left := Bitmap.Width;
Rect.Intersect(ClipRect);
Canvas.FillRect(Rect);
Rect := ClientRect;
Rect.Top := Bitmap.Height;
Rect.Width := Bitmap.Width;
Rect.Intersect(ClipRect);
Canvas.FillRect(Rect);
end;
end;
procedure TSpriteControl.MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
var I:Integer;Sprite, HitSprite:TSprite;
begin
inherited MouseDown(Button, Shift, X, Y);
if Button = mbLeft then begin
HitSprite := nil;
for I := 0 to Sprites.Count - 1 do begin
Sprite := Sprites[I];
if Sprite.HitTest(TPoint.Create(X, Y)) then begin
HitSprite := Sprite;
FClickedPoint := TPoint.Create(X, Y);
FClickedCoord := Sprite.Rect.TopLeft;
Break;
end;
end;
FClickedSprite := HitSprite;
end;
end;
procedure TSpriteControl.MouseMove(Shift: TShiftState; X,Y: Integer);
var I:Integer;Sprite, HitSprite:TSprite;
begin
inherited MouseMove(Shift, X, Y);
if Assigned(FClickedSprite) then begin
if not FDragging then begin
if (Abs(X - FClickedPoint.X) > 5) or (Abs(Y - FClickedPoint.Y) > 5) then begin
FDragging := True;
end;
end;
if FDragging then begin
UpdateSprite(FClickedSprite);
FClickedSprite.Move(FClickedCoord + TPoint.Create(X, Y) - FClickedPoint);
UpdateSprite(FClickedSprite);
SpriteUnderCursor := FClickedSprite;
Exit;
end;
end;
HitSprite := nil;
for I := 0 to Sprites.Count - 1 do begin
Sprite := Sprites[I];
if Sprite.HitTest(TPoint.Create(X, Y)) then begin
HitSprite := Sprite;
end;
end;
SpriteUnderCursor := HitSprite;
end;
procedure TSpriteControl.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
begin
inherited MouseUp(Button, Shift, X, Y);
if Button = mbLeft then begin
if FDragging then begin
FDragging := False;
end
else begin
if Assigned(FClickedSprite) then begin
Sprites.Move(Sprites.IndexOf(FClickedSprite), 0);
UpdateSprite(FClickedSprite);
end;
end;
FClickedSprite := nil;
end;
end;
procedure TSpriteControl.SetSpriteUnderCursor(ASprite:TSprite);
var OldSprite:TSprite;
begin
if SpriteUnderCursor <> ASprite then begin
OldSprite := SpriteUnderCursor;
FSpriteUnderCursor := ASprite;
if Assigned(OldSprite) then begin
UpdateSprite(OldSprite);
end;
if Assigned(SpriteUnderCursor) then begin
UpdateSprite(SpriteUnderCursor);
end;
end;
end;
end.