unit BMPImage; interface uses classes; type TColor = object r: byte; g: byte; b: byte; procedure set_color(tr: byte; tg: byte; tb: byte); procedure reset(); end; TPxData = array of array of TColor; TBMPImage = object private width, height: integer; function get_padding(): integer; public pixel_data: array of array of TColor; constructor init(); constructor init(w: integer; h: integer; c: TColor); constructor init(px_data: TPxData); destructor done(); procedure set_pixel_data(px_data: TPxData); procedure set_width(w: integer); procedure set_height(h: integer); function get_width(): integer; function get_height(): integer; procedure open(path: string); procedure save(path: string; monochrome: boolean); end; implementation procedure TColor.reset(); begin r := 0; g := 0; b := 0; end; procedure TColor.set_color(tr: byte; tg: byte; tb: byte); begin r := tr; g := tg; b := tb; end; procedure TBMPImage.set_pixel_data(px_data: TPxData); var i, j: longint; begin width := length(px_data); height := length(px_data[0]); setLength(pixel_data, width, height); for i := 0 to width - 1 do begin for j := 0 to height - 1 do begin pixel_data[i][j] := px_data[i][j]; end; end; end; constructor TBMPImage.init(); begin setLength(pixel_data, 0, 0); width := 0; height := 0; end; constructor TBMPImage.init(w: integer; h: integer; c: TColor); var i, j: integer; begin setLength(pixel_data, w, h); width := w; height := h; for i := 0 to width - 1 do begin for j := 0 to height - 1 do begin pixel_data[i][j] := c; end; end; end; constructor TBMPImage.init(px_data: TPxData); begin set_pixel_data(px_data); end; destructor TBMPImage.done(); begin setLength(pixel_data, 0, 0); // not neccesary width := 0; height := 0; end; function TBMPImage.get_padding(): integer; var bytes_per_row, padding: integer; begin bytes_per_row := width * 3; padding := 4 - bytes_per_row mod 4; if padding = 4 then padding := 0; get_padding := padding; end; procedure TBMPImage.set_width(w: integer); var color: TColor; i, j: integer; begin setLength(pixel_data, w, height); if (w > width) then begin for i := width to w - 1 do begin for j := 0 to height - 1 do begin color.set_color(255, 255, 255); pixel_data[i][j] := color; end; end; end; width := w; end; procedure TBMPImage.set_height(h: integer); var color: TColor; i, j: integer; begin setLength(pixel_data, width, h); if (h > height) then begin for i := 0 to width - 1 do begin for j := height to h - 1 do begin color.set_color(255, 255, 255); pixel_data[i][j] := color; end; end; end; height := h; end; function TBMPImage.get_width(): integer; begin get_width := width; end; function TBMPImage.get_height(): integer; begin get_height := height; end; procedure TBMPImage.open(path: string); var instream: TFileStream; px_data_offset, i, j, k, padding: integer; color: TColor; begin instream := TFileStream.Create(path, fmOpenRead); instream.position := 10; px_data_offset := instream.readword(); instream.position := 18; width := instream.readword(); instream.position := 22; height := instream.readword(); setLength(pixel_data, width, height); // indexes begins with zero padding := get_padding(); instream.position := px_data_offset; k := 1; for i := height - 1 downto 0 do begin for j := 0 to width - 1 do begin color.b := instream.readbyte(); color.g := instream.readbyte(); color.r := instream.readbyte(); pixel_data[j][i] := color; inc(k); end; instream.position := instream.position + padding; end; end; procedure TBMPImage.save(path: string; monochrome: boolean); var ostream: TFileStream; padding, i, j, cs: integer; color: TColor; buf: array[1..1000000] of byte; k, size: longint; begin ostream := TFileStream.Create(path, fmCreate + fmOpenWrite); ostream.writeword(19778); // "BM" - format specifier ostream.position := 10; ostream.WriteDWord(54); // pixel data offset is bytes (54) ostream.WriteDWord(40); // second header size in bytes (40, 14 - first header) ostream.WriteDWord(width); ostream.WriteDWord(height); ostream.position := 26; ostream.writeword(1); // must be one // bits per pixel if (monochrome) then ostream.writeword(1) else ostream.writeword(24); padding := get_padding(); ostream.position := 54; size := width * 3 + padding; for k := 1 to size do begin // we need zero bytes to fill padding buf[k] := 0; end; if (monochrome) then begin {color := pixel_data[j][i]; cs := color.r + color.g + color.b; if (cs > 425) then begin cs := 255; end else begin cs := 0; end; ostream.writebyte(cs); ostream.writebyte(cs); ostream.writebyte(cs);} end else begin for i := height - 1 downto 0 do begin k := 1; for j := 0 to width - 1 do begin color := pixel_data[j][i]; buf[k + 0] := color.b; buf[k + 1] := color.g; buf[k + 2] := color.r; k := k + 3; end; ostream.writebuffer(buf, size); end; end; end; begin end.