| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Добавление в Memo или RichEdit [D7, XP]
MegaNop © (2006-12-15 00:51:00)Вообщем такая ситуация:
В 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), то он добавляет всё в одну строку, а мне надо: сколько пикселей - столько блоков.
---
У-у-ф, объяснил как мог. Надеюсь поняли.
Gydvin (2006-12-17 00:34:00) [1]
> Заколебался я с этими Memo. Поэтому взял StringGrid.
> Cols=Bitmap height
> Rows=Bitmap width
> И в каждую ячейку - три составляющие RGB.
>
Бу-га-га
MegaNop (2006-12-16 23:32:00) [2]Заколебался я с этими Memo. Поэтому взял StringGrid.
Cols=Bitmap height
Rows=Bitmap width
И в каждую ячейку - три составляющие RGB.
Virgo_Style (2006-12-16 19:06:00) [3]MegaNop © (16.12.06 18:56) [19]
Что то я не припомню, что это такое. Может пояснишь?
есть одно пояснение на уйму случаев жизни: "справка вызывается клавишей F1"
MegaNop (2006-12-16 18:56:00) [4]-> Gydvin
>... - юзаq tstringlist
Что то я не припомню, что это такое. Может пояснишь?
Anatoly Podgoretsky (2006-12-16 12:13:00) [5]> Gydvin (16.12.2006 0:41:17) [17]
Ааа, а то я думал зубы выбили :-)
Gydvin (2006-12-16 00:41:00) [6]шлишком = слишком
Gydvin (2006-12-16 00:40:00) [7]
> MegaNop © (15.12.06 23:36) [14]
Нсколько я знаю, когда шлишком длинная строка, текстовый редактор переносит строку принудительно! Если для тебя неважен просмотр из твоей проги - юзаq tstringlist
PS. В [8] - я неправильно понял сабж. Там действительно бъется только по три блока. Остальные переносятся на следующюю строку
RASkov (2006-12-15 23:43:00) [8]> Memo.WordWrap:=False не исправляет ситуацию.
Добавь еще и Memo.ScrollBars:=ssHorizontal;
> Чётко и ясно.
Ну здесь нужно определится с составлением строки так как я предложил ровно не будет ибо
[255 10 105]
<>
[3 5 6]
Т.е. формируй строку блоков либо с нулями либо моноширным шрифтом и пробелами...
MegaNop (2006-12-15 23:36:00) [9]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:24:00) [10]> [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;
RASkov (2006-12-15 23:18:00) [11]> [11] MegaNop © (15.12.06 22:00)
Memo.WordWrap:=False;
> Это действует только при небольшом кол-ве пикселей. А потом
> memo1 самопроизвольно начинает переносить символы через
> какое-то определённое их количество.
Ну сам подумай как тебе это хочеться видеть... ты ж понимаешь, что 1 пиксель это тебе не блок [255 255 255], а тебе нужно в одну строку мемо записать ряд пикселей картинки в "блочном виде", определись... кстати смотрел [8] там вроде бы по три блока выводится, но строк получается более чем рядов в картинке, вроде бы... я не вникал конкретно, просто разок "запустил тот код".
MegaNop (2006-12-15 22:00:00) [12]-->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 самопроизвольно начинает переносить символы через какое-то определённое их количество.
MegaNop (2006-12-15 13:09:00) [13]Ни фига ты код выложил. Во всяком случае - огромное спасибо всем.
Сейчас буду разбираться.
Gydvin (2006-12-15 09:30:00) [14]И где-то есть ошибка. Искать лениво
Gydvin (2006-12-15 09:27:00) [15]Делать было нечего
Нужно оптимизировать
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.
RASkov (2006-12-15 01:58:00) [16]Т.е.
R:=GetRValue(Image.Canvas.Pixels[ w,h]);
вроде бы...
RASkov (2006-12-15 01:57:00) [17]R:=GetRValue(Image.Canvas.Pixels[h,w]);
и т.п.
RASkov (2006-12-15 01:55:00) [18]> [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;
MegaNop (2006-12-15 01:46:00) [19]А как определить, что уже кол-во блоков равно кол-ву пикселей по горизонтали и перейти на новую строку?
RASkov (2006-12-15 01:36:00) [20]> [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);
| |
Страницы: 