⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dibtools.pas

📁 (Delphi) Universal dib codes. Usign DIB palettes, dib bitmaps and more
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit DIBTools;
{TUniDIB - advanced functions}

{by Vit Kovalcik}

interface
uses  UniDIB,Classes,Windows,SysUtils;

{$R-}

const UDIBNoError=0;
      UDIBUndefError=1;
      UDIBFileOpenError=2;
      UDIBReadError=3;
      UDIBWriteError=4;
      UDIBBadFile=5;

const Std2ColPalette:Array [0..1] of TPaletteEntry=
   ((peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$ff;peGreen:$ff;peBlue:$ff));

const Std16ColPalette:Array [0..15] of TPaletteEntry=
   ((peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$aa),
    (peRed:$00;peGreen:$aa;peBlue:$00),
    (peRed:$00;peGreen:$aa;peBlue:$aa),
    (peRed:$aa;peGreen:$00;peBlue:$00),
    (peRed:$aa;peGreen:$00;peBlue:$aa),
    (peRed:$aa;peGreen:$55;peBlue:$00),
    (peRed:$aa;peGreen:$aa;peBlue:$aa),
    (peRed:$55;peGreen:$55;peBlue:$55),
    (peRed:$55;peGreen:$55;peBlue:$ff),
    (peRed:$55;peGreen:$ff;peBlue:$55),
    (peRed:$55;peGreen:$ff;peBlue:$ff),
    (peRed:$ff;peGreen:$55;peBlue:$55),
    (peRed:$ff;peGreen:$55;peBlue:$ff),
    (peRed:$ff;peGreen:$ff;peBlue:$55),
    (peRed:$ff;peGreen:$ff;peBlue:$ff));

const Std256ColPalette:Array [0..255] of TPaletteEntry=
   ({EGA Palette}
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$aa),
    (peRed:$00;peGreen:$aa;peBlue:$00),
    (peRed:$00;peGreen:$aa;peBlue:$aa),
    (peRed:$aa;peGreen:$00;peBlue:$00),
    (peRed:$aa;peGreen:$00;peBlue:$aa),
    (peRed:$aa;peGreen:$55;peBlue:$00),
    (peRed:$aa;peGreen:$aa;peBlue:$aa),
    (peRed:$55;peGreen:$55;peBlue:$55),
    (peRed:$55;peGreen:$55;peBlue:$ff),
    (peRed:$55;peGreen:$ff;peBlue:$55),
    (peRed:$55;peGreen:$ff;peBlue:$ff),
    (peRed:$ff;peGreen:$55;peBlue:$55),
    (peRed:$ff;peGreen:$55;peBlue:$ff),
    (peRed:$ff;peGreen:$ff;peBlue:$55),
    (peRed:$ff;peGreen:$ff;peBlue:$ff),
    {Grey palette}
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$14;peGreen:$14;peBlue:$14),
    (peRed:$20;peGreen:$20;peBlue:$20),
    (peRed:$2c;peGreen:$2c;peBlue:$2c),
    (peRed:$38;peGreen:$38;peBlue:$38),
    (peRed:$45;peGreen:$45;peBlue:$45),
    (peRed:$51;peGreen:$51;peBlue:$51),
    (peRed:$61;peGreen:$61;peBlue:$61),
    (peRed:$71;peGreen:$71;peBlue:$71),
    (peRed:$82;peGreen:$82;peBlue:$82),
    (peRed:$92;peGreen:$92;peBlue:$92),
    (peRed:$a2;peGreen:$a2;peBlue:$a2),
    (peRed:$b6;peGreen:$b6;peBlue:$b6),
    (peRed:$cb;peGreen:$cb;peBlue:$cb),
    (peRed:$e3;peGreen:$b3;peBlue:$b3),
    (peRed:$ff;peGreen:$ff;peBlue:$ff),
    {rest of palette}
    (peRed:$00;peGreen:$00;peBlue:$ff),
    (peRed:$41;peGreen:$00;peBlue:$ff),
    (peRed:$7d;peGreen:$00;peBlue:$ff),
    (peRed:$be;peGreen:$00;peBlue:$ff),
    (peRed:$ff;peGreen:$00;peBlue:$ff),
    (peRed:$ff;peGreen:$00;peBlue:$be),
    (peRed:$ff;peGreen:$00;peBlue:$7d),
    (peRed:$ff;peGreen:$00;peBlue:$41),
    (peRed:$ff;peGreen:$00;peBlue:$00),
    (peRed:$ff;peGreen:$41;peBlue:$00),
    (peRed:$ff;peGreen:$7d;peBlue:$00),
    (peRed:$ff;peGreen:$be;peBlue:$00),
    (peRed:$ff;peGreen:$ff;peBlue:$00),
    (peRed:$be;peGreen:$ff;peBlue:$00),
    (peRed:$7d;peGreen:$ff;peBlue:$00),
    (peRed:$41;peGreen:$ff;peBlue:$00), {16}
    (peRed:$00;peGreen:$ff;peBlue:$00),
    (peRed:$00;peGreen:$ff;peBlue:$41),
    (peRed:$00;peGreen:$ff;peBlue:$7d),
    (peRed:$00;peGreen:$ff;peBlue:$be),
    (peRed:$00;peGreen:$ff;peBlue:$ff),
    (peRed:$00;peGreen:$be;peBlue:$ff),
    (peRed:$00;peGreen:$7d;peBlue:$ff),
    (peRed:$00;peGreen:$41;peBlue:$ff),
    (peRed:$7d;peGreen:$7d;peBlue:$ff),
    (peRed:$9e;peGreen:$7d;peBlue:$ff),
    (peRed:$be;peGreen:$7d;peBlue:$ff),
    (peRed:$df;peGreen:$7d;peBlue:$ff),
    (peRed:$ff;peGreen:$7d;peBlue:$ff),
    (peRed:$ff;peGreen:$7d;peBlue:$df),
    (peRed:$ff;peGreen:$7d;peBlue:$be),
    (peRed:$ff;peGreen:$7d;peBlue:$9e), {32}
    (peRed:$ff;peGreen:$7d;peBlue:$7d),
    (peRed:$ff;peGreen:$9e;peBlue:$7d),
    (peRed:$ff;peGreen:$be;peBlue:$7d),
    (peRed:$ff;peGreen:$df;peBlue:$7d),
    (peRed:$ff;peGreen:$ff;peBlue:$7d),
    (peRed:$df;peGreen:$ff;peBlue:$7d),
    (peRed:$be;peGreen:$ff;peBlue:$7d),
    (peRed:$9e;peGreen:$ff;peBlue:$7d),
    (peRed:$7d;peGreen:$ff;peBlue:$7d),
    (peRed:$7d;peGreen:$ff;peBlue:$9e),
    (peRed:$7d;peGreen:$ff;peBlue:$be),
    (peRed:$7d;peGreen:$ff;peBlue:$df),
    (peRed:$7d;peGreen:$ff;peBlue:$ff),
    (peRed:$7d;peGreen:$df;peBlue:$ff),
    (peRed:$7d;peGreen:$be;peBlue:$ff),
    (peRed:$7d;peGreen:$9e;peBlue:$ff), {48}
    (peRed:$b6;peGreen:$b6;peBlue:$ff),
    (peRed:$c7;peGreen:$b6;peBlue:$ff),
    (peRed:$db;peGreen:$b6;peBlue:$ff),
    (peRed:$eb;peGreen:$b6;peBlue:$ff),
    (peRed:$ff;peGreen:$b6;peBlue:$ff),
    (peRed:$df;peGreen:$b6;peBlue:$eb),
    (peRed:$ff;peGreen:$b6;peBlue:$db),
    (peRed:$ff;peGreen:$b6;peBlue:$c7),
    (peRed:$ff;peGreen:$b6;peBlue:$b6),
    (peRed:$ff;peGreen:$c7;peBlue:$b6),
    (peRed:$ff;peGreen:$db;peBlue:$b6),
    (peRed:$ff;peGreen:$eb;peBlue:$b6),
    (peRed:$ff;peGreen:$ff;peBlue:$b6),
    (peRed:$eb;peGreen:$ff;peBlue:$b6),
    (peRed:$db;peGreen:$ff;peBlue:$b6),
    (peRed:$c7;peGreen:$ff;peBlue:$b6), {64}
    (peRed:$b6;peGreen:$df;peBlue:$b6),
    (peRed:$b6;peGreen:$ff;peBlue:$c7),
    (peRed:$b6;peGreen:$ff;peBlue:$db),
    (peRed:$b6;peGreen:$ff;peBlue:$eb),
    (peRed:$b6;peGreen:$ff;peBlue:$ff),
    (peRed:$b6;peGreen:$eb;peBlue:$ff),
    (peRed:$b6;peGreen:$db;peBlue:$ff),
    (peRed:$b6;peGreen:$c7;peBlue:$ff),
    (peRed:$00;peGreen:$00;peBlue:$71),
    (peRed:$1c;peGreen:$00;peBlue:$71),
    (peRed:$38;peGreen:$00;peBlue:$71),
    (peRed:$55;peGreen:$00;peBlue:$71),
    (peRed:$71;peGreen:$00;peBlue:$71),
    (peRed:$71;peGreen:$00;peBlue:$55),
    (peRed:$71;peGreen:$00;peBlue:$38),
    (peRed:$71;peGreen:$00;peBlue:$1c), {80}
    (peRed:$71;peGreen:$00;peBlue:$00),
    (peRed:$71;peGreen:$1c;peBlue:$00),
    (peRed:$71;peGreen:$38;peBlue:$00),
    (peRed:$71;peGreen:$55;peBlue:$00),
    (peRed:$71;peGreen:$71;peBlue:$00),
    (peRed:$55;peGreen:$71;peBlue:$00),
    (peRed:$38;peGreen:$71;peBlue:$00),
    (peRed:$1c;peGreen:$71;peBlue:$00),
    (peRed:$00;peGreen:$71;peBlue:$00),
    (peRed:$00;peGreen:$71;peBlue:$1c),
    (peRed:$00;peGreen:$71;peBlue:$38),
    (peRed:$00;peGreen:$71;peBlue:$55),
    (peRed:$00;peGreen:$71;peBlue:$71),
    (peRed:$00;peGreen:$55;peBlue:$71),
    (peRed:$00;peGreen:$38;peBlue:$71),
    (peRed:$00;peGreen:$1c;peBlue:$71), {96}
    (peRed:$38;peGreen:$38;peBlue:$71),
    (peRed:$45;peGreen:$38;peBlue:$71),
    (peRed:$55;peGreen:$38;peBlue:$71),
    (peRed:$61;peGreen:$38;peBlue:$71),
    (peRed:$71;peGreen:$38;peBlue:$71),
    (peRed:$71;peGreen:$38;peBlue:$61),
    (peRed:$71;peGreen:$38;peBlue:$55),
    (peRed:$71;peGreen:$38;peBlue:$45),
    (peRed:$71;peGreen:$38;peBlue:$38),
    (peRed:$71;peGreen:$45;peBlue:$38),
    (peRed:$71;peGreen:$55;peBlue:$38),
    (peRed:$71;peGreen:$61;peBlue:$38),
    (peRed:$71;peGreen:$71;peBlue:$38),
    (peRed:$61;peGreen:$71;peBlue:$38),
    (peRed:$55;peGreen:$71;peBlue:$38),
    (peRed:$45;peGreen:$71;peBlue:$38), {112}
    (peRed:$38;peGreen:$71;peBlue:$38),
    (peRed:$38;peGreen:$71;peBlue:$45),
    (peRed:$38;peGreen:$71;peBlue:$55),
    (peRed:$38;peGreen:$71;peBlue:$61),
    (peRed:$38;peGreen:$71;peBlue:$71),
    (peRed:$38;peGreen:$61;peBlue:$71),
    (peRed:$38;peGreen:$55;peBlue:$71),
    (peRed:$38;peGreen:$45;peBlue:$71),
    (peRed:$51;peGreen:$51;peBlue:$71),
    (peRed:$59;peGreen:$51;peBlue:$71),
    (peRed:$61;peGreen:$51;peBlue:$71),
    (peRed:$69;peGreen:$51;peBlue:$71),
    (peRed:$71;peGreen:$51;peBlue:$71),
    (peRed:$71;peGreen:$51;peBlue:$69),
    (peRed:$71;peGreen:$51;peBlue:$61),
    (peRed:$71;peGreen:$51;peBlue:$59), {128}
    (peRed:$71;peGreen:$51;peBlue:$51),
    (peRed:$71;peGreen:$59;peBlue:$51),
    (peRed:$71;peGreen:$61;peBlue:$51),
    (peRed:$71;peGreen:$69;peBlue:$51),
    (peRed:$71;peGreen:$71;peBlue:$51),
    (peRed:$69;peGreen:$71;peBlue:$51),
    (peRed:$61;peGreen:$71;peBlue:$51),
    (peRed:$59;peGreen:$71;peBlue:$51),
    (peRed:$51;peGreen:$71;peBlue:$51),
    (peRed:$51;peGreen:$71;peBlue:$59),
    (peRed:$51;peGreen:$71;peBlue:$61),
    (peRed:$51;peGreen:$71;peBlue:$69),
    (peRed:$51;peGreen:$71;peBlue:$71),
    (peRed:$51;peGreen:$69;peBlue:$71),
    (peRed:$51;peGreen:$61;peBlue:$71),
    (peRed:$51;peGreen:$59;peBlue:$71), {144}
    (peRed:$00;peGreen:$00;peBlue:$41),
    (peRed:$10;peGreen:$00;peBlue:$41),
    (peRed:$20;peGreen:$00;peBlue:$41),
    (peRed:$30;peGreen:$00;peBlue:$41),
    (peRed:$41;peGreen:$00;peBlue:$41),
    (peRed:$41;peGreen:$00;peBlue:$30),
    (peRed:$41;peGreen:$00;peBlue:$20),
    (peRed:$41;peGreen:$00;peBlue:$10),
    (peRed:$41;peGreen:$00;peBlue:$00),
    (peRed:$41;peGreen:$10;peBlue:$00),
    (peRed:$41;peGreen:$20;peBlue:$00),
    (peRed:$41;peGreen:$30;peBlue:$00),
    (peRed:$41;peGreen:$41;peBlue:$00),
    (peRed:$30;peGreen:$41;peBlue:$00),
    (peRed:$20;peGreen:$41;peBlue:$00),
    (peRed:$10;peGreen:$41;peBlue:$00), {160}
    (peRed:$00;peGreen:$41;peBlue:$00),
    (peRed:$00;peGreen:$41;peBlue:$10),
    (peRed:$00;peGreen:$41;peBlue:$20),
    (peRed:$00;peGreen:$41;peBlue:$30),
    (peRed:$00;peGreen:$41;peBlue:$41),
    (peRed:$00;peGreen:$30;peBlue:$41),
    (peRed:$00;peGreen:$20;peBlue:$41),
    (peRed:$00;peGreen:$10;peBlue:$41),
    (peRed:$20;peGreen:$20;peBlue:$41),
    (peRed:$28;peGreen:$20;peBlue:$41),
    (peRed:$30;peGreen:$20;peBlue:$41),
    (peRed:$38;peGreen:$20;peBlue:$41),
    (peRed:$41;peGreen:$20;peBlue:$41),
    (peRed:$41;peGreen:$20;peBlue:$38),
    (peRed:$41;peGreen:$20;peBlue:$30),
    (peRed:$41;peGreen:$20;peBlue:$28), {176}
    (peRed:$41;peGreen:$20;peBlue:$20),
    (peRed:$41;peGreen:$28;peBlue:$20),
    (peRed:$41;peGreen:$30;peBlue:$20),
    (peRed:$41;peGreen:$38;peBlue:$20),
    (peRed:$41;peGreen:$41;peBlue:$20),
    (peRed:$38;peGreen:$41;peBlue:$20),
    (peRed:$30;peGreen:$41;peBlue:$20),
    (peRed:$28;peGreen:$41;peBlue:$20),
    (peRed:$20;peGreen:$41;peBlue:$20),
    (peRed:$20;peGreen:$41;peBlue:$28),
    (peRed:$20;peGreen:$41;peBlue:$30),
    (peRed:$20;peGreen:$41;peBlue:$38),
    (peRed:$20;peGreen:$41;peBlue:$41),
    (peRed:$20;peGreen:$38;peBlue:$41),
    (peRed:$20;peGreen:$30;peBlue:$41),
    (peRed:$20;peGreen:$28;peBlue:$41),
    (peRed:$2c;peGreen:$2c;peBlue:$41),
    (peRed:$30;peGreen:$2c;peBlue:$41), {192}
    (peRed:$34;peGreen:$2c;peBlue:$41),
    (peRed:$3c;peGreen:$2c;peBlue:$41),
    (peRed:$41;peGreen:$2c;peBlue:$41),
    (peRed:$41;peGreen:$2c;peBlue:$3c),
    (peRed:$41;peGreen:$2c;peBlue:$34),
    (peRed:$41;peGreen:$2c;peBlue:$30),
    (peRed:$41;peGreen:$2c;peBlue:$2c),
    (peRed:$41;peGreen:$30;peBlue:$2c),
    (peRed:$41;peGreen:$34;peBlue:$2c),
    (peRed:$41;peGreen:$3c;peBlue:$2c),
    (peRed:$41;peGreen:$41;peBlue:$2c),
    (peRed:$3c;peGreen:$41;peBlue:$2c),
    (peRed:$34;peGreen:$41;peBlue:$2c),
    (peRed:$30;peGreen:$41;peBlue:$2c),
    (peRed:$2c;peGreen:$41;peBlue:$2c),
    (peRed:$2c;peGreen:$41;peBlue:$30), {208}
    (peRed:$2c;peGreen:$41;peBlue:$34),
    (peRed:$2c;peGreen:$41;peBlue:$3c),
    (peRed:$2c;peGreen:$41;peBlue:$41),
    (peRed:$2c;peGreen:$3c;peBlue:$41),
    (peRed:$2c;peGreen:$34;peBlue:$41),
    (peRed:$2c;peGreen:$30;peBlue:$41),
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$00),
    (peRed:$00;peGreen:$00;peBlue:$00)  {224}
    );

function UDIBLoadPCX (AName:String;var ADIB:TUniDIB):Integer;
function UDIBLoadBMP (AName:String;var ADIB:TUniDIB):Integer;

var UpsideDownDIB:Boolean;
  {You can set this to True if you want to load file and
   have bitmap with point [0,0] in upper left corner}

implementation

{-------------}
{TBufferedFile}
{-------------}

const MinBufferSize=65536;
      VeryMuch=1000000000;

type TBuffer=Array [0..VeryMuch-1] of Byte;
     PBuffer=^TBuffer;
     TOpenMode=(omRead,omWrite);

type TBufferedFile=class
     protected
       FPos:Integer;
       FOpenMode:TOpenMode;
       FBufSize:Integer;
       FMaxPos:Integer;
       procedure SetBufSize (Value:Integer);
       function GetFilePos:Integer;
     public
       Str:TFileStream;
       Buffer:PBuffer;
       property Pos:Integer read FPos write FPos; {position of next read byte}
       property BufSize:Integer read FBufSize write SetBufSize;
       property FilePos:Integer read GetFilePos;
       property MaxPos:Integer read FMaxPos;
       procedure PreReadBytes (ACount:Integer);
         {This function makes sure that next <ACount> bytes are in buffer}
         {Count must be lower than or equal to BufSize !!!}
       procedure ReadFromPos (APos:Integer);
       function ReadByte:byte;
       constructor Create (AFileName:String;AOpenMode:TOpenMode);
       destructor Destroy; override;
     end;

procedure TBufferedFile.SetBufSize (Value:Integer);
var A:Integer;
begin
  If Value<MinBufferSize then
    A:=MinBufferSize
  else
    A:=Value;
  If (A>0) AND (FBufSize>0) AND
     ((FMaxPos=-1) OR (FMaxPos-FPos+1<=A)) then
  begin
    If (FPos>0) then
    begin
      Move (Buffer[FPos],Buffer[0],FMaxPos-FPos+1);
      Dec (FMaxPos,FPos);
      FPos:=0;
    end;
    ReallocMem (Buffer,A);
    FBufSize:=A;
  end;
end;

constructor TBufferedFile.Create (AFileName:String;AOpenMode:TOpenMode);
begin
  Buffer:=nil;
  try
    If AOpenMode=omRead then
      Str:=TFileStream.Create (AFileName,fmOpenRead)
    else
      Str:=TFileStream.Create (AFileName,fmOpenWrite);
    GetMem (Buffer,MinBufferSize);
    FBufSize:=MinBufferSize;
    FMaxPos:=-1;
    FPos:=0;
  except
    Str.Free;
    Str:=nil;
    ReallocMem (Buffer,0);
    FBufSize:=0;
    raise;
  end;
end;

procedure TBufferedFile.PreReadBytes (ACount:Integer);
begin
  If (ACount>0) AND (FMaxPos-FPos+1<ACount) AND
{     (BufSize-FMaxPos+FPos>ACount) AND} (BufSize>=ACount) AND
     (Str.Position<Str.Size) then
  begin
    If FPos>FMaxPos then
    begin
      FPos:=0;
      FMaxPos:=-1;
    end;
    If FPos>0 then
    begin
      Move (Buffer[FPos],Buffer[0],FMaxPos-FPos+1);
      Dec (FMaxPos,FPos);
    end;
    If FMaxPos>=0 then
      Inc (FMaxPos,Str.Read (Buffer[FMaxPos+1],BufSize-FMaxPos-1))
    else
      FMaxPos:=Str.Read (Buffer^,BufSize)-1;
    FPos:=0;
  end;
end;

destructor TBufferedFile.Destroy;
begin
  ReallocMem (Buffer,0);
  Str.Free;
  inherited Destroy;
end;

procedure TBufferedFile.ReadFromPos (APos:Integer);
begin
  FMaxPos:=-1;
  FPos:=0;
  If APos>0 then
    Str.Seek (APos,soFromBeginning)
  else
    Str.Seek (APos,soFromEnd);
  PreReadBytes (1);
end;

function TBufferedFile.ReadByte:byte;
begin
  If FPos>FMaxPos then
    PreReadBytes (FBufSize);
  Result:=Buffer[FPos];
  Inc (FPos);
end;

function TBufferedFile.GetFilePos:Integer;
begin
  Result:=Str.Position-FMaxPos+FPos-1;
end;

{------------}
{UniDIB Tools}
{------------}

function UDIBLoadPCX (AName:String;var ADIB:TUniDIB):Integer;
var Width,Height:Integer;
    Ver,Planes,Bits:Byte;
    BPP:Integer;
    BytesPerLine:Word;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -