AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Multimedia Delphi PortableBitMap (PBM) in Delphi lesen & erstellen
Thema durchsuchen
Ansicht
Themen-Optionen

PortableBitMap (PBM) in Delphi lesen & erstellen

Ein Thema von WorstNightmare · begonnen am 6. Nov 2009
Antwort Antwort
WorstNightmare

Registriert seit: 6. Okt 2008
159 Beiträge
 
RAD-Studio 2010 Arc
 
#1

PortableBitMap (PBM) in Delphi lesen & erstellen

  Alt 6. Nov 2009, 16:30
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] <> '4then
      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

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


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 16:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz