Добавление в Memo или RichEdit

← →
MegaNop © (2006-12-15 00:51) [0]

Вообщем такая ситуация:
В Image загружается картинка. Специальная процедура считывает цвет каждого пикселя и разбивает его на составляющие R G B, которые записываются в многомерный массив.
Необходимо: записать в Memo или RichEdit попиксельную цветовую схему. Объясняю:
Есть картинка 3х3 пикселя(для примера)
В Memo должно быть(например):
[1 2 3] [4 5 6] [7 8 9] -- Число блоков [r g b] по горизонтали = 3
[1 4 6] [2 6 8] [3 4 6] -- Число блоков [r g b] по вертикали = 3
[2 5 7] [4 7 8] [5 3 6]
Не могу реализовать процедуру этого самого поблочного добавления. Если просто memo.lines.add(string), то он добавляет всё в одну строку, а мне надо: сколько пикселей - столько блоков.
---
У-у-ф, объяснил как мог. Надеюсь поняли.

← →
Германн © (2006-12-15 01:03) [1]

> Не могу реализовать процедуру этого самого поблочного добавления.
> Если просто memo.lines.add(string), то он добавляет всё
> в одну строку

Приведи код, который формирует вышеуказанную string.

← →
MegaNop © (2006-12-15 01:14) [2]

У меня пока так:

Memo1.Lines.Add("["+inttostr(R)+" "+inttostr(G)+" "+inttostr(B)+"]");

Но это только для проверки работоспособности всёй программы, так, естественно, он всё пишет на каждой строке.

← →
RASkov (2006-12-15 01:36) [3]

> [2] MegaNop © (15.12.06 01:14)

Сформируй сначала строку а потом ее добавь в мемо
что-нибудь типа так:
str:=""; for n:=0 to Image.Width do begin R:=... G:=... B:=... str:=str+"["+inttostr(R)+" "+inttostr(G)+" "+inttostr(B)+"];"; end; Memo1.Lines.Add(str);

← →
MegaNop © (2006-12-15 01:46) [4]

А как определить, что уже кол-во блоков равно кол-ву пикселей по горизонтали и перейти на новую строку?

← →
RASkov (2006-12-15 01:55) [5]

> [4] MegaNop © (15.12.06 01:46)

for h:=0 to Image.Height do begin str:=""; for w:=0 to Image.Width do begin R:=... G:=... B:=... str:=str+"["+inttostr(R)+" "+inttostr(G)+" "+inttostr(B)+"];"; end; Memo1.Lines.Add(str); end;

← →
RASkov (2006-12-15 01:57) [6]

R:=GetRValue(Image.Canvas.Pixels[h,w]);
и т.п.

← →
RASkov (2006-12-15 01:58) [7]

Т.е.
R:=GetRValue(Image.Canvas.Pixels[w,h]);
вроде бы...

← →
Gydvin © (2006-12-15 09:27) [8]

Делать было нечего
Нужно оптимизировать

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TRGB = packed record R, G, B: Byte; end; pRGB = ^TRGB; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; procedure Button1Click(Sender: TObject); function CnvToTxt(Bitmap: tbitmap; rect: trect): tstringlist; procedure view(list: tstrings; var bit: tbitmap; rect: trect); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var bit, de: tbitmap; x, y: integer; r: trect; begin bit := tbitmap.Create; bit.LoadFromFile("C:\YourBitmap.bmp"); bit.PixelFormat := pf24bit; r := rect(0, 0, bit.Width - 1, bit.Height - 1); memo1.Lines.Assign(CnvToTxt(bit, r)); ///Поместить битмап в мемо de := tbitmap.Create; de.Width := bit.Width; de.Height := bit.Height; de.PixelFormat := pf24bit; bit.free; caption := (inttostr(memo1.Lines.Count)); view(memo1.Lines, de, r); //отобразить битмап из мемо (проверка) canvas.Draw(0, 0, de); de.Free; end; function TForm1.CnvToTxt(Bitmap: tbitmap; rect: trect): tstringlist; function add(var i: integer; RGB: TRGB; var buffer: array of TRGB; var liststr: tstringlist): boolean; begin if i < 2 then begin buffer[i] := RGB; inc(i); result := false; end else begin liststr.Add("[" + inttostr(buffer[0].r) + " " + inttostr(buffer[0].g) + " " + inttostr(buffer[0].b) + "]" + "[" + inttostr(buffer[1].r) + " " + inttostr(buffer[1].g) + " " + inttostr(buffer[1].b) + "]" + "[" + inttostr(RGB.r) + " " + inttostr(RGB.g) + " " + inttostr(RGB.b) + "]"); result := true; end; end; procedure clear(var i: integer; var RGB: TRGB; var buffer: array of TRGB); var x: integer; begin RGB.R := 0; RGB.G := 0; RGB.B := 0; i := 0; for x := 0 to 1 do buffer[x] := RGB; end; var ind, x, y: integer; buff: array[0..1] of TRGB; Col: TRGB; list: tstringlist; Dest: pRGB; s: string; begin list := tstringlist.Create; clear(ind, Col, buff); for y := rect.Top to rect.Bottom do begin Dest := Bitmap.ScanLine[y]; for x := rect.Left to rect.Right do begin col := Dest^; if add(ind, col, buff, list) then clear(ind, Col, buff); inc(Dest); end; end; if ind > 0 then begin dec(ind); case ind of 0: list.Add("[" + inttostr(buff[0].r) + " " + inttostr(buff[0].g) + " " + inttostr(buff[0].b) + "]"); 1: list.Add("[" + inttostr(buff[0].r) + " " + inttostr(buff[0].g) + " " + inttostr(buff[0].b) + "]" + "[" + inttostr(buff[1].r) + " " + inttostr(buff[1].g) + " " + inttostr(buff[1].b) + "]"); end; end; clear(ind, Col, buff); result := tstringlist.Create; result.Assign(list); list.Free; end; procedure TForm1.view(list: tstrings; var bit: tbitmap; rect: trect); type Tdf = record a, b, v: string; end; function razb(s_in: string): tdf; var s: string; i: integer; begin if s_in <> "" then begin i := pos("]", s_in); if i > 0 then begin result.a := copy(s_in, 2, i - 2); delete(s_in, 1, i) end; end else result.a := ""; if s_in <> "" then begin i := pos("]", s_in); if i > 0 then begin result.b := copy(s_in, 2, i - 2); delete(s_in, 1, i) end; end else result.b := ""; if s_in <> "" then begin i := pos("]", s_in); if i > 0 then begin result.v := copy(s_in, 2, i - 2); delete(s_in, 1, i) end; end else result.v := ""; end; function StringToRGB(s: string): trgb; var i: integer; begin if s = "" then exit; s := s + " "; result.R := strtoint(copy(s, 1, pos(" ", s) - 1)); delete(s, 1, pos(" ", s)); result.g := strtoint(copy(s, 1, pos(" ", s) - 1)); delete(s, 1, pos(" ", s)); result.b := strtoint(copy(s, 1, pos(" ", s) - 1)); delete(s, 1, pos(" ", s)); end; var x, y, i, a: integer; tr: tstringlist; s: TDf; Dest: pRGB; begin tr := tstringlist.Create; tr.Clear; for x := 0 to list.Count - 1 do begin s := razb(list.Strings[x]); if s.a <> "" then tr.Add(s.a); if s.b <> "" then tr.Add(s.b); if s.v <> "" then tr.Add(s.v); end; i := 0; a := tr.Count - 1; for y := rect.Top to rect.Bottom do begin Dest := bit.ScanLine[y]; for x := rect.Left to rect.Right do begin dest^ := StringToRGB(tr.Strings[i]); if i < a then inc(i); inc(Dest); end; end; tr.Free; end; end.

← →
Gydvin © (2006-12-15 09:30) [9]

И где-то есть ошибка. Искать лениво

← →
MegaNop © (2006-12-15 13:09) [10]

Ни фига ты код выложил. Во всяком случае - огромное спасибо всем.
Сейчас буду разбираться.

← →
MegaNop © (2006-12-15 22:00) [11]

-->RASkov

> for h:=0 to Image.Height do begin
> str:="";
> for w:=0 to Image.Width do begin
> R:=...
> G:=...
> B:=...
> str:=str+"["+inttostr(R)+" "+inttostr(G)+" "+inttostr(B)+"];
> ";
> end;
> Memo1.Lines.Add(str);
> end;

Это действует только при небольшом кол-ве пикселей. А потом memo1 самопроизвольно начинает переносить символы через какое-то определённое их количество.

← →
RASkov (2006-12-15 23:18) [12]

> [11] MegaNop © (15.12.06 22:00)

Memo.WordWrap:=False;

> Это действует только при небольшом кол-ве пикселей. А потом
> memo1 самопроизвольно начинает переносить символы через
> какое-то определённое их количество.

Ну сам подумай как тебе это хочеться видеть... ты ж понимаешь, что 1 пиксель это тебе не блок [255 255 255], а тебе нужно в одну строку мемо записать ряд пикселей картинки в "блочном виде", определись... кстати смотрел [8] там вроде бы по три блока выводится, но строк получается более чем рядов в картинке, вроде бы... я не вникал конкретно, просто разок "запустил тот код".

← →
RASkov (2006-12-15 23:24) [13]

> [11] MegaNop © (15.12.06 22:00)

В дополнение к [5],[11] и [12]
Memo.WordWrap:=False;

for h:=0 to Image.Height do begin str:="["+IntToStr(h)+"]: "; for w:=0 to Image.Width do begin R:=GetRValue(Image.Canvas.Pixels[w,h]); G:=GetGValue(Image.Canvas.Pixels[w,h]); B:=GetBValue(Image.Canvas.Pixels[w,h]); str:=str+"["+inttostr(R)+" "+inttostr(G)+" "+inttostr(B)+"];"; end; Memo1.Lines.Add(str); end;

← →
MegaNop © (2006-12-15 23:36) [14]

Memo.WordWrap:=False не исправляет ситуацию.
Работает сейчас так:

1 строчка: [1 2 3][4 5 6]...[4 6
2 строчка: 8][5 7 3][4 5 2]...[1 2 5][1
3 строчка: 2 6][5 7 3]...[4 5 6]

А надо соответственно так:
[1 2 3] [4 5 6] [7 8 9]
[1 4 6] [2 6 8] [3 4 6]
[2 5 7] [4 7 8] [5 3 6]
Чётко и ясно.

← →
RASkov (2006-12-15 23:43) [15]

> Memo.WordWrap:=False не исправляет ситуацию.

Добавь еще и Memo.ScrollBars:=ssHorizontal;

> Чётко и ясно.

Ну здесь нужно определится с составлением строки так как я предложил ровно не будет ибо
[255 10 105]
<>
[3 5 6]
Т.е. формируй строку блоков либо с нулями либо моноширным шрифтом и пробелами...

> MegaNop © (15.12.06 23:36) [14]

Нсколько я знаю, когда шлишком длинная строка, текстовый редактор переносит строку принудительно! Если для тебя неважен просмотр из твоей проги - юзаq tstringlist

PS. В [8] - я неправильно понял сабж. Там действительно бъется только по три блока. Остальные переносятся на следующюю строку

шлишком = слишком

> Gydvin (16.12.2006 0:41:17) [17]

Ааа, а то я думал зубы выбили :-)

-> Gydvin

>... - юзаq tstringlist

Что то я не припомню, что это такое. Может пояснишь?

MegaNop © (16.12.06 18:56) [19]
Что то я не припомню, что это такое. Может пояснишь?

есть одно пояснение на уйму случаев жизни: "справка вызывается клавишей F1"

Заколебался я с этими Memo. Поэтому взял StringGrid.
Cols=Bitmap height
Rows=Bitmap width
И в каждую ячейку - три составляющие RGB.

> Заколебался я с этими Memo. Поэтому взял StringGrid.
> Cols=Bitmap height
> Rows=Bitmap width
> И в каждую ячейку - три составляющие RGB.
>

Бу-га-га

Добавление в Memo или RichEdit Найти похожие ветки