| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

TBitmap не хочет сохранять картинку

acp ©   (2003-05-26 23:32:00) 

Точнее сохраняет, но не совсем то. А именно, сохраняется простой чёрный фон. Может кто что подскажет? Тыкнет носом в ошибку?

TmpBMP := NewBitmap(100, 100);
with SrcRect do
begin
Left := 10;
Top := 10;
Right := 50;
Bottom := 50;
end;

//TmpBMP.Canvas.ModeCopy := cmSrcCopy;
TmpBMP.Canvas.CopyRect(SrcRect, LBMP.Canvas, SrcRect);
TmpBMP.SaveToFile(FileName);

PS: код по моему, достаточно ясный. В VCL аналогичное работает. Посмотрел реализацию CopyRect, вроде всё нормально...

---

Кладов   (2003-05-28 22:43:00) [1]

Причину нашел. Точнее, нашел, как исправить. Вот код NewBitmap.

function NewBitmap( W, H: Integer ): PBitmap;
var DC: HDC;
begin
New( Result, Create );
Result.fHandleType := bmDDB;
Result.fDetachCanvas := DummyDetachCanvas;
Result.fWidth := W;
Result.fHeight := H;
if (W <> 0) and (H <> 0) then
begin
//DC := CreateCompatibleDC( 0 );
DC := GetDC( 0 );
Result.fHandle := CreateCompatibleBitmap( DC, W, H );
Assert( Result.fHandle <> 0, "Can not create bitmap handle" );
//DeleteDC( DC );
( 0, DC) [3]

Причину нашел. Точнее, нашел, как исправить. Вот код NewBitmap.

function NewBitmap( W, H: Integer ): PBitmap;
var DC: HDC;
begin
New( Result, Create );
Result.fHandleType := bmDDB;
Result.fDetachCanvas := DummyDetachCanvas;
Result.fWidth := W;
Result.fHeight := H;
if (W <> 0) and (H <> 0) then
begin
//DC := CreateCompatibleDC( 0 );
DC := GetDC( 0 );
Result.fHandle := CreateCompatibleBitmap( DC, W, H );
Assert( Result.fHandle <> 0, "Can not create bitmap handle" );
//DeleteDC( DC );
ReleaseDC( 0, DC );
end;
end;


Закомментаренные строки заменены жирными. Теперь бы еще найти причину, почему такправильно, а так, как было, давало монохромный битмап :)

---

acp   (2003-05-27 00:14:00) [2]

Да... Может быть это и работает. В принципе, не суть важно. Для меня важнее вопрос - _почему_ не работает, почему выставление BPP решает эту проблема?

---

puky   (2003-05-26 23:59:00) [3]

Выставь pixelformat.
Вот рабочий пример:

procedure TForm1.Button1Click(Sender: PObj);
var
tmpbmp : PBitmap;
SrcRect : TRect;
begin
tmpbmp := NewDIBBitmap( 100, 100, pf24bit );
with tmpbmp^ do begin
SrcRect := MakeRect( 0, 0, 100, 400 );
Canvas.CopyRect( SrcRect, Form.Canvas, SrcRect );
( "c:\1.bmp") [1]

Выставь pixelformat.
Вот рабочий пример:

procedure TForm1.Button1Click(Sender: PObj);
var
tmpbmp : PBitmap;
SrcRect : TRect;
begin
tmpbmp := NewDIBBitmap( 100, 100, pf24bit );
with tmpbmp^ do begin
SrcRect := MakeRect( 0, 0, 100, 400 );
Canvas.CopyRect( SrcRect, Form.Canvas, SrcRect );
SaveToFile( "c:\1.bmp" );
Free;
end;
end;


---

Наверх