Перенаправление вывода(отрисовка) на Bitmap(Интересная фича)

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

Перенаправление вывода(отрисовка) на Bitmap(Интересная фича)

Сообщение Alex2013 » 04.02.2025 17:36:08

Несколько лет назад уже сталкивался с похожей задачей но надежного решения тогда не нашел ...

Потом решили что-то похожее, но для OpenGL, и вот "снова здравствуйте": по ходу дела решил скопировать содержимое панели (TPanel) на картинку (было лень возиться с центровкой текста, которая отлично работает в стандартном TStaticText), первым делом попробовал простой BlitBit, что предсказуемо не сработало.

Потом решил дернуть "кусок скриншота"...

Код: Выделить всё
function CaptureScreenRect(aRect: TRect): TBitMap;
var
ScreenDC: HDC;
begin
Result := TBitMap.Create;
with Result, aRect do
  begin
Result := TBitMap.Create;
Result.Width := aRect.Right - aRect.Left;
Result.Height := aRect.Bottom - aRect.Top;
ScreenDC := CreateDC(PChar('DISPLAY'), nil, nil, nil);
try
   BitBlt(Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, ScreenDC, aRect.Left, aRect.Top, SRCCOPY);
finally
   ReleaseDC(0, ScreenDC);
end;
end;
end;

..это сработало лучше, но мне нужна возможность дергать содержимое "Невидимого окна". желательно чтобы панель или другой визуальный компонент вообще были не связаны с формой .

Немного погуглив нашел два "хитрых" варианта "создания скриншота панели" ...

Код: Выделить всё
Function PanelToBmp ( Panel:TPanel):TBitmap;
VAR
  bmp : tBitmap;
  DC  : HDC;
Begin
  bmp := tBitmap.Create;
  bmp.width := Panel.ClientWidth;
  bmp.Height := Panel.ClientHeight;
  DC := GetDc ( Panel.Handle );
  Bitblt(bmp.canvas.handle, 0, 0, Panel.Width, Panel.Height, Dc, 0, 0, SRCCOPY);
  Releasedc (Panel.handle,dc);
  result := bmp;
End;


Код: Выделить всё
  Function CopyPanelToBitmap(Panel:TPanel): TBitmap;
    var
      Bitmap: TBitmap;
      ControlCanvas: TControlCanvas;
    begin
      Bitmap := TBitmap.Create;
      ControlCanvas := TControlCanvas.Create;
      try
        Bitmap.Width := Panel.ClientWidth;
        Bitmap.Height := Panel.ClientHeight;
        ControlCanvas.Control := Panel;
        BitBlt(Bitmap.Canvas.Handle, 0, 0, Bitmap.Width, Bitmap.Height,
          ControlCanvas.Handle, 0, 0, SRCCOPY);
        // Теперь у вас есть содержимое Panel1 в Bitmap

      finally
        ControlCanvas.Free;

      end;
       Result:= Bitmap;
    end;

На удивление оба почти рабочие ... Почему "почти" ? Потому что скриншот загадочным образом не включает в себя изображение вставленного в панель TImage. Можно было-бы решить проблему "в ручном режиме " (или через обход дерева контролов ) но это уже полная кустарщина и колхоз.

Так что нашел более другой путь ... :idea:
Код: Выделить всё
B := tBitmap.Create;
b.SetSize(Panel1.ClientWidth,Panel1.ClientHeight);
Panel1.PaintTo(B.Canvas.Handle, 0, 0);

Так работает и по идее это вообще универсальное решение.

Controls.TWinControl.PaintTo
procedure PaintTo(DC: HDC; X, Y: Integer); overload;
procedure PaintTo(Canvas: TCanvas; X, Y: Integer); overload;

Тест выглядит как то так . ( вторая панелька в левом углу "первичный клон на картинке" который я потом тиражирую в "мозаичную тестовую галерею" )
Изображение
Зы
Разумеется, дальше я планирую не "лепить горбатого" в начале клонируя целиком "готовую панель" на битмап, а сразу вставить надпись формируемую с помощью TStaticText в битмап через PaintTo при создании миниатюры элемента галереи , но именно этот пример отлично показывает универсальность метода PaintTo .
Последний раз редактировалось Alex2013 05.02.2025 12:42:44, всего редактировалось 3 раз(а).
Alex2013
долгожитель
 
Сообщения: 3100
Зарегистрирован: 03.04.2013 11:59:44

Re: Перенаправление вывода(отрисовка) на Bitmap(Интересная ф

Сообщение 7bit » 04.02.2025 22:15:33

Я тут недавно пытался сделать свою модальность окон в линуксе. Для "заморозки" окон навешивал на все окно TPanel и рисовал на нем методом PaintTo содержимое формы. Нормально рисует. Только плохо, что кнопка, которая открывает "модальное" окно рисуется нажатой.
7bit
новенький
 
Сообщения: 39
Зарегистрирован: 01.10.2011 12:35:52

Re: Перенаправление вывода(отрисовка) на Bitmap

Сообщение Alex2013 » 05.02.2025 00:28:17

7bit писал(а):Я тут недавно пытался сделать свою модальность окон в линуксе. Для "заморозки" окон навешивал на все окно TPanel и рисовал на нем методом PaintTo содержимое формы. Нормально рисует. Только плохо, что кнопка, которая открывает "модальное" окно рисуется нажатой.

Ну одну кнопку по идее и подрисовать можно... :wink:
...или проверить вариант CopyPanelToBitmap (он вроде кроссплатформенный ) :idea:
Последний раз редактировалось Alex2013 12.02.2025 13:12:45, всего редактировалось 1 раз.
Alex2013
долгожитель
 
Сообщения: 3100
Зарегистрирован: 03.04.2013 11:59:44

Re: Перенаправление вывода(отрисовка) на Bitmap

Сообщение Alex2013 » 12.02.2025 13:08:46

Все же решил что юзать PaintTo в моем случае не слишком оправдано и перешёл на использование TextRect с настройкой TTextStyle;
(Разумеется сделать центровку текста и в "ручном режиме" не проблема, но зачем "плодить лишние сущности" если их уж наплодили? :wink: )
Код: Выделить всё
var
     B,B1: TBitmap;
     TS:TTextStyle;
  Begin   
  В:=Load_Image;
...
   TS:=Canvas.TextStyle;
     ts.Alignment:=taCenter;
     ts.Layout:=tlTop;//:=tlCenter;
     ts.SingleLine:=False;
     B1 := tBitmap.Create;
     b1.SetSize(DrawPanel.ClientWidth,DrawPanel.ClientHeight);
     b1.Canvas.Draw(0,0,B);
     b1.Canvas.Font.Color:=clWhite;
     b1.Canvas.Font.Bold:=True;
     b1.Canvas.Font.Size:=10;
     b1.Canvas.TextRect(rect(5,b.Height+3,b1.Width-5,b1.Height-1),
                          0,b.Height+3,Txt,
                          TS); 
     
Alex2013
долгожитель
 
Сообщения: 3100
Зарегистрирован: 03.04.2013 11:59:44


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 12

Рейтинг@Mail.ru