PutImage

[Pavia]

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

Там картинка специальная заранее подготовленная. Формат другой, а расширения совпадают.

[Лекс Айрин]

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

Добавлено спустя 58 секунд:
Pavia, сказано, что принесенный экзешник работает как надо. Так что вряд ли.

[Снег Север]

Да и, допустим, игры часто требуют полного экрана.

Игры последние -надцать лет используют по никсами opengl, а под виндой - ее же или directx.

Добавлено спустя 1 минуту 47 секунд:

Там картинка специальная заранее подготовленная. Формат другой, а расширения совпадают.

Безусловно - это ясно из документации по PutImage, что там не стандартный bmp формат.

[Mikhail]

Посмотрел исходник 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

[Cheb]

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

В смысле, оно картинку ищет где надо? Оно её вообще находит? Что будет, если файл с картинкой убрать - прога встанет с ошибкой или будет работать неправильно?

[Mavlyudov]

Mikhail

Код: Выделить всё

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


Почему при выводе на форму не работает Form1.Canvas.Draw(x,y,p) или
Form1.Canvas.copyrect(Rect1, p, Rect2) вместо putimage?

[Alex2013]

Хм все работает... Нужно только в обработчике события отPaint прорисовку писать или рисовать на PaintBox-се .
https://youtu.be/Q5yS1MI1id0

[Mavlyudov]

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

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

[Alex2013]

Падает на 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 секунд:

На форме рисуется же просто через Canvax.Pixels

Рисоваться то рисуется, да до первого сдвига /переключения окна и даже курсор мышки все сотрет .
Так что нужно или писать отрисовку по событию onPaint или рисовать на TPaintBox или TImage.
Зы
Разумеется если вы не пытаетесь юзать WinGraph и WinCrt там вообще все иначе .

[Mavlyudov]

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

[Alex2013]

Тут вся соль в том, чтобы файл прочитать не средствами 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; в конце.
Зы
Разумеется нужно заранее знать разрешение и формат картинки записанной в дамп и наче ничего хорошего не увидишь .

[Mavlyudov]

Alex2013
А вообще не используя TBitmap можно как-то? Пусть и медленно.

[Alex2013]

В смысле "нарисовать массив точек на форме" разумеется можно( и даже довольно быстро ), не зачем ?
Например через 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;

[Mavlyudov]

Alex2013

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

Код: Выделить всё

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);

[Alex2013]

Извиняюсь за лень, разумеется я не выдал "рабочий код" , а просто примерно обозначил направление "куда копать" .
Что касается конваса (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.