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

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

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

Krants ©   (2006-05-22 21:12:00) 

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

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

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

---

Юрий Зотов   (2006-05-23 23:07:00) [1]

> 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;


---

Pavia   (2006-05-23 22:42:00) [2]

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

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

---

Desdechado   (2006-05-23 22:41:00) [3]

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

---

Юрий Зотов   (2006-05-23 21:47:00) [4]

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

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

---

Desdechado   (2006-05-23 20:45:00) [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 20:24:00) [6]

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

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

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

---

Krants   (2006-05-22 23:41:00) [7]

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

---

Pavia   (2006-05-22 21:47:00) [8]

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


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;


---

Desdechado   (2006-05-22 21:22:00) [9]

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

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

---

Наверх