Farbwerte aller Pixel eines Bildes in einem String speichern

pmw · Beiträge: 65

Hallo!

Ich möchte gerne alle Farbwerte aller Pixel eines Bildes in einem String speichern. Mein kleines Programm funkoniert auch, braucht aber leider für ein normales Bitmap (512x384 Pixel) mehrere Minuten! Kann ich die Farbwerte irgendwie schneller auslesen?

markieren

Quelltext

1:
2:
3:
4:

for x := 0 to Image.Width-1 do begin
   for y := 0 to Image.Height-1 do
      sFileString := sFileString+Copy(ColorToString(Image.Canvas.Pixels[x,y]),4,6);
end;

Viele Grüße
Martin Winandy

Gast Erhaltene Danke: 1

Mit ScanLine

pmw · Beiträge: 65

Zitat:

Mit ScanLine

Wie funktoniert dies?

Gast Erhaltene Danke: 1

Guck dir am besten dieses Tutorial an:

www.tutorials.delphi-source.de/bitmap

pmw · Beiträge: 65

Hallo!

Danke! Mein neues Programm ist jetzt deutlich schneller. Aber 5 Sekunden empfinde ich immer noch als zu langsam. Gibt es eine Möglichkeit dern Algorithmus noch ein wenig zu beschleunigen. Ich bräuchte eine Geschwindigkeit < 1 Sekunde.

Viele Grüße
Martin Winandy

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

procedure TForm1.EncodeClick(Sender: TObject);
type
PixArray = Array [1..3] of Byte;
var
p: ^PixArray;
x,y: integer;
begin

   for y := 0 to Image.Height-1 do begin
      p:= Image.Picture.Bitmap.ScanLine[y];
      for x := 0 to Image.Width-1 do begin
         sFileString := sFileString+Char(p^[1])+Char(p^[2])+Char(p^[3]);
         Inc(p);
      end;
   end;

end;

AXMD · Verfasst: Mo 30.12.02 14:19

Hi,

Soweit ich weiß, gibts nichts schnelleres als ScanLine

AXMD

Gast Erhaltene Danke: 1

Ich kann mir nicht vorstellen, daß es 5 Sekunden dauert. Wenn ich ohne ScanLine arbeite, dann dauert es nicht mal 5 Sekunden.

Udontknow · Beiträge: 2596 Win7 D2006 WIN32, .NET (C#)

Dann setze dich doch mal an eine Maschine, die weniger als 3 GHz hat... :wink:

Ne im Ernst: Was habt ihr denn für Rechner?

Cu,
Udontknow

pmw · Beiträge: 65

Hallo!

Ich besitze einen Pentium III mit 1GHz und 128MB SD-Ram (PC 133).

Viele Grüße
Martin Winandy

Gast Erhaltene Danke: 1

Das Problem durfte nicht ScanLine sein, sondern etwas anderes. Im Grunde genommen sind das nur noch zwei for-Schleifen. Die kosten doch keine Zeit.

Sowas kostet aber Zeit:

markieren

Quelltext

1:	String := String + Char;

Hier muß die Größe des Strings einige Tausend mal neu bestimmt werden. Das könnte die 5 Sekunden dauern.

Am besten ein String von der größe (Height-1 + Width-1) * 3 erstellen und dann nur noch mit String[x] arbeiten.

pmw · Beiträge: 65

Hallo!

Zitat:

Am besten ein String von der größe (Height-1 + Width-1) * 3 erstellen und dann nur noch mit String[x] arbeiten.

Wie mache ich das ohne Schleifen?

Ich habe noch ein Problem: Ich kann die Procedure "EncodeClick" immer nur ein Mal durchlaufen lassen. Beim 2. AUfruf der Procedure reagiert das Programm nicht mehr. Es kommt aber keine Fehlermeldung.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:

var
  Form1: TForm1;
  sFileString: AnsiString;

implementation

{$R *.dfm}

function SaveStringToFile(sOutFile: String; sFileString: AnsiString): Boolean;
var
  FileStream: TFileStream;
begin
  Result := False;
  FileStream := TFileStream.Create(sOutFile, fmCreate);
  try
    if Length(sFileString) <> 0 then begin
      FileStream.Write(sFileString[1], Length(sFileString));
      Result := True;
    end;
  finally FileStream.Free end;
end;

procedure TForm1.EncodeClick(Sender: TObject);
type
PixArray = Array [1..3] of Byte;
var
p: ^PixArray;
x,y: integer;
pic: TBitmap;
begin

   pic := TBitmap.Create;
   pic.LoadFromFile(bmp.Text);
   pic.PixelFormat:= pf24Bit;

   for y := 0 to pic.Height-1 do begin
      p := pic.ScanLine[y];
      for x := 0 to pic.Width-1 do begin
         sFileString := sFileString+Char(p^[1])+Char(p^[2])+Char(p^[3]);
         Inc(p);
      end;
   end;

   try DeleteFile(spf.Text); except end;

   SaveStringToFile(spf.Text,sFileString);

   pic.Free;

end;

Gast Erhaltene Danke: 1

Um die Länge des Strings festzulegen nimmst du:

SetLength(var S: string; NewLength: Integer);

Dannach ist der S String so lang wie in NewLength festgelegt. Du hast dann eine Art Stream.

pmw · Beiträge: 65

Hallo!

Leider bringt dies auch keinen Geschwindikkeitsvorteil.Bis zur Fertig-Meldung sind es immer noch 5 Sekunden.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:

procedure TForm1.EncodeClick(Sender: TObject);
type
PixArray = Array [1..3] of Byte;
var
p: ^PixArray;
x,y: integer;
pic: TBitmap;
begin

   pic := TBitmap.Create;
   pic.LoadFromFile(bmp.Text);
   pic.PixelFormat:= pf24Bit;
   SetLength(sFileString,(pic.Height+pic.Width)*3);
 
   ShowMessage('START!');
  
   for y := 0 to pic.Height-1 do begin
      p := pic.ScanLine[y];
      for x := 0 to pic.Width-1 do begin
         sFileString := sFileString+Char(p^[1])+Char(p^[2])+Char(p^[3]);
         Inc(p);
      end;
   end;

   ShowMessage('FERTIG!');

   try DeleteFile(spf.Text); except end;

   SaveStringToFile(spf.Text,sFileString);

   pic.Free;

end;

AndyB · Beiträge: 1173 Erhaltene Danke: 14 RAD Studio XE2

Du hast ja nicht genau das gemacht, was Popov gemeint hat. Du baust den String immer noch mit + zusammen.

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:

procedure TForm1.EncodeClick(Sender: TObject);
var
  p: PByte;
  x, y, i: Integer;
  Pic: TBitmap;
  Stream: TFileStream;
  sFileString: string;
  Width, Height: Integer;
  ByteTable: array[0..255] of string[2];
  F: PChar;
begin
 // "Nachschau" Tabelle anlegen
  for i := 0 to 255 do ByteTable[i] := IntToHex(i, 2);

  Pic := TBitmap.Create;
  try
    Pic.LoadFromFile('c:\Test.bmp');
    Pic.PixelFormat := pf24Bit;
    Width := Pic.Width;
    Height := Pic.Height;

   { genug Speicher reservieren: 3 Farbwerte mit je 2 Zeichen }
    SetLength(sFileString, Height * Width * 3 * 2);

    ShowMessage('START!');
    F := PChar(sFileString);
    for y := 0 to Height - 1 do
    begin
      p := Pic.ScanLine[y];
      for x := 0 to (Width * 3) - 1 do
      begin
        PWord(F)^ := PWord(@ByteTable[p^][1])^;
{    ein wenig schneller als:
        F[0] := ByteTable[p^][1];
        F[1] := ByteTable[p^][2]; }
        Inc(F, 2);

        Inc(p);
      end;
    end;
  finally
    Pic.Free;
  end;

  ShowMessage('FERTIG!');

  Stream := TFileStream.Create('C:\Test.txt', fmCreate);
  try
    if Length(sFileString) > 0 then
      Stream.Write(sFileString[1], Length(sFileString));
  finally
    Stream.Free;
  end;
end;

Der Code brauch bei mir (650 MHz) 79 Millisekunden für ein 1024x768x24 Bild.

_________________
Ist Zeit wirklich Geld?

pmw · Beiträge: 65

Hallo!

Danke für den Quellcode. Der Ist wirklich schnell! Leider verstehe ich den nicht ganz richtig und es kommt auch nicht ganz das gewünschte Ergebnis raus.
Der Code braucht für jeden Farbwert 2 Bytes (30 45 30 41 30 35). Ich wollte aber jeden Farbwert in einen Byte (0E 0A 05) speichern.

Viele Grüße
Martin Winandy

pmw · Beiträge: 65

Hallo!

Ich habe jetzt die Lösung gefunden!

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:

procedure TForm1.EncodeClick(Sender: TObject); 
var 
p: PByte;
x, y: Integer;
Pic: TBitmap;
sFileString: string;
F: PChar;
begin 

   Pic := TBitmap.Create;
   try
      Pic.LoadFromFile(bmp.Text);
      Pic.PixelFormat := pf24Bit;
      SetLength(sFileString, Pic.Height * Pic.Width * 3);

      F := PChar(sFileString);
      for y := 0 to Pic.Height - 1 do begin
          p := Pic.ScanLine[y];
          for x := 0 to (Width * 3) - 1 do begin
             F^ := Char(p^);
             Inc(F);
             Inc(p);
          end;
      end;
   finally
      Pic.Free;
   end;

   try DeleteFile(spf.Text); except end;

   SaveStringToFile(spf.Text,sFileString);

end;

Vielen Dank an alle, die mir geholfen haben und ich wünsche eine guten Rutsch ins Jahr 2003!
Martin Winandy

pmw · Beiträge: 65

Hallo!

Ich sehe gerade, dass mein Quellcode doch nicht stimmt. Ab dem 576.000 Byte werde nur noch Nullen ausgegeben. Woran kann das liegen?

AndyB · Beiträge: 1173 Erhaltene Danke: 14 RAD Studio XE2

pmw hat folgendes geschrieben:

Der Code braucht für jeden Farbwert 2 Bytes (30 45 30 41 30 35). Ich wollte aber jeden Farbwert in einen Byte (0E 0A 05) speichern.

Also wenn du pro Pixel 3 Bytes (RGB = 3 * 1 Byte) verwenden willst, dann kann ich dir einen um einiges schnelleren Code geben:

markieren

Quelltext

1:
2:
3:
4:
5:
6:

SetLength(sFileString, Pic.Height * Pic.Width * 3);
for y := 0 to Height - 1 do
begin
  p := Pic.ScanLine[y];
  Move(p^, sFileString[y * (Width * 3) + 1], Width * 3);
end;

Mein Code (2 Bytes pro Farbwert) wandelt die Bytes in Hexadezimal-Strings um und schreibt diese dann in die Datei. Das was du da willst (1 Byte pro Farbwert) ist nichts anderes, als die Daten 1:1 kopieren.

_________________
Ist Zeit wirklich Geld?

pmw · Beiträge: 65

Hallo!

Danke! Jetzt funktioniert alles wies es soll! Dafür arbeitet aber meine DLL nicht mehr richtig mit dem String zusammen. Ich bekomme immer eine Fehlermeldung "External Error 80003".

Programm - Form1:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Spin;

type
  TForm1 = class(TForm)
    bmp: TEdit;
    Label1: TLabel;
    spf: TEdit;
    Label2: TLabel;
    Encode: TButton;
    Label3: TLabel;
    concolor: TComboBox;
    Label4: TLabel;
    filesize: TSpinEdit;
    Button1: TButton;
    procedure EncodeClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function convert(const filesize, color, pixelx,pixely: integer; picture: AnsiString): AnsiString; stdcall; external 'spf_en.dll';

function SaveStringToFile(sOutFile: String; sFileString: AnsiString): Boolean;
var
  FileStream: TFileStream;
begin
  Result := False;
  FileStream := TFileStream.Create(sOutFile, fmCreate);
  try
    if Length(sFileString) <> 0 then begin
      FileStream.Write(sFileString[1], Length(sFileString));
      Result := True;
    end;
  finally FileStream.Free end;
end;

procedure TForm1.EncodeClick(Sender: TObject); 
var 
p: PByte;
y: Integer;
pic: TBitmap;
input, output: AnsiString;
begin 

   pic := TBitmap.Create;
   try
   
      Pic.LoadFromFile(bmp.Text);
      Pic.PixelFormat := pf24Bit;
      SetLength(input,pic.Height*pic.Width*3);

      for y := 0 to pic.Height-1 do begin
         p := pic.ScanLine[y];
         Move(p^,input[y*(pic.Width*3)+1],pic.Width*3);
      end;

   finally pic.Free; end;

   output := input;
   output := convert(filesize.Value,concolor.ItemIndex,pic.Width,pic.Height,output); // Fehlermeldung! 

   try DeleteFile(spf.Text); except end;

   SaveStringToFile(spf.Text,output);

end;

procedure TForm1.Button1Click(Sender: TObject);
begin

   ShowMessage(convert(0,0,30,55,'Hallo!')); // Funktioniert einwandfrei! 

end;

end.

DLL:

markieren

Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:

library spf_en;

uses
  ShareMem, Dialogs, SysUtils, Classes;

{$R *.res}

function convert(const filesize, color, pixelx,pixely: integer; picture: AnsiString): AnsiString; stdcall;
var
header: String;
begin

   result := picture;

end;

exports
  convert;
  
begin
end.

Viele Grüße
Martin Winandy

AndyB · Beiträge: 1173 Erhaltene Danke: 14 RAD Studio XE2

Hast du ShareMem auch in Hauptprogramm (.dpr-Datei) als erste Unit eingebunden?

_________________
Ist Zeit wirklich Geld?

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme