Создать TBitmap "с нуля" в электронном виде.

← →
Курдль © (2004-03-05 14:30) [0]

Здоровствуйте, коллеги и сочувствующие!
Не могу найти полного описания сего процесса (см. сабж).
Мне надо создать полноценный TBitmap для вывода его как на экран, так и на принтер. Т.е. прописать ему все требуемые свойства и набить этот мэп, собснно, битами изображения "от руки" (или из заранее заготовленного массива).
Типа как на Java "createImage(new MemoryImageSource(...))"

← →
SammIk © (2004-03-05 14:34) [1]

Берешь в поисковике забиваешь
Формат фаила BMP
И гуляешь в поисках нужного дока

← →
TUser © (2004-03-05 14:36) [2]

> Создать TBitmap "с нуля"

MyBitMap:=TBitMap.Create;
Потом задать Width и Height, нарисовать чаго-нибудь и вперед ...

← →
Курдль © (2004-03-05 14:56) [3]

> MyBitMap:=TBitMap.Create;
> Потом задать Width и Height, нарисовать чаго-нибудь и вперед
> ...

Нарисовать в канве - это примитивно!
Да и может не прокатить, ведь канвы-то бывают разные!
Мне надо какой-нить универсальный алгоритм инициализации.

Кстати, если просто рисовать, то принтер его не съедает.
Зато если сначала его грузануть из файла (LoadFromFile),
а уж потом накалякать поверх, то все нормально выводится...
Парадокс...

← →
BOA_KAA © (2004-03-05 15:07) [4]

> Нарисовать в канве - это примитивно!
> Да и может не прокатить, ведь канвы-то бывают разные!

Бывает же...

> если просто рисовать, то принтер его не съедает

Это как?

← →
pasha_golub © (2004-03-05 15:14) [5]

Курдль © (05.03.04 14:56) [3]
А вы орехи любите?

← →
KSergey © (2004-03-05 15:17) [6]

> [4] BOA_KAA © (05.03.04 15:07)
> > если просто рисовать, то принтер его не съедает
>
> Это как?

Выплевывает ;)

← →
Курдль © (2004-03-05 15:18) [7]

> BOA_KAA
Вы помочь хотите, или сотрясаетесь от собственной значимости?

prnBitmap.LoadFromFile("1.bmp");
prnBitmap.Canvas.FillRect(Rect(10, 10, 20, 20));
Printer.BeginDoc;
Printer.Canvas.Draw(0,0,prnBitmap);
Printer.EndDoc;

Без 1-й строчки на принтер выводится чистый лист.
Если ее включить, то принтер печатает картинку с наложенным квадратом.

Вот я спрашиваю, какие свойства битмап берет из подгружаемого файла, которые позволяют ему нормально отображаться (Width и Height не предлагать).

← →
KSergey © (2004-03-05 15:20) [8]

> [7] Курдль © (05.03.04 15:18)
> (Width
> и Height не предлагать).

Это почему, интересно??
Без первой строчки лично я не вижу где вы их задаете...

← →
BOA_KAA © (2004-03-05 15:21) [9]

> Вы помочь хотите, или сотрясаетесь от собственной значимости?

Второе.

> Без 1-й строчки на принтер выводится чистый лист.

Нет, он печатает белый квадрат, если Вам так легче ;)

← →
Семен Сорокин © (2004-03-05 15:22) [10]

Курдль © (05.03.04 15:18) [7]
н-да, советую прислушаться к товарищам, почитать информацию, по Canvas"у в частности, а потом уже рассуждать.

ЗЫ. А орехи все-таки любите :))

← →
sniknik © (2004-03-05 15:22) [11]

а если так?

prnBitmap.Canvas.Brush.Color:= clBlack;
prnBitmap.Canvas.FillRect(Rect(10, 10, 20, 20));
Printer.BeginDoc;
Printer.Canvas.Draw(0,0,prnBitmap);
Printer.EndDoc;

← →
Семен Сорокин © (2004-03-05 15:27) [12]

sniknik © (05.03.04 15:22) [11]
не лучше так, так красивее, Малевич отдыхает :))

prnBitmap.Width := Printer.PageWidth; prnBitmap.Height := Printer.PageHeight; prnBitmap.Canvas.Brush.Color:= clBlack; prnBitmap.Canvas.FillRect(Rect(10, 10, Printer.PageWidth-10, Printer.PageHeight-10)); Printer.BeginDoc; Printer.Canvas.Draw(0,0,prnBitmap); Printer.EndDoc;

← →
BOA_KAA © (2004-03-05 15:31) [13]

> Семен Сорокин © (05.03.04 15:27) [12]

Не, он так квадратом не будет :)

← →
pasha_golub © (2004-03-05 15:33) [14]

var
B: TBitmap;
begin
B := TBitmap.Create;
try
B.Width := 400;
B.Height := 400;
B.Canvas.Brush.Color := clBlack;
B.Canvas.FillRect(Rect(10,10,100,100));
Printer.BeginDoc;
Printer.Canvas.Draw(0,0,B);
Printer.EndDoc;
finally
B.Free;
end;
end;

← →
Курдль © (2004-03-05 15:33) [15]

> не лучше так, так красивее, Малевич отдыхает :))

Ну и как, ЭТО у Вас напечаталось? У меня - нет! :(

← →
MBo © (2004-03-05 15:40) [16]

>Курдль
1. Tbitmap.Create
установить width, height и при необходимости глубину цвета
размеры могут быть произвольны (тогда вывод на принтер со Stretch-ингом) или задаваться по GetDeviceСaps принтера

2. CreateCompatibleBitmap c контекстом принтера

Заполнить из массива - одни из путей - SetDiBits

← →
KSergey © (2004-03-05 15:44) [17]

> [15] Курдль © (05.03.04 15:33)
> Ну и как, ЭТО у Вас напечаталось? У меня - нет! :(

А у меня - да! :)

Можно ваш код полностью полюбопытствовать? Который на основе [12] Семен Сорокин © (05.03.04 15:27) сделан?

PS
Я надеюсь - принтер у вас есть? ;)

← →
Курдль © (2004-03-05 15:46) [18]

> MBo ©
Вот и мастера пожаловали!
1. Ни один из приведенных выше примеров (за исключением моего первоначального с загрузкой из файла) ничего не печатают.
2. CreateCompatibleBitmap c контекстом принтера подразумевает создание HBITMAP при наличии работающего принтера.
У меня же сложная графика из одного и того же битмапа (ранее созданного) должна быть видна на экране и печататься на принтере.

← →
KSergey © (2004-03-05 15:48) [19]

Код в конце-концов можно увидеть??? Полный, относящийся к делу.

← →
Курдль © (2004-03-05 15:52) [20]

Код в конце-концов можно увидеть??? Полный, относящийся к делу.

Вот, пжалста - в сильно усеченном виде (но тож не работает):

procedure TGantt2D.PrintStretch;
var prnBitmap: TBitmap;
// prnDC: HDC;
// prnBitmap: HBITMAP;
begin
prnBitmap := TBitmap.Create;
prnBitmap.Width := 200;
prnBitmap.Height := 200;
try
prnBitmap.Width := Printer.PageWidth;
prnBitmap.Height := Printer.PageHeight;
prnBitmap.Canvas.Brush.Color:= clBlack;
prnBitmap.Canvas.FillRect(Rect(10, 10, Printer.PageWidth-10, Printer.PageHeight-10));
Printer.BeginDoc;
try
Printer.Canvas.Draw(300,300,prnBitmap);
Printer.EndDoc;
except
Printer.Abort;
end;
finally
prnBitmap.Free;
end;
end;

← →
Семен Сорокин © (2004-03-05 15:59) [21]

наверное принтер не цветной, добавь после создания:
prnBitmap.PixelFormat := pf1bit;
или
prnBitmap.Monohrome := true;

← →
pasha_golub © (2004-03-05 16:03) [22]

Семен Сорокин © (05.03.04 15:59) [21]
Это к делу врядлле относится. :-)

← →
KSergey © (2004-03-05 16:03) [23]

> [20] Курдль © (05.03.04 15:52)
> Вот, пжалста - в сильно усеченном виде (но тож не работает):

Вот буквально приведенный код у меня печатает. Черный прямоугольник почти на весь лист.

← →
Курдль © (2004-03-05 16:04) [24]

> prnBitmap.PixelFormat := pf1bit;

ЙЙЙЙЙЙес!
Я пробовал на 3-х разных лазерниках, но про формат мне мысль не приходила!

Спасибо!

← →
pasha_golub © (2004-03-05 16:09) [25]

Курдль © (05.03.04 16:04) [24]

И что проблема была в формате?
Не верю (с) Станиславский

Доступ к отдельным точкам, а точнее строкам, компонента TBitmap осуществляется с помощью property ScanLine[i], i - это индекс нужной строки битмапа, причём учитывая, что битмап загружается "вверх ногами" - это индексация "снизу-вверх".
property ScanLine[Row: Integer]: Pointer;
Далее преобразуете Pointer к PChar, прибавляете к указателю на char нужное значение (X*BytesPerPixel). И работаете с указателем на точку. :))))

pasha_golub © (05.03.04 16:09) [25]
И что проблема была в формате?
было у меня похожее на лазернике HP 1200-PCL под 2000, пока не установил нужный формат - печатал белый лист.

> И что проблема была в формате?

Вполне реально для HP с PCL. Дальше еще прикольнее может быть ;)

> И что проблема была в формате?

> Вполне реально для HP с PCL.

LG, HP и Lexmark...

> WebErr ©

ScanLine[i] дает указатель на точки физического устройства (видеокарты, принтера и т.д.).
Считаю, что работа с ними - не корректна. Если Вы имеете другое мнение и опыт - рад послушать.

> ScanLine[i] дает указатель на точки физического устройства
> (видеокарты, принтера и т.д.).
> Считаю, что работа с ними - не корректна. Если Вы имеете
> другое мнение и опыт - рад послушать.

:))))
Это-ж битмап!!! Сам по себе он ни с каким устройством не связан!!! Я очень часто использую свойство ScanLine[i] и пока безо всяких приключений, чего и Вам советую! :))))
Так что вопрос о корректности использования ScanLine pointer"a прошу считать некорректным! :))))
А вот когда Вы сотворяете Canvas.Draw/StretchDraw(TBitmap), вот тогда всё, что попадёт на устройство будет на вашей совести!!! :))))
procedure TForm1.FormCreate(Sender: TObject); var P: Pointer; begin Bitmap1 := TBitmap.Create; Bitmap2 := TBitmap.Create; Bitmap2.LoadFromFile("C:\Work\Apteka-V\Bitmaps\Ãàëî÷êà.bmp"); Bitmap1.Width := 16; Bitmap1.Height := 16; Bitmap1.PixelFormat := pf24bit; Bitmap1.IgnorePalette := true; P := Bitmap1.ScanLine[15]; // this bitch is turned!!! FillChar(P^, 3*16*16, 64); end;
Это как пример работающего кода! ;)

> WebErr

Спасибо! Особенно понравилось "this bitch is turned!!!
" :)

А альтернативы нет, типа распределить память, разметить ее в соотв. с картинкой и сделать какой-нить "Assign..."?..

> BOA_KAA

Спасибо! Это как раз ТО_САМОЕ, начиная с:

procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap:
TBitmap);
var
Header, Bits: Pointer;
HeaderSize: Integer;
BitsSize: Longint;
begin
GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
Header := MemAlloc(HeaderSize);
Bits := MemAlloc(BitsSize);
try
GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
DestRect.Right, DestRect.Bottom,
0, 0, ABitmap.Width, ABitmap.Height, Bits,TBitmapInfo(Header^),
DIB_RGB_COLORS, SRCCOPY);
{ you might want to try DIB_PAL_COLORS instead, but this is well
beyond the scope of my knowledge. }
finally
MemFree(Header, HeaderSize);
MemFree(Bits, BitsSize);
end;
end;

Да! И не забудьте, что у битмапа длинна каждой строки в байтах кратна 4 - это, так называемое "выравнивание по двойному слову". То есть битмап, с шириной не кратной 4, дополняется нулевыми байтами в конце строки.
Значит для Bitmap1.Width := N длина строки битмапа вычисляется по формуле [Round](N*BytesPerPixel+3) and $7FFFFFFC. Где BytesPerPixel может быть и Real (или Double), и Integer.

> Спасибо! Особенно понравилось "this bitch is turned!!!
> " :)

Строку удалить забыл - напоминание о том, как долго я искал ошибку при закраске моего битмапа, и о том как долго я на него ругался! :)

> А альтернативы нет, типа распределить память, разметить
> ее в соотв. с картинкой и сделать какой-нить "Assign..."?..

Есть такая штука! :)
Создаёте буффер с байтами картинки, которую вы сами ручками создадите, а потом StretchDIBits/SetDIBitsToDevice - это кульные апишные функции, которые очень быстро работают (стретч работает на порядок медленнее!) :))))

Семен Сорокин ©

> наверное принтер не цветной, добавь после создания:
> prnBitmap.PixelFormat := pf1bit;
> или
> prnBitmap.Monohrome := true;

В частном случае все заработало, но оставило неприятный осадок недопонимания. Хотелось бы "дожать этот вопрос".

1. prnBitmap.Monohrome := true; не помогает (это как раз и понятно)
2. Но не понятно, почему значение, полученное от принтера ф-цией GetDeviceCaps(Printer.Handle, BITSPIXEL) и подставленное битмапу (в моем частном случае - pf24bit) опять же вызывает печать белого листа.
(Для тех, кто не в курсе, речь идет о черно-белых лазерниках)

Создать TBitmap "с нуля" в электронном виде. Найти похожие ветки