Bild erstellen mit Text

Bronstein · Verfasst: Do 14.06.07 15:43

Möchte so was als Bild speichern (siehe Anhang 1).
Ich habe dazu ein Pannel genommen und auf diesem einige RichEdits plaziert.

Jetzt habe ich mit Hilfe von Delphi einen Sceenshot gemacht.
Leider werden da aber die Edits nicht angezeigt.

Hier mal mein Code für den Screenshot:

markieren

Delphi-Quelltext

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

procedure TForm1.Button2Click(Sender: TObject);
var
  bmp , TargetBitmap: TBitmap;
begin
  try
    bmp := TBitmap.Create;
    BMP.Assign(Form1.GetFormImage);
    TargetBitmap := TBitmap.Create;
    TargetBitmap.Height := Form1.Panel1.Height-41;
    TargetBitmap.Width := Form1.Panel1.Width-26;
    BitBlt(TargetBitmap.Canvas.Handle, 0, 0, Form1.Panel1.Width, Form1.Panel1.Height, bmp.Canvas.Handle,Form1.Panel1.Left, Form1.Panel1.Top, SRCCOPY);
    TargetBitmap.SaveToFile('test.bmp');
  except

  end;
end;

Einloggen, um Attachments anzusehen!

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Klabautermann · Verfasst: Do 14.06.07 15:52

Hi,

ich denke an einfachsten wird es sein, wenn du das ganze direkt auf ein Suche in: Delphi-Forum, Delphi-Library

CANVAS Zeichnest und dieses dann speicherst.

Gruß
Klabautermann

Danniolo · Beiträge: 693

Warum malst du's nich einfach mit Canvas selbst?
Suche in der Entwickler-Ecke

CANVAS TEXTOUT

Tilman · Verfasst: Do 14.06.07 16:26

Ansonsten, versuch mal sowas in der art:

markieren

Delphi-Quelltext

1:
2:
3:
4:

[..]
targetbitmap.Canvas.CopyRect(Canvas.ClipRect,Canvas,Canvas.ClipRect);
targetbitmap.saveToFile('test.bmp');
[..]

(Canvas ist die Canvas deines Formulars, z.B. form1.Canvas)

_________________
Bringe einen Menschen zum grübeln, dann kannst du heimlich seinen Reis essen.
(Koreanisches Sprichwort)

Bronstein · Verfasst: Do 14.06.07 16:31

Ja, das dachte ich mir auch schon.
Wie soll ich das aber mit der Textausrichtung machen.
Denn ich möchte den Text zentrieren

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Bronstein · Verfasst: Do 14.06.07 19:09

Danke für eure Tipps.
Habe aber eine andere Lösung herrausgefunden. Ich nehme anstatt RichEdits einfach Memos. Da kann ich den Text auch mittig ausrichten und sie werden auch mit meiner Screenshort Funktion angezeigt

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Bronstein

Jetzt hab ich doch noch ein Problem.
Ich habe jetzt eine Schleife, mit der ich verschiedene Bilder erstellen möchte. Dazu möchte ich die Memos immer neu füllen und dann einen Screenshot machen. Jetzt stimmt mein Schleifenzähler aber nicht, trotz dass ich ihn auf 0 gesetzt hat, ist er beim ersten Schleifendurchgang gleich auf 51. Woran kann das liegen.

Hier mal mein Code der Schleife:

markieren

Delphi-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:

[...]
var
  Tester, Baugruppe, ErsterTest, LetzterTest: String;
  Pruefergebnisse, Pass, Fail, SetPass, Reperaturaktionen, i, z: Integer;
  tmpFloat: Extended;
  ListItem: TListItem;
  Von: TDateTime;
  aTester, aType: array[0..50] of String;
  aZaehler, aGetestet, aPass, aFail: array[0..50] of Integer;
  check: Boolean;
  bmp , TargetBitmap: TBitmap;
[...]

for z:=0 to 50 do
  begin
    Memo1.Clear;
    Memo2.Clear;
    Memo3.Clear;
    Memo4.Clear;
    if aTester[z] = '' then
      break;
    Memo1.Text := aTester[z];
    tmpFloat := aGetestet[z] / 100;
    tmpFloat := RundeAufStelle(aPass[z]/tmpFloat, 0);
    if tmpFloat > 95 then
    begin
      Memo1.Color := clLime;
      Memo2.Color := clLime;
    end;
    if (tmpFloat >= 90) and (tmpFloat < 95) then
    begin
      Memo1.Color := clYellow;
      Memo2.Color := clYellow;
    end;
    if tmpFloat < 90 then
    begin
      Memo1.Color := clRed;
      Memo2.Color := clRed;
    end;

    Memo2.Text := FloatToStr(tmpFloat) + '%';
    Memo3.Text := aType[z];
    Memo4.Lines.Add('Getestete BGR = ' + IntToStr(aGetestet[z]));
    Memo4.Lines.Add('Pass BGR = ' + IntToStr(aPass[z]));
    Memo4.Lines.Add('Fail BGR = ' + IntToStr(aFail[z]));
    //Scrennshot erstellen
    bmp := TBitmap.Create;
    BMP.Assign(Form1.GetFormImage);
    TargetBitmap := TBitmap.Create;
    TargetBitmap.Height := Form1.Panel1.Height;
    TargetBitmap.Width := Form1.Panel1.Width;
    BitBlt(TargetBitmap.Canvas.Handle, 0, 0, Form1.Panel1.Width, Form1.Panel1.Height, bmp.Canvas.Handle,Form1.Panel1.Left, Form1.Panel1.Top, SRCCOPY);
    TargetBitmap.SaveToFile(aTester[i] + '.bmp');
    TargetBitmap.Destroy;
    BMP.Destroy;
  end;

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

alzaimar · Verfasst: Fr 15.06.07 07:31

Vermutlich optimiert Delphi hier. Es ist schneller, rückwärts zu zählen. Wenn Du unbedingt vorwärts zählen willst, verwende eine While-Schleife:
aus

markieren

Delphi-Quelltext

1:	For i:= a to b do ...

wird

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:

i := a;
While i <= b so begin
  ...
  inc (i)
end;

_________________
Na denn, dann. Bis dann, denn.

Bronstein · Verfasst: Fr 15.06.07 07:52

Danke, mit der while Schleife funktioniert es jetzt.

Jetzt hab ich schon wieder ein Problem nachdem ich das zwnzigste Bild erstellt habe bekomme ich wenn ich das 21 erstellen möchte folgende Fehlermeldung.
---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt Project1.exe ist eine Exception der Klasse EOutOfResources aufgetreten. Meldung: 'Für diesen Befehl ist nicht genügend Speicher verfügbar.
'. Prozeß wurde angehalten. Mit Einzelne Anweisung oder Start fortsetzen.
---------------------------
OK Hilfe
---------------------------

Ich gebe dich den speicher aber immer wieder frei durch:

markieren

Delphi-Quelltext

1:
2:

TargetBitmap.Destroy;
BMP.Destroy;

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Zyklame · Verfasst: Fr 15.06.07 10:20

Erzeug doch mal nur ein Bitmap Object vor der Schleife,
in dem du das Bild zum Speicher zeichnest

evtl. mit zwischen den Screenshots mit

markieren

Delphi-Quelltext

1:	Bild.canvas.rect(0,0,Bild.width, Bild.height);

löschen (es kann sein das ich Höhe und Breite vertauscht hab)

und am Ende erst freigeben nach der Schleife

das ganze dann am besten so

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:

//...
Bild := TBitmap.create;
try
//(Schleife)
finally
  Bild.free;
end;
//...

Bronstein · Verfasst: Fr 15.06.07 10:43

Ich lösche doch das Bitmap aber auch bei jedem Schleifendurchgang wieder.
bmp.destroy;

Doch nach jedem Schleifendurchgang, sehe ich im Taskmanager, dass meine Auslagerungsdatei bei jedem durchgang größer wird.

Habe ich vielleicht was vergessen zu löschen, ich sehe zumindest nichts

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Zyklame · Verfasst: Fr 15.06.07 10:59

Ja ich weiß das du das Bild nach jeder Schleife löschst.

Aber Der Delphi Speichermanager gibt den Speicherbereich des Bildes dabei nicht an Windows zurück
siehe dazu
www.dsdt.info/inside.../speichermanager.php

versuch es doch mal mit meiner Lösung es könnte wirklich helfen.

Zudem würde ich nicht ".Destroy" sondern (fast) immer ".Free" aufrufen, denn an dieser Stelle könnte es auch sein das nicht alles freigegeben wird

Bronstein · Verfasst: Fr 15.06.07 11:23

Hab ich mal versucht, doch dann bekomme ich trotzdem den Fehler bei:
BMP.Assign(Form1.GetFormImage);

Nehme ich das auch aus der Schleife, dann sieht halt das Bild immer gleich aus, sprich meine Werte werden nicht aktualisiert.

Also was nun

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Zyklame · Verfasst: Fr 15.06.07 11:44

Ich hab jetz mal den code aus deinem Post angepasst un mit kommenteren an den entscheidenen stellen versehen

markieren

Delphi-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:

[...]
var
  Tester, Baugruppe, ErsterTest, LetzterTest: String;
  Pruefergebnisse, Pass, Fail, SetPass, Reperaturaktionen, i, z: Integer;
  tmpFloat: Extended;
  ListItem: TListItem;
  Von: TDateTime;
  aTester, aType: array[0..50] of String;
  aZaehler, aGetestet, aPass, aFail: array[0..50] of Integer;
  check: Boolean;
  bmp , TargetBitmap: TBitmap;
begin
[...]
// Bitmaps erzeugen
TargetBitmap := TBitmap.Create;
TargetBitmap.Height := Form1.Panel1.Height;
TargetBitmap.Width := Form1.Panel1.Width;
bmp := TBitmap.Create;


try // versuche

for z:=0 to 50 do
  begin
    [...] // Memos ändern ...

    //Scrennshot erstellen

    // Form neu zeichnen
    Form1.repaint;
    // Dem Programm / der Form zeit geben zu zeichnen
    Application.processmessage;
    
    // bild "leeren" einfach übermalen (ich glaub das ist hier nicht nötig)
    bmp.canvas.pen.color := clwhite;              // Stiftfarbe setzen (Randfarbe)
    bmp.canvas.brush.color := cl white;           // Hintergrundfarbe setzen (Füllfarbe)
    bmp.canvas.brush.style := bssolid;            // Alles im Rechteck ausfüllen
    bmp.canvas.rect(0, 0, bmp.width, bmp.height); // mit rechteck übermalen

    // der eigentliche Screenshot

    //bmp := TBitmap.Create;  <- nicht hier
    BMP.Assign(Form1.GetFormImage);
    //TargetBitmap := TBitmap.Create; <- nicht hier
    //TargetBitmap.Height := Form1.Panel1.Height; <- nicht hier (es sei den du änderst die Form größe)
    //TargetBitmap.Width := Form1.Panel1.Width;   <- nicht hier (es sei den du änderst die Form größe)
    BitBlt(TargetBitmap.Canvas.Handle, 0, 0, Form1.Panel1.Width, Form1.Panel1.Height, bmp.Canvas.Handle,Form1.Panel1.Left, Form1.Panel1.Top, SRCCOPY);
    TargetBitmap.SaveToFile(aTester[i] + '.bmp');
    //TargetBitmap.Destroy;
    //BMP.Destroy;
  end;
finally {das "gegenstück" zum try 
(wenn zwischen try finally ein fehler auftritt wird dieser Code trotzdem ausgeführt wenn keiner auftritt natürlich auch}

// hier erst freigeben
  bmp.free;
  TargetBitmap.Free 
end;
[...]

// Edit hab jetz erst dein geänderten Post gelesen habs ergänst

Bronstein · Verfasst: Fr 15.06.07 12:13

Bei deinem Code gibt es aber einen Fehler bei der Zeile:

markieren

Delphi-Quelltext

1:	bmp.canvas.rect(0, 0, bmp.width, bmp.height); // mit rechteck übermalen

[Fehler] Unit1.pas(412): Undefinierter Bezeichner: 'rect'

Die Unit Types habe ich eingebunden, oder muss ich da eine andere Unit einbinden

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Zyklame · Verfasst: Fr 15.06.07 12:18

tipp doch einfach mal "bmp.canvas." dann zeigt er dir doch an was möglich ist.
guck doch mal nach "rectangle" oder so ähnlich kann sein das ich mich irre hab grad kein Delphi hier.

mit der Unit Types hat das eigentlich nichts zu tun kann mich aber auch irren

Bronstein · Verfasst: Fr 15.06.07 14:04

Ja es heißt

markieren

Delphi-Quelltext

1:	bmp.Canvas.Rectangle(0, 0, bmp.width, bmp.height);

Leider geht das aber auch nicht. Gleicher Fehler

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

iKilledKenny · Verfasst: Fr 15.06.07 14:09

FillRect heisst die Zaubermethode.

Bronstein · Verfasst: Fr 15.06.07 16:29

Ich meinte die Fehlermeldung:
Im Projekt Project1.exe ist eine Exception der Klasse EOutOfResources aufgetreten. Meldung: 'Für diesen Befehl ist nicht genügend Speicher verfügbar.
'. Prozeß wurde angehalten. Mit Einzelne Anweisung oder Start fortsetzen

_________________
Es gibt keine dummen Fragen nur dumme Antworten!!!

Lannes · Verfasst: Fr 15.06.07 21:33

Hallo,

eine Textausgabe über Memos per Screenshoot ist schon etwas "selten", ich habe mir den Code dazu deshalb auch nicht näher angeschaut.
Erzeuge die Bitmaps besser wie user profile icon

Klabautermann und user profile icon

Danniolo es Dir zu Beginn des Themas vorgeschlagen haben.

Bronstein hat folgendes geschrieben:

Ja, das dachte ich mir auch schon.
Wie soll ich das aber mit der Textausrichtung machen.
Denn ich möchte den Text zentrieren

DrawText hilft enorm dabei.

Hab mal kurz einen Beispielcode zusammengestellt, ist in vielen Teilen noch verbesserungswürdig, aber funktioniert(1000 bmp in ca 45 Sek). Denke das Du ihn an Deine Anwendung anpassen kannst.

markieren

Delphi-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:

    bmp : TBitmap;
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  bmp := TBitmap.Create;
  bmp.Width := 284;
  bmp.Height := 300;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  bmp.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
var aRect : TRect;
    s : String;
    z : Integer;
begin
  aRect := Rect(0,10,284,300);
  bmp.Canvas.Font.Name := 'Arial';
  bmp.Canvas.Font.Style := [fsBold];
  for z := 0 to 1000 do
    begin
    bmp.Canvas.FillRect(aRect);
    bmp.Canvas.Font.size := 18;
    DrawText(bmp.Canvas.Handle,Pchar(IntToStr(z)),Length(IntToStr(z)),aRect,DT_CENTER);
    bmp.Canvas.Font.size := 32;
    aRect.top := 65;
    DrawText(bmp.Canvas.Handle,'___________',Length('___________'),aRect,DT_CENTER);
    bmp.Canvas.Font.size := 42;
    aRect.top := 40;
    DrawText(bmp.Canvas.Handle,Pchar(IntToStr(z)+' %'),Length(IntToStr(z)+' %'),aRect,DT_CENTER);
    aRect.top := 125;
    bmp.Canvas.Font.size := 18;
    DrawText(bmp.Canvas.Handle,Pchar('75.466.'+IntToStr(z)),Length('75.466.'+IntToStr(z)),aRect,DT_CENTER);
    aRect.top := 180;
    bmp.Canvas.Font.size := 16;
    s := 'Getestete BGR = '+IntToStr(z*10)+#13#10
         +'Pass BGR = '+IntToStr(z)+#13#10
         +'Fail BGR = '+IntToStr(z);
    DrawText(bmp.Canvas.Handle,Pchar(s),Length(s),aRect,DT_CENTER);
    bmp.SaveToFile('c:\temp\xyz'+IntToStr(z)+'.bmp');
    end;
  showmessage('fertig');
end;

_________________
MfG Lannes
(Nichts ist nicht Nichts) and ('' <> nil ) and (Pointer('') = nil ) and (@('') <> nil )

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme