![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как определить "графическое быстрдействия" компьютера [D7, Win95/98, WinXP]
Mefodiy © (2005-07-21 09:11:00)В программе производится плавное преобразование одной картинки в другую. Скорость преобразования зависит от задаваемого числа итераций. Проблема в том, что при одном и том же числе итераций на разных компьютерах скорость преобразования разная и весь эффект порой пропадает.
Как можно на этапе загрузки программы вычислить некий "коэффициент графического быстродействия" и на его основе соответствующее число итераций для каждого конкретного случая.
Спасибо.
Mefodiy (2005-07-22 10:30:00) [1]>Alx2 ©
Работает нормально. Спасибо за труды.
Alx2 (2005-07-22 10:02:00) [2]>Mefodiy (21.07.05 15:42)
Вот лениво разогнанный вариант:
Procedure TForm1.StartButton10Click(Sender: TObject);
Const
Exp_Factor = 12; // Величина двоичного сдвига (позволит исключить деление и одно умножение)
TransformTime_ms = 1000; // Время в мс на преобразование
Var
Count, i, x, y: integer;
bm, bm1, bm2: TBitMap;
p1, p2, p: PByteArray;
StartTime: Cardinal;
Begin
bm := TBitMap.Create;
bm1 := TBitMap.Create;
bm2 := TBitMap.Create;
Try
bm1.LoadFromFile('MyPic1.bmp');
bm2.LoadFromFile('MyPic2.bmp');
Count := round(power(2, Exp_Factor)); // Вычисляем количество кадров как степень двойки
If bm1.Height < bm2.Height Then
Begin
bm.Height := bm1.Height;
bm2.Height := bm1.Height;
End
Else
Begin
bm.Height := bm2.Height;
bm1.Height := bm2.Height;
End;
If bm1.Width < bm2.Width Then
Begin
bm.Width := bm1.Width;
bm2.Width := bm1.Width;
End
Else
Begin
bm.Width := bm2.Width;
bm1.Width := bm2.Width;
End;
bm.PixelFormat := pf24bit;
bm1.PixelFormat := pf24bit;
bm2.PixelFormat := pf24bit;
StartTime := GetTickCount;
Canvas.Draw(0, 0, bm1);
Repeat
i := round(min((GetTickCount - StartTime) / TransformTime_ms, 1) * Count);
For y := 0 To bm.Height - 1 Do
Begin
p := bm.ScanLine[y];
p1 := bm1.ScanLine[y];
p2 := bm2.ScanLine[y];
For x := 0 To bm.Width * 3 - 1 Do
p^[x] := (p1^[x] Shl Exp_Factor + (p2^[x] - p1^[x]) * i) Shr Exp_Factor;
// Здесь раскрыли скобки и все, что имеет отношение к count заменили на сдвиги.
End;
Canvas.Draw(0, 0, bm);
Caption := IntToStr(Round(i / count * 100)) + '%';
Until I >= Count;
Caption := 'Done';
Finally
bm1.free;
bm2.free;
bm.free;
End;
End;
Alx2 (2005-07-22 09:28:00) [3]>Mefodiy (21.07.05 15:42)
>Куда и как это всунуть? Привожу код программы (она взята из
>интернета).
Всунул.
Procedure TForm1.StartButton10Click(Sender: TObject);
Const
count = 2000;
TransformTime_ms = 5000; // Время в мс на преобразование
Var
i: integer;
x, y: integer;
bm, bm1, bm2: TBitMap;
p1, p2, p: PByteArray;
StartTime: Cardinal;
Begin
bm := TBitMap.Create;
bm1 := TBitMap.Create;
bm2 := TBitMap.Create;
Try
bm1.LoadFromFile('MyPic1.bmp');
bm2.LoadFromFile('MyPic2.bmp');
If bm1.Height < bm2.Height Then
Begin
bm.Height := bm1.Height;
bm2.Height := bm1.Height;
End
Else
Begin
bm.Height := bm2.Height;
bm1.Height := bm2.Height;
End;
If bm1.Width < bm2.Width Then
Begin
bm.Width := bm1.Width;
bm2.Width := bm1.Width;
End
Else
Begin
bm.Width := bm2.Width;
bm1.Width := bm2.Width;
End;
bm.PixelFormat := pf24bit;
bm1.PixelFormat := pf24bit;
bm2.PixelFormat := pf24bit;
StartTime := GetTickCount; // Пускаем "секундомер"
Canvas.Draw(0, 0, bm1);
Repeat
i := round(min((GetTickCount - StartTime) / TransformTime_ms, 1) * Count); // Вычисляем "номер кадра" для отрисовки.
For y := 0 To bm.Height - 1 Do
Begin
p := bm.ScanLine[y];
p1 := bm1.ScanLine[y];
p2 := bm2.ScanLine[y];
For x := 0 To bm.Width * 3 - 1 Do
p^[x] := Round((p1^[x] * (count - i) + p2^[x] * i) / count); // Здесь особые тормоза. Делают несколько иначе.
End;
Canvas.Draw(0, 0, bm);
Caption := IntToStr(Round(i / count * 100)) + '%';
Until I >= Count;
Canvas.Draw(0, 0, bm2); // Имхо, параноидально несколько
Caption := 'Done';
Finally
bm1.free;
bm2.free;
bm.free;
End;
End;
PS
Код в плане скорострельности мне не нравится
evvcom (2005-07-21 16:16:00) [4]
> Скорость преобразования зависит от задаваемого числа итераций.
Убрать итерации и вставить Sleep(...).
Mefodiy (2005-07-21 15:42:00) [5]Куда и как это всунуть? Привожу код программы (она взята из интернета).
procedure TForm1.StartButtonClick(Sender: TObject);
const count = 200;
var i: integer;
x, y: integer;
bm, bm1, bm2: TBitMap;
p1, p2, p: PByteArray;
begin
bm := TBitMap.Create;
bm1 := TBitMap.Create;
bm2 := TBitMap.Create;
bm1.LoadFromFile('MyPic1.bmp');
bm2.LoadFromFile('MyPic2.bmp');
if bm1.Height < bm2.Height then
begin
bm.Height := bm1.Height;
bm2.Height := bm1.Height;
end
else
begin
bm.Height := bm2.Height;
bm1.Height := bm2.Height;
end;
if bm1.Width < bm2.Width then
begin
bm.Width := bm1.Width;
bm2.Width := bm1.Width;
end
else
begin
bm.Width := bm2.Width;
bm1.Width := bm2.Width;
end;
bm.PixelFormat := pf24bit;
bm1.PixelFormat := pf24bit;
bm2.PixelFormat := pf24bit;
Form1.Canvas.Draw(0, 0, bm1);
for i := 1 to count - 1 do begin
for y := 0 to bm.Height - 1 do
begin
p := bm.ScanLine[y];
p1 := bm1.ScanLine[y];
p2 := bm2.ScanLine[y];
for x := 0 to bm.Width * 3 - 1 do
p^[x] := Round((p1^[x] * (count - i) + p2^[x] * i) / count);
end;
Form1.Canvas.Draw(0, 0, bm);
Form1.Caption := IntToStr(Round(i / count * 100)) + '%';
Application.ProcessMessages;
if Application.Terminated then
Break;
end;
Form1.Canvas.Draw(0, 0, bm2);
Form1.Caption := 'Done';
bm1.Destroy;
bm2.Destroy;
bm.Destroy;
end;
Alx2 (2005-07-21 09:15:00) [6]Mefodiy (21.07.05 9:11)
Привязываться ко времени. В момент t должна быть картинка с номером ~ t/T * N , где T - общее время эффекта, N - количество "кадров" эффекта.