Продолжение поста «Двойная буфферизация для Delphi 7»

Небольшой движок для рисования и пример вывода графики на канву в Rad Studio. Работает при создании:

multi-device application, при создании чисто Windows-приложений, жалуется на ошибочные функции DrawBitmap

var
Form1: TForm1;

Sprites : array of TBitmap;
Sprite_name: array of String;
proc:single;

implementation

{$R *.fmx}

function Sprite_Add(const FileName, SpriteName : string): TBitmap;
var
s:string;
i:integer;
begin
s:=spritename+’ ‘+filename;
try
SetLength(Sprites, Length(Sprites) + 1);
SetLength(Sprite_name, Length(Sprites) + 1);
Result := TBitmap.Create;
Result.LoadFromFile(FileName);
Sprites[Length(Sprites) — 1] := Result;
Sprite_name[Length(Sprites) — 1]:=SpriteName;
except
end;
end;

procedure Init;
var
i:integer;
begin

try
Sprites := nil;
Sprite_Add(‘art\start.bmp’,’background’);
except
end;
end;

procedure Sprite_Draw2(x, y, z, z2: single; s:string); //x, y, — процент где все находится z — размер
var
i, idx:integer;
R, R2: TRectF;
x2, y2:single;
popravka:integer;

begin
try
idx:=0;
for i:=0 to (Length(Sprites) — 1) do
if Sprite_name[i]=s then
begin
idx:=i;
Break;
end;

popravka:=0;

if (form1.ClientHeight/proc)>50 then popravka:=round((((form1.ClientHeight/proc)-50)/2)*proc);

x2:=(proc*x);
y2:=(proc*y/2);

R.Create(0,0,sprites[idx].Width,sprites[idx].Height);
R2.Create(x2,y2+popravka,x2+proc*z, y2+proc/2*z2+popravka);
form1.Canvas.DrawBitmap(Sprites[idx], R, R2, 100 );
except

end;
end;

// Вывод текста, х-у координаты (в процентах),
function textout(x, y, z, z2: single; text:string):TRectF;
var
i, idx:integer;
R, R2: TRectF;
x1, y1, x2, y2:single;
popravka:integer;

begin
popravka:=0;
proc:=form1.ClientWidth/100;
if (form1.ClientHeight/proc)>50 then popravka:=round((((form1.ClientHeight/proc)-50)/2)*proc);

x1:=form1.Width/100;
y1:=form1.Width/200;

x2:=(x1*x);
y2:=(y1*y);

result.Create(x2,y2+popravka,x2+x1*z, y2+y1*z2+popravka);
form1.Canvas. FillText(result,text ,true, 1,[], TTextAlign.Center, TTextAlign.Center);
end;

procedure TForm1.FormPaint(Sender: TObject; Canvas: TCanvas;
const ARect: TRectF);
begin
try
if Canvas.BeginScene then
try

canvas.Stroke.Kind := TBrushKind.Solid;
canvas.Stroke.Color := TAlphaColorRec.Yellow;
canvas.Fill.Color:= TAlphaColors.Yellow;
canvas.Font.Size:=20;
canvas.Stroke.Thickness:=3;
canvas.Font.Family:=’Impact’;
Sprite_Draw2(0, 0, 100, 100, ‘background’);
textout(33, 5, 10, 100, ‘CONTINUE’);
finally
Canvas.EndScene;
end;
except

end;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
proc:=form1.Width/ 100;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
init;
end;