type
// Класс, изображающий спрайт в форме сплошного эллипса
TEllipseSprite=class(TTracedSprite)
Здесь
· Служебное слово const указывает на то, что DefaultColor является постоянной величиной. Значение DefaultColor записано в 16-ной системе счисления, которая удобна при записи цветов. (В данном случае $ffffff означает максимальное число, содержащееся в трех байтах; в десятичной системе это число равно 224 – 1 = 1677215.) Дело в том, что информация о цвете в Delphi представляется четырехбайтовым целым числом. Старший байт используется для системных цветов, а в трех младших байтах находятся стандартные цвета – в младшем красный, в среднем зеленый и в старшем байте - синий. Другими словами чисто зеленый цвет, к примеру, отвечает числу $ff00. В 16-ричной записи видна структура байтов. Каждому байту отводится по две 16-ричные цифры. В данном случае число $ffffff означает, что все составляющие цвета входят одинаково и с полной интенсивностью – это белый цвет.
· Вслед за описанием постоянной идет описание класса TEllipseSprite, поэтому набирается служебное слово type, действие которого было отменено const.
· Класс TEllipseSprite является наследником класса TTracedSprite. В классе TEllipseSprite уже реализован абстрактный метод PaintPicture, поэтому можно создавать его экземпляры – сплошные эллипсовидые спрайты заданного цвета.
В этой секции модуля находится код методов пяти классов, описанных выше
implementation uses SysUtils;
//Определяет, находится ли прямоугольник source внутри прямоугольника dest
function Contains(const source,dest:Types.TRect):Boolean;
begin
with dest do
Result:=(source.Left>=Left) and (source.Top>=Top)
and (source.Right<=Right) and (source.Bottom<=Bottom);
end {Contains};
//Реализация методов класса TSpriteList
constructor TSpriteList.Create(const aCanvas:Controls.TControlCanvas);
begin
inherited Create;
if Assigned(aCanvas) then FCanvas:=aCanvas else
raise SysUtils.Exception.Create('Конструктору класса TSpriteList не передана канва!');
FClientRect:=FCanvas.Control.ClientRect;
FCanvasCopyMode:=FCanvas.CopyMode;
FList:=Classes.TList.Create;
end {TSpriteList.Create};
procedure TSpriteList.BeforeDestruction;
begin
Clear;
FCanvas.CopyMode:=FCanvasCopyMode;
FList.Free;
FCount:=0;
inherited
end {TSpriteList.BeforeDestruction};
function TSpriteList.GetSprite(aZ:integer):TSprite;
begin
Result:=TSprite(FList[aZ]);
end {GetSprite};
function TSpriteList.AddSprite(const aSpriteClass:TSpriteClass;
const SpriteRect:Types.TRect):TSprite;
var aSprite:TSprite;
begin
Result:=nil;
if Assigned(aSpriteClass) and (SpriteRect.Right- SpriteRect.Left>0) and
(SpriteRect.Bottom-SpriteRect.Top>0) and Contains(SpriteRect,ClientRect) then
begin
aSprite:=aSpriteClass.Create(SpriteRect,Self);
aSprite.FZ:=FList.Add(aSprite);
FCount:=FList.Count;
Result:=aSprite;
end
end {AddSprite};
procedure TSpriteList.MoveSprite(const fromZ,toZ:integer);
var i,minZ:integer;
begin
if (fromZ<>toZ) and (fromZ>-1) and (fromZ<FCount) and
(toZ>-1) and (toZ<FCount) then
begin
if fromZ<toZ then minZ:=fromZ else minZ:=toZ;
for i:=FCount-1 downto minZ do
if Self[i].FVisible then Self[i].Restore;
FList.Move(fromZ,toZ);
for i:=minZ to FCount-1 do
begin
Self[i].FZ:=i;
if Self[i].FVisible then Self[i].Paint
end
end
end {MoveSprite};
procedure TSpriteList.DeleteSprite(const aZ:integer);
var i:integer;
begin
if (aZ>-1) and (aZ<FCount) then
begin
for i:= FCount-1 downto aZ do
with Self[i] do
if Visible then Restore;
Self[aZ].Free;
FList[aZ]:=nil;
FList.Delete(aZ);
FCount:=FList.Count;
for i:= aZ to FCount-1 do
with Self[i] do
begin
Dec(FZ);
if Visible then Paint;
end
end
end {TSpriteList.DeleteSprite};
procedure TSpriteList.Clear;
var i:integer;
begin
if Assigned(FList) then
for i:= FCount - 1 downto 0 do DeleteSprite(i);
end {TSpriteList.Clear};
//Реализация методов класса TSprite
constructor TSprite.Create(const SpriteRect:Types.TRect;const Sprites:TSpriteList);
begin
inherited Create;
FZ:=-1;
FSpriteList:=Sprites;
FLocation:=SpriteRect.TopLeft;
with FSize,SpriteRect do
begin
cx:=Right-Left;cy:=Bottom-Top
end;
end {TSprite.Create};
procedure TSprite.AfterConstruction;
begin
inherited;
FImage:=Graphics.TBitmap.Create;
FImage.Height:=FSize.cy;
FImage.Width:=FSize.cx;
end {TSprite.AfterConstruction};
procedure TSprite.BeforeDestruction;
begin
FImage.Free;
inherited
end {TSprite.BeforeDestruction};
procedure TSprite.SetVisible(const aVisible:Boolean);
begin
if aVisible<>FVisible then
begin
if aVisible then
begin
BeginPaint;
Paint;
EndPaint;
end else
begin
BeginPaint;
Restore;
EndPaint;
end;
FVisible:=aVisible
end
end {SetVisible};
function TSprite.Move(const drift:Types.TSize):boolean;
var NewPos:Types.TPoint;VisState:Boolean;
begin
Result:=true;
NewPos:=Types.Point(FLocation.X+drift.cx,FLocation.Y+drift.cy);
if Assigned(FOnMove) then Result:=FOnMove(Self,NewPos);
Result:=Result and Contains(
Types.Rect(NewPos.X,NewPos.Y,NewPos.X+FSize.cx,NewPos.Y+FSize.cy),
FSpriteList.FClientRect);
if Result then
begin
VisState:=FVisible;
Visible:=false;
FLocation:=NewPos;
Visible:=VisState
end
end {TSprite.Move};
function TSprite.MoveTo(const NewLocation:Types.TPoint):boolean;
begin
Result:=Move(Types.TSize(
Types.Point(NewLocation.X-FLocation.X,NewLocation.Y-FLocation.Y)))
end {MoveTo};
procedure TSprite.BeginPaint;
var i:integer;
begin
SetMask(FZ);
for i:=FSpriteList.FCount-1 downto FZ+1 do
with FSpriteList[i] do
if FMask and FVisible then Restore;
end {BeginPaint};
procedure TSprite.SetMask(const aZ:integer);
var i:integer;
begin
for i:=aZ+1 to FSpriteList.FCount-1 do
begin
with FSpriteList[i] do
FMask:= Intersect(aZ,i) or FMask;
if FMask then SetMask(i)
end
end {SetMask};
procedure TSprite.EndPaint;
var i:integer;
begin
for i:=FZ+1 to FSpriteList.FCount-1 do
with FSpriteList[i] do
if FMask then
begin
if FVisible then Paint;
FMask:=false
end
end {EndPaint};
procedure TSprite.Paint;
begin
with FSpriteList do
begin
FCanvas.CopyMode:=cmSrcCopy;
with FImage do
Canvas.CopyRect(Types.Rect(0,0,Width,Height),FCanvas,SpriteRect);
end;
PaintPicture
end {Paint};
procedure TSprite.Restore;
begin
with FSpriteList.FCanvas do
begin
CopyMode:= cmSrcCopy;
with FImage do CopyRect(SpriteRect,Canvas,Types.Rect(0,0,Width,Height));
end
end {Restore};
function TSprite.GetSpriteRect:Types.TRect;
begin
with FLocation,FSize do Result:=Types.Rect(X, Y, X+cx,Y+cy)
end {GetSpriteRect};
function TSprite.Intersect(const First,Second:integer):boolean;
var rect:Types.TRect;
begin
with FSpriteList[First] do
Result:=IntersectRect(rect,SpriteRect,FSpriteList[Second].SpriteRect);
end {Intersect};
//Реализация методов класса TTracedSpriteList
procedure TTracedSpriteList.AfterConstruction;
begin
inherited;
with ClientRect do SetLength(FTraceMap,Right-Left+1,Bottom-Top+1);
end {TTracedSpriteList.AfterConstruction};
procedure TTracedSpriteList.BeforeDestruction;
begin
inherited;
FTraceMap:=nil;
end {TTracedSpriteList.BeforeDestruction};
procedure TTracedSpriteList.DeleteSprite(const aZ:integer);
begin
if (aZ > -1) and (aZ < Count) then
begin
TTracedSprite(Self[aZ]).FTracePoints:=nil;
inherited DeleteSprite(aZ);
end
end {TTracedSpriteList.DeleteSprite};
procedure TTracedSpriteList.Clear;
var i,j:integer;
begin
for i:= Low(FTraceMap) to High(FTraceMap) do
for j:= Low(FTraceMap[i]) to High(FTraceMap[i]) do
FTraceMap[i,j]:= false;
inherited Clear;
end {TTracedSpriteList.Clear};
//Реализация методов класса TTracedSprite
procedure TTracedSprite.AfterConstruction;
begin
inherited;
FCenter:=Types.CenterPoint(SpriteRect);
end {TTracedSprite.AfterConstruction};
procedure TTracedSprite.BeforeDestruction;
begin
FTracePoints:=nil;
inherited
end {TTracedSprite.BeforeDestruction};
procedure TTracedSprite.SetTraceColor(const aTraceColor:Graphics.TColor);
begin
FTraceColor:=aTraceColor;
FTraceColored:=true
end {SetTraceColor};
function TTracedSprite.Move(const drift:Types.TSize):Boolean;
begin
if FVisible and FTraced then PutTrace;
Result:=inherited Move(drift);
if Result then
FCenter:=Types.CenterPoint(SpriteRect)
end {TTracedSprite.Move};
procedure TTracedSprite.PutTrace;
var i:integer;
begin
with FCenter do
begin
for i:=FSpriteList.FCount-1 downto 0 do
begin
with FSpriteList[i] do
if FVisible and Types.PtInRect(SpriteRect,Self.FCenter)
then Restore;
end;
with TTracedSpriteList(FSpriteList),FClientRect do
if not TraceMap[x-Left,y-Top] then
begin
with FCanvas do
if FTraceColored then Pixels[x,y]:=FTraceColor else
Pixels[x,y]:=$ffffff xor Pixels[x,y];
TraceMap[x-Left,y-Top]:=true;
SetLength(FTracePoints,High(FTracePoints)+2);
FTracePoints[High(FTracePoints)].X:=x;FTracePoints[High(FTracePoints)].Y:=y;
end;
for i:=0 to FSpriteList.FCount-1 do
begin
with FSpriteList[i] do
if FVisible and Types.PtInRect(SpriteRect,Self.FCenter)
then Paint;
end
end
end {PutTrace};
//Реализация методов класса TEllipseSprite
procedure TEllipseSprite.AfterConstruction;
begin
inherited;
FColor:=DefaultColor;
end {TEllipseSprite.AfterConstruction};
procedure TEllipseSprite.SetColor(const aColor: Graphics.TColor);
var VisState:Boolean;
begin
if FColor<>aColor then
begin
VisState:=FVisible;
Visible:=false;
FColor:=aColor;
if VisState then Visible:=true
end
end {SetColor};
procedure TEllipseSprite.PaintPicture;
begin
with FSpriteList.FCanvas do
begin
Brush.Style:=bsSolid;
Brush.Color:=Color;
Pen.Color:=color;
Ellipse(SpriteRect);
end;
end {PaintPicture};
end {uSprite}.
Следует отметить, что в Delphi в разделе реализации можно указывать лишь имена методов, не повторяя список параметров и тип функции. Например, вместо строки кода
function TTracedSprite.Move(const drift: Types.TSize): Boolean;
можно было бы записать ее краткий вариант
function TTracedSprite.Move;
Здесь мы этим не пользовались, чтобы не затруднять чтение кода.
Предлагается составить оконное приложение, тестирующее представленные классы спрайтов. Для этого следует разместить на форме объект типа TPaintBox с произвольным фоном (в виде рисунка). Создать на нем произвольный список эллиптических спрайтов, имеющих разные атрибуты (цвет, размер) и перемещающихся в границах прямоугольника с произвольными скоростями, зеркально отражаясь от границ и оставляя след.
C++
Теперь рассмотрим версию тех же классов спрайтов, написанную на языке C++ в среде C++ Builder (6-ая версия) фирмы Borland.
Структура программного модуля в C++ несколько отличается от структуры модуля, написанного на Object Pascal в Delphi. В некотором смысле интерфейсной секции дельфийского модуля соответствует отдельный физический файл программного модуля на C++, именуемый «хэдер», или файл заголовков. Хэдер имеет расширение .h. Хэдер все же отличается от дельфийской секции interface тем, что в него можно помещать содержательную часть кода, а не только заголовки. Смотрите, к примеру, функцию Contains, описанную в хэдере.
Другой файл, имеющий расширение .cpp и то же имя, что хэдер, содержит реализацию кода, как в секции реализации дельфийского модуля. Оба файла образуют пару, соответствующую одному программному модулю типа unit в Delphi.
В начале рассмотрим подробнее содержание хэдера классов спрайтов модуля uSprite.
#ifndef uSpriteH
#define uSpriteH
//---------------------------------------------------------------------------
/*Модуль, в котором описаны классы TSpriteList и TSprite
для Z-упорядочения графических изображений
на любой канве (например, канве объекта типа TPaintBox).
Конструктор класса TSpriteList имеет один параметр - канву,
на которой производится отрисовка.
Конструктор класса TSprite имеет также один параметр - прямоугольник спрайта.
Объекты типа TSprite помещаются в список
методом AddSprite класса TSpriteList*/
class TSprite;
//TSpriteList
class TSpriteList
{
private:
// Поля
int count;
TControlCanvas* canvas;
TRect clientRect;
TList* list;
TCopyMode canvasCopyMode;
// Метод
TSprite* __fastcall GetItems(int);
public:
// Свойства
__property int Count={read=count};
__property TControlCanvas* Canvas={read=canvas};
__property TRect ClientRect={read=clientRect};
__property TList* List={read=list};