ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Создание Bitmap
22 сообщений из 22, страница 1 из 1
Создание Bitmap
    #39253949
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Глупый вопрос. Есть у меня массив цветов. Мне нужно из этого массива создать Bitmap. Читаю описание функций
CreateBitmap()/CreateBitmapIndirect()
авторThe CreateBitmap function can be used to create color bitmaps. However, for performance reasons applications should use CreateBitmap to create monochrome bitmaps and CreateCompatibleBitmap to create color bitmaps .Подскажите, пожалуйста, как через CreateCompatibleBitmap передать мой массив? Еще я, что-то похожее вижу в CreateDIBSection()

С уважением, Vasilisk
...
Рейтинг: 0 / 0
10.06.2016, 00:09
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39253952
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Соколинский Борис
Участник
_Vasilisk_,
через CreateCompatible... - никак, он DDB для буферизации отрисовки.
CreateDIBSection или CreateDIBitmap, разница несущественная.
...
Рейтинг: 0 / 0
10.06.2016, 00:13
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254225
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Соколинский Борис,

Спасибо
...
Рейтинг: 0 / 0
10.06.2016, 13:29
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254359
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Вопрос такой:

Код:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
procedure TForm1.CreateBitmap(ABitmap: TBitmap);
var
  LHeight, LWidth: Integer;
  LInfo: PBitmapInfo;
  LBmp: HBITMAP;
  LRow, LCol: Integer;
begin
  LHeight := 256;
  LWidth := 640;
  //
  GetMem(LInfo, SizeOf(LInfo) + (LHeight * LWidth - 1) * SizeOf(LInfo^.bmiColors[0]));
  try
    LInfo^.bmiHeader.biSize := SizeOf(LInfo^.bmiHeader);
    LInfo^.bmiHeader.biWidth := LWidth;
    LInfo^.bmiHeader.biHeight := LHeight;
    LInfo^.bmiHeader.biPlanes := 1;
    LInfo^.bmiHeader.biBitCount := 24;
    LInfo^.bmiHeader.biCompression := BI_RGB;
    LInfo^.bmiHeader.biSizeImage := 0;
    LInfo^.bmiHeader.biXPelsPerMeter := 96;
    LInfo^.bmiHeader.biYPelsPerMeter := 96;
    LInfo^.bmiHeader.biClrUsed := 0;
    LInfo^.bmiHeader.biClrImportant := 0;
    //
    for LCol := 0 to LHeight - 1 do begin
      for LRow := 0 to LWidth - 1 do begin
        LInfo^.bmiColors[LCol * LWidth + LRow].rgbBlue := 255;
        LInfo^.bmiColors[LCol * LWidth + LRow].rgbGreen := 0;
        LInfo^.bmiColors[LCol * LWidth + LRow].rgbRed := 0;
        LInfo^.bmiColors[LCol * LWidth + LRow].rgbReserved := 0;
      end;
    end;

    LBmp := CreateDIBitmap(
      ABitmap.Canvas.Handle,
      LInfo^.bmiHeader,
      CBM_INIT,
      @LInfo^.bmiColors,
      LInfo^,
      DIB_RGB_COLORS
    );

    Win32Check(LBmp <> 0);
    ABitmap.Handle := LBmp;
  finally
    FreeMem(LInfo);
  end;
end;

Вызов:
Код: pascal
1.
  CreateBitmap(Image1.Picture.Bitmap);

Получаю черный прямоугольник указанного размера. Что я делаю не так?
...
Рейтинг: 0 / 0
10.06.2016, 16:26
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254387
Фотография Квейд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Квейд
Участник
_Vasilisk_Что я делаю не так?
Ты в дизайн-тайме засунул в Image1.Picture не .BMP-файл, очевидно же!
...
Рейтинг: 0 / 0
10.06.2016, 17:07
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254392
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
КвейдТы в дизайн-тайме засунул в Image1.Picture не .BMP-файл, очевидно же!Я в дизайнтайме ничего не засовывал. А потом смотрю код
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
function TPicture.GetBitmap: TBitmap;
begin
  ForceType(TBitmap);
  Result := TBitmap(Graphic);
end;

procedure TPicture.ForceType(GraphicType: TGraphicClass);
begin
  if not (Graphic is GraphicType) then
  begin
    FGraphic.Free;
    FGraphic := nil;
    FGraphic := GraphicType.Create;
    FGraphic.OnChange := Changed;
    FGraphic.OnProgress := Progress;
    Changed(Self);
  end;
end;
...
Рейтинг: 0 / 0
10.06.2016, 17:13
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254394
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Соколинский Борис
Участник
_Vasilisk_, да, в общем все.
Во-первых, в GDI присутствует некая багофича, вследствие которой память под DIB-карту должна непременно выделяться виндовым менеджером (GlobalAllocPtr(... )) и непременно отдельным дескриптором. Иначе получается то, что получается.
Во-вторых, для такого заполнения должно быть biBitCount := 32;
В- третьих, в карте другой порядок байтов по сравнению с палитрой.
...
Рейтинг: 0 / 0
10.06.2016, 17:15
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254399
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Соколинский Борисдолжно быть biBitCount := 32;Проверял. Ничего не меняется
Соколинский Бориспамять под DIB-карту должна непременно выделяться виндовым менеджером (GlobalAllocPtr(... )) и непременно отдельным дескриптором.Сейчас попробую
...
Рейтинг: 0 / 0
10.06.2016, 17:16
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254401
Фотография Квейд
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Квейд
Участник
Я повторил твой пример у себя на компе, только предварительно загрузив .BMP-файл в Image1.Picture.
Все сработало ожидаемо, получили вертикальное полосы.
...
Рейтинг: 0 / 0
10.06.2016, 17:17
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254412
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
КвейдВсе сработало ожидаемо, получили вертикальное полосы.А должен получиться прямоугольник синего цвета



Соколинский Борис,

Что-то опять не взлетело
 
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
procedure TForm1.CreateBitmap(ABitmap: TBitmap; const AColors: TColorMatrix);
var
  LHeight, LWidth: Integer;
  LInfo: TBitmapInfo;
  LBmp: HBITMAP;
  LRow, LCol: Integer;
  LColors: PRGBTriple;
  LCurColor: PRGBTriple;
begin
  LHeight := 256;
  LWidth := 640;
  //
  LInfo.bmiHeader.biSize := SizeOf(LInfo.bmiHeader);
  LInfo.bmiHeader.biWidth := LWidth;
  LInfo.bmiHeader.biHeight := LHeight;
  LInfo.bmiHeader.biPlanes := 1;
  LInfo.bmiHeader.biBitCount := 24;
  LInfo.bmiHeader.biCompression := BI_RGB;
  LInfo.bmiHeader.biSizeImage := 0;
  LInfo.bmiHeader.biXPelsPerMeter := 96;
  LInfo.bmiHeader.biYPelsPerMeter := 96;
  LInfo.bmiHeader.biClrUsed := 0;
  LInfo.bmiHeader.biClrImportant := 0;
  LInfo.bmiColors[0].rgbBlue := 0;
  LInfo.bmiColors[0].rgbGreen := 0;
  LInfo.bmiColors[0].rgbRed := 0;
  LInfo.bmiColors[0].rgbReserved := 0;
  //
  LColors := GlobalAllocPtr(GMEM_FIXED, LHeight * LWidth * SizeOf(LColors^));
  try
    LCurColor := LColors;
    for LCol := 0 to LHeight - 1 do begin
      for LRow := 0 to LWidth - 1 do begin
        LCurColor^.rgbtBlue := 255;
        LCurColor^.rgbtGreen := 0;
        LCurColor^.rgbtRed := 0;
        Inc(LCurColor);
      end;
    end;

    LBmp := CreateDIBitmap(
      ABitmap.Canvas.Handle,
      LInfo.bmiHeader,
      CBM_INIT,
      LColors,
      LInfo,
      DIB_RGB_COLORS
    );
    Win32Check(LBmp <> 0);
  finally
    GlobalFreePtr(LColors);
  end;
  ABitmap.Handle := LBmp;
end;

Все тот же черный прямоугольник. Еще и AV на закрытии. Но AV - это мелочи
...
Рейтинг: 0 / 0
10.06.2016, 17:32
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254415
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Соколинский Борисв карте другой порядок байтов по сравнению с палитрой.Так я же заполняю структуру.
...
Рейтинг: 0 / 0
10.06.2016, 17:33
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254417
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
_Vasilisk_Еще и AV на закрытииВру. AV пропал
...
Рейтинг: 0 / 0
10.06.2016, 17:35
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254424
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Соколинский Борис
Участник
_Vasilisk_, Проще самому написать
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
procedure TForm1.CreateBitmap(ABitmap: TBitmap; const AColors: TColorMatrix);
var
  LHeight, LWidth: Integer;
  LInfo: TBitmapInfo;
  LBmp: HBITMAP;
  LRow, LCol: Integer;
  LColors:    PRGBTriple;

  LCurColor: PRGBTriple;

  LineSize: cardinal;
begin
  LHeight := 256;
  LWidth := 640;
  //
  fillchar(LInfo, sizeof(LInfo),0);
  with LInfo.bmiHeader do begin
  
    biSize := SizeOf(LInfo.bmiHeader);
    biWidth := LWidth;
    biHeight := LHeight;
    biPlanes := 1;
    biBitCount := 24;
    biXPelsPerMeter := 96; //эта херь все равно никем не используется
    biYPelsPerMeter := 96;

    LineSize:=(BiWidth*biBitcount+31) shr 5 shl 2;
  end;


  LColors := GlobalAllocPtr(GPTR, LHeight * LineSize);
  try
    for LCol := 0 to LHeight - 1 do begin
      LCurColor:=Pointer(Cardinal(LColors)+LineSize*(LHeight - 1 - Lcol)); //в bmp хранение bottom-up

      for LRow := 0 to LWidth - 1 do begin
        LCurColor^.rgbtBlue := 255;
        LCurColor^.rgbtGreen := 0;
        LCurColor^.rgbtRed := 0;
        Inc(LCurColor);
      end;
    end;

    LBmp := CreateDIBitmap(GetDC(0),
      LInfo.bmiHeader,
      CBM_INIT,
      LColors,
      LInfo,
      DIB_RGB_COLORS
    );
    Win32Check(LBmp <> 0);
  finally
     GlobalFreePtr(LColors);  
  end;

  ABitmap.Handle := LBmp;
end;
...
Рейтинг: 0 / 0
10.06.2016, 17:46
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254445
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Соколинский БорисПроще самому написатьЕще раз спасибо. Нашел ошибку в своем коде. Т.к. у меня ABitmap был пустой, то он возвращал какой-то левый контекст.

Нужно было, либо перед вызовом ABitmap.Canvas.Handle, вызвать ABitmap.SetSize(1, 1), либо получить его через GetDC(0).

Еще вопрос - зачем это?

Соколинский Борис
Код: pascal
1.
    LineSize:=(BiWidth*biBitcount+31) shr 5 shl 2;

Чтобы привязаться к biBitcount?
...
Рейтинг: 0 / 0
10.06.2016, 18:13
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254450
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Соколинский Борис
Участник
_Vasilisk_Еще вопрос - зачем это? Длина строки в байтах должна быть кратна 4.
...
Рейтинг: 0 / 0
10.06.2016, 18:22
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254457
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Соколинский БорисДлина строки в байтах должна быть кратна 4.Спасибо.

И еще вопрос
Соколинский Бориспамять под DIB-карту должна непременно выделяться виндовым менеджером (GlobalAllocPtr(... ))Заменил PRGBTriple на array of TRGBTriple + SetLength() - все работает. Где-то грабли будут?
...
Рейтинг: 0 / 0
10.06.2016, 18:31
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254460
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Соколинский Борис
Участник
_Vasilisk_Где-то грабли будут? При больших размерах картинки.
Хотя именно в этом способе может ничего и не будет, будет точно если StretchDIBits использовать.
...
Рейтинг: 0 / 0
10.06.2016, 18:35
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254474
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Соколинский Борис
Участник
_Vasilisk_Т.к. у меня ABitmap был пустой, то он возвращал какой-то левый контекст. Забыл отметить - это еще один косяк GDI.
Для DIB-ов HDC нужен только чтобы считать палитру с контекста в случае если используется DIB_RGB_COLORS, в противном случае он никак не используется. Но WinAPI почему-то всегда требует валидный.
...
Рейтинг: 0 / 0
10.06.2016, 19:04
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254495
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
Соколинский БорисДля DIB-ов HDC нужен только чтобы считать палитру с контекста в случае если используется DIB_RGB_COLORS, в противном случае он никак не используется. Но WinAPI почему-то всегда требует валидный.Спасибо еще раз
...
Рейтинг: 0 / 0
10.06.2016, 20:00
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254512
Фотография _Vasilisk_
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
_Vasilisk_
Участник
И еще вопрос в контексте многопоточности. Могу ли я получить один раз GetDC(0), записать его в глобальную переменную, а потом без всякой синхронизации передавать этот контекст в CreateDIBitmap, вызываемой в разных потоках?
...
Рейтинг: 0 / 0
10.06.2016, 21:47
| Ответить | Цитировать | Написать  
Создание Bitmap
    #39254525
Соколинский Борис
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Соколинский Борис
Участник
_Vasilisk_,
Теоретически можно. А практически... не вижу смысла создавать потенциальную уязвимость, когда без нее запросто можно обойтись, вызывая GetDC из потока, что совершенно корректно и не накладно.
...
Рейтинг: 0 / 0
10.06.2016, 23:32
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
Создание Bitmap
    #39793658
konvikkor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
konvikkor
Гость
_Vasilisk_,

Доброго времени суток. У меня всё работет вот так вот

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
procedure TMediaDisplay.Render(w, h: SInt32; Data: array of PByte;
  linesize: array of Integer);
var
  BMPFile:TMemoryStream;//TFileStream;
  BMPHeader:BITMAPFILEHEADER;
  BMPInfo:TBitmapV4Header;
  ret:Integer;

  bmp:TBitmap;
  Graphics : TGPGraphics;
  Img:TGPBitmap;
  Text:string;

  TextureID:LongInt;
  Buffer:BITMAP;

begin
 if Assigned(CS) then CS.Enter;
 try
  bmpheader.bfReserved1 := 0;
  bmpheader.bfReserved2 := 0;
  bmpheader.bfType := $4d42;
  bmpheader.bfOffBits := sizeof(BITMAPFILEHEADER) + sizeof(BITMAPV4HEADER);
  bmpheader.bfSize := bmpheader.bfOffBits + w*h*32 div 8;

  bmpinfo.bV4Size := sizeof(BITMAPV4HEADER);
  bmpinfo.bV4Width := w;
  bmpinfo.bV4Height := -h;
  bmpinfo.bV4Planes := 1;
  bmpinfo.bV4BitCount := 32;//24;
  bmpinfo.bV4V4Compression := BI_BITFIELDS;
  bmpinfo.bV4SizeImage := 0;
  bmpinfo.bV4XPelsPerMeter := 100;//2835; // ResolutionHorizontal
  bmpinfo.bV4YPelsPerMeter := 100;//2835; //ResolutionVertical
  bmpinfo.bV4ClrUsed := 0;
  bmpinfo.bV4ClrImportant := 0;
  BMPInfo.bV4RedMask:=$00FF0000;
  BMPInfo.bV4GreenMask:=$0000FF00;
  BMPInfo.bV4BlueMask:=$000000FF;
  BMPInfo.bV4AlphaMask:=$FF000000;
  BMPInfo.bV4CSType:=$206E6957;
  BMPInfo.bV4GammaRed:=0;
  BMPInfo.bV4GammaGreen:=0;
  BMPInfo.bV4GammaBlue:=0;

  BMPFile:=TMemoryStream.Create;
  bmp:=TBitmap.Create;
  try
    BMPFile.WriteBuffer(bmpheader,SizeOf(bmpheader));
    BMPFile.WriteBuffer(bmpinfo,SizeOf(bmpinfo));
    BMPFile.WriteBuffer(data[0]^,w*h*32 div 8);
    BMPFile.Position:=0;
    BMP.LoadFromStream(BMPFile);
    Self.DrawBitmap(BMP,0,0);
  finally
    FreeAndNil(BMPFile);
    FreeAndNil(bmp);
    FreeAndNil(Graphics);
  end;
 finally
  if Assigned(CS) then CS.Leave;
 end;
end;
...
Рейтинг: 0 / 0
29.03.2019, 15:07
| Ответить | Цитировать | Написать  
22 сообщений из 22, страница 1 из 1
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Создание Bitmap
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=58&msg=39254525&tid=2039647]:
 0ms
get settings:
 6ms
get forum list:
 15ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 407ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 59ms
get tp. blocked users:
 1ms
others: 212ms
total:  717ms
созд. / загр.: 717ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]