Как получить реальное изображение компонента

← →
Krants (2006-05-22 21:12) [0]

Допустим компонент обладает методом Canvas, и с помошью подобной процедуры можно скопировать его изображение в Image1:

Image1.Canvas.Copyrect(Rect(0,0,Image1.Width,Image1.Height),
ListBox1.Canvas,
Rect(0,0,ListBox1.Width,ListBox1.Height));

Все бы хорошо, но если данный компонент частично прикрыт(а хуже если полностью закрыт другой формой), то на Image1 попадает не полное его изображение...
Как быть, подскажите кто знает.

← →
Desdechado © (2006-05-22 21:22) [1]

зачем тебе полное, если реальное - прикрытое

по сабжу - попробуй заставить его отрисоваться на подсунутой ему канве вместо его родной

← →
Pavia © (2006-05-22 21:47) [2]

Не знаю то или нет.

function GetImage(C:TWinControl): TBitmap; var Ofs: Integer; begin Result := TBitmap.Create; try Result.Width := C.Width; Result.Height := C.Height; Result.Canvas.Brush := C.Brush; Result.Canvas.FillRect(C.ClientRect); Result.Canvas.Lock; try if GetWindowLong(C.Handle, GWL_STYLE) and WS_BORDER <> 0 then Ofs := -1 // Don"t draw form border else Ofs := 0; // There is no border C.PaintTo(Result.Canvas.Handle, Ofs, Ofs); finally Result.Canvas.Unlock; end; except Result.Free; raise; end; end; procedure TForm1.Button2Click(Sender: TObject); begin image1.Picture.Bitmap:=GetImage(ListBox1) end;

← →
Krants (2006-05-22 23:41) [3]

Спасибо огромное, то что надо!

← →
Юрий Зотов © (2006-05-23 20:24) [4]

> Pavia © (22.05.06 21:47) [2]

При таком вызове
image1.Picture.Bitmap := GetImage(ListBox1)
будем иметь утечку памяти.

Вообще, функция, создающая объект и возвращающая его в виде Result - штука в этом смысле опасная.

← →
Desdechado © (2006-05-23 20:45) [5]

да, лучше было бы
except Result.Free; Result := nil; raise; end; end;procedure TForm1.Button2Click(Sender: TObject); x: TBitmap; begin x:=GetImage(ListBox1); if(x<>nil) then begin image1.Picture.Bitmap.Assign(x); x.Free; end; end;
а то при ошибке в функции ловим AV

и согласен с
> функция, создающая объект и возвращающая его в виде Result - штука опасная.

← →
Юрий Зотов © (2006-05-23 21:47) [6]

> Desdechado © (23.05.06 20:45) [5]

Какой смысл в строке Result := nil, если следующая строка все равно возбуждает исключение?

да, raise я проглядел :(
имхо, оно там не нужно
или вызовы переделывать

> Вообще, функция, создающая объект и возвращающая его в виде
> Result - штука в этом смысле опасная.

Учту на будущие. Спасибо за совет.

> Pavia © (23.05.06 22:42) [8]

Приводимый ниже вариант ничем не хуже, но безопасен. Утечек памяти он не дает, а если пользователь процедуры (то есть, использующий ее программист) подсунет ей неверную ссылку (например, ссылку на несозданный объект), то он получит нормальное AV (что сразу просигнализирует ему о его ошибке - то есть, он еще и подсказку получит).
procedure PaintControl(C: TWinControl; Bitmap: TBitmap); var Ofs: integer; begin with Bitmap do begin Width := C.Width; Height := C.Height; Canvas.Brush := C.Brush; Canvas.FillRect(C.ClientRect); Canvas.Lock; try if GetWindowLong(C.Handle, GWL_STYLE) and WS_BORDER <> 0 then Ofs := -1 // Don"t draw form border else Ofs := 0; // There is no border C.PaintTo(Canvas.Handle, Ofs, Ofs) finally Canvas.Unlock end end end; procedure TForm1.Button2Click(Sender: TObject); begin PaintControl(ListBox1, Image1.Picture.Bitmap) end;

Как получить реальное изображение компонента Найти похожие ветки