VPF::Закрасить квадраты белого цвета.

assFalt

Дата 2.6.2012, 19:44 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 12
Регистрация: 11.5.2012

Репутация: нет
Всего: нет

Добрый день.

Помогите, пожалуйста.

Суть дела вот в чем: есть рисунок (image), который состоит из 2х цветов: зеленый и белый. Я на image, поверх рисунка, черчу сетку. Теперь мне надо закрасить все те квадраты, в которых есть белый цвет (а еще лучше, если только те, в которых белого цвета больше, чем половина).

Пытаюсь так сделать:

Код


procedure TForm1.Button5Click(Sender: TObject);
  var ostx,osty:real;    bo:integer; colp: TColor;
begin
x:=(z div 2); //, где z - сторона квадрата
y:=(z div 2);
For x:=0 to Form1.Image1.Width do
  For y:=0 to Form1.Image1.Height do
//while x<form1.Image1.Height do
  // While y<Form1.Image1.Width do
  begin
  colp:=Form1.Image1.Canvas.Pixels[x,y];
  edit12.Color:=colp;
      if pix=16777215 then //заранее искала цвет пикселя, но только под мышью который. а какой сюда засунуть - не знаю.
      Begin
      Form1.Image1.Canvas.Brush.Color:=clBlue;
      risuem;
      str:='Нет'; //это дело с координатами я еще в БД сую.
Form2.Table1.Insert;
Form2.Table1.Fields[0].Value:=Str;
Form2.Table1.Fields[1].Value:=Edit5.Text;
Form2.Table1.Fields[2].Value:=Edit6.Text;
Form2.Table1.Fields[3].Value:=edit7.Text;
Form2.Table1.Fields[4].Value:=Edit8.Text;
Form2.Table1.Post;
      Form1.Edit5.Text:=inttostr(x);
      Form1.Edit6.Text:=inttostr(y);
      Form1.Edit7.Text:=inttostr(x+z);
      Form1.Edit8.Text:=inttostr(y+z);
end; 
end;
//x:=x+z; y:=y+z;
end;

Чучмек

Дата 2.6.2012, 23:30 (ссылка)

(нет голосов)

Загрузка ...

НЭТ БИЛЭТ

Профиль
Группа: Участник
Сообщений: 841
Регистрация: 11.5.2008
Где: СССР

Репутация: 2
Всего: 41

Код



type
 prgb=^trgb;
 trgb=record
  b,r,g:byte;
 end;

procedure TForm1.Button1Click(Sender: TObject);
var
 bmp:tbitmap;
 ic,jc,i,j,a,sum1,sum2:integer;
 wc,hc,bmpW,bmpH:integer;
 p:pointer;
 clr:trgb;
begin
clr.b:=255;
clr.g:=0;
clr.r:=0;

a:=25;

if not opendialog1.Execute then exit;
bmp:=tbitmap.Create;
try
 bmp.LoadFromFile(opendialog1.FileName);
 if bmp.PixelFormat<> pf24bit then
  begin
  messagebox(0,'no 24bit bitmap',nil,0);
  exit;
  end;

 image1.Picture.Bitmap:=bmp;

 bmpW:=bmp.Width;
 bmpH:=bmp.Height;
 wc:= bmpW  div a;
 hc:= bmpH  div a;
 if wc*a<bmpW then inc(wc);
 if hc*a<bmpH then inc(hc);

 for ic:=0 to wc-1 do
 for jc:=0 to hc-1 do
  begin
  sum1:=0;
  sum2:=0;
  for j:=0 to a-1 do
  begin
  if (jc*a+j>=bmp.Height) then break;
  p:=bmp.ScanLine[jc*a+j];
  for i:=0 to a-1 do
  if (ic*a+i<bmp.Width)then
   begin
   if pcardinal(cardinal(p)+(ic*a+i)*3)^ and $FFFFFF = $FFFFFF then inc(sum1);
   inc(sum2);
   end;
  end;
  if sum1>sum2 div 2 then
   for j:=0 to a-1 do
   begin
   if (jc*a+j>=bmp.Height) then break;
   p:=bmp.ScanLine[jc*a+j];
   for i:=0 to a-1 do
   if (ic*a+i<bmp.Width)then prgb(cardinal(p)+(ic*a+i)*3)^:=clr;
   end;
  end;
 image2.Picture.Bitmap:=bmp;
finally  bmp.Destroy; end;

end;

--------------------

умную мысль держи при себе, а дурной - поделись с другими

assFalt

Дата 3.6.2012, 10:11 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 12
Регистрация: 11.5.2012

Репутация: нет
Всего: нет

ОГРОМНЕЙШЕЕ СПАСИБО!!!!!! smile

Вы просто волшебник! smile

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »