:
This message was edited by Phat Nat at 2005-5-29 19:33:28
: : Can somebody please teach me how to use bitmap pics in a pascal program?
: : What unit must i have? I use Turbo pascal 7.0.
: :
: : Thank you in advance.
: :
:
: I made this quite a while ago. It's not perfect, but it handles higher graphicx than just 320x200. Feel free to modify as you see fit. Sorry, I din't comment it very much, but should hopefully be kinda straight-forward. The graphics routines are written in assembly, but here are some basics:
:
:
: Graphix($10F); { = 320x200, 32-bit (4.2 Billion) Colors }
: Graphix($101); { = 640x480, 8-bit (256) Colors }
: Graphix($110); { = 640x480, 16-bit (65,536) Colors }
: Graphix($112); { = 640x480, 32-bit (4.2 Billion) Colors }
: Graphix($115); { = 800x600, 32-bit (4.2 Billion) Colors }
:
:
: There's lots of others, but these are the basic higher ones. Anyways, just more choice here. If I get time I may comment better.
:
: Phat Nat
:
:
:
:
: UNIT Show_Bmp;
:
: INTERFACE
:
: USES Crt;
:
: TYPE
: BMPHeaderRec = record
: Identifier : Array[0..1] Of Char;
: Size : LongInt;
: Reserved : LongInt;
: BitMapOffset : LongInt;
: CheckType : LongInt;
: Width : LongInt;
: Height : LongInt;
: Planes : Word;
: Bits : Word;
: Compression : LongInt;
: ImageSize : LongInt;
: XPels : LongInt;
: YPels : LongInt;
: ColorUsed : LongInt;
: ColorImportant : LongInt;
: End;
:
: InfoBlock = record
: Valid : Boolean;
: Cmp : ShortInt;
: BMPHeader : BMPHeaderRec;
: END;
:
: ColorType = record
: Blue : Byte;
: Green : Byte;
: Red : Byte;
: Index : Integer;
: END;
:
: HiColorType = record
: Blue : Byte;
: Green : Byte;
: Red : Byte;
: END;
:
: VAR
: ScreenH : Integer;
: ScreenW : Integer;
: BPP : Byte;
:
: PROCEDURE Graphix(Mode : Word);
: PROCEDURE TextMode;
: PROCEDURE SetPal(Num : Byte;Red, Green, Blue : Byte);
: PROCEDURE GetPal(Num : Byte;VAR Red, Green, Blue : Byte);
: PROCEDURE GetPixel(X,Y : Integer;VAR Color : ColorType);
: PROCEDURE PutPixel(X,Y : Integer;Color, ClearColor : ColorType; Where : Word);
: FUNCTION GetBMPInfo(Name : String; VAR Info : InfoBlock) : Boolean;
: PROCEDURE ShowBMPInfo(Info : InfoBlock);
: PROCEDURE ShowBMP(StartX, StartY : Integer; Name : String; DoColors : Boolean; Clear : ColorType; Where : Word);
:
: IMPLEMENTATION
:
: CONST
: Header : array[1..2] Of Char = 'BM';
: PalCount = 255;
: BI_RGB = 0;
: BI_RLE8 = 1;
: BI_RLE4 = 2;
:
: VAR
: Colors : Array[0..255,1..4] Of Byte;
: C : Char;
: CA : Array[0..7] Of Boolean;
: CA2 : Array[1..3] Of Byte;
: CurrentMode : Word;
: CurrentBlock : Byte;
: Red, Blue, Green : Byte;
: Temp : Byte;
: Temp2 : Array[1..4] Of Byte;
: F : File;
: S2 : Array[1..2] Of Char;
: Junk : Array[0..10000] Of Char;
: X, X2, Y, Y2, Z : Integer;
:
: PROCEDURE Graphix(Mode : Word);
: Begin
: ASM
: Cmp Mode, $FF
: Jg @VESA
: Mov Ax, Mode
: INT 10h
: Mov ScreenW, 320
: Mov ScreenH, 200
: Mov BPP, 8
: @MT1:
: Cmp Mode, $11
: Jne @MT2
: Mov ScreenW, 640
: Mov ScreenH, 480
: Mov BPP, 1
: @MT2:
: Cmp Mode, $12
: Jne @MT3
: Mov ScreenW, 640
: Mov ScreenH, 480
: Mov BPP, 4
: @MT3:
: Cmp Mode, $13
: Jne @MT4
: Mov ScreenW, 320
: Mov ScreenH, 200
: Mov BPP, 8
: @MT4:
: Jmp @End
: @VESA:
: Mov Ax, $4F02
: Mov Bx, Mode
: INT 10h
: @VMT01:
: Cmp Mode, $101
: Jne @VMT0F
: Mov ScreenW, 640
: Mov ScreenH, 480
: Mov BPP, 8
: @VMT0F:
: Cmp Mode, $10F
: Jne @VMT10
: Mov ScreenW, 320
: Mov ScreenH, 200
: Mov BPP, 32
: @VMT10:
: Cmp Mode, $110
: Jne @VMT11
: Mov ScreenW, 640
: Mov ScreenH, 480
: Mov BPP, 16
: @VMT11:
: Cmp Mode, $111
: Jne @VMT12
: Mov ScreenW, 640
: Mov ScreenH, 480
: Mov BPP, 16
: @VMT12:
: Cmp Mode, $112
: Jne @VMT15
: Mov ScreenW, 640
: Mov ScreenH, 480
: Mov BPP, 32
: @VMT15:
: Cmp Mode, $115
: Jne @VMT5
: Mov ScreenW, 800
: Mov ScreenH, 600
: Mov BPP, 32
: @VMT5:
: @End:
: End;
: CurrentMode := Mode;
: End;
:
: PROCEDURE TextMode; assembler;
: ASM
: Mov Ax, $0003
: INT 10h
: End;
:
: PROCEDURE SetPal(Num : Byte;Red, Green, Blue : Byte);
: Begin
: Port[$3c8] := Num;
: Port[$3c9] := Red;
: Port[$3c9] := Green;
: Port[$3c9] := Blue;
: End;
:
: PROCEDURE GetPal(Num : Byte;VAR Red, Green, Blue : Byte);
: Begin
: Port[$3c7] := Num;
: Red := Port[$3c9];
: Green := Port[$3c9];
: Blue := Port[$3c9];
: End;
:
: PROCEDURE SetBlock(X,Y : Integer);
: Begin
: Temp := (((LONGINT(Y)*ScreenW*(BPP Shr 3)+X)) Shr 16);
: If CurrentBlock <> Temp Then
: Begin
: ASM
: Mov Ax, $4f05
: Xor Bh, Bh
: Mov Dl, Temp
: Int $10
: END;
: CurrentBlock := Temp;
: End;
: End;
:
: PROCEDURE GetPixel(X,Y : Integer;VAR Color : ColorType);
: Begin
: If (X < 0) or (Y < 0) or (X >= ScreenW) or (Y >= ScreenH) Then Exit;
: With Color Do
: Begin
: If BPP <= 8 Then
: Begin
: SetBlock(X*(BPP Shr 3),Y);
: Index := Mem[$A000:((X+Y*ScreenW)*(BPP Shr 3)) - Temp Shl 16]
: End
: ELSE
: Begin
: SetBlock(X*(BPP Shr 3),Y);
: Blue := Mem[$A000:((X+Y*ScreenW)*(BPP Shr 3)+0) - Temp Shl 16];
: SetBlock(X*(BPP Shr 3)+1,Y);
: Green := Mem[$A000:((X+Y*ScreenW)*(BPP Shr 3)+1) - Temp Shl 16];
: SetBlock(X*(BPP Shr 3)+2,Y);
: Red := Mem[$A000:((X+Y*ScreenW)*(BPP Shr 3)+2) - Temp Shl 16];
: Index := -1;
: End;
: End;
: End;
:
: PROCEDURE PutPixel(X,Y : Integer;Color, ClearColor : ColorType; Where : Word);
: VAR Z : Byte;
: Begin
: If (X < 0) or (Y < 0) or (X >= ScreenW) or (Y >= ScreenH) Then Exit;
: With Color Do
: Begin
: If BPP <= 8 Then
: Begin
: If Color.Index = ClearColor.Index Then Exit;
: Z := BPP Shr 3;
: SetBlock(X*Integer(Z),Y);
: Mem[Where:((X+Y*ScreenW)*Integer(Z)) - (CurrentBlock Shl 16)] := Index;
: End
: ELSE
: If (Color.Red = ClearColor.Red) AND
: (Color.Green = ClearColor.Green) AND
: (Color.Blue = ClearColor.Blue) Then Exit
: ELSE
: If Index = -1 Then
: Begin
: Case BPP Of
: 16 : Begin
: SetBlock(X*2,Y);
: Mem[Where:((X+Y*ScreenW)*2+0) - CurrentBlock Shl 16] :=
: (Blue Shr 3) AND 31 + ((Green Shr 3) Shl 7) AND 224;
: SetBlock(X*2+1,Y);
: Mem[Where:((X+Y*ScreenW)*2+1) - CurrentBlock Shl 16] :=
: (((Green Shr 3) Shr 2) AND 7) + (((RED Shr 3) Shl 3) AND 248);
: End;
: 24,
: 32 : Begin
: SetBlock(X*(BPP Shr 3)+0,Y);
: Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+0) - CurrentBlock Shl 16] := Blue;
: SetBlock(X*(BPP Shr 3)+1,Y);
: Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+1) - CurrentBlock Shl 16] := Green;
: SetBlock(X*(BPP Shr 3)+2,Y);
: Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+2) - CurrentBlock Shl 16] := Red;
: End;
: End;
: End
: ELSE
: Begin
: Color.Blue := Colors[Index,1];
: Color.Green := Colors[Index,2];
: Color.Red := Colors[Index,3];
: SetBlock(X*(BPP Shr 3),Y);
: Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+0) - CurrentBlock Shl 16] := Blue;
: SetBlock(X*(BPP Shr 3)+1,Y);
: Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+1) - CurrentBlock Shl 16] := Green;
: SetBlock(X*(BPP Shr 3)+2,Y);
: Mem[Where:((X+Y*ScreenW)*(BPP Shr 3)+2) - CurrentBlock Shl 16] := Red;
: End;
: End;
: End;
:
: FUNCTION GetBMPInfo(Name : String; VAR Info : InfoBlock) : Boolean;
: VAR Final : Boolean;
: Begin
: {$I-}
: Assign(F, Name);Reset(F,1);
: If IOResult <> 0 Then
: Begin
: GetBMPInfo := False;
: Exit;
: End;
: {$I+}
: BlockRead(F, Info.BMPHeader, SizeOf(Info.BMPHeader));
:
: Info.Valid := Info.BMPHeader.Identifier = Header;
: Final := Info.Valid;
:
: Info.Cmp := Info.BMPHeader.Compression;
: If Info.Cmp In[0] Then Final := True;
:
: Close(F);
: End;
:
: PROCEDURE ShowBMPInfo(Info : InfoBlock);
: Begin
: With Info.BMPHeader Do
: Begin
: GotoXY(21, 1);WriteLn('Size = ',Size);
: GotoXY(21, 2);WriteLn('BitMapOffset= ',BitMapOffset);
: GotoXY(21, 3);WriteLn('Type = ',CheckType);
: GotoXY(21, 4);WriteLn('Width = ',Width);
: GotoXY(21, 5);WriteLn('Height = ',Height);
: GotoXY(21, 6);WriteLn('Bits = ',ORD(Bits));
: GotoXY(21, 7);WriteLn('Planes = ',ORD(Planes));
: GotoXY(21, 8);WriteLn('FileSize = ',ImageSize);
: GotoXY(21, 9);WriteLn('RealSize = ',Width*Height);
: GotoXY(21,10);WriteLn('XPelsPerMet = ',XPels);
: GotoXY(21,11);WriteLn('YPelsPerMet = ',YPels);
: GotoXY(21,12);WriteLn('Color Used = ',ColorUsed);
: GotoXY(21,13);WriteLn('Color Imp. = ',ColorImportant);
: End;
: End;
:
: PROCEDURE ShowBMP(StartX, StartY : Integer; Name : String; DoColors : Boolean; Clear : ColorType; Where : Word);
: VAR
: Info : InfoBlock;
: Color : ColorType;
: Begin
: If GetBMPInfo(Name,Info) = False Then Exit;
: Assign(F, Name);Reset(F,1);
: BlockRead(F, Info.BMPHeader, SizeOf(Info.BMPHeader));
:
: Reset(F,1);
: BlockRead(F, Junk, 14);
: BlockRead(F, Junk, Info.BMPHEader.CheckType);
:
: With Info.BMPHeader Do
: If Bits = 1 Then
: Begin
: For X := 0 to 1 Do
: Begin
: BlockRead(F, Colors[X], 4);
: SetPal(X*63, Colors[X,3]*63 DIV 255, Colors[X,2]*63 DIV 255, Colors[X,1]*63 DIV 255);
: End;
: Reset(F,1);
: BlockRead(F, Junk, BitMapOffset);
: Z := Width SHR 3;
: While Z MOD(4) <> 0 Do Inc(Z);
: For Y := 0 to Height-1 Do
: Begin
: BlockRead(F, Junk, Z);
: For X := 0 to Z-1 Do
: Mem[Where:StartX+X+(StartY+Height-Y)*80] := ORD(Junk[X]);
: End;
: End;
:
: With Info.BMPHeader Do
: If Bits = 4 Then
: Begin
: For X := 0 to 15 Do
: Begin
: BlockRead(F, Colors[X], 4);
: SetPal(X, Colors[X,3]*63 DIV 255, Colors[X,2]*63 DIV 255, Colors[X,1]*63 DIV 255);
: End;
: Reset(F,1);
: BlockRead(F, Junk, BitMapOffset);
: Z := Width SHR 1;
: While Z MOD(4) <> 0 Do Inc(Z);
: For Y := 0 to Height-1 Do
: Begin
: BlockRead(F, Junk, Z);
: For X := 0 to (Width SHR 1)-1 Do
: Begin
: Mem[Where:StartX+X*2+0+(StartY+Height-Y)*ScreenW] := ORD(Junk[X]) SHR 4;
: Mem[Where:StartX+X*2+1+(StartY+Height-Y)*ScreenW] := ORD(Junk[X]) AND 15;
: End;
: End;
: End;
:
: With Info.BMPHeader Do
: If (Bits = 8) Then
: Begin
: BlockRead(F, Colors[0], PalCount*4);
: For X := 0 to PalCount Do
: Begin
: If DoColors Then SetPal(X, Colors[X,3]*63 DIV 255, Colors[X,2]*63 DIV 255, Colors[X,1]*63 DIV 255);
: End;
: Reset(F,1);
: BlockRead(F, Junk, BitMapOffset);
: Z := (Width*Bits) SHR 3;
: While Z MOD(4) <> 0 Do Inc(Z);
: For Y := Height-1 downto 0 Do
: Begin
: BlockRead(F, Junk, Width);
: For X := 0 to Width-1 do
: Begin
: Color.Index := ORD(Junk[X]);
: PutPixel(StartX+X,StartY+Y,Color,Clear,Where);
: { Mem[Where:StartX+(StartY+Height-Y)*ScreenW+(X)] := ORD(C);}
: End;
: For X := 1 to Z-Width Do BlockRead(F, C, 1);
: If KeyPressed Then
: Begin
: While KeyPressed Do ReadKey;
: Break;
: End;
: End;
: End;
:
: With Info.BMPHeader Do
: If (Bits = 24) or (Bits = 32) Then
: Begin
: If CurrentMode <= $109 Then
: For X := 0 to PalCount Do
: SetPal(X, X*63 DIV 255, X*63 DIV 255, X*63 DIV 255);
: Reset(F,1);
: BlockRead(F, Junk, BitMapOffset);
: Z := (Width*Bits) SHR 3;
: While Z MOD(4) <> 0 Do Inc(Z);
: Color.Index := -1; Bits := (Bits shr 3);
: For Y := Height-1 downto 0 Do
: Begin
: BlockRead(F, Junk, Z);
: For X := 0 to Width-1 do
: Begin
: If BPP <= 8 Then
: Color.Index := Ord(Junk[X*(BPP shr 3)])
: ELSE
: Begin
: Color.Blue := Ord(Junk[X*Bits+0]);
: Color.Green := Ord(Junk[X*Bits+1]);
: Color.Red := Ord(Junk[X*Bits+2]);
: End;
: PutPixel(StartX+X,StartY+Y,Color,Clear,Where);
: End;
: If KeyPressed Then Begin While KeyPressed Do ReadKey; Break; End;
: End;
: End;
: Close(F);
: End;
:
: End.
Is this unit compatible with Turbo Pascal 6? I used to use TP 5.5, but it's becoming limiting, so I'm stepping up to TP 6. Also, since I'm using a mouse unit, will the mouse cursor show up in all modes with this unit?
