![]() |
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:
Aufrufen tu ich es so:
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.
Delphi-Quellcode:
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:
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; 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