PutImage

Форум для изучающих FPC и их учителей.

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

Re: PutImage

Сообщение Pavia » 20.07.2015 14:28:07

Герасим писал(а):Вот это меня и озадачивает. У школоты в школе PutImage работает, но дома нет.

Там картинка специальная заранее подготовленная. Формат другой, а расширения совпадают.
Последний раз редактировалось Pavia 20.07.2015 14:28:57, всего редактировалось 1 раз.
Аватара пользователя
Pavia
постоялец
 
Сообщения: 290
Зарегистрирован: 07.01.2011 12:46:51

Re: PutImage

Сообщение Лекс Айрин » 20.07.2015 14:28:41

Герасим, а пусть сын принесет школьный модуль graph. Возможно, он подправленный.

Добавлено спустя 58 секунд:
Pavia, сказано, что принесенный экзешник работает как надо. Так что вряд ли.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 5723
Зарегистрирован: 19.02.2013 16:54:51
Откуда: Волгоград

Re: PutImage

Сообщение Снег Север » 20.07.2015 15:43:15

Лекс Айрин писал(а):Да и, допустим, игры часто требуют полного экрана.
Игры последние -надцать лет используют по никсами opengl, а под виндой - ее же или directx.

Добавлено спустя 1 минуту 47 секунд:
Pavia писал(а):Там картинка специальная заранее подготовленная. Формат другой, а расширения совпадают.
Безусловно - это ясно из документации по PutImage, что там не стандартный bmp формат.
Аватара пользователя
Снег Север
долгожитель
 
Сообщения: 2993
Зарегистрирован: 27.11.2007 16:14:47

Re: PutImage

Сообщение Mikhail » 20.07.2015 15:56:44

Посмотрел исходник Wingraph, был неправ, нужно читать весь файл в память.
Вот рабочий пример

Код: Выделить всё
{$MODE DELPHI}
{$APPTYPE CONSOLE}
program testwingraph;
uses WinGraph, WinCrt;

function GetBitmap(const AFilename: string):pointer;
var F: file;
    size: Integer;
begin
Result:=nil;
AssignFile(F, AFilename);
Reset(F, 1);

size:=Filesize(F);
GetMem(Result, size);
BlockRead(F, Result^, size);
CloseFile(F);
end;

const cFilename = 'test.bmp';
var gd, gm: smallint;
    p:pointer = nil;
    bExit: Boolean = False;
    ch:char = #0;
begin
gd:=Detect;
gm:=0;
InitGraph(gd, gm, 'Put Image demo');
if GraphResult <> grOk then begin
  writeln(errOUtput, 'Initgraph error');
  Halt(1);
end;

p:=GetBitmap(cFilename);

PutImage(0, 0, p^, normalput);

FreeMem(p);
repeat
  bExit:=CloseGraphRequest;

  if KeyPressed then begin
   ch:=Readkey;
   bExit:= bExit or (ch = #27);
  end;
until bExit;

CloseGraph;
end.


Модуль wingraph взят отсюда
http://math.ubbcluj.ro/~sberinde/wingraph/main.html
Mikhail
энтузиаст
 
Сообщения: 562
Зарегистрирован: 24.10.2013 16:06:47

Re: PutImage

Сообщение Cheb » 10.09.2015 17:13:47

Простейший вопрос: в ней бензин не кончился?

В смысле, оно картинку ищет где надо? Оно её вообще находит? Что будет, если файл с картинкой убрать - прога встанет с ошибкой или будет работать неправильно?
Аватара пользователя
Cheb
энтузиаст
 
Сообщения: 994
Зарегистрирован: 06.06.2005 15:54:34

Re: PutImage

Сообщение Mavlyudov » 15.06.2022 07:05:49

Mikhail
Код: Выделить всё
PutImage(0, 0, p^, normalput);

Почему при выводе на форму не работает Form1.Canvas.Draw(x,y,p) или
Form1.Canvas.copyrect(Rect1, p, Rect2) вместо putimage?
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: PutImage

Сообщение Alex2013 » 15.06.2022 11:21:03

Хм все работает... Нужно только в обработчике события отPaint прорисовку писать или рисовать на PaintBox-се .
https://youtu.be/Q5yS1MI1id0
Alex2013
долгожитель
 
Сообщения: 2923
Зарегистрирован: 03.04.2013 11:59:44

Re: PutImage

Сообщение Mavlyudov » 15.06.2022 11:54:29

Alex2013
Не работает! Падает на FreeMem(p);

На форме риcуется же просто через Canvax.Pixels[x,y]:=clColor;
А тут нет. Может что с указателем?
Может надо указатель делать так var p:^TBitmap ?
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: PutImage

Сообщение Alex2013 » 15.06.2022 13:34:34

Mavlyudov писал(а):Падает на FreeMem(p);
На форме риcуется же просто через Canvax.Pixels[x,y]:=clColor;
А тут нет. Может что с указателем?
Может надо указатель делать так var p:^TBitmap ?


1 Чистая форма выводится ?
2 Покажите ваш код.
3 Разумеется "Падает на FreeMem(p);"
Нужно что-то вроде
Код: Выделить всё
procedure TForm1.FormPaint(Sender: TObject);
Const
B:TBitmap=nil;
begin
If B = nil then begin
  B:=TBitmap.Create ;
  B.LoadFromFile('Pic.bmp');
end;
Form1.Canvas.Draw(100,100,b);
//(освобождение памяти по   B.free; но в этом коде это делать не нужно )
end;


Добавлено спустя 7 минут 18 секунд:
Alex2013 писал(а):На форме рисуется же просто через Canvax.Pixels

Рисоваться то рисуется, да до первого сдвига /переключения окна и даже курсор мышки все сотрет .
Так что нужно или писать отрисовку по событию onPaint или рисовать на TPaintBox или TImage.
Зы
Разумеется если вы не пытаетесь юзать WinGraph и WinCrt там вообще все иначе .
Последний раз редактировалось Alex2013 15.06.2022 14:02:53, всего редактировалось 1 раз.
Alex2013
долгожитель
 
Сообщения: 2923
Зарегистрирован: 03.04.2013 11:59:44

Re: PutImage

Сообщение Mavlyudov » 15.06.2022 13:58:56

Тут вся соль в том, чтобы файл прочитать не средствами TBitmap, а как файл, через BlockRead(F, Result^, size);
Поэтому, наверное, надо ещё как-то пробовать с указателем. Через Wingraph+Delphi получается через putimage. А через Delphi и Canvas нет
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: PutImage

Сообщение Alex2013 » 15.06.2022 14:39:40

Mavlyudov писал(а):Тут вся соль в том, чтобы файл прочитать не средствами TBitmap, а как файл, через BlockRead(F, Result^, size);


Ну так это другой разговор...
Как-то приблизительно так (очень грубо но по идее работать будет ).
Код: Выделить всё
procedure Load_Bitmap_From_DUMP (Var B: TBitmap);
Var
F:File;
P:Pointer;
begin
Assign(F,'Pic.IMG');
Reset (F,1);
   B.BeginUpdate(False);
   P:= B.RawImage.Data; 
    BlockRead(F, P^, B.RawImage.DataSize);
   B.EndUpdate(False);
close(f);
end;

Разумеется вначале нужно где-то сделать
Код: Выделить всё
Bmp: = TBitmap.Create ; 
Bmp.PixelFormat:=pf24bit;// или  pf32bit и т.п.
Bmp.SetSize(w,h);
и только потом
Load_Bitmap_From_DUMP(Bmp); и
Form1.Canvas.Draw(100,100,Bmp);

...не забыв (если это нужно ) Bmp.Free; в конце.
Зы
Разумеется нужно заранее знать разрешение и формат картинки записанной в дамп и наче ничего хорошего не увидишь .
Alex2013
долгожитель
 
Сообщения: 2923
Зарегистрирован: 03.04.2013 11:59:44

Re: PutImage

Сообщение Mavlyudov » 15.06.2022 18:56:15

Alex2013
А вообще не используя TBitmap можно как-то? Пусть и медленно.
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: PutImage

Сообщение Alex2013 » 16.06.2022 00:38:55

В смысле "нарисовать массив точек на форме" разумеется можно( и даже довольно быстро ), не зачем ?
Например через StretchDIBits
http://platonov-andrei.narod.ru/Delphi/ ... DIBits.htm
procedure TForm1.FormPaint(Sender: TObject);
Var
F:File;
PDUMP:Pointer;
Size:Integer;
begin
Assign(F,'Pic.IMG');
Reset (F,1);
Size:=FileSize(F);
GetMem(PDUMP^,Size);
BlockRead(F, PDUMP^,Size);
Close(F);
StretchDIBits(Form1.Canvas.Handle, 0,0, Form1.Width, Form1.Height, 0, 0, AWidth, AHeight, PDUMP^, PBitmapInfo(@Form1.Canvas), DIB_RGB_Colors, SRCCOPY);
end;
Alex2013
долгожитель
 
Сообщения: 2923
Зарегистрирован: 03.04.2013 11:59:44

Re: PutImage

Сообщение Mavlyudov » 16.06.2022 02:17:27

Alex2013

Сейчас попробую. Про код выше и модуль Graphics cо структурами типа B.RawImage.DataSize - это не Делфи.
Переделал. Идея загнать bmp в массив и его потом отрисовать через Canvs.Draw, правда для этого надо создать промежуточный bitmap и переместить туда массив (функцией move), что не есть хорошо. А хотел без него. Кстати, код ниже не работает :roll: . Поправьте пожалуйста

Код: Выделить всё
var
Buf: array[0..32767] of Byte;
w,h,i:integer;

function TakeBitmap:pointer;
var F: file;
    size: Integer;
//    P1:Pointer;
    AFilename: string;
begin

AFilename := 'i:\image.bmp';
AssignFile(F, AFilename);
Reset(F, 1);
//Пропускаем 14 байт заголовка BitMapFileHeader
//и 40 байт BitMapInfoHeader
Seek(F, 55);
BlockRead(F, buf, size);
CloseFile(F);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
w:=260;
h:=260;
Bmp:=TBitmap.Create ;
Bmp.PixelFormat:=pf8bit;
Bmp.Width:=w;
bmp.Height:=h;
p:=TakeBitmap;
Move(p, Bmp, w*h);
Form1.Canvas.Draw(100,100,Bmp);
end;


Added
Попробовал. Пришлось допиливать, но не до конца удалось. Картинка 260 на 260 пикселов, черная надпись на белом фоне. Сохранена как 16 цветная.
Рисует на розовом фоне и увеличивает раза в 4 - 5.
Интересует еще как сделать не через API, а через Canvas (через API тоже интересно как допилить).

Код: Выделить всё
procedure TForm1.Button2Click(Sender: TObject);
Var
F:File;
PDUMP:Pointer;
Size:Integer;
bi:BitmapInfo;
begin
w:=260;
h:=260;
with bi.bmiHeader do begin
    biSize:= SizeOf(TBitmapInfoHeader);
    biWidth:= w;
    biHeight:= h;
    biPlanes:= 1;
    biBitCount:= 4;
    biCompression:= BI_RGB;
    biSizeImage:= 0;
    biXPelsPerMeter:= 0;
    biYPelsPerMeter:= 0;
    biClrUsed:= 0;
    biClrImportant:= 0;
  end;

AssignFile(F,'i:\image.bmp');
Reset (F,1);
Size:=FileSize(F);
GetMem(PDUMP,Size);
BlockRead(F, PDUMP^,Size);
CloseFile(F);
StretchDIBits(Form1.Canvas.Handle,
0,0, Form1.Width, Form1.Height,
0, 0, w, h,
PDUMP,
bi,
0, SRCCOPY);
end;


Такой фокус не проходит
Код: Выделить всё
Move(PDUMP, Bmp, w*h*size);
Form1.Canvas.Draw(100,100,Bmp);
Mavlyudov
новенький
 
Сообщения: 50
Зарегистрирован: 24.01.2010 20:35:23

Re: PutImage

Сообщение Alex2013 » 16.06.2022 14:01:22

Извиняюсь за лень, разумеется я не выдал "рабочий код" , а просто примерно обозначил направление "куда копать" .
Что касается конваса (Canvas.Draw) то там есть возможность использовать любой класс порожденный от TGraphic и по идее там можно хоть "черта в ступе описать". Но это явная нецелесообразность для простой задачи .

Такой фокус не проходит
Код: Выделить всё
Move(PDUMP, Bmp, w*h*size);
Form1.Canvas.Draw(100,100,Bmp);

Разумеется , такой фокус не работает .
Canvas.Draw работает даже не со структурой, а с КЛАССОМ порожденным от TGraphic.
Зы
B.RawImage.Data можно заменить на B.scanline[0] а размер вычислить как w*h*bpp (bpp число байт на пиксель Для pf8bit bpp=1, pf24bit bpp=3, pf32bit bpp=4 и т. п.)
В делфи сработает так
Код: Выделить всё
Move(PDUMP, Bmp.scanline[0]^, w*h*bpp);
Form1.Canvas.Draw(100,100,Bmp);

В лазарусе это тоже сработает но с дополнением
Код: Выделить всё
   B.BeginUpdate(False);
      Move(PDUMP, Bmp.scanline[0]^, w*h*bpp);
   B.EndUpdate(False);
Form1.Canvas.Draw(100,100,Bmp);

Чем хорош Canvas.Draw так это тем что сам умеет конвертировать любой PixelFormat источника (Bmp) в текущий режим отображения на приемнике в данном случае Form1. Но еще раз повторяю рисовать что либо на прямо на форме "по кнопке " не верно нужно вставить PaintBox который можно отмасштабировать на всю форму рисовать уже на нем, иначе нужно делать обработчик события оnPaint или можно вообще не увидеть результат работы кода и он будет постоянно пропадать .

То есть нормально будет писать как-то так...
Код: Выделить всё
Form1.PaintBox1.Canvas.Draw(100,100,Bmp);
Form1.PaintBox1.Refresh;

Зы
1,4,8,16 -ти битные режимы требует настройки поллитры так что проще использовать 24 и 32 -х битные так как там все всегда отображается "как есть ". Размер данных сейчас большого значения не имеет потому что для отображения картинок можно использовать "стандартный JPG" и потерять заметно меньше качества (особенно в многоцветных фото-изображениях ) чем при снижении bpp.
Alex2013
долгожитель
 
Сообщения: 2923
Зарегистрирован: 03.04.2013 11:59:44

Пред.

Вернуться в Обучение Free Pascal

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

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

Рейтинг@Mail.ru