TImage рисование точки

← →
Bitt (2013-03-14 22:34) [0]

Гружу картинку bmp в TImage, он большой 7000 пикселей,чб
procedure TForm1.Button11Click(Sender: TObject); var pixelz:byte; x:dword; begin for x:=0 to 7400 do begin pixelz:=Image1.Picture.Bitmap.Canvas.Pixels[x,0]; {if pixelz<>0 then} Image1.Canvas.Pixels[x,0]:=clRed; end; end;
Хочу рисовать точку(пока полосу красную) где произошел визуальный скан строчки. Т.к на экран полностью картинка не влезла, то TImage1.Strech:=True;
Цвет точки из битмапа, черчение тоже на визуально сжатом изображении, без изменения исходного изображения в памяти.
Но что-то не работает, нет красной полосы!

← →
DimaBr © (2013-03-16 12:58) [1]

Внимание! Здесь обсуждаются вопросы, связанные с разработкой компонентов, редакторов свойств, редакторов компонентов и экспертов IDE.
Вопросы по поиску и использованию готовых компонентов, редакторов или экспертов являются нарушением тематики и могут быть удалены.

← →
Savek (2013-03-16 13:10) [2]

Image1.Bitmap.Canvas.Pixels[x,0]:=clRed;

← →
robt (2013-03-16 13:20) [3]

рисовать линию точками - самый тупой и медленный вариант что мог прийти в голову

← →
antonn © (2013-03-16 13:23) [4]

> рисовать линию точками

это единственный вариант нарисовать линию.
а вот каким образом вычислять точки и заполнять их - второй вопрос, и тут стоило бы уже поинтересоваться у автора зачем он линию одного цвета и без прозрачности рисует точками через getpixel()/setpixel()

← →
robt (2013-03-16 13:24) [5]

> это единственный вариант нарисовать линию.

lineto не?

← →
Kerk © (2013-03-16 15:53) [6]

> robt (16.03.13 13:24) [5]
>
> > это единственный вариант нарисовать линию.
>
> lineto не?

А lineto разве не точками рисует? :)

← →
antonn © (2013-03-16 16:37) [7]

просто он узко мыслит :)
ну а мы, как обычно, широко буквоедствуем =)

← →
robt (2013-03-16 18:37) [8]

> Kerk © (16.03.13 15:53) [6]

ну не через setpixel однозначно, а в любом случае более кошерным алгоритмом

← →
clickmaker © (2013-03-16 19:07) [9]

> он большой 7000 пикселей,чб

> пока полосу красную

← →
DVM © (2013-03-16 20:12) [10]

> Kerk © (16.03.13 15:53) [6]

> А lineto разве не точками рисует? :)

Не совсем. То, как рисует LineTo (это это ведь обертка над соответствующей функцией GDI) полностью зависит от устройства на который выводится линия. Это ведь может быть и векторный дисплей и метафайл, плоттер какой нибудь, да много чего еще. Т.е вполне себе возможен вариант, когда устройству достаточно сообщить начало и конец линии, а дальше оно уже само.

← →
Bitt (2013-04-09 13:32) [11]

линию как тест пытался рисовать
визуально
считывание текущего цвета в пикселе,
окраска в красный цвет,
пауза,
окраска пикселя в старый цвет
переход к следующему пикселю.

Визуально бегущая красная точка по картинке,
там где данные обрабатываются...

← →
Павиа (2013-04-09 14:05) [12]

У тебя картинка ч/б. Один бит на пиксель. Поэтому ты не можешь нарисовать красную точку. Тебе надо перевести картинку в цветную к примеру 24 бита на пиксель.
Image1.Picture.Bitmap.PixelFormat:=pf24bit;

← →
Pitt (2013-04-09 14:08) [13]

> TImage1.Strech:=True;
Вот в этом ваша ошибка.
Исходное изображение нужно грузить в память, а отображать в Image1 нужно другое изображение - интерполированное.
И рисовать точки и линии нужно именно на уменьшенном, при этом запоминая положение нарисованного в большем изображении.

← →
О-Сознание (2013-04-09 17:52) [14]

> Bitt (14.03.13 22:34)

Что за программа такая?
Для чего это всё?

← →
Baks (2013-04-10 14:46) [15]

С помощью библиотек FastDIB или Graphics32, загружай в память оригинал, копируй, изменяй размер и потом вывод на TImage.Canvas. Canvas.Stretch вообще не трогай.

← →
Bitt (2013-04-13 21:02) [16]

ага,
собирался даже 2 изображения иметь для визуализации расчетов
и собственно для расчетов в памяти.
Просто в цветную перевести - большой расход памяти, в чб картинка 12-20мб весит...
2 изображения - банально большое уменьшать и переводить в цветное и скидывать в темп...

← →
Bitt (2013-04-14 21:38) [17]

О-Сознание
для выжигателя отображение прогресса, позже за счет визуального контроля хочу прикрутить пропуск холостых рядов и отрубания конца прохода.
Сделал движок - долго ходит, реальное разрешение будет меньше, пока не валится в ошибку.
Только красной точки нет, белый фон окрашивается в красный, кроме черного.
VISUAL - Timage мелкий битмап цветной 24бит 400х213 для визуализации
MAP - большой 7485х3986 чб. для инфы.
код:
procedure TForm1.Button11Click(Sender: TObject); label start,enduro; var pixelz,w:byte; x,y:dword; differX,xd,temp,differY,yd:dword; begin y:=0; differX:=MAP.Picture.Graphic.Width DIV 400; // resize const {7400}=18 temp:=(MAP.Picture.Graphic.Height*400) DIV MAP.Picture.Graphic.Width; // {3986}=213 differY:=MAP.Picture.Graphic.Height DIV temp; //showmessage(intTOstr(differY)); start: for x:=0 to MAP.Picture.Graphic.Width do begin pixelz:=MAP.Picture.Bitmap.Canvas.Pixels[x,y]; {if pixelz<>0 then fire on!!!} xd:=x DIV differX; yd:=y DIV differY; w:=VISUAL.Canvas.Pixels[xd,yd]; // save color VISUAL.Canvas.Pixels[xd,yd]:=clRed; Label2.Caption:="REAL:"+IntToStr(x)+"/"+IntToStr(y); Label4.Caption:="VISUAL:"+IntToStr(xd)+"/"+IntToStr(yd); VISUAL.Canvas.Pixels[xd,yd]:=w; // reverse color end; Inc(y); application.ProcessMessages; if Button14.tag=1 then goto enduro;{STOP KEY} if MAP.Picture.Graphic.Height<y then goto enduro; goto start; enduro: end;

TImage рисование точки Найти похожие ветки