Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Multimedia (https://www.delphipraxis.net/16-multimedia/)
-   -   Delphi PortableBitMap (PBM) in Delphi lesen & erstellen (https://www.delphipraxis.net/142949-portablebitmap-pbm-delphi-lesen-erstellen.html)

WorstNightmare 6. Nov 2009 16:30


PortableBitMap (PBM) in Delphi lesen & erstellen
 
Hi,

ich schreibe gerade ein kleines Programm, welches Dateien in einem beliebigen Format lädt und ins Portable Bitmap Format umwandeln soll, um das dann an GOCR weiterzureichen.

Ich habe eine Image Library gefunden (Vampyre), die das Format parsen kann und den Teil mal übersetzt:
Delphi-Quellcode:
unit PortableBitmap;

interface

uses Classes, SysUtils;

const
  WhiteChars = [#9, #10, #13, #32];

type
  TPortableBitmap = class
  private
    FWidth, FHeight: Integer;
    FData: TBytes;

    function ConvertTo8Bit(const Data: TBytes; WidthBytes: Cardinal): TBytes;
  public
    procedure LoadFromFile(Filename: string);

    property Data: TBytes read FData;
    property Height: Integer read FHeight;
    property Width: Integer read FWidth;
  end;

  TPBMReader = class helper for TStream
  public
    function ReadString: string;
    function ReadInt: Integer;
  end;

implementation

{ TPBMReader }

function TPBMReader.ReadInt: Integer;
begin
  Result := StrToInt(ReadString);
end;

function TPBMReader.ReadString: string;
var
  C: AnsiChar;
begin
  repeat
    Read(C, 1);
    if not (C in WhiteChars) then
      Result := Result + Char(C);
  until (Position >= Size - 1) or (C in WhiteChars);

  while C in WhiteChars do
    Read(C, 1);

  Position := Position - 1;
end;

{ TPortableBitmap }

procedure TPortableBitmap.LoadFromFile(Filename: string);
var
  ScanLineSize, MonoSize: Cardinal;
  MonoData: TBytes;
  FS: TFileStream;
begin
  FS := TFileStream.Create(Filename, fmOpenRead);
  try
    if FS.ReadString[2] <> '4' then
      raise Exception.Create('Kein kompatibles PortableBitmap Bild:' + sLineBreak + Filename);

    FWidth := FS.ReadInt;
    FHeight := FS.ReadInt;

    if (FHeight < 1) or (FWidth < 1) then
      raise Exception.Create('Höhe/Breite des Bildes ungültig!');

    ScanLineSize := (FWidth + 7) div 8;
    MonoSize := ScanLineSize * FHeight;

    if MonoSize > FS.Size - FS.Position then
      MonoSize := FS.Size - FS.Position;

    SetLength(MonoData, MonoSize);
    FS.Read(MonoData[0], MonoSize);
    FData := ConvertTo8Bit(MonoData, ScanLineSize);
  finally
    FS.Free;
  end;
end;

function TPortableBitmap.ConvertTo8Bit(const Data: TBytes; WidthBytes: Cardinal): TBytes;
const
  Mask: array[0..7] of Byte = ($80, $40, $20, $10, $08, $04, $02, $01);
  Shift: array[0..7] of Byte = (7, 6, 5, 4, 3, 2, 1, 0);
var
  X, Y, I: Integer;
begin
  SetLength(Result, FWidth * FHeight);
  for Y := 0 to FHeight - 1 do
    for X := 0 to FWidth - 1 do
      Result[Y * FWidth + X] :=
        (Data[Y * WidthBytes + X shr 3] and Mask[X and 7]) shr Shift[X and 7];

  for I := 0 to FWidth * FHeight - 1 do
    Result[I] := 255 - Result[I] * 255;
end;

end.
Aufrufen tu ich es so:
Delphi-Quellcode:
procedure TForm1.Button2Click(Sender: TObject);
var
  X, Y: Integer;
begin
  with TPortableBitmap.Create do
  begin
    LoadFromFile('D:\gocr\gencap.pbm');

    Image1.Picture.Bitmap.SetSize(Width, Height);
    Image1.Picture.Bitmap.PixelFormat := pf8bit;

    for Y := 0 to Height - 1 do
      for X := 0 to Width - 1 do
        imgCaptcha.Picture.Bitmap.Canvas.Pixels[X, Y] := Data[Y * Width + X];

    Free;
  end;
end;
Das Bild wird angezeigt (wenn auch mit einem roten Hintergrund), allerdings fehlen ca. 8 Pixel am linken Rand (ich denke die sind irgendwie nach rechts verschwunden, da ist so ein kleiner schwarzer Strich). In der Demo dieser Library ist es übrigens dasselbe, ich habe es also nicht falsch übernommen :lol:

Kennt sich jemand zufällig gut mit dem Format aus und kann mir helfen?


Alle Zeitangaben in WEZ +1. Es ist jetzt 11:42 Uhr.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz