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

📄 depng.pas

📁 类似文明的游戏源代码。
💻 PAS
📖 第 1 页 / 共 3 页
字号:
   current_text_size: Integer;     // current size of text input data
   current_text_left: Integer;     // how much text left to read in input
   current_text: PByte;           // current text chunk buffer
   current_text_ptr: PByte;       // current location in current_text
   palette_lookup: PByte;         // lookup table for dithering
   dither_index: PByte;           // index translation for palette files
   hist: PWord;                // histogram
   heuristic_method: Byte;        // heuristic for row filter selection
   num_prev_filters: Byte;        // number of weights for previous rows
   prev_filters: PByte;           // filter type(s) of previous row(s)
   filter_weights: PWord;      // weight(s) for previous line(s)
   inv_filter_weights: PWord;  // 1/weight(s) for previous line(s)
   filter_costs: PWord;        // relative filter calculation cost
   inv_filter_costs: PWord;    // 1/relative filter calculation cost
   time_buffer: PByte;            // String to hold RFC 1123 time text
end;
type PPng_Struct = ^TPng_Struct;
type PPPng_Struct = ^PPng_Struct;

type
png_set_fnc = procedure (png_ptr: PPng_Struct); cdecl;

png_close_file_fnc = function (filep: Pointer): Integer; cdecl;

png_open_file_fnc = function (fname, mode: PChar): Pointer; cdecl;

png_create_info_struct_fnc = function (png_ptr: PPng_Struct): PPng_Info; cdecl;

png_init_io_fnc = procedure (png_ptr: PPng_Struct; fp: Pointer); cdecl;

png_read_image_fnc = procedure (png_ptr: PPng_Struct; image: PPByte); cdecl;

png_read_info_fnc = procedure (png_ptr: PPng_Struct; info_ptr: PPng_Info);
  cdecl;

png_set_read_status_fn_fnc = procedure (png_ptr: PPng_Struct; read_row_fn:
  Pointer); cdecl;

png_get_rowbytes_fnc = function (png_ptr: PPng_Struct; info_ptr: PPng_Info):
  Cardinal; cdecl;

png_get_valid_fnc = function (png_ptr: PPng_Struct; info_ptr: PPng_Info; flag:
  Cardinal): Cardinal; cdecl;

png_destroy_read_struct_fnc = procedure (png_ptr_ptr: PPPng_Struct;
  info_ptr_ptr, end_info_ptr_ptr: PPPng_Info); cdecl;

png_create_read_struct_fnc = function (user_png_ver: PChar; error_ptr,
  error_fn, warn_fn: Pointer): PPng_Struct; cdecl;

png_get_IHDR_fnc = function (png_ptr: PPng_Struct; info_ptr: PPng_Info; width,
  height: PCardinal; bit_depth, color_type, interlace_type, compression_type,
  filter_type: PInteger): Cardinal; cdecl;

var
png_set_expand, png_set_invert_alpha, png_set_swap, png_set_packing:
  png_set_fnc;
png_close_file: png_close_file_fnc;
png_open_file: png_open_file_fnc;
png_create_info_struct: png_create_info_struct_fnc;
png_init_io: png_init_io_fnc;
png_read_image: png_read_image_fnc;
png_read_info, png_read_update_info: png_read_info_fnc;
png_set_read_status_fn: png_set_read_status_fn_fnc;
png_get_rowbytes: png_get_rowbytes_fnc;
png_get_valid: png_get_valid_fnc;
png_destroy_read_struct: png_destroy_read_struct_fnc;
png_create_read_struct: png_create_read_struct_fnc;
png_get_IHDR: png_get_IHDR_fnc;

HLib: integer;

function LoadBitMapFromPNG;
var
FBitDepth:      Integer;
FBytesPerPixel: Integer;
FColorType:     Integer;
FHeight:        Integer;
FWidth:         Integer;
Data:           PByte;
RowPtrs:        PByte;

  procedure Load;
  var
    cvaluep:  PCardinal;
    y:        Integer;
    png:      PPng_Struct;
    pnginfo:  PPng_Info;
    rowbytes: Cardinal;
    PngFile:  Pointer;
    tmp:      array[0..32] of char;
  begin
    pngfile := png_open_file(@Filename[1], 'rb');
    if pngfile = nil then
      raise Exception.Create('Error Opening File ' + Filename + '!');

    try
      StrPCopy(tmp, PNG_LIBPNG_VER_STRING);
      try
        png := png_create_read_struct(tmp, nil, nil, nil);
        if png <> nil then
        begin
          try
            pnginfo := png_create_info_struct(png);
            png_init_io(png, pngfile);
            png_set_read_status_fn(png, nil);
            png_read_info(png, pnginfo);
            png_get_IHDR(png, pnginfo, @FWidth, @FHeight,
                         @FBitDepth, @FColorType, nil, nil, nil);
            png_set_invert_alpha(png);
            // if bit depth is less than 8 then expand...
            if (FColorType = PNG_COLOR_TYPE_PALETTE) and
               (FBitDepth <= 8) then
              png_set_expand(png);
            if (FColorType = PNG_COLOR_TYPE_GRAY) and
               (FBitDepth < 8) then
              png_set_expand(png);
            // Add alpha channel if pressent
            if png_get_valid(png, pnginfo, PNG_INFO_tRNS) = PNG_INFO_tRNS then
              png_set_expand(png);
            // expand images to 1 pixel per byte
            if FBitDepth < 8 then
              png_set_packing(png);
            // Swap 16 bit images to PC Format
            if FBitDepth = 16 then
              png_set_swap(png);
            // update the info structure
            png_read_update_info(png, pnginfo);
            png_get_IHDR(png, pnginfo, @FWidth, @FHeight,
                         @FBitDepth, @FColorType, nil, nil, nil);

            rowbytes := png_get_rowbytes(png, pnginfo);
            FBytesPerPixel := integer(rowbytes) div FWidth;

            // Initialize Data and RowPtrs
            GetMem(Data, FHeight * FWidth * FBytesPerPixel);
            GetMem(RowPtrs, sizeof(Pointer) * FHeight);
            if (Data <> nil) and (RowPtrs <> nil) then
            begin
              cvaluep := Pointer(RowPtrs);
              for y := 0 to FHeight - 1 do
              begin
                cvaluep^ := Cardinal(Data) + Cardinal(FWidth * FBytesPerPixel * y);
                Inc(cvaluep);
              end;
              // Read the image
              png_read_image(png, PPByte(RowPtrs));
            end;

          finally
            png_destroy_read_struct(@png, @pnginfo, nil);
          end;  // try pnginfo create
        end;  // png <> nil
      except
        raise Exception.Create('Error Reading File!');
      end;  // try png create

    finally
      png_close_file(pngfile);
    end;
  end;  // Load

  procedure Draw;
  var
    valuep:  PByte;
    x, y:    Integer;
    ndx:     Integer;
    sl:      PByteArray;  // Scanline of bitmap
    slbpp:   Integer;     // Scanline bytes per pixel
  begin
    self.Height := FHeight;
    self.Width  := FWidth;
    case FBytesPerPixel of
      2: begin
        self.PixelFormat := pf16Bit;
        slbpp := 2;
      end;
      else begin
        self.PixelFormat := pf24Bit;
        slbpp := 3;
      end;
    end;

    // point to data
    valuep := Data;
    for y := 0 to FHeight - 1 do
    begin
      sl := self.Scanline[y];  // current scanline
      for x := 0 to FWidth - 1 do
      begin
        ndx := x * slbpp;    // index into current scanline
        if FBytesPerPixel = 2 then
        begin
          // handle 16bit grayscale images, this will display them
          // as a 16bit color image, kinda hokie but fits my needs
          // without altering the data.
          sl[ndx]     := valuep^;  Inc(valuep);
          sl[ndx + 1] := valuep^;  Inc(valuep);
        end
        else
        begin
          // RGB - swap blue and red for windows format
          sl[ndx + 2] := valuep^;  Inc(valuep);
          sl[ndx + 1] := valuep^;  Inc(valuep);
          sl[ndx]     := valuep^;  Inc(valuep);
          if FBytesPerPixel = 4 then Inc(valuep); // Alpha chanel present
        end
      end;
    end;
  end;  // Draw

begin
if (HLib=0) or not FileExists(FileName) then
  begin Result:=false; exit end;
Data     := nil;
RowPtrs  := nil;
FHeight  := 0;
FWidth   := 0;
Load;
Draw;
if Data <> nil then FreeMem(Data);
if RowPtrs <> nil then FreeMem(RowPtrs);
result:=true
end;

initialization
HLib:=LoadLibrary(Lib);
if HLib>0 then
  begin
  png_set_expand:=GetProcAddress(HLib,'png_set_expand');
  png_set_invert_alpha:=GetProcAddress(HLib,'png_set_invert_alpha');
  png_set_swap:=GetProcAddress(HLib,'png_set_swap');
  png_set_packing:=GetProcAddress(HLib,'png_set_packing');
  png_close_file:=GetProcAddress(HLib,'png_close_file');
  png_open_file:=GetProcAddress(HLib,'png_open_file');
  png_create_info_struct:=GetProcAddress(HLib,'png_create_info_struct');
  png_init_io:=GetProcAddress(HLib,'png_init_io');
  png_read_image:=GetProcAddress(HLib,'png_read_image');
  png_read_info:=GetProcAddress(HLib,'png_read_info');
  png_read_update_info:=GetProcAddress(HLib,'png_read_update_info');
  png_set_read_status_fn:=GetProcAddress(HLib,'png_set_read_status_fn');
  png_get_rowbytes:=GetProcAddress(HLib,'png_get_rowbytes');
  png_get_valid:=GetProcAddress(HLib,'png_get_valid');
  png_destroy_read_struct:=GetProcAddress(HLib,'png_destroy_read_struct');
  png_create_read_struct:=GetProcAddress(HLib,'png_create_read_struct');
  png_get_IHDR:=GetProcAddress(HLib,'png_get_IHDR');
  end;

finalization
if HLib>0 then FreeLibrary(HLib);

end.

⌨️ 快捷键说明

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