На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> Как правильно использовать GetDIBits?
    На этом же форуме, пост - Get(Set)DIBits нашла пример использования GetDIBits.

    Однако при запуске GetDIBits всегда возвращает "0" и соответственно ошибку которая здесь указано в условии.
    ShowMessage('Error on Get');
    Как работает GetDIBits? Мне бы простой пример?
    ExpandedWrap disabled
      procedure TForm1.Button1Click(Sender: TObject);
      var
        dc: HDC;
        BI: tagBITMAPINFO;
        pBits:Pointer;
        OK: integer;
      begin
        DC:=GetDC(0); //handle ekrana
        image1.Width:=screen.Width;
        image1.Height:=screen.Height;
        //не забываем про размер самого битмапа
        image1.Picture.Bitmap.Width:=image1.Width;
        image1.Picture.Bitmap.Height:=image1.Height;
         // ustonavlivaem snimok ekrana v kartinku
        BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DC, 0, 0, SRCCOPY);
        with BI.bmiHeader do begin
          biSize:= SizeOf(BI.bmiHeader);//установливаем только размер структуры
        end;
        //первый вызов - заполняем структуру
        OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, BI.bmiHeader.biHeight, nil, BI, DIB_RGB_COLORS);
        Form1.Caption:=IntToStr(OK);
        if ok=0 then ShowMessage('Error on Get');
        //занимаем память под массив
        pBits:=PChar(GlobalAlloc(GPTR,BI.bmiHeader.biSizeImage));
        //второй вызов - заполняем массив
        OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, BI.bmiHeader.biHeight, pBIts, BI, DIB_RGB_COLORS);
        if ok=0 then ShowMessage('Error on Get');
        //задаем размеры второго рисунка
        image2.Width:=image1.Width;
        image2.Height:=image1.Height;
        //и его битмапа
        image2.Picture.Bitmap.Width:=image1.Width;
        image2.Picture.Bitmap.Height:=image1.Height;
        ok:=SetDIBits(Canvas.Handle,image2.Picture.Bitmap.Handle,0,BI.bmiHeader.biHeight,pBits,BI,DIB_RGB_COLORS);
        if ok=0 then ShowMessage('Error on Get');
        //освобождаем занятую память
        GlobalFree(Cardinal(pBits));
        //а это - просто что не мешался
        image1.Width:=0;
        image1.Height:=0;
      end;
       
      procedure TForm1.FormCreate(Sender: TObject);
      var
        ABitmap: TBitmap;
      begin
      ABitmap:=TBitmap.Create;
      ABitmap.LoadFromFile('.\bitmap\main.bmp');
      Image1.Canvas.Draw(0,0,ABitmap);
      end;
      Тут вся проблема в том, что структура tagBITMAPINFO объявлена фактически без палитры
      ExpandedWrap disabled
          PBitmapInfo = ^TBitmapInfo;
          {$EXTERNALSYM tagBITMAPINFO}
          tagBITMAPINFO = packed record
            bmiHeader: TBitmapInfoHeader;
            bmiColors: array[0..0] of TRGBQuad; // <<<----- нет места под палитры т.к. 0 элементов в массиве
          end;
          TBitmapInfo = tagBITMAPINFO;
          {$EXTERNALSYM BITMAPINFO}
          BITMAPINFO = tagBITMAPINFO;
      Чтобы функция GetDIBits правильно заполнила структуру, то ей нужно место для палитры максимум в 256 цветов. Т.е. выделяем место вручную и передаем в функцию не структуру, а указатель на динамическую память.

      ExpandedWrap disabled
        procedure TForm1.Button1Click(Sender: TObject);
        var
          dc: HDC;
          BI: Pointer;
          pBI: PBitmapInfo;
          pBits:Pointer;
          OK, Sz: integer;
        begin
          Sz := SizeOf(TBitmapInfo) + 256 * SizeOf(TRGBQuad);
          GetMem(BI, Sz);
          pBI := BI; // Если сразу передать в GetMem, то будет выделено в несколько раз больше памяти
        { т.к. Pointer - не знает о размерах структуры TBitmapInfo, а PBitmapInfo знает и величина
         (SizeOf(TBitmapInfo) + 256 * SizeOf(TRGBQuad)) будет не в байтах а в структурах TBitmapInfo
         Но типизированный указатель потом проще будет использовать для доступа к полям структуры }
          DC:=GetDC(0); //handle ekrana
          image1.Width:=screen.Width;
          image1.Height:=screen.Height;
          //не забываем про размер самого битмапа
          image1.Picture.Bitmap.Width:=image1.Width;
          image1.Picture.Bitmap.Height:=image1.Height;
           // ustonavlivaem snimok ekrana v kartinku
          BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DC, 0, 0, SRCCOPY);
          with pBI^ do begin
            bmiHeader.biSize:= SizeOf(bmiHeader);//установливаем только размер структуры
            bmiHeader.biBitCount := 0; // !!!!!!  ЭТО ТОЖЕ НАДО ИНИЦИАЛИЗИРОВАТЬ !!!!!!
          end;
          //первый вызов - заполняем структуру
          OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, pBI^.bmiHeader.biHeight, nil, pBI^, DIB_RGB_COLORS);
          Form1.Caption:=IntToStr(OK);
          if ok=0 then ShowMessage('Error on Get');
          //занимаем память под массив
          GetMem(pBits, pBI^.bmiHeader.biSizeImage);
          //второй вызов - заполняем массив
          OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, pBI^.bmiHeader.biHeight, pBIts, pBI^, DIB_RGB_COLORS);
          if ok=0 then ShowMessage('Error on Get');
          //задаем размеры второго рисунка
          image2.Width:=image1.Width;
          image2.Height:=image1.Height;
          //и его битмапа
          image2.Picture.Bitmap.Width:=image1.Width;
          image2.Picture.Bitmap.Height:=image1.Height;
          ok:=SetDIBits(Canvas.Handle,image2.Picture.Bitmap.Handle,0,pBI^.bmiHeader.biHeight,pBits,pBI^,DIB_RGB_COLORS);
          if ok=0 then ShowMessage('Error on Get');
          //освобождаем занятую память
          FreeMem(pBits, );
          //а это - просто что не мешался
          image1.Width:=0;
          image1.Height:=0;
          FreeMem(BI, Sz);
        end;
         
        procedure TForm1.FormCreate(Sender: TObject);
        var
          ABitmap: TBitmap;
        begin
        ABitmap:=TBitmap.Create;
        ABitmap.LoadFromFile('.\bitmap\main.bmp');
        Image1.Canvas.Draw(0,0,ABitmap);
        end;
        Почему-то когда я добавляю новые параметры.
        ExpandedWrap disabled
           PBitmapInfo = ^TBitmapInfo;
            {$EXTERNALSYM tagBITMAPINFO}
            tagBITMAPINFO = packed record
              bmiHeader: TBitmapInfoHeader;
              bmiColors: array[0..0] of TRGBQuad; // <<<----- нет места под палитры т.к. 0 элементов в массиве
            end;
            TBitmapInfo = tagBITMAPINFO;
            {$EXTERNALSYM BITMAPINFO}
            BITMAPINFO = tagBITMAPINFO;

        появляется ряд ошибок.


        Прикреплённый файлПрикреплённый файлimg123.jpg (86,55 Кбайт, скачиваний: 11)
          А не надо добавлять ничего в описание. Этот кусок скопирован из стандартного модуля Windows.pas.

          Описание правильное для большинства случаев, но вот тут нужно выделять память динамически.

          Надо просто сделать как показано. Можете сделать функции обертки, чтобы не создавать лишних переменных:
          ExpandedWrap disabled
            const
              SizeOfBitmapInfoWithColorArray = SizeOf(TBitmapInfo) + 256 * SizeOf(TRGBQuad);
             
            function GetBitmapInfoBufferWithColorArray: PBitmapInfo;
            var
              P: Pointer;
            begin
              GetMem(P, SizeOfBitmapInfoWithColorArray);
              with PBitmapInfo(P)^ do begin
                bmiHeader.biSize     := SizeOf(bmiHeader);
                bmiHeader.biBitCount := 0;
              end;
              Result                 := P;
            end;
             
            procedure FreeBitmapInfoBufferWithColorArray(aBuffer: PBitmapInfo);
            begin
              FreeMem(aBuffer, SizeOfBitmapInfoWithColorArray);
            end;
          Тогда можно сделать так
          ExpandedWrap disabled
            procedure TForm1.Button1Click(Sender: TObject);
            var
              dc: HDC;
              pBI: PBitmapInfo;
              pBits:Pointer;
              OK, Sz: integer;
            begin
              DC:=GetDC(0); // Получение DC экрана
              pBI := GetBitmapInfoBufferWithColorArray; // Получение буфера для BitmapInfo
             
              // Установка размеров компонента и буфера для хранения изображения
              image1.Width:=screen.Width;
              image1.Height:=screen.Height;
              image1.Picture.Bitmap.Width:=image1.Width;
              image1.Picture.Bitmap.Height:=image1.Height;
             
              // Копирование изображения экрана в буфер изображения компонента Image1
              BitBlt(Image1.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,DC, 0, 0, SRCCOPY);
             
              // Получение актуальной информации о формате изображения
              OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, pBI^.bmiHeader.biHeight, nil, pBI^, DIB_RGB_COLORS); // Получение информации
              Form1.Caption:=IntToStr(OK);
              if ok=0 then ShowMessage('Error on Get 1'); // Проверка на наличие ошибок
             
              // Получение массива пикселей изображения
              Sz := pBI^.bmiHeader.biSizeImage; // Выделение памяти под массив пикселей
              GetMem(pBits, Sz);
              OK:=GetDIBits(Canvas.Handle, image1.Picture.Bitmap.Handle, 0, pBI^.bmiHeader.biHeight, pBIts, pBI^, DIB_RGB_COLORS); // Получение массива
              if ok=0 then ShowMessage('Error on Get 2'); // Проверка на наличие ошибок
             
              // Изменение размеров во втором компоненте
              image2.Width:=image1.Width;
              image2.Height:=image1.Height;
              image2.Picture.Bitmap.Width:=image1.Width;
              image2.Picture.Bitmap.Height:=image1.Height;
             
              // Перенос массива пикселей в буфер второго компонента
              ok:=SetDIBits(Canvas.Handle,image2.Picture.Bitmap.Handle,0,pBI^.bmiHeader.biHeight,pBits,pBI^,DIB_RGB_COLORS);
              if ok=0 then ShowMessage('Error on Get'); // Проверка на наличие ошибок
             
              // Изменение размеров в первом компоненте
              image1.Width:=0;
              image1.Height:=0;
             
              // Освобождение памяти
              FreeMem(pBits, Sz); // Массив пикселей
              FreeBitmapInfoBufferWithColorArray(pBI); // Информация о формате изображения
            end;
            Все работает, в этом посту Как сделать линию пунктиром у Rectangle в Delphi? упоминали GetBitmapBits как аналог getImageData(HTML5). Но в интернете очень мало примеров. Как использовать GetBitmapBits на картинке которая загружается в компонент Image?
            ExpandedWrap disabled
              procedure TForm1.FormCreate(Sender: TObject);
              var
                ABitmap: TBitmap;
              begin
               ABitmap:=TBitmap.Create;
               ABitmap.LoadFromFile('.\main.bmp');
               Image1.Canvas.Draw(0,0,ABitmap);
              end;
              По WinAPI все примере есть в MSDN и описаны они достаточно подробно.

              К тому же вам уже дали пример современного аналога этой функции GetDIBits. В GetBitmapBits можно передавать только HBITMAP без HDC, чтобы получить пиксели. Но в GetDIBits надо передать оба хэндла (и HDC и HBITMAP). Это дополнительная возня, но можно пользоваться только последней.

              HBITMAP у TImage можно найти в Image1.Picture.Bitmap.Handle, а HDC в Image1.Canvas.Handle
              0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
              0 пользователей:


              Рейтинг@Mail.ru
              [ Script execution time: 0,0303 ]   [ 18 queries used ]   [ Generated: 26.05.24, 09:32 GMT ]