Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.10.07;
Скачать: [xml.tar.bz2];

Вниз

Image   Найти похожие ветки 

 
Надуев Алексей ©   (2007-09-06 22:44) [0]

Как можно быстро заполнить image (например случайными цветными пикселями) через Image.canvas.pixels.


 
Вася Правильный   (2007-09-06 22:46) [1]


>  через Image.canvas.pixels.

через это быстро не получится


 
Надуев Алексей ©   (2007-09-06 22:56) [2]

А по другому как можно сделать быстро?


 
Dib@zol ©   (2007-09-06 23:01) [3]

CreateBitmap с последним параметром nil. Случайность полученной картинки гарантируется ;) т.к. она берётся напрямую из куска памяти, выделенного битмапу, а до того использованного ещё кем-то и успевшего там наследить...


 
DVM ©   (2007-09-06 23:04) [4]

Как то так, если не ошибся нигде:

procedure ProcessBitmap(var Bmp: TBitmap);
type
 PByteArray = ^TByteArray;
 TByteArray = array[0..32767] of Byte;
var
 pb: pbytearray;
 x, y: Integer;
begin
 for y:=0 to bmp.Height-1 do
 begin
   pb := bmp.scanline[y];
   for x:=0 to bmp.Width - 1 do
   begin
     pb[x*3]:=...случ значение от 0 до 255;
     pb[x*3+1]:=...случ значение от 0 до 255
     pb[x*3+2]:=...случ значение от 0 до 255
   end;
 end;
end;


 
Надуев Алексей ©   (2007-09-06 23:07) [5]

Как пользоваться CreateBitmap? там есть свойства, их заполняю при запуске ни чего не происходит


 
Надуев Алексей ©   (2007-09-06 23:08) [6]

Как пользоваться CreateBitmap? там есть свойства, их заполняю при запуске ни чего не происходит


 
{RASkov} ©   (2007-09-06 23:09) [7]

var B, Pic: TBitmap; R, C: Integer;
begin
 B:=TBitmap.Create;
 B.Width:=25; B.Height:=25;
 for C:=0 to B.Width do
  for R:=0 to B.Height do B.Canvas.Pixel[C, R]:=RGB(Random(255), Random(255), Random(255));
 Pic:=TBitmap.Create;
 Pic.Width:=250;
 Pic.Height:=250;
 Pic.Canvas.Brush.Bitmap:=TBitmap.Create;
 Pic.Canvas.Brush.Bitmap.Assign(B);
 Pic.Canvas.FillRect(Pic.Canvas.ClipRect);
 Canvas.Draw(0, 0, Pic);
 B.Free;
 Pic.Free;
end;


Это не ответ на вопрос, но попробуй как вариант для начала....


 
DVM ©   (2007-09-06 23:10) [8]


> Как пользоваться CreateBitmap?

Забудь. Рано тебе еще.


 
Надуев Алексей ©   (2007-09-06 23:14) [9]

Что должно быть в параметрах?

procedure ProcessBitmap(var Bmp: TBitmap);


 
Надуев Алексей ©   (2007-09-06 23:20) [10]

Ничего не понимаю

var
B, Pic: TBitmap;
R, C: Integer;
begin
B:=TBitmap.Create;
B.Width:=25; B.Height:=25;
for C:=0 to B.Width do



тут ошибку выдает---
for R:=0 to B.Height do B.Canvas.Pixel[C, R]:=RGB(Random(255), Random(255), Random(255));

[Error] Unit1.pas(59): Undeclared identifier: "Pixel"

Pic:=TBitmap.Create;
Pic.Width:=250;
Pic.Height:=250;
Pic.Canvas.Brush.Bitmap:=TBitmap.Create;
Pic.Canvas.Brush.Bitmap.Assign(B);
Pic.Canvas.FillRect(Pic.Canvas.ClipRect);
Canvas.Draw(0, 0, Pic);
B.Free;
Pic.Free;
end;


 
DVM ©   (2007-09-06 23:22) [11]


> Надуев Алексей ©   (06.09.07 23:14) [9]
> Что должно быть в параметрах?

procedure TForm1.Button1Click(Sender: TObject);
var
 BMP: TBitmap;
begin
 BMP:=TBitmap.Create;
 try
   BMP.Width := 100;
   BMP.Height := 100;
   BMP.PixelFormat := pf24bit;
   ProcessBitmap(BMP);
   Image1.Picture.Bitmap.Assign(BMP);
 finally
   BMP.Free;
 end
end;


 
Anatoly Podgoretsky ©   (2007-09-06 23:22) [12]

> Надуев Алексей  (06.09.2007 23:20:10)  [10]

Нет такого свойства, во поэтому и говорит, что не знает.


 
{RASkov} ©   (2007-09-06 23:24) [13]

> [9] Надуев Алексей ©   (06.09.07 23:14)
> Что должно быть в параметрах?
>
> procedure ProcessBitmap(var Bmp: TBitmap);

Дык там же указаны параметры.... нда...
Передавай заранее созданный битмап в данную процедуру... там он и "покраситься случайно"... наверное :)

> [10] Надуев Алексей ©   (06.09.07 23:20)
> тут ошибку выдает---
> for R:=0 to B.Height do B.Canvas.Pixel[C, R]:=RGB(Random(255), Random(255), Random(255));

Ну я ошибся, а ты вообще походу не знаком с языком, на котором пытаешься писать...
>замени на Pixels


 
{RASkov} ©   (2007-09-06 23:28) [14]

> Надуев Алексей
из анкеты:
>Изучаю Turbo Pascal, Delphi, HTTP и еще кучу всякого добра.

Попробуй что-нибудь одно :)

Вот тебе "копипаст", только что проверил.... работает :)
procedure TForm1.Button1Click(Sender: TObject);
var B, Pic: TBitmap; R, C: Integer;
begin
 Randomize;
 B:=TBitmap.Create;
 B.Width:=50; B.Height:=50;
 for C:=0 to B.Width do
  for R:=0 to B.Height do B.Canvas.Pixels[C, R]:=RGB(Random(255), Random(255), Random(255));
 Pic:=TBitmap.Create;
 Pic.Width:=250;
 Pic.Height:=250;
 Pic.Canvas.Brush.Bitmap:=TBitmap.Create;
 Pic.Canvas.Brush.Bitmap.Assign(B);
 Pic.Canvas.FillRect(Pic.Canvas.ClipRect);
 Canvas.Draw(0, 0, Pic);
 B.Free;
 Pic.Free;
end;


 
Надуев Алексей ©   (2007-09-06 23:32) [15]

Здесь получается два битмапа? один 50*50 второй 250*250, а как сдалать что бы первый битмап сразу отобразился и где его координаты?


 
DVM ©   (2007-09-06 23:34) [16]


> {RASkov} ©   (06.09.07 23:28) [14]

много лишних телодвижений


 
DVM ©   (2007-09-06 23:37) [17]


> Надуев Алексей ©

Кладем на форму TButton и TImage. Пишем код.


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls;

type
 TForm1 = class(TForm)
   Image1: TImage;
   Button1: TButton;
   procedure Button1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure ProcessBitmap(var Bmp: TBitmap);
type
PByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
var
pb: pbytearray;
x, y: Integer;
begin
for y:=0 to bmp.Height-1 do
begin
  pb := bmp.scanline[y];
  for x:=0 to bmp.Width - 1 do
  begin
    pb[x*3]:=Random(255);
    pb[x*3+1]:=Random(255);
    pb[x*3+2]:=Random(255);
  end;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 BMP: TBitmap;
begin
 Randomize;
 BMP:=TBitmap.Create;
 try
   BMP.Width := Image1.Width;
   BMP.Height := Image1.Height;
   BMP.PixelFormat := pf24bit;
   ProcessBitmap(BMP);
   Image1.Picture.Bitmap.Assign(BMP);
 finally
   BMP.Free;
 end
end;

end.



Вуаля.

Сидим, думаем и читаем книжки.


 
{RASkov} ©   (2007-09-06 23:40) [18]

> [16] DVM ©   (06.09.07 23:34)

Конфа для начинающих.... пусть хоть со стандартными объектами разберется :)

> [15] Надуев Алексей ©   (06.09.07 23:32)

Да, два. Зачем тебе первый? Первый это для "закраски" второго.....
Впрочем по аналогии с первым можно закрасить сразу второй таким образом, но это уже быстро, впрочем тебе может и устроит....
Тебеж всеравно для учебы, верно? Вот и учись потихоньку.... :) Потом можно и СканЛайн изучить...


 
{RASkov} ©   (2007-09-06 23:41) [19]

> но это уже быстро, впрочем

но это уже НЕ быстро, впрочем :) Сорри...


 
{RASkov} ©   (2007-09-07 00:20) [20]

> [16] DVM ©   (06.09.07 23:34)
> {RASkov} ©   (06.09.07 23:28) [14]
> много лишних телодвижений

Кстати... пример [17] тоже можно немного упростить и даже чуточку ускорить
:)
procedure TForm1.Button2Click(Sender: TObject);
begin
 Randomize;
 Image1.Picture.Bitmap.Width := Image1.Width;
 Image1.Picture.Bitmap.Height := Image1.Height;
 Image1.Picture.Bitmap.PixelFormat := pf24bit;
 ProcessBitmap(Image1.Picture.Bitmap);
end;


ProcessBitmap - тот же самый, за исключением var параметра Bmp, его нужно просто указателем
т.е. procedure ProcessBitmap(Bmp: TBitmap); И проверочку бы туда не мешало-бы на валидность Bmp,
также ...впрочем.... необязательно было переопределять типы:
type
PByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
в D7 они именно так и объявлены... в SysUtils...
ну это уже придирки :)


 
homm ©   (2007-09-07 06:18) [21]

> [14] {RASkov} ©   (06.09.07 23:28)

Зачем ты дерьмо вское постишь, теебе не стыдно человека в заблуждение вводить?


 
{RASkov} ©   (2007-09-07 13:57) [22]

> [21] homm ©   (07.09.07 06:18)

Стыдно... не стыдно....
Я человеку начальный путь только предложил.... и то на выбор.
Да, мой способ медленнее раз в 20... но я и не говорил, что он быстрый...
и "закраска" идет не всего битмапа случайно, а фрагмента, а этим фрагментом весь - вот это не сказал, говорю.
Не наезжай не обаснованно...
Хотя.... ладно. Просто когда я писал [7], [4] - не было еще.... и перед отправкой я видел, что появились посты и соответственно [4]
Но всеж отправил пост. Впрпочем зря.


 
homm ©   (2007-09-07 14:08) [23]

> [22] {RASkov} ©   (07.09.07 13:57)
> Я человеку начальный путь только предложил.... и то на выбор.

А человек что попросил? Ты тему зачем открываешь, если отвечаешь неглядя. Вообщето даже в вопросе уже написано, что автор с предложеным тобой способом знаком.


 
{RASkov} ©   (2007-09-07 14:15) [24]

> [23] homm ©   (07.09.07 14:08)
> А человек что попросил? Ты тему зачем открываешь, если отвечаешь неглядя

Ну вообще-то есть разница когда мы один большой битмап по пиксельно "красим" и когда маленький и им большой...

> Вообщето даже в вопросе уже написано, что автор с предложеным
> тобой способом знаком.

:)
Был бы знаком, то не было-бы [10] :о)


 
{RASkov} ©   (2007-09-07 14:35) [25]

> [23] homm ©   (07.09.07 14:08)

Тем более автор конкретно указал - "через Image.canvas.pixels"
А ему тут сканлайн "впаривают" :))

Если автор заглянет, то это ему:
Лучше используй пример со сканлайном, он быстрее, а мой - так для изучения :)


 
homm ©   (2007-09-07 14:47) [26]

> [25] {RASkov} ©   (07.09.07 14:35)
> Тем более автор конкретно указал - "через Image.canvas.pixels"
> А ему тут сканлайн "впаривают" :))

Вот я и говорю, что ты ветку не читаешь :) [1], [2].



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2007.10.07;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.52 MB
Время: 0.044 c
15-1189306522
Aller
2007-09-09 06:55
2007.10.07
виста + хп


15-1189250656
tesseract
2007-09-08 15:24
2007.10.07
Футболки обсуждаем тут!


2-1189391632
арпывапр
2007-09-10 06:33
2007.10.07
отключение USB?


15-1189233132
AlexanderCoum
2007-09-08 10:32
2007.10.07
UnZip


15-1188941829
Германн
2007-09-05 01:37
2007.10.07
Скорость анимации. Глупый, но интересный для меня вопрос.





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский