Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Здравствуйте, эксперты!
Я прорисовываю попиксельно изображение на компоненте TImage, но мне нужно ускорить процесс! Пожалуйста помогите ускорить процесс!
Изображение может выйти за пределы компонента, но процесс продолжит подсчет. Ограничение области вычисления приводит к некорректному отображению цвета!

Т.е. если
while my<strtofloat(Edit5.Text) do и while mx<strtofloat(Edit4.Text) do
заменить на while my<py do и while mx<px do
тогда цвет не тот! Как в таком случае ускорить процесс не урезая число вычислений.

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  BX, BY, mx, my, Cy, Cx, ix, iy,it, px, py : real;
  xx, yy, n,t : longint;
  col : tcolor;
begin
  Image1.Canvas.Rectangle(0,0,Image1.Width,Image1.Height);
  yy:=0;
  it:=1/strtoint(Edit3.Text);
  my:=strtofloat(Edit2.Text); //начальная точка вычислений в координатной плоскости по оси oY
  py:=my+Image1.Height*it;
  while my<strtofloat(Edit5.Text) do
  //while my<py do
    begin
      Image1.Repaint;
      my:=my+it;
      yy:=yy+1;
      xx:=0;
      mx:=strtofloat(Edit1.Text); //начальная точка вычислений в координатной плоскости по оси oX
      px:=mx+Image1.Width*it;
    //while mx<px do
    while mx<strtofloat(Edit4.Text) do
        begin
          mx:=mx+it;
          xx:=xx+1;
          Cx:=mx;
          Cy:=my;
          BY:=my;
          BX:=mx;
          ix:=0; iy:=0; n:=0;
          while (((sqr(ix)+sqr(iy))<4) and (n<64)) do
            begin
              ix:=sqr(BX)-sqr(BY)+Cx;
              iy:=2*BX*BY+Cy;
              n:=n+1;
              BX:=ix;
              By:=iy;
            end;
          Col:=Color(n);
          Form1.Image1.Canvas.Pixels[xx,yy]:=col;
        end;
    end;
end;
 
 
Function TForm1.ColorChange(var n, l ,r:longint):boolean;
begin
  if (n>l) and (n<=r) then result:=true else result:=false;
end;
 
Function TForm1.Color(var n:longint):tcolor;
var
  a : array [1..9,1..2] of longint;
  i : longint;
begin
  for I := 1 to 8 do begin a[i,1]:=7*(i-1); a[i,2]:=7*i; end;
       if ColorChange(n,a[1,1],a[1,2]) then result:=RGB(32*n,0,0)
  else if ColorChange(n,a[2,1],a[2,2]) then result:=RGB(32*n,32*n,0)
  else if ColorChange(n,a[3,1],a[3,2]) then result:=RGB(32*n,0,32*n)
  else if ColorChange(n,a[4,1],a[4,2]) then result:=RGB(0,32*n,0)
  else if ColorChange(n,a[5,1],a[5,2]) then result:=RGB(32*n,32*n,0)
  else if ColorChange(n,a[6,1],a[6,2]) then result:=RGB(0, 32*n,32*n)
  else if ColorChange(n,a[7,1],a[7,2]) then result:=RGB(0, 0, 32*n)
  else if ColorChange(n,a[8,1],a[8,2]) then result:=RGB(32*n, 0, 32*n)
  else if ColorChange(n,a[9,1],a[9,2]) then result:=RGB(0, 32*n,32*n);
end;

Вопрос задал: prorok-kane (статус: Посетитель) Вопрос отправлен: 3 октября 2010, 00:57 Состояние вопроса: открыт, ответов: 1.

Ответ #1. Отвечает эксперт: Вадим К

Здравствуйте, prorok-kane!
Ускорить в раз 10 (при большой картинке и больше получается) можно простым методом, просто вместо TImage использовать TBitmap, а потом с помощью копирования переносить на TImage
Image.Canvas.CopyRect(Image.ClientRect,bitmap.canvas,Image.ClientRect); // где то так:)
Если хочется ещё быстрее, то нужно использовать ScanLine
http://www.delphisources.ru/pages/faq/base/bitmap_scanline_for_pixelformat.html
Но скорее всего придется немного переделать код.

Ответ отправил: Вадим К (статус: Академик) Время отправки: 4 октября 2010, 10:51 Оценка за ответ: 4 Комментарий к оценке: TBitmap действительно ускорил процесс вывода, но в моем случае изображение выводилось постепенно, а в этом необходимо подождать. Так, что спасибо!

Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.