|
Вопрос # 3 500/ вопрос открыт / |
|
Доброго времени суток, уважаемые эксперты! Подскажите пожалуйста, как сделать "снимок" какого-либо компонента. К примеру дан компонент TLabel, из него нужно сделать изображение (такого же размера) и поместить, к примеру, в TImage.
 |
Вопрос задал: Free (статус: Посетитель)
Вопрос отправлен: 8 декабря 2009, 15:22
Состояние вопроса: открыт, ответов: 1.
|
Ответ #1. Отвечает эксперт: min@y™
По поводу TLabel я бы не стал заморачиваться. Так как текст (Caption), шрифт (Font) и цвет фона известны из свойств TLabel, на канвас можно тупо вывести копию TLabel методом TCanvas.TextOut().
А вот у потомков TWinControl (оконных компонентов) есть метод PaintTo(), подходящий для решения. К нему, кстати, есть даже пример в хэлпе.
Draws the windowed control to a device context.
Delphi syntax:
procedure PaintTo(DC: HDC; X, Y: Integer);
Description
Call PaintTo to draw the control on a device context. Specify the device context as the value of the DC parameter and specify the X and Y coordinates on the device context where the top-left corner of the windowed control is to be drawn. PaintTo first erases the background of the device context and then paints the control.
PaintTo is useful for drawing an image of the control into a bitmap DC.
Warning: When using PaintTo to draw on a canvas, you must lock the canvas first (and unlock it after the call to PaintTo. If you do not lock the canvas, Windows calls that occur while the control is painting can cause the canvas to lose its handle.
 |
Ответ отправил: min@y™ (статус: Доктор наук)
Время отправки: 8 декабря 2009, 15:52
|
Мини-форум вопроса
Всего сообщений: 10; последнее сообщение — 8 декабря 2009, 18:20; участников в обсуждении: 3.
|
AlexMPEI (статус: 1-ый класс), 8 декабря 2009, 15:34 [#1]:
Можно сделать снимок экрана, через функцию
BOOL ClientToScreen(
HWND hWnd, // дескриптор окна
LPPOINT lpPoint // экранные координаты
);
получить координаты объекта на этом снимке и скопировать этот участок в TImage
|
|
|
Free (статус: Посетитель), 8 декабря 2009, 15:44 [#2]:
Нет, нет. Мне нужна функция, которая перерисовывала бы компонент и вставляла в TImage без использования буфера обмена (она должна работать быстро).
|
|
|
AlexMPEI (статус: 1-ый класс), 8 декабря 2009, 15:55 [#3]:
procedure TForm1.Button1Click(Sender: TObject);
var bmp:TBitmap;
begin
bmp := TBitmap.Create;
bmp.Width := Screen.Width;
bmp.Height := Screen.Height;
BitBlt(bmp.Canvas.Handle, 0,0, Screen.Width, Screen.Height,
GetDC(0), 0,0,SRCCOPY);
Image1.Width := Screen.Width;
Image1.Height := Screen.Height;
Image1.Picture.Assign(bmp);
bmp.Free;
end;
если тут немного поменять то будет делаться скриншот только нужного компонента и ничего более. И никаких буферов обмена
|
|
|
Free (статус: Посетитель), 8 декабря 2009, 17:28 [#4]:
Извините, за ужасно глупый вопрос, но опишите пожалуйста, что именно и на что нужно поменять (я в графике абсолютно "не бум-бум")?
|
|
|
min@y™ (статус: Доктор наук), 8 декабря 2009, 17:49 [#5]:
Цитата (Free):
Извините, за ужасно глупый вопрос, но опишите пожалуйста, что именно и на что нужно поменять (я в графике абсолютно "не бум-бум")?
А чем тебя мой ответ не устроил?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
AlexMPEI (статус: 1-ый класс), 8 декабря 2009, 17:51 [#6]:
почему же, вопрос не глупый, просто надо немного подумать.
http://vsokovikov.narod.ru/New_MSDN_API/Bitmaps/fn_bitblt.htm
здесь подробно расписано про функцию BitBlt.
bmp.Width := Screen.Width;
bmp.Height := Screen.Height;
тут надо вместо Screen.Width, Screen.Height установить высоту и ширину вашего лейбла, это же будет размер картинки. тоже самое для Image1. аналогично в функции BitBlt. Вторые два нуля в ней же надо заменить на координаты левой верхней точки вашего лейбла.
собственно и все
|
|
|
Free (статус: Посетитель), 8 декабря 2009, 17:55 [#7]:
В принципе устроил, но в изображении кроме того, что мне надо появляются ещё всякие полоски и т.п.. Вроде бы должна быть какая-то функция для перерисовки конкретного эл-а управления?..
|
|
|
AlexMPEI (статус: 1-ый класс), 8 декабря 2009, 18:09 [#8]:
да, читал я о такой проблеме... надо перед функцией копирования еще какую-то вызвать, но какую не помню. поищите в яндексе, это известная проблема.
|
|
|
Free (статус: Посетитель), 8 декабря 2009, 18:10 [#9]:
Спасибо всем!
|
|
|
min@y™ (статус: Доктор наук), 8 декабря 2009, 18:20 [#10]:
Цитата (Free):
В принципе устроил, но в изображении кроме того, что мне надо появляются ещё всякие полоски и т.п
Какие ещё полоски?
Пришлось написать пример, чтобы убедиться, что всё работает.
На форме Label, Edit, Button, CheckBox и Image. Обработчик OnClick кнопки:
procedure TForm1.ButtonClick(Sender: TObject);
var
Index: Integer;
L: TLabel;
begin
for Index:= 0 to Self.ControlCount - 1 do
if Self.Controls[Index] is TWinControl
then TWinControl(Self.Controls[Index]).PaintTo(Image.Canvas, Self.Controls[Index].Left, Self.Controls[Index].Top)
else if Self.Controls[Index] is TLabel
then begin
L:= TLabel(Self.Controls[Index]);
Image.Canvas.Font.Assign(L.Font);
if L.Transparent
then Image.Canvas.Brush.Style:= bsClear
else Image.Canvas.Brush.Style:= bsSolid;
Image.Canvas.Brush.Color:= L.Color;
Image.Canvas.TextOut(L.Left, L.Top, L.Caption);
end;
end;
Всё работает.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
