unit SpriteControl;
{$mode objfpc}{$H+}
interface
uses {$ifdef windows}Windows,{$endif} Classes, Controls, Graphics, Fgl;
type
TSprite = class
protected
FBitmap:TBitmap;
public
Rect:TRect;
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;
end;
TSpriteList = specialize TFPGObjectList<TSprite>;
TSpriteControl = class(TCustomControl)
protected
FBitmap:TBitmap;
FSprites:TSpriteList;
FSpriteUnderCursor:TSprite;
FUpdateCount:Integer;
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);
property Bitmap:TBitmap read FBitmap;
property Sprites:TSpriteList read FSprites;
property SpriteUnderCursor:TSprite read FSpriteUnderCursor write SetSpriteUnderCursor;
end;
implementation
uses SysUtils;
constructor TSprite.Create(ABitmap:TBitmap;ACoord:TPoint);
begin
inherited Create;
FBitmap := ABitmap;
Rect := 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 TRect.Intersect(ARect, Rect).IsEmpty then begin
ACanvas.Draw(Rect.Left, Rect.Top, Bitmap);
end;
end;
procedure TSprite.Move(APoint:TPoint);
begin
Rect := 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;
FUpdateCount := 1;
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);
{$else}
Invalidate;
{$endif}
Inc(FUpdateCount);
end;
procedure TSpriteControl.Paint;
var Rect, ClipRect, PaintRect:TRect;
I:Integer;Sprite:TSprite;
FocusSprite:TSprite;
begin
inherited Paint;
Rect := TRect.Create(TPoint.Create(0, 0), Bitmap.Width, Bitmap.Height);
ClipRect := Canvas.ClipRect;
PaintRect := Rect * ClipRect;
if FUpdateCount > 0 then begin
with Bitmap.Canvas do begin
Brush.Color := BackgroundColor;
FillRect(PaintRect);
end;
FocusSprite := nil;
for I := Sprites.Count - 1 downto 0 do begin
Sprite := Sprites[I];
Sprite.Draw(Bitmap.Canvas, PaintRect);
if Sprite = SpriteUnderCursor then begin
FocusSprite := Sprite;
end;
end;
if Assigned(FocusSprite) then begin
with Bitmap.Canvas do begin
DrawFocusRect(FocusSprite.Rect);
end;
end;
FUpdateCount := 0;
end;
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.
Recent
