[player891]

Здравствуйте,подскажите как сделать чтобы программа присваивала значение пикселя с картинки в ячейку программы?картинка в формате bmp(самый простой вариант на мой взгляд),надо чтоб прога брала 1 пиксель картинки и заносила инфу о цвете в 1 ячейку,потом 2 пиксель во 2 ячейку и так далее.

[lmikle]

По простому - что-то типа:

Код:

var
  I, J : Integer;
  A : Array Of Array DWORD;
begin
  setLength(A,Bitmap.Width,Bitmap.Height);
  For I := 0 To ABitmap.Width-1 Do
    For J := 0 To ABitmap.Height-1 Do
      A[I,J] := Bitmap.Canvas.Pixels[I,J]

Но это долго. Поищи пример использования ScanLine.

[player891]

Код:

var
  Form1: TForm1;
  bp:TBitmap;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
bp:=TBitmap.Create;
bp.LoadFromFile('ball.bmp');
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
begin
StringGrid1.ColCount:=bp.Width;
StringGrid1.RowCount:=bp.Height;
for i:=1 to bp.Width do
for j:=1 to bp.Height do
StringGrid1.Cells[j-1,i-1]:=IntToStr(bp.Canvas.Pixels[i,j]);
 
end;

вот так норм?посоветовали люди добрые)

[angvelem]

Норм , но только медленно. Всё-таки разберись со ScanLine - гораздо быстрее будет.
P.S. А если картинка хотя бы 800 на 600 будет? Это что же со StringGrid-ом станется, представить страшно.

[player891]

Большое всем спасибо за советы,подскажите как бы мне теперь из массива ,в который записывались значения пикселей из бмп файла,записать эти значения в бмп файл?то есть обратная манипуляция,проверка.

[angvelem]

Обратно, оно и есть обратно:

взять пиксел

Код:

...
StringGrid1.Cells[j-1,i-1]:=IntToStr(bp.Canvas.Pixels[i,j]);

вернуть обратно

Код:

...
bp.Canvas.Pixels[i,j] := StringToColor(StringGrid1.Cells[j-1,i-1], 0);

[player891]

делаю вот так

Код:

bp:=TBitmap.Create;
bp.LoadFromFile(form1.OpenPictureDialog1.FileName);
StringGrid1.ColCount:=gor;
StringGrid1.RowCount:=vert;
for i:=1 to gor do begin
form1.ProgressBar1.Position:= i div (gor div 100);
for j:=1 to vert do
StringGrid1.Cells[j-1,i-1]:=IntToStr(bp.Canvas.Pixels[i,j]);
end;

procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
begin
for i:=1 to gor do
for j:=1 to vert do
form1.Canvas.Pixels[i,j]:=strtoint(StringGrid1.Cells[j-1,i-1] );
end;

procedure TForm1.Button3Click(Sender: TObject);
var i,j:integer;
begin
bp1:=TBitmap.Create;
for i:=1 to gor do
for j:=1 to vert do
bp1.Canvas.Pixels[i,j]:=strtoint(StringGrid1.Cells[j-1,i-1] );
bp1.SaveToFile('ball_new.bmp');
end;
	

баттон 2 работает норм,а вот баттон 3 почему то не сохраняет в файл из гридрида,пишет пустой файл.

[angvelem]

Забыл размер создааемого битмапа bp1 указать. В твоём варианте, должно равняться размерам bp.

[player891]

переделал,вместо гридрида делал с массивом

Код:

var
Form1: TForm1;
bp,bp1: TBitmap;
pic: array of array of tcolor;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
i,j:integer;
begin
if (OpenPictureDialog1.Execute) and FileExists(OpenPictureDialog1.FileName)
then begin
form1.Image1.Picture.LoadFromFile(form1.OpenPictureDialog1.FileName);
bp:=TBitmap.Create;
bp.LoadFromFile(form1.OpenPictureDialog1.FileName);
end;

SetLength(pic,bp.Width,bp.Height);
for i:=1 to bp.Width do
for j:=1 to bp.Height do
pic[i-1,j-1]:=bp.Canvas.Pixels[i,j];

end;

procedure TForm1.Button2Click(Sender: TObject);
var i,j:integer;
begin
for i:=1 to bp.Width do
for j:=1 to bp.Height do
form1.Canvas.Pixels[i,j]:=pic[i-1,j-1] ;
end;

procedure TForm1.Button3Click(Sender: TObject);
var i,j:integer;
begin
bp1:=TBitmap.Create;
bp1.Width:=bp.Width;
bp1.Height:=bp.Height;
for i:=1 to bp.Width do
for j:=1 to bp.Height do
bp1.Canvas.Pixels[i,j]:=pic[i-1,j-1];
bp1.SaveToFile('ball_new.bmp');
end;

end.

все равно не сохранияет в файл хоть и указал размер битмапа
bp1.Width:=bp.Width;
bp1.Height:=bp.Height;

[angvelem]

Прекрасно всё работает:

Код:

unit Unit28;

interface

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

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

var
  Form1: TForm1;
  bp, bp1 : TBitmap;
  pic: array of array of TColor;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  I, J : Integer;
begin
  if (OpenPictureDialog1.Execute) and FileExists(OpenPictureDialog1.FileName) then
  begin
    Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
    bp := TBitmap.Create;
    bp.LoadFromFile(OpenPictureDialog1.FileName);
  end;

  SetLength(pic, bp.Width, bp.Height);
  for I := 0 to bp.Width - 1 do
    for J := 0 to bp.Height - 1 do
      pic[I, J] := bp.Canvas.Pixels[I, J];
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  I, J : Integer;
begin
  for I := 0 to bp.Width - 1 do
    for J := 0 to bp.Height - 1 do
      Form1.Canvas.Pixels[I, J] := pic[I, J];
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  I, J : Integer;
begin
  bp1 := TBitmap.Create;
  bp1.Width := bp.Width;
  bp1.Height := bp.Height;
  for I := 0 to bp1.Width - 1 do
    for J := 0 to bp1.Height - 1 do
      bp1.Canvas.Pixels[I, J] := pic[I, J];

  bp1.SaveToFile('ball_new.bmp');
end;

end.

[player891]

не могу понять что не так,файл бмпшный создает но не сохраняет ничего туда,размер 0 байт

[angvelem]

Посмотри мой код внимательно и найди отличия от твоего или просто скопируй нужные места, всё будет прекрасно сохранять.

[player891]

все!!!ура!!!свершилось)короче проблема была в следующем:я в тоталкомандере файлик открывал и смотрел он почему то не отображался,случайно зашел просто через проводник смотрю-ball_new.bmp 70kb,открыл - увидел изображение,не знаю по какой причине тотал не показывает.