Grafik als screenshot

[Hartfrid Krause]

Ich maniupuliere in einem delphi7-pogramm eine geladene bitmap-Datei farblich.
Dies möchte ich innerhalb meines Programmes ausdrucken ohne erst (extern) hardcopy zu installieren.
Der Umweg über Druck - in word datei kopieren und druckensoll nicht beschritten werden.

[SirThornberry]

dazu könntest du die Unit Printers einbinden und über Printer.Canvas dann drucken. Ein gutes Tutorial gibts hier:
so kannst du zum Beispiel Text ausdrucken

Delphi-Quellcode:

Printer.BeginDoc();
Printer.Canvas.TextOut(10, 10, 'MeinText');
Printer.EndDoc();

Über die suche findet sich da sicher auch noch einiges dazu.

[Edit]
Hast du dich eventuell im Titel vertan? Was hat ein Screenshot mit deinem Problem (das Drucken) zu tun?

[Hartfrid Krause]

Ich Lade zunächst eine bitmap-Datei (Umrisse der Bundesländer).
Dann färbe ich die einzelnen Bundesländer nach den stärksten politischen Fraktionen.
Jetzt möchste ich dieses neue Bild ausdrucken, erhalte über print aber nur die originäre bitmap-Datei, nicht die farblich überschriebene (mit floodfil).
Dein Hinweis löstz so das Problem nicht.[delphi]

[marabu]

Herzlich willkommen in der Delphi-PRAXiS, Hartfrid.

Vielleicht bringt dich dieser Code auf die richtige Spur: klick

Freundliche Grüße

[Hartfrid Krause]

So klappt das noch nicht.
Hier mehr - neben eoiner bitmap der Umrisse der Bundesländer, die durch die Prozedure unterschiedlich farblich markiert werden. Der Ausdruck sollte mit den farblichen Flächenfüllungen - also bunt - erfolgen.

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    procedure form1show(sender:TObject);
     procedure PaintBox1Paint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure einfaerben(sender:TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
   Bitmap1: TBitmap;
    Form1: TForm1;

implementation

{$R *.dfm}
procedure tform1.form1show(sender:TObject);
begin
 form1.Height:=19*screen.Height div 20;
 form1.Left:=(screen.Width-form1.Width) DIV 2;
 form1.Top:=(screen.Height-form1.Height) div 2;
 button1.top:=form1.Top+form1.Height-4*button1.height;
 button2.Top:=button1.Top;
 button2.left:=button1.Left+21*button1.width div 20;
 paintbox1.Height:=645;
 paintbox1.width:=486;
 paintbox1.Left:=(form1.Width-paintbox1.Width) div 2;
 paintbox1.Top:=(form1.Height-paintbox1.Height) div 2;
 paintbox1paint(sender);
end;


procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
 Bitmap1 := TBitmap.Create;
 Bitmap1.LoadFromFile('DeutschUmriss.bmp');
 PaintBox1.Canvas.Draw(0,0,Bitmap1);
 Bitmap1.Free;
 einfaerben(sender);
end;


procedure tform1.einfaerben(sender:TObject);
Var  farbe:tcolor;
 x,y:integer;
begin
 with canvas do
 with paintbox1 do
 begin
 moveto(paintbox1.Left,paintbox1.Top);
 lineto(paintbox1.Left+paintbox1.Width,paintbox1.Top);
 lineto(paintbox1.Left+paintbox1.Width,paintbox1.Top+paintbox1.Height);
 lineto(paintbox1.Left,paintbox1.Top+paintbox1.Height);
   brush.color:= clred;  //Berlin
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+385,paintbox1.Top+200,farbe, fsborder);

   brush.color:= clyellow;  //Hamburg
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+220,paintbox1.Top+115,farbe, fsborder);

   brush.color:= clblack;  //Bremen
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+154,paintbox1.Top+160,farbe, fsborder);
   floodfill(paintbox1.Left+150,paintbox1.Top+124,farbe, fsborder);

   brush.color:= clgreen;  //Nieders
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+170,paintbox1.Top+150,farbe, fsborder);

   brush.color:= clmaroon;  //NRW
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+80,paintbox1.Top+260,farbe, fsborder);
 end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 showmessage('Aber wie???');
end;

end.

[edit=r_kerber]Delphi-Tags eingefügt. Das nächste Mal bitte selbst machen. Mfg, r_kerber[/edit]

[Namenloser]

was funktionert denn nicht? du weist x und y nie einen wert zu.

[bitsetter]

Hallo,

mit deinem Code lädst du das Bild, und zeichnest es dann auf den Canvas der Paintbox und dann färbst du einige Bereiche auf dem Canvas der Paintbox ein.
Deine Bilddatei wird dadurch jedoch nicht geändert. Hier ist ein wenig Code, wie du deine gezeichneten Bereiche in die Bilddatei speicherst.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
   Bitmap1: TBitmap;
begin
  Bitmap1 := TBitmap.Create;
  try
    Bitmap1.LoadFromFile('DeutschUmriss.bmp');
    Bitmap1.Canvas.CopyRect(Rect(0, 0, Bitmap1.Width, Bitmap1.Height), PaintBox1.Canvas, Rect(0, 0, Bitmap1.Width, Bitmap1.Height));
    Bitmap1.SaveToFile('DeutschUmriss.bmp');//wird jetzt überschrieben!
  finally
    Bitmap1.Free;
  end;
end;

Wenn du Canvas deiner Paintbox ausdrucken möchtest, dann müsste es etwa so aussehen: (allerdings nicht getestet)

Delphi-Quellcode:

uses printers;

procedure TForm1.Button2Click(Sender: TObject);
var
   Bitmap1: TBitmap;
begin
  Bitmap1 := TBitmap.Create;
  try//oder du druckst den Bitmap1.Canvas aus(dann Code anpassen)
    Bitmap1.LoadFromFile('DeutschUmriss.bmp');//breite und höhe feststellen
    Printer.BeginDoc;                                                
    Printer.Canvas.CopyRect(Rect(0, 0, Bitmap1.Width, Bitmap1.Height), PaintBox1.Canvas, Rect(0, 0, Bitmap1.Width, Bitmap1.Height));
    Printer.EndDoc;
  finally
    Bitmap1.Free;
  end;
end;

[Hartfrid Krause]

danke, das klappt hervorragend.
Nun doch noch eine Frage:
Wie muss ich dies abändern, um nicht nur die bveränderte bitmap auszudrucken, sondern die gesamte Form54, die noch einige andere listbox' etc enthält??
danke für die Unterstützung
h.k.

[bitsetter]

Delphi-Quellcode:

uses Printers;

Procedure BildAusSchnitt(hWND: HWND; iLeft, iTop, iWidth, iHeight: integer);
var
  c: TCanvas;
begin
  BringWindowToTop(hWND);
  c:= TCanvas.Create;
  c.Handle:= GetWindowDC(hWND);
  try
    printer.begindoc;
    printer.Canvas.CopyRect(Rect(0, 0, iWidth* 10, iHeight* 10), c, Rect(iLeft, iTop, iLeft+ iWidth, iTop+ iHeight));
    printer.enddoc;
  finally
    ReleaseDC(hWND, c.handle);
    c.Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   BildAusSchnitt(Form54.Handle, 0, 0, Form54.Width, Form54.Height);
end;

Wie der Name der Procedur es schon vermuten lässt, kann man wenn die Parameter verändert werden, auch nur ein Bildausschnitt ausdrucken.
Theoretisch kannst du damit auch fremde Fenster ausdrucken, wenn du das Handle des Fensters kennst.

[Hartfrid Krause]

Wunderbar, wie das klappt.
Zu jeder Frage gibt es eine Neue:
auf dem Bildschirm erscheint nunmehr eine Grenzen-Karte
n Deutschlands(als bmp-Datei).
Jetzt möchte ich erreichen, dass die Bundesländernamen angezeigt werden, wenn man mit der Maus über die Fläche fährt.
Wenn es eine Schaltfläche wäre, ginge es ganz gut, aber die Differenzierung innerhalb der Karte macht Schwierigkeiten
Idee??
Danke für die Hilfe

[Namenloser]

Willst du selber was programmieren oder andere was programmieren lassen? :D

Also am einfachsten machst du dir ein zweites bitmap im speicher, auf dem jedes bundesland eine andere farbe hat. dann fragst du ab, welche farbe dieses bitmap an der mausposition hat und gibst den namen aus, der dieser farbe zugeornet ist.

nach dem motto
case speicherbitmap.canvas.pixels[mausposition.x,mausposition.y] of
clred: label1.caption := 'Bayern';
clblue: label1.caption := 'hessen';
cllime: label1.caption := 'Rheinland-Pfalz';
...
end;

zugegeben nicht gerade optimal...

[Hartfrid Krause]

Gute Idee, aber die Flächen der Bundesländer sind bereits farbig, je nach der stärlsten Fraktion der Wahl
Insofern geht es so nicht
gruß

[bitsetter]

Zitat:

Zitat von NamenLozer

Also am einfachsten machst du dir ein zweites bitmap im speicher, auf dem jedes bundesland eine andere farbe hat. dann fragst du ab, welche farbe dieses bitmap an der mausposition hat und gibst den namen aus, der dieser farbe zugeornet ist.

@Hartfrid Krause: NamenLozer meint du könntest dir noch ein 2. Bild erstellen, diesmal aber mit verschiedenfarbigen Bundesländern und dann lädst du das Bild in den Speicher:

Delphi-Quellcode:

  private
    BildBundeslaender: TBitmap;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
   Pfad: AnsiString;
begin
  BildBundeslaender:= TBitmap.Create;
  Pfad:= 'FarbigeBundesländer.bmp';
  if FileExists(Pfad) then
    BildBundeslaender.LoadFromFile(Pfad);
end;

procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  label1.caption:= '';
  if (X <= BildBundeslaender.Width) and (Y <= BildBundeslaender.Height) then
    case BildBundeslaender.canvas.pixels[X, Y] of
      clred: label1.caption := 'Bayern';
      clblue: label1.caption := 'hessen';
      cllime: label1.caption := 'Rheinland-Pfalz';
      //...
    end;
end;

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

Bis auf die Farben, sollten beide Bilder, also stärkste Fraktionen und farbige Bundesländer aber identisch sein.

[Hartfrid Krause]

Das klappt bei mir noch nicht nach beiden Seiten.
Mit dem folgenden Zeilen werden die Bundesländer zwar unterschiedlich gefärbt, speichere ich sie ab, erhalte ich nur einen schwarz-weiße Kopie.
Mit der schwarz-weiß-Kopie komme ich nicht zum Anzeigen der Ländernamen (als Doublette im Speicher).

Delphi-Quellcode:

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

type
  Tform1 = class(TForm)
    PaintBox1: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure fromshow(sender:TObject);
    procedure  paintbox1paint(sender:TObject);
    procedure einfaerben(sender:TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  form1: Tform1;
  var bitmap1:tbitmap;

  implementation

{$R *.dfm}

procedure tform1.fromshow(sender:TObject);
begin
 form1.Width:=7*screen.Width DIV 8;
 form1.Height:=19*screen.Height div 20;
 form1.Left:=(screen.Width-form1.Width) DIV 2;
 form1.Top:=(screen.Height-form1.Height) div 2;
 paintbox1.Height:=645;
 paintbox1.width:=486;
 paintbox1.Left:=(form1.Width-paintbox1.Width) div 2;
 paintbox1.Top:=(form1.Height-paintbox1.Height) div 2;
 paintbox1paint(sender);
end;

procedure tform1. paintbox1paint(sender:TObject);
begin
 Bitmap1 := TBitmap.Create;
 Bitmap1.LoadFromFile('laender.bmp');
 PaintBox1.Canvas.Draw(0,0,Bitmap1);
// Bitmap1.Free;
 einfaerben(sender);
end;

procedure tform1.einfaerben(sender:TObject);
Var  farbe:tcolor;
 x,y:integer;
begin
   with canvas do
   with paintbox1 do
   begin
  brush.color:= clbackground;  //NRW
  farbe:= pixels[X,Y];
  floodfill(paintbox1.Left+120,paintbox1.Top+260,farbe, fsborder);

   brush.color:= clskyblue;  //RHPf
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+80,paintbox1.Top+400,farbe, fsborder);

   brush.color:= clblack;  //Nieders
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+170,paintbox1.Top+150,farbe, fsborder);

   brush.color:= clred;  //Hessen
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+130,paintbox1.Top+390,farbe, fsborder);

    brush.color:= clfuchsia;  //BaWü
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+230,paintbox1.Top+500,farbe, fsborder);

    brush.color:= clmaroon;  //Bayern
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+260,paintbox1.Top+450,farbe, fsborder);

   brush.color:=clgreen;  //Saarland
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+60,paintbox1.Top+460,farbe, fsborder);

   brush.color:= claqua;  //Schl.Holstein
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+200,paintbox1.Top+90,farbe, fsborder);

   brush.color:= clmoneygreen;  //Bremen
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+154,paintbox1.Top+160,farbe, fsborder);
   floodfill(paintbox1.Left+150,paintbox1.Top+124,farbe, fsborder);

   brush.color:= clmedgray;  //Mecklenburg Vorpomm
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+289,paintbox1.Top+150,farbe, fsborder);

   brush.color:= clappworkspace;  //Brandenburg
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+350,paintbox1.Top+200,farbe, fsborder);

    brush.color:= clhotlight;  //SachsenAnhalt
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+370,paintbox1.Top+370,farbe, fsborder);

    brush.color:= clyellow;  //Sachsen
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+270,paintbox1.Top+270,farbe, fsborder);

   brush.color:= clpurple;  //Thüringen
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+250,paintbox1.Top+320,farbe, fsborder);

   brush.color:= clolive;  //Berlin
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+385,paintbox1.Top+200,farbe, fsborder);

    brush.color:= cllime;  //Hamburg
   farbe:= pixels[X,Y];
   floodfill(paintbox1.Left+220,paintbox1.Top+115,farbe, fsborder);
  end;
 end;

procedure Tform1.Button2Click(Sender: TObject);
begin
  Bitmap1.Canvas.CopyRect(Rect(0, 0, Bitmap1.Width, Bitmap1.Height),
  PaintBox1.Canvas, Rect(0, 0, Bitmap1.Width, Bitmap1.Height));
  Bitmap1.SaveToFile('B.bmp');//wird jetzt überschrieben!
  bitmap1.free;
end;

procedure Tform1.Button1Click(Sender: TObject);
begin
  form1.close;
end;

end.

[edit=SirThornberry]Delphi-Tags gesetzt - nächstes mal bitte selbst machen. Mfg, SirThornberry[/edit]

[bitsetter]

Hallo,

hier ist ein Ausschnitt aus deinem Code:

Delphi-Quellcode:

procedure tform1. paintbox1paint(sender:TObject);
begin
Bitmap1 := TBitmap.Create;
Bitmap1.LoadFromFile('laender.bmp');
PaintBox1.Canvas.Draw(0,0,Bitmap1);
// Bitmap1.Free;
einfaerben(sender);
end;

Also jedes mal wenn das Ereignis onPaint der Paintbox ausgelöst wird, lädst du das Bild nach meiner Ansicht immer wieder neu. Also den Code da oben würde ich löschen und dafür folgenden Code hinzufügen:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
Bitmap1 := TBitmap.Create;
Bitmap1.LoadFromFile('laender.bmp');
PaintBox1.Canvas.Draw(0,0,Bitmap1);
einfaerben(sender);
end;

Also einen Button hinzufügen und damit das Bild laden und nicht mit onPaint.

Folgendes ist mir auch noch aufgefallen, wieder Code von dir:

Delphi-Quellcode:

   
procedure tform1.einfaerben(sender:TObject);
Var  farbe:tcolor;
x,y:integer;
begin
   with canvas do
   with paintbox1 do
   begin

Mit with canvas do zeichnest du auf den Canvas deiner Form und nicht auf die Paintbox, aber das kann natürlich von dir auch gewollt sein.

Ob damit das Problem gelöst ist, weis ich allerdings nicht.

[Hartfrid Krause]

Es klappt immer noch nicht;
ich habe den quellcode minimal verändert, rufe paintbox nur direkt auf und erhalte beim Speichern nur einen schwarz weiße Kopie, obwohl die BRD zunächst farbig markiert wurde.
Liegt es an canvas-paintbox??
Hier noch einmal der quellcoe:

Delphi-Quellcode:

var
  form1: Tform1;
  var bitmap1:tbitmap;

  implementation

{$R *.dfm}

procedure tform1.fromshow(sender:TObject);
begin
 form1.Width:=7*screen.Width DIV 8;
 form1.Height:=19*screen.Height div 20;
 form1.Left:=(screen.Width-form1.Width) DIV 2;
 form1.Top:=(screen.Height-form1.Height) div 2;
 paintbox1.Height:=645;
 paintbox1.width:=486;
 paintbox1.Left:=(form1.Width-paintbox1.Width) div 2;
 paintbox1.Top:=(form1.Height-paintbox1.Height) div 2;
 paintbox1paint(sender);
end;

procedure tform1. paintbox1paint(sender:TObject);
begin
 Bitmap1 := TBitmap.Create;
 Bitmap1.LoadFromFile('laender.bmp');
 PaintBox1.Canvas.Draw(0,0,Bitmap1);
// Bitmap1.Free;
 einfaerben(sender);
end;

 procedure tform1.einfaerben(sender:TObject);
begin
   with canvas do
  // with paintbox1 do
   begin
  brush.color:= clbackground;  //NRW
  floodfill(paintbox1.Left+120,paintbox1.Top+260,clblack, fsborder);

   brush.color:= clskyblue;  //RHPf
   floodfill(paintbox1.Left+80,paintbox1.Top+400,clblack, fsborder);

   brush.color:= clblack;  //Nieders
   floodfill(paintbox1.Left+170,paintbox1.Top+150,clblack, fsborder);

   brush.color:= clred;  //Hessen
   floodfill(paintbox1.Left+130,paintbox1.Top+390,clblack, fsborder);

    brush.color:= clfuchsia;  //BaWü
   floodfill(paintbox1.Left+230,paintbox1.Top+500,clblack, fsborder);

    brush.color:= clmaroon;  //Bayern
   floodfill(paintbox1.Left+260,paintbox1.Top+450,clblack, fsborder);

   brush.color:=clgreen;  //Saarland
   floodfill(paintbox1.Left+60,paintbox1.Top+460,clblack, fsborder);

   brush.color:= claqua;  //Schl.Holstein
   floodfill(paintbox1.Left+200,paintbox1.Top+90,clblack, fsborder);

   brush.color:= clmoneygreen;  //Bremen
   floodfill(paintbox1.Left+154,paintbox1.Top+160,clblack, fsborder);
   floodfill(paintbox1.Left+150,paintbox1.Top+124,clblack, fsborder);

  brush.color:= clmedgray;  //Mecklenburg Vorpomm
   floodfill(paintbox1.Left+289,paintbox1.Top+150,clblack, fsborder);

   brush.color:= clappworkspace;  //Brandenburg
   floodfill(paintbox1.Left+350,paintbox1.Top+200,clblack, fsborder);

    brush.color:= clhotlight;  //SachsenAnhalt
   floodfill(paintbox1.Left+370,paintbox1.Top+370,clblack, fsborder);

    brush.color:= clyellow;  //Sachsen
   floodfill(paintbox1.Left+270,paintbox1.Top+270,clblack, fsborder);

   brush.color:= clpurple;  //Thüringen
   floodfill(paintbox1.Left+250,paintbox1.Top+320,clblack, fsborder);

   brush.color:= clolive;  //Berlin
   floodfill(paintbox1.Left+385,paintbox1.Top+200,clblack, fsborder);

    brush.color:= cllime;  //Hamburg
   floodfill(paintbox1.Left+220,paintbox1.Top+115,clblack, fsborder);
  end;
 end;

procedure Tform1.Button2Click(Sender: TObject);
begin
  Bitmap1.Canvas.CopyRect(Rect(0, 0, Bitmap1.Width, Bitmap1.Height),
  PaintBox1.Canvas, Rect(0, 0, Bitmap1.Width, Bitmap1.Height));
  Bitmap1.SaveToFile('B.bmp');//wird jetzt überschrieben!
  bitmap1.free;
end;

procedure Tform1.Button1Click(Sender: TObject);
begin
  form1.close;
end;

end.

[edit=Jelly]Nächstes mal die Code-Tags bitte selbs einfügen Mfg, Jelly[/edit]

[bitsetter]

Hallo,

du hast jetzt praktisch gar nichts geändert denn

Delphi-Quellcode:

 with paintbox1 do

war sowieso umsonst. Dann lieber so:

Delphi-Quellcode:

procedure tform1.einfaerben(sender:TObject);
Var  farbe:tcolor;
x,y:integer;
begin
   with paintbox1.canvas do
   begin

Dein onPaint Ereignis hast du immer noch nicht abgeändert. Jedesmal wenn du floodfill() benutzt, wird 'DeutschUmriss.bmp' nach meiner Meinung immer wieder neu geladen. Daher kann ich nur auf meinen letzten Beitrag verweisen.
dein Code:

Delphi-Quellcode:

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
Bitmap1 := TBitmap.Create;
Bitmap1.LoadFromFile('DeutschUmriss.bmp');
PaintBox1.Canvas.Draw(0,0,Bitmap1);
Bitmap1.Free;
einfaerben(sender);
end;

Ich habe dir eine Demo angehängt, wo der gleiche Code von dir benutzt wird, jedoch anstatt der TPaintbox mit einem TImage. Beim TImage kannst du gleich auf den Canvas deines Bitmaps zeichnen.

[Hartfrid Krause]

an bitsetter
das mit den 2 bitmaps: die eine zum Färben, die andere mit degfinierten Farben zu abfragen ist eine gute Idee.
Doch wie kriege ich die beiden bitmaps so, dass ich abfragen kann.
Mit:
procedure tform54.paintbox2paint(sender:TObject);
begin
Bitmap2 := TBitmap.Create;
Bitmap2.LoadFromFile('laender.bmp');
paintbox2.Canvas.Draw(0,0,Bitmap2);
Bitmap2.Free;
faerben(sender);
end;
frage ich die Eingefärbte ab (durch faerben kommen die definierten Farben auf die Länder).
Mit
Bitmap1 := TBitmap.Create;
Bitmap1.LoadFromFile('DeutschUmriss.bmp');
PaintBox1.Canvas.Draw(0,0,Bitmap1);
Bitmap1.Free;

frage ich die n ach den Fraktionen einzufärbenmden ab.

Mit
paintbox2paint(sender);
label20.Show;
paintbox1paint(sender);
weiter(sender);
lade ich beiden - ich denke hier ist der Fehler
und nuin klappt die Zuordnung zu vordefinierten Farben zu Bundesländernamen nicht mehr

wo istz der fehler

danke und ciau

[bitsetter]

Hallo,

gedacht ist es eigentlich so, dass du die Bundesländer einmalig verschiedenfarbig mit der procedure einfaerben einfärbst und dann das Bild abspeicherst.

Dann kannst du das eingefärbte Bild mit Bitmap1.LoadFromFile laden und im onMouseMove Ivent der Paintbox kannst du dann die Farben des Bildes mit Bitmap1.canvas.pixels[X, Y] auslesen.

Delphi-Quellcode:

//onMouseMove Ivent der Paintbox
procedure TForm1.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin//Zuornung der Farben entsprechen der procedure einfaerben
  label1.caption:= '';
  case PaintBox1.canvas.pixels[X, Y] of//Farbe unter dem Cursor auslesen
  //case PaintBox2.canvas.pixels[X, Y] of
  //case Bitmap1.canvas.pixels[X, Y] of//oder Farbe vom Bitmap auslesen
    clbackground: label1.caption := 'NRW';
    clskyblue: label1.caption := 'RHPf';
    clblack: label1.caption := 'Nieders';
    clred: label1.caption := 'Hessen ';
    clfuchsia: label1.caption := 'BaWü ';
    clmaroon: label1.caption := 'Bayern ';
    clgreen: label1.caption := 'Saarland ';
    claqua: label1.caption := 'Schl.Holstein';
    clmoneygreen: label1.caption := 'Bremen ';
    clmedgray: label1.caption := 'Mecklenburg Vorpomm ';
    clappworkspace: label1.caption := 'Brandenburg';
    clhotlight: label1.caption := 'SachsenAnhalt';
    clyellow: label1.caption := 'Sachsen ';
    clpurple: label1.caption := 'Thüringen ';
    clolive: label1.caption := 'Berlin ';
    cllime: label1.caption := 'Hamburg ';
  end;
end;

[Hartfrid Krause]

Einfärben und Namen abfrtagen klappt;
Es klappt nicht, die Originalfarbige in den Arbeitsspeicher zu schaffen (wie???) und die mit dne Parteifarben einzufärbenden im Vordergrund zu haben.
die mit verschiedenen Farben (nur in den Arbeitsspeicher) zu ladende Datei heisst:

Bitmap2 := TBitmap.Create;
Bitmap2.LoadFromFile('bildbundeslaender.bmp');
paintbox1.Canvas.Draw(0,0,Bitmap2);
sie erhält dann unterschiedliche Farben.

Die Parteien bmp (alle gleiche Position und gleoiche Größe)
wird aufgerufen mit:


Bitmap1 := TBitmap.Create;
Bitmap1.LoadFromFile('laender.bmp');
paintbox2.Canvas.Draw(0,0,Bitmap1);
faerben(sender);

dann klappt das mit dem Mauszeiger drüberfahren nicht mehr

procedure TForm1.paintbox2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
// label1.caption:= '';
if (X <= paintbox2.Width) and (Y <= paintbox2.Height) then
case paintbox2.canvas.pixels[X, Y] of
clcream:label1.Caption:='Nordrhein-Westfalen';
$0005727A:label1.Caption:='Rheinland-Pfalz';
$006F6F11:label1.Caption:='Niedersachsen';
$00C551D9:label1.Caption:='Hessen';
...
end;
end;


Ohne die bitmap1 funktioniert die Darstellung und die Ländernamen.

Außerdem:
ih würde gerne den label1.caption dann jeweils an der Mausspitze haben, um den Ländernamen quasi "auf" dem Land zu haben, wenn ich drüberfahre

Wie das geht, weiss ich nicht
:wall:

wer hilft??

[bitsetter]

Hallo,

Zitat:

Zitat von Hartfrid Krause

Außerdem:
ih würde gerne den label1.caption dann jeweils an der Mausspitze haben, um den Ländernamen quasi "auf" dem Land zu haben, wenn ich drüberfahre

Wie das geht, weiss ich nicht
:wall:

wer hilft??

dazu ist mir was eingefallen, man kann einen Cursor für Paintbox2 erstellen, der den Namen der Bundesländer dann anzeigt.

Delphi-Quellcode:

  
  private
    Bitmap2: TBitmap;//Bild im Speicher
    NewCursor: TIcon;//selbst erstellter Cursor
    CursorText: AnsiString;//Text des Cursors
  public
    { Public declarations }
  end;

//...

procedure TForm1.FormShow(Sender: TObject);
begin     
  NewCursor:= TIcon.Create;//Cursor mit Text
  CursorText:= ' ';

  Bitmap2 := TBitmap.Create;
  Bitmap2.LoadFromFile('bildbundeslaender.bmp');//Bild mit schon eingefärbten Bundesländern
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  NewCursor.Free;
  Bitmap2.Free;
end;

//einen Cursor mit Text erstellen und zuweisen
procedure SetTextCursor(Text: AnsiString; var NewCursor: TIcon; Contr: TControl);
var
  ImageList: TImageList;
  BildTemp: TBitmap;
const
  FadenKreuzWidth = 10;
begin
  BildTemp := TBitmap.Create;
  try
    if Win32Platform = VER_PLATFORM_WIN32_NT then
    begin
      BildTemp.Width := BildTemp.Canvas.TextWidth(Text);
      if BildTemp.width < FadenKreuzWidth then
        BildTemp.width := FadenKreuzWidth+ 1;
      BildTemp.Height := 38;
    end;
    if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
    begin
      BildTemp.width := 32;
      BildTemp.Height := 32;
    end;
    BildTemp.Canvas.Brush.Color:= clWhite- 10;
    if Assigned(NewCursor) then
      NewCursor.Free;
    NewCursor:= TIcon.Create;
    NewCursor.Width := BildTemp.Width;
    NewCursor.Height := BildTemp.Height;
    ImageList:= TImageList.CreateSize(BildTemp.width, BildTemp.height);
    try
      if Text <> '' then
        BildTemp.Canvas.TextOut(0, 0, Text);
      BildTemp.Canvas.MoveTo(BildTemp.Width div 2- FadenKreuzWidth div 2, 19);
      BildTemp.Canvas.LineTo(BildTemp.Width div 2+ (FadenKreuzWidth div 2)+ 1, 19);
      BildTemp.Canvas.MoveTo(BildTemp.Width div 2, 14);
      BildTemp.Canvas.LineTo(BildTemp.Width div 2, 25);

      ImageList.AddMasked(BildTemp, clWhite);
      ImageList.GetIcon(0, NewCursor);

      Screen.Cursors[0] := NewCursor.Handle;
      Contr.Cursor := 1;
    finally
      ImageList.Free;
    end;
  finally
    BildTemp.Free;
  end;  
end;

procedure TForm1.paintbox2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer); 
var
  NewText: AnsiString;
begin
  NewText := '';
  if (X <= Bitmap2.Width) and (Y <= Bitmap2.Height) then
    case Bitmap2.canvas.pixels[X, Y] of//Pixel vom Bild im Speicher auslesen
     clcream:label1.Caption:='Nordrhein-Westfalen';
     $0005727A:label1.Caption:='Rheinland-Pfalz';
     $006F6F11:label1.Caption:='Niedersachsen';
     $00C551D9:label1.Caption:='Hessen';
     ... 
    end;

  if NewText <> CursorText then
  begin
    CursorText := NewText;               //Control mit geändertem Cursor
    SetTextCursor(CursorText, NewCursor, PaintBox2);//einen Cursor mit Text erstellen
  end;
    end;
end;

[Hartfrid Krause]

Klasse, es klappt
Dank an bitsetter

[bitsetter]

Hallo,

schön dass es jetzt endlich klappt :)

Funktioniert das mit dem Cursor auch, denn ich habe noch einen kleinen Fehler entdeckt:

Delphi-Quellcode:

procedure TForm1.paintbox2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
  NewText: AnsiString;
begin
  NewText := '';
  if (X <= Bitmap2.Width) and (Y <= Bitmap2.Height) then
    case Bitmap2.canvas.pixels[X, Y] of
     //anstatt label1.Caption muss hier natürlich immer "NewText:=" stehen
     clcream:NewText:='Nordrhein-Westfalen';
     $0005727A:NewText:='Rheinland-Pfalz';
     $006F6F11:NewText:='Niedersachsen';
     $00C551D9:NewText:='Hessen';
     ...
    end;

  if NewText <> CursorText then
  begin
    CursorText := NewText;               //Control mit geändertem Cursor
    SetTextCursor(CursorText, NewCursor, PaintBox2);//einen Cursor mit Text erstellen
  end;
    end;
end;