Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Создание Bitmap / 22 сообщений из 22, страница 1 из 1
10.06.2016, 00:09
    #39253949
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
Глупый вопрос. Есть у меня массив цветов. Мне нужно из этого массива создать 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:13
    #39253952
Соколинский Борис
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_Vasilisk_,
через CreateCompatible... - никак, он DDB для буферизации отрисовки.
CreateDIBSection или CreateDIBitmap, разница несущественная.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 13:29
    #39254225
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
Соколинский Борис,

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

Код:
Код: 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, 17:07
    #39254387
Квейд
Квейд
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_Vasilisk_Что я делаю не так?
Ты в дизайн-тайме засунул в Image1.Picture не .BMP-файл, очевидно же!
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 17:13
    #39254392
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
КвейдТы в дизайн-тайме засунул в 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:15
    #39254394
Соколинский Борис
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_Vasilisk_, да, в общем все.
Во-первых, в GDI присутствует некая багофича, вследствие которой память под DIB-карту должна непременно выделяться виндовым менеджером (GlobalAllocPtr(... )) и непременно отдельным дескриптором. Иначе получается то, что получается.
Во-вторых, для такого заполнения должно быть biBitCount := 32;
В- третьих, в карте другой порядок байтов по сравнению с палитрой.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 17:16
    #39254399
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
Соколинский Борисдолжно быть biBitCount := 32;Проверял. Ничего не меняется
Соколинский Бориспамять под DIB-карту должна непременно выделяться виндовым менеджером (GlobalAllocPtr(... )) и непременно отдельным дескриптором.Сейчас попробую
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 17:17
    #39254401
Квейд
Квейд
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
Я повторил твой пример у себя на компе, только предварительно загрузив .BMP-файл в Image1.Picture.
Все сработало ожидаемо, получили вертикальное полосы.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 17:32
    #39254412
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
КвейдВсе сработало ожидаемо, получили вертикальное полосы.А должен получиться прямоугольник синего цвета



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

Что-то опять не взлетело
 
Код: 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:33
    #39254415
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
Соколинский Борисв карте другой порядок байтов по сравнению с палитрой.Так я же заполняю структуру.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 17:35
    #39254417
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_Vasilisk_Еще и AV на закрытииВру. AV пропал
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 17:46
    #39254424
Соколинский Борис
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_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, 18:13
    #39254445
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
Соколинский БорисПроще самому написатьЕще раз спасибо. Нашел ошибку в своем коде. Т.к. у меня 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:22
    #39254450
Соколинский Борис
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_Vasilisk_Еще вопрос - зачем это? Длина строки в байтах должна быть кратна 4.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 18:31
    #39254457
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
Соколинский БорисДлина строки в байтах должна быть кратна 4.Спасибо.

И еще вопрос
Соколинский Бориспамять под DIB-карту должна непременно выделяться виндовым менеджером (GlobalAllocPtr(... ))Заменил PRGBTriple на array of TRGBTriple + SetLength() - все работает. Где-то грабли будут?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 18:35
    #39254460
Соколинский Борис
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_Vasilisk_Где-то грабли будут? При больших размерах картинки.
Хотя именно в этом способе может ничего и не будет, будет точно если StretchDIBits использовать.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 19:04
    #39254474
Соколинский Борис
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_Vasilisk_Т.к. у меня ABitmap был пустой, то он возвращал какой-то левый контекст. Забыл отметить - это еще один косяк GDI.
Для DIB-ов HDC нужен только чтобы считать палитру с контекста в случае если используется DIB_RGB_COLORS, в противном случае он никак не используется. Но WinAPI почему-то всегда требует валидный.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 20:00
    #39254495
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
Соколинский БорисДля DIB-ов HDC нужен только чтобы считать палитру с контекста в случае если используется DIB_RGB_COLORS, в противном случае он никак не используется. Но WinAPI почему-то всегда требует валидный.Спасибо еще раз
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 21:47
    #39254512
_Vasilisk_
_Vasilisk_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
И еще вопрос в контексте многопоточности. Могу ли я получить один раз GetDC(0), записать его в глобальную переменную, а потом без всякой синхронизации передавать этот контекст в CreateDIBitmap, вызываемой в разных потоках?
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
10.06.2016, 23:32
    #39254525
Соколинский Борис
Соколинский Борис
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_Vasilisk_,
Теоретически можно. А практически... не вижу смысла создавать потенциальную уязвимость, когда без нее запросто можно обойтись, вызывая GetDC из потока, что совершенно корректно и не накладно.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Период между сообщениями больше года.
29.03.2019, 15:07
    #39793658
konvikkor
konvikkor
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Создание Bitmap
_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
| Ответить | Цитировать | Написать  
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Создание Bitmap / 22 сообщений из 22, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 522ms
Закрыть
start [/forum/topic.php?fid=58&mobile=1&tid=2039647]:
 0ms
get settings:
 9ms
get forum list:
 20ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 179ms
get topic data:
 12ms
get forum data:
 3ms
get page messages:
 70ms
get tp. blocked users:
 1ms
others: 220ms
total:  522ms
x
x
Закрыть


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