Making Pascal Display Picture Files 
Author Message
 Making Pascal Display Picture Files

I'm sorta new to Pascal programming, could someone show me how or put me
on the right track to figuring out how to make pascal display picture
files, jpg, gif, bmp, pcx, tif, etc...
I would be eternally grateful if anyone could help.
Mike Bailey a.k.a. Phantom {*filter*}Space
Owner/K&K SoftWare, Consulting & Webpage Design



Fri, 17 Dec 1999 03:00:00 GMT  
 Making Pascal Display Picture Files

Quote:

> I'm sorta new to pascal programming, could someone show me how or put
> me
> on the right track to figuring out how to make pascal display picture
> files, jpg, gif, bmp, pcx, tif, etc...
> I would be eternally grateful if anyone could help.
> Mike Bailey a.k.a. Phantom {*filter*}Space
> Owner/K&K SoftWare, Consulting & Webpage Design

I have a very straightforward PCX-procedure at
http://www.*-*-*.com/ ~remcodek/program.html. There's a sample program
at  my downloadpage (same site).

Remco



Fri, 17 Dec 1999 03:00:00 GMT  
 Making Pascal Display Picture Files

Quote:
> I'm sorta new to pascal programming, could someone show me how or put me
> on the right track to figuring out how to make pascal display picture
> files, jpg, gif, bmp, pcx, tif, etc...
> I would be eternally grateful if anyone could help.
> Mike Bailey a.k.a. Phantom {*filter*}Space
> Owner/K&K SoftWare, Consulting & Webpage Design

unit TBMP;

{ Unit for show Windows Bitmap files.        }
{ Now support only :                         }
{   BMP 256 colors (Not RLE)                 }
{   BMP 16  colors (Not RLE)                 }
{ image show in CURRENT screen graphics mode }

interface

const
  BmpOk           =  0;
  BmpUnknownError = -1;
  BmpFileNotFound = -2;
  BmpNotSuppRes   = -3;
  BmpNotSuppFmt   = -4;

  function ShowBitMapImage(Name : String; X, Y : Word) : Integer;

implementation

uses Crt, Dos, Graph;

type
  TPalet{*filter*}try = record
    B: Byte;
    G: Byte;
    R: Byte;
    Flags: Byte;
  end;
  TBitmapFileHeader = record
    bfType: Word;
    bfSize: Longint;
    bfReserved1: Word;
    bfReserved2: Word;
    bfOffBits: Longint;
    biSize: Longint;
    biWidth: Longint;
    biHeight: Longint;
    biPlanes: Word;
    biBitCount: Word;
    biCompression: Longint;
    biSizeImage: Longint;
    biXPel{*filter*}eter: Longint;
    biYPel{*filter*}eter: Longint;
    biClrUsed: Longint;
    biClrImportant: Longint;
  end;

var
  BitmapName : String;
  F : File;
  bfh : TBitmapFileHeader;
  Pal256 : array[0..255] of TPalet{*filter*}try;
  Pal16 : array[0..15] of TPalet{*filter*}try;
  FileOpen : Boolean;
  Width_R, Width, Height : Word;
  BitCount : Word;
  Xstart, Ystart, xt, yt : Word;
  W2 : Word;

  function SwapNibble(B : Byte) : Byte;
    {-Swap the high and low nibbles of B: SwapNibble($F0) returns $0F.}
    inline(
      $58/                     {pop ax     ;AL = B}
      $88/$C4/                 {mov ah,al  ;AH = B}
      $B9/$04/$00/             {mov cx,4   ;4 bits/nibble}
                               {Start:}
      $D0/$CC/                 {ror ah,1   ;rotate rightmost bit of AH}
      $D0/$D8/                 {rcr al,1   ;into leftmost bit of AL}
      $E2/$FA);                {loop Start ;do it four times}

  function OpenFile : Boolean;
  begin
    FileOpen := False;
    OpenFile := False;
    Assign(F, BitmapName);
    Reset(F, 1);
    if IoResult <> 0 then Exit;
    FileOpen := True;
    OpenFile := True;
  end;

  function CloseFile : Boolean;
  begin
    FileOpen := False;
    CloseFile := False;
    Close(F);
    if IoResult <> 0 then Exit;
    CloseFile := True;
  end;

  function ReadBMPFileHead : Boolean;
  begin
    ReadBMPFileHead := False;
    BlockRead(F, bfh, SizeOf(bfh));
    if (IoResult <> 0) or
       (bfh.bfType <> $4D42) then Exit;
    Width := bfh.biWidth;
    Height := bfh.biHeight;
    BitCount := bfh.biBitCount;
    Width_R := Width;
    ReadBMPFileHead := True;
  end;

  function ReadPalette16 : Boolean;
  var C : Byte;
  begin
    ReadPalette16 := False;
    BlockRead(F, Pal16, SizeOf(Pal16));
    if IoResult <> 0 then Exit;
    for C := 0 to 15 do
      begin
        Pal16[C].R := Pal16[C].R shr 2;
        Pal16[C].G := Pal16[C].G shr 2;
        Pal16[C].B := Pal16[C].B shr 2;
      end;
    ReadPalette16 := True;
  end;

  function ReadPalette256 : Boolean;
  var C : Byte;
  begin
    ReadPalette256 := False;
    BlockRead(F, Pal256, SizeOf(Pal256));
    if IoResult <> 0 then Exit;
    for C := 0 to 255 do
      begin
        Pal256[C].R := Pal256[C].R shr 2;
        Pal256[C].G := Pal256[C].G shr 2;
        Pal256[C].B := Pal256[C].B shr 2;
      end;
    ReadPalette256 := True;
  end;

  procedure SetPalette256;
  const
    RED = 0;
    GREEN = 1;
    BLUE = 2;
  type
    Pal_array = array[0..255, RED..BLUE] of Byte;
  var
    Palette256 : Pal_array;
    Reg : Registers;
    i : Byte;
  begin
    for i := 0 to 255 do
      begin
        Palette256[i, RED]   := Pal256[i].R;
        Palette256[i, GREEN] := Pal256[i].G;
        Palette256[i, BLUE]  := Pal256[i].B;
      end;
    Reg.ah := $10;                { Set DAC Call }
    Reg.al := $12;                { set a block of DAC registers }
    Reg.bx := 0;                  { first DAC register number }
    Reg.cx := 255;                { number of registers to update }
    Reg.dx := Ofs(Palette256);    { offset of block }
    Reg.es := Seg(Palette256);    { segment of block }
    Intr($10, Reg);               { call interrupt }
  end;

  function SetPalette16 : Boolean;
  const
    RED = 0;
    GREEN = 1;
    BLUE = 2;
  type
    Pal_array = array[0..15, RED..BLUE] of Byte;
  var
    Palette16 : Pal_array;
    Reg : Registers;
    i : Byte;
  begin
    for i := 0 to 15 do
      begin
        Palette16[i, RED]   := Pal16[i].R;
        Palette16[i, GREEN] := Pal16[i].G;
        Palette16[i, BLUE]  := Pal16[i].B;
      end;
    Reg.ah := $10;                { Set DAC Call }
    Reg.al := $12;                { set a block of DAC registers }
    Reg.bx := 0;                  { first DAC register number }
    Reg.cx := 16;                 { number of registers to update }
    Reg.dx := Ofs(Palette16);     { offset of block }
    Reg.es := Seg(Palette16);     { segment of block }
    Intr($10, Reg);               { call interrupt }
  end;

  function ShowImage4 : Boolean;
  var
    Px, C0, C1 : Byte;
    Lin4 : array[0..1023] of Byte;
  begin
    ShowImage4 := False;
    Seek(F, bfh.bfOffBits);
    if (Width mod 8) <> 0 then
      while (Width mod 8) <> 0 do Inc(Width);
    W2 := (Width_R-1) div 2;
    for yt := Height-1 downto 0 do
      begin
        BlockRead(F, Lin4, Width div 2);
        for xt := 0 to W2 do
          begin
            Px := Lin4[xt];
            C0 := Px shr 4;
            Px := SwapNibble(Px);
            C1 := Px shr 4;
            PutPixel(Xstart+xt*2, Ystart+yt, C0);
            PutPixel(Xstart+xt*2+1, Ystart+yt, C1);
          end;
      end;
    ShowImage4 := True;
  end;

  function ShowImage8 : Boolean;
  type
    TLin = record
      X, Y : Word;
      Data : array[0..1023] of Byte;
    end;
  var
    SizeP : Word;
    Lin8 : ^TLin;
  begin
    ShowImage8 := False;
    if (Width mod 4) <> 0 then
      while (Width mod 4) <> 0 do Inc(Width);
    Seek(F, bfh.bfOffBits);
    SizeP := ImageSize(0, 0, 1028, 0);
    GetMem(Lin8, SizeP);
    Lin8^.X := Width_R-1;
    Lin8^.Y := 0;
    for yt := Height-1 downto 0 do
      begin
        BlockRead(F, Lin8^.Data, Width);
        PutImage(Xstart, Ystart+yt, Lin8^, NormalPut);
      end;
    FreeMem(Lin8, SizeP);
    ShowImage8 := True;
  end;

  procedure ShowPalette16;
  var x : Byte;
  begin
    for x := 0 to 15 do
      begin
        SetFillStyle(SolidFill, x);
        Bar(x*20, 0, (x+1)*20, 20);
      end;
  end;

  procedure ShowPalette256;
  var x, y, c : Byte;
  begin
    c := 0;
    for y := 0 to 15 do
      for x := 0 to 15 do
        begin
          SetFillStyle(SolidFill, c);
          Bar(x*20, y*20, (x+1)*20, (y+1)*20);
          Inc(c);
        end;
  end;

  procedure FadeOut16;
  var i, k : Byte;
  begin
    ReadKey;
    for k := 0 to 63 do
      begin
        for i := 0 to 15 do
          begin
            if Pal16[i].R > 0 then Dec(Pal16[i].R);
            if Pal16[i].G > 0 then Dec(Pal16[i].G);
            if Pal16[i].B > 0 then Dec(Pal16[i].B);
          end;
        SetPalette16;
        Delay(20);
      end;
  end;

  procedure FadeOut256;
  var i, k : Byte;
  begin
    ReadKey;
    for k := 0 to 63 do
      begin
        for i := 0 to 255 do
          begin
            if Pal256[i].R > 0 then Dec(Pal256[i].R);
            if Pal256[i].G > 0 then Dec(Pal256[i].G);
            if Pal256[i].B > 0 then Dec(Pal256[i].B);
          end;
        SetPalette256;
        Delay(20);
      end;
  end;

  function ShowBitMapImage(Name : String; X, Y : Word) : Integer;
  begin
    ShowBitMapImage := BmpUnknownError;
    BitmapName := Name;
    ShowBitMapImage := BmpFileNotFound;
    Xstart := X;
    Ystart := Y;
    if not OpenFile then Exit;
    if not ReadBMPFileHead then Exit;
    case BitCount of
      4 : begin
            ReadPalette16;
            SetPalette16;
            ShowImage4;
          end;
      8 : begin
            ReadPalette256;
            SetPalette256;
            ShowImage8;
          end;
    end;
    if not CloseFile then Exit;
    ShowBitMapImage := BmpOk;
  end;

end.



Tue, 21 Dec 1999 03:00:00 GMT  
 Making Pascal Display Picture Files

--------------25ABE3595CCEFC69D5A400BF
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit

I don't know what PASCAL you're using, but with Borland Pascal 7, you
can create your own pictures with (any kind of) graphical software (like
photo-shop, etc.) or the resources toolkit that is included with Pascal.

These pictures can be added in your program, using the {$R <name.bmp>}
directive (as I'm not quite sure if other formats like TIFF and JPEG are
supported...)
and then can be displayed with the (Windows) call BitBlt.

I've include a function whic I use (sorry for the Dutch comments...)
which displays a bitmap and overlays it with a colour bitmap. As you
might see, the bitmaps are referenced with a PChar type, which is a
pointer to the bitmap's stringname,

function TVenster.PutShape(Bericht: TBericht; Rop:LongInt): Bool;
var HMyBit:HBitmap;
    HMyDC: HDC;
begin
  HSrcDC:=GetDC(HWindow);
  HMyDC:=CreateCompatibleDC(HSrcDC);        { Een Device Context maken
die gelijk is aan DC van de bestemming (venster).}
  with Bericht do
  begin
    PutShape:=true;
    HMyBit:=LoadBitMap(HInstance, Bitmap); { Load a Bitmap.}
    SelectObject(HMyDC, HMyBit);           { Put bitmap in new Device
Context. }
    if(not BitBlt(HSrcDC, (Pos.X+1)*C_BlokGrootte,
(Pos.Y+1)*C_BlokGrootte, C_BlokGrootte, C_BlokGrootte, HMyDC, 0,0, Rop))
{ display bitmap in source Window.}
    then
    begin
      PutShape:=false; {Fout bij laden.}
    end; { if Bitblt.}
    DeleteObject(HMyBit); { Verwijder de aangemaakte Bitmap uit het
geheugen.}

    if (Kleur<>C_Wit) then
    begin
      HMyBit:=LoadBitMap(HInstance, KleurNaam[Kleur]); { Load a colour.}

      SelectObject(HMyDC, HMyBit);           { Zet de bitmap in de
nieuwe Device Context. }
      if(not BitBlt(HSrcDC,
(Pos.X+1)*C_BlokGrootte,(Pos.Y+1)*C_BlokGrootte,C_BlokGrootte,
C_BlokGrootte, HMyDC, 0,0, SrcAnd))
      then
      begin
        PutShape:=false; {Fout bij laden.}
      end; { if Bitblt.}
      DeleteObject(HMyBit); { Verwijder de aangemaakte Bitmap uit het
geheugen.}
    end; {if not Gegv.Kleur.}
  end; { with Posi.}
  DeleteDC(HMyDC); { Verwijder de aangemaakte Device Context uit het
geheugen.}
  UpdateWindow(HWindow);
  ReleaseDC(HWindow, HSrcDC);
end; { Putshape.}

Quote:

> I'm sorta new to pascal programming, could someone show me how or put
> me
> on the right track to figuring out how to make pascal display picture
> files, jpg, gif, bmp, pcx, tif, etc...
> I would be eternally grateful if anyone could help.
> Mike Bailey a.k.a. Phantom {*filter*}Space
> Owner/K&K SoftWare, Consulting & Webpage Design

--------------25ABE3595CCEFC69D5A400BF
Content-Type: text/html; charset=us-ascii
Content-Transfer-Encoding: 7bit

<HTML>
I don't know what PASCAL you're using, but with Borland Pascal 7, you can
create your own pictures with (any kind of) graphical software (like photo-shop,
etc.) or the resources toolkit that is included with Pascal.
<BR>These pictures can be added in your program, using the {$R &lt;name.bmp>}
directive (as I'm not quite sure if other formats like TIFF and JPEG are
supported...)
<BR>and then can be displayed with the (Windows) call BitBlt.

<P>I've include a function whic I use (sorry for the Dutch comments...)
which displays a bitmap and overlays it with a colour bitmap. As you <I>might</I>
see, the bitmaps are referenced with a PChar type, which is a pointer to
the bitmap's stringname,

<P>function TVenster.PutShape(Bericht: TBericht; Rop:LongInt): Bool;
<BR>var HMyBit:HBitmap;
<BR>&nbsp;&nbsp;&nbsp; HMyDC: HDC;
<BR>begin
<BR>&nbsp; HSrcDC:=GetDC(HWindow);
<BR>&nbsp; HMyDC:=CreateCompatibleDC(HSrcDC);&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
{ Een Device Context maken die gelijk is aan DC van de bestemming (venster).}
<BR>&nbsp; with Bericht do
<BR>&nbsp; begin
<BR>&nbsp;&nbsp;&nbsp; PutShape:=true;
<BR>&nbsp;&nbsp;&nbsp; HMyBit:=LoadBitMap(HInstance, Bitmap); { Load a
Bitmap.}
<BR>&nbsp;&nbsp;&nbsp; SelectObject(HMyDC, HMyBit);&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
{ Put bitmap in new Device Context. }
<BR>&nbsp;&nbsp;&nbsp; if(not BitBlt(HSrcDC, (Pos.X+1)*C_BlokGrootte, (Pos.Y+1)*C_BlokGrootte,
C_BlokGrootte, C_BlokGrootte, HMyDC, 0,0, Rop)) { display bitmap in source
Window.}
<BR>&nbsp;&nbsp;&nbsp; then
<BR>&nbsp;&nbsp;&nbsp; begin
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; PutShape:=false; {Fout bij laden.}
<BR>&nbsp;&nbsp;&nbsp; end; { if Bitblt.}
<BR>&nbsp;&nbsp;&nbsp; DeleteObject(HMyBit); { Verwijder de aangemaakte
Bitmap uit het geheugen.}

<P>&nbsp;&nbsp;&nbsp; if (Kleur&lt;>C_Wit) then
<BR>&nbsp;&nbsp;&nbsp; begin
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; HMyBit:=LoadBitMap(HInstance, KleurNaam[Kleur]);
{ Load a colour.}
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; SelectObject(HMyDC, HMyBit);&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
{ Zet de bitmap in de nieuwe Device Context. }
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; if(not BitBlt(HSrcDC, (Pos.X+1)*C_BlokGrootte,(Pos.Y+1)*C_BlokGrootte,C_BlokGrootte,
C_BlokGrootte, HMyDC, 0,0, SrcAnd))
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; then
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; begin
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; PutShape:=false; {Fout bij
laden.}
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; end; { if Bitblt.}
<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; DeleteObject(HMyBit); { Verwijder de
aangemaakte Bitmap uit het geheugen.}
<BR>&nbsp;&nbsp;&nbsp; end; {if not Gegv.Kleur.}
<BR>&nbsp; end; { with Posi.}
<BR>&nbsp; DeleteDC(HMyDC); { Verwijder de aangemaakte Device Context uit
het geheugen.}
<BR>&nbsp; UpdateWindow(HWindow);
<BR>&nbsp; ReleaseDC(HWindow, HSrcDC);
<BR>end; { Putshape.}
<BR>&nbsp;

<BLOCKQUOTE TYPE=CITE>I'm sorta new to pascal programming, could someone
show me how or put me
<BR>on the right track to figuring out how to make pascal display picture
<BR>files, jpg, gif, bmp, pcx, tif, etc...
<BR>I would be eternally grateful if anyone could help.
<BR>Mike Bailey a.k.a. Phantom {*filter*}Space
<BR>Owner/K&amp;K SoftWare, Consulting &amp; Webpage Design</BLOCKQUOTE>
&nbsp;&nbsp;</HTML>

--------------25ABE3595CCEFC69D5A400BF--



Fri, 31 Dec 1999 03:00:00 GMT  
 
 [ 4 post ] 

 Relevant Pages 

1. Making Pascal Display Picture Files

2. how do I display picture files in turbo?

3. Making binary files in pascal for an OS

4. How can a .exe file runs in DOS has windows?(Made in Turbo Pascal)

5. Displaying pictures

6. Pictures Display.

7. Displaying background pictures

8. how do I display pictures in turbo?

9. Displaying .JPG files in Pascal.

10. Displaying PCX files in Turbo Pascal

11. Displaying PCX files in Turbo Pascal

12. Display of BMP files in DOS Pascal

 

 
Powered by phpBB® Forum Software