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

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

Приветствую, уважаемые эксперты!
Есть функция (см. приложение). Работает очень медленно - 43 такта. Надо упростить.

Вопрос задал: Gooddy (статус: 3-ий класс) Вопрос отправлен: 17 ноября 2008, 17:23 Состояние вопроса: решён, ответов: 2.

Ответ #1. Отвечает эксперт: ANBsoft

Здравствуйте, Failure!
Примерно так:
setka:=15;
for x:=0 to (Image1.Width div Setka) do
for y:=0 to (image1.Height div Setka) do
image1.Canvas.Pixels[x*Seta,y*Setka]:=clGray;

Ответ отправил: ANBsoft (статус: Студент) Время отправки: 17 ноября 2008, 17:50 Оценка за ответ: 5 Комментарий к оценке: конечно быстро но рисуются не линии:)

Ответ #2. Отвечает эксперт: min@y™

Ну нафига так усложнять?
Если нужна сетка из точек, зачем же перебирать все координаты Canvas?
Не проще ли написать вот так?

procedure TForm1.ButtonClick(Sender: TObject);
const
  GridStep = 15;
var
  X, Y: Integer;
begin
  Image.Canvas.FillRect(Image.Canvas.ClipRect);
 
  X:= GridStep - 1;
  Y:= GridStep - 1;
 
  while True do
    begin
      Image.Canvas.Pixels[X, Y]:= clGray;
      Inc(X, GridStep);
 
      if (X >= Image.Width) and (Y >= Image.Height)
        then Break;
 
      if X >= Image.Width
        then begin
               X:= GridStep - 1;
               Inc(Y, GridStep);
             end;
    end;
end;

Ответ отправил: min@y™ (статус: Доктор наук) Время отправки: 17 ноября 2008, 18:14 Оценка за ответ: 5 Комментарий к оценке: спасибо

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

Страницы: [« Предыдущая] [1] [2]

Gooddy (статус: 3-ий класс), 17 ноября 2008, 18:28 [#21]: t:=gettickcount; tackts:=gettickcount-t; Чисти код! Чисти код! Чисти код!

Вадим К (статус: Академик), 17 ноября 2008, 18:42 [#22]: Это не такты. Это милисекунды. И значениям меньше 55 на обычном декстопе и 130 на сервером варианте (если только небыли сделаны специальные хитрые манипуляции с реестром) доверять нельзя. Потому что 55 (130) это точность внутреннего таймера. Во-вторых, считаю, что обоим экспертам, ответившим на вопрос, можно ставить по жирному минусу. Кто рисует прямо на канве??? надо сразу нарисовать на битмате в памяти и потом перенести. получится ускорение просто феноменальное. Кстати, картинку можно прорисовать только один раз, а потом просто копировать А функция GetPixels, которая неявно фигурирует в обоих ответах - очень, очень медленная и крайне не рекомендована для "попиксельной прорисовки". Галочка "подтверждения прочтения" - вселенское зло.

Gooddy (статус: 3-ий класс), 17 ноября 2008, 19:04 [#23]: спасибо. тоесть у меня лучший вариант если рисовать на битмапе? Чисти код! Чисти код! Чисти код!

Вадим К (статус: Академик), 17 ноября 2008, 19:33 [#24]: Да. Если создать в памяти битмап, нарисовать на нем, а потом перенести например методом draw. Но если хочеться супербыстрого переноса, то самая быстрая фунция - bitbtl (если мне моя память не изменяет). В многих случаях, если рисовать на битмапе в памяти, получается ускорение до 10 раз без применения каких-либо оптимизирующих технологий. Всё за счёт того, что не расходуется время в пустую на обновление формы/компонентов и так далее. Резонный вопрос, а зачем такая скорость? что прорисовываем? Может есть лучше путь? Галочка "подтверждения прочтения" - вселенское зло.

Вадим К (статус: Академик), 17 ноября 2008, 19:37 [#25]: и что бы меня не обявили в голословности. var bmp:TBitmap; begin .... bmp := TBitmap.create; bmp.width := 100; bmp.height := 100; //Можно ещё выставить битность цвета, но это для особых нужд //теперь можно рисовать, типа так bmp.Canvas.lineto(1,1); //в конце работы надо освободить ресурсы. bmp.free; Только если надо прорисовывать десятки раз в секунду, то лучше создавать один раз в FormCreate и удалять в FormDestroy. А очистка - это просто нарисоват один большой прямоугольник нужного цвета с методом Draw попробуйте самостоятельно. Галочка "подтверждения прочтения" - вселенское зло.

Gooddy (статус: 3-ий класс), 17 ноября 2008, 21:18 [#26]: спасибки Чисти код! Чисти код! Чисти код!

ANBsoft (статус: Студент), 17 ноября 2008, 21:32 [#27]: Да разница почти в 2 раза (если не нужно каждый раз выделять память). procedure TFormMain.Button4Click(Sender: TObject); Var Setka,n,x,y:Integer; t:Integer; begin setka:=15; image2.Canvas.Pen.Color:=clGray; t:=gettickcount; for n:=1 to 10000 do begin for x:=0 to Image2.Width div Setka do begin image2.Canvas.MoveTo(X*Setka,0); image2.Canvas.LineTo(X*Setka,Image2.Height); end; for y:=0 to Image2.Height div Setka do begin image2.Canvas.MoveTo(0,Y*Setka); image2.Canvas.LineTo(Image2.Width,Y*Setka); end; end; ShowMessage(IntToStr(gettickcount-t)); end; procedure TFormMain.Button5Click(Sender: TObject); Var Setka,n,x,y:Integer; t:Integer; bmp:TBitmap; begin bmp := TBitmap.create; bmp.width := 601; bmp.height := 441; //Можно ещё выставить битность цвета, но это для особых нужд //теперь можно рисовать, типа так setka:=15; bmp.Canvas.Pen.Color:=clGray; t:=gettickcount; for n:=1 to 10000 do begin for x:=0 to bmp.Width div Setka do begin bmp.Canvas.MoveTo(X*Setka,0); bmp.Canvas.LineTo(X*Setka,bmp.Height); end; for y:=0 to bmp.Height div Setka do begin bmp.Canvas.MoveTo(0,Y*Setka); bmp.Canvas.LineTo(bmp.Width,Y*Setka); end; BitBlt(image2.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, bmp.Canvas.Handle, 0, 0, SRCCOPY); end; ShowMessage(IntToStr(gettickcount-t)); //в конце работы надо освободить ресурсы. bmp.free; end;

31 января 2011, 19:32: Статус вопроса изменён на решённый (изменил модератор Ерёмин А.А.): Автоматическая обработка (2 и более ответов с оценкой 5)

Страницы: [« Предыдущая] [1] [2]

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