1 Тема от 0CodErr (изменено: Freeman, 25.07.2022 в 00:36)

  • 0CodErr
  • Заинтересованный
  • Неактивен
  • Зарегистрирован: 08.06.2019
  • Сообщений: 264

Тема: Работа с изображением фона(получить фон, используя MapBackground)

Пример показывает возможность спроецировать данные фона на адресное пространство процесса с помощью системной функции MapBackground для последующей работы с этим изображением. misc.php?action=pun_attachment&item=129&download=0
Процитирую справку:

Спроецированные данные доступны на чтение и запись.
Размер данных фона равен 3*xsize*ysize. Изменение размеров фона блокируется на время работы с спроецированными данными.
Цвет каждого пикселя хранится как 3-байтовая величина BBGGRR.
Пиксели фонового изображения записываются последовательно слева направо, сверху вниз.

Размер можно узнать с помощью системной функции GetBackgroundSize.
И далее в этом примере фоновое изображение выводится в окно.
После окончания работы с фоновым изображением закрыть проекцию данных фона на адресное пространство процесса можно с помощью системной функции UnmapBackground.

В кратце суть, как это можно сделать:

var
  BackgroundSize: TSize;
  Background: Pointer;
.........  
  BackgroundSize := GetBackgroundSize;
  Background := MapBackground;   
  DrawImage(Background^, 0, 0, BackgroundSize.Width, BackgroundSize.Height);  
  UnmapBackground(Background);

В примере используется DrawImageEx с workaround-ом против рисования на правой и нижней границе окна(известный баг ядра: обсуждалось и есть варианты решения). 
Окно изменяемого размера — его можно растягивать.

program MapUnmapBackground;

uses
  KolibriOS;

var
  WndWidth, WndHeight: LongWord;
  WndLeft, WndTop: LongInt;
  ThreadInfo: TThreadInfo;
  BackgroundSize: TSize;
  Background: Pointer;

procedure On_Redraw;

  procedure DrawBackgroundImageToWindow;
  var
    W, H, Pad: LongWord;
  begin
    if LongInt(TBox(ThreadInfo.Client).Height) > -1 then
    begin
      if TBox(ThreadInfo.Client).Width > BackgroundSize.Width then
      begin
        W := BackgroundSize.Width;
        Pad := 0;
      end
      else
      begin
        W := TBox(ThreadInfo.Client).Width;
        Pad := (BackgroundSize.Width - TBox(ThreadInfo.Client).Width) * 3;
      end;
      if TBox(ThreadInfo.Client).Height > BackgroundSize.Height then
        H := BackgroundSize.Height
      else
        H := TBox(ThreadInfo.Client).Height;
      DrawImageEx(Background^, 0, 0, W, H, 24{бита}, nil, Pad);
    end;
  end;

begin
  BeginDraw;
  DrawWindow(WndLeft, WndTop, WndWidth, WndHeight, 'Map\Unmap Background', $00FFFFFF,
    WS_SKINNED_SIZABLE + WS_CLIENT_COORDS + WS_CAPTION, CAPTION_MOVABLE);
  GetThreadInfo($FFFFFFFF, ThreadInfo);
  BackgroundSize := GetBackgroundSize;
  Background := MapBackground;
  DrawBackgroundImageToWindow;
  UnmapBackground(Background);
  EndDraw;
end;

begin
  HeapInit;

  with GetScreenSize do
  begin
    WndHeight := Height div 2;
    WndWidth := Width div 2;
    WndLeft := (Width - WndWidth) div 2;
    WndTop := (Height - WndHeight) div 2;
  end;

  SetEventMask(EM_REDRAW + EM_BUTTON);

  while True do
    case WaitEvent of
      REDRAW_EVENT:
        On_Redraw;
      BUTTON_EVENT:
          Break;
    end;
end.

Прикладываю скомпилированный пример MapUnmapBackground.kex

Модератор: офтопик вырезан, никому не прилетело из-за истечения сроков по причине длительного отсутствия модератора.

Post's attachments

Иконка вложений MapUnmapBackground.kex 757 b, 70 скачиваний с 2022-01-02 

Иконка вложений MapUnmapBackground.PNG 40.06 Кб, 33 скачиваний с 2022-01-02