вариант со снятием огрызка скриншота вместо рисования одноцветных прямоугольников, затирающих нашу машинку и ее какашки в виде надписи "loading N%"
// progress sample for leonid
// (c) barsunduk
// 02.11.2011
program carload;
var
car, back: image;
i, ww, scrW, scrH: integer;
// на входе состояние прогресса
// от 0 до scrW (ширина экрана)
procedure progress(x: integer);
var
w, h, y: integer;
s: string;
begin
w := GetImageWidth(car);
h := GetImageHeight(car);
y := scrH - h - h;
// восстанавливаем содержимое экрана из скриншота - стираем прогрессбар
DrawImage(back, 0, y);
s := 'loading... ' + (100 * x / scrW) + '% ';
SetColor(0, 0, 0);
DrawText(s, x - GetStringWidth(s), y + h - GetStringHeight(s));
SetColor(240, 255, 240);
DrawText(s, x - GetStringWidth(s) - 1, y + h - GetStringHeight(s) - 1);
// рисуется машинка
DrawImage(car, x, y);
end;
begin
car := loadImage('/car.png');
scrW := GetWidth;
scrH := GetHeight;
SetColor(0, 0, 0);
FillRect(0, 0, scrW, scrH);
// тут рисуется всякое... ну там реклама, лого, заставка, хз
// ...
// например завалим экран мусором:
ww := scrW;
if ww > 255 then
ww := 255;
for i := 0 to ww do
begin
SetColor(ww - i, ww - i, ww - i);
DrawLine(i, 0, i, scrH);
end;
// берем кусок скриншота
back := ImageFromCanvas(0, scrH - GetImageHeight(car) * 2, GetWidth, GetImageHeight(car));
// цикл с шагом в 2 пиксела
for i := 0 to scrW / 2 do
begin
progress(i * 2);
repaint;
delay(40);
end;
// очищаем память от ненужных картинок
delay(2000);
end.