Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Problem mit Label (https://www.delphipraxis.net/35016-problem-mit-label.html)

stoermi 1. Dez 2004 15:05


Problem mit Label
 
Hallo!

Ich erstelle mit folgendem Quell-Code ein Label:

Code:
   
  newLabel := TLabel.Create(nil);
  with newLabel as TLabel do
  begin
    Parent := HotelForm.TabSheet2;
    Name := 'Label_'+zimmerNummer;
    Caption := zimmerNummer;
    Left := round((x1+x3)/2)+hRand-round(Width/2);
    Top := round((y1+y3)/2)+hRand-round(Height/2);
    Alignment := taCenter;
    Layout := tlCenter;
    Transparent := True;
    Visible := True;
  end;
Problem ist, dass das Label nicht einfach nur angezeigt wird, sondern, so wie es scheint immer wieder neu erstellt wird. Die Prozessor-Auslastung steigt auf 100% und der benötigt Speicher steigt laut TaskManager auch immer weiter an.

Ich habe jedoch keinerlei Schleife laufen.

Die Prozedur wird einmalig aufgerufen.
Woran könnte das liegen?

Vielleicht kann mir ja jemand helfen!

Mario 1. Dez 2004 15:06

Re: Problem mit Label
 
An dem Codeschnipsel liegt es nicht. Schon mal mit dem Debugger den Aufrufstack überprüft?

stoermi 1. Dez 2004 15:25

Re: Problem mit Label
 
Nein hab ich noch nicht.

Aber wie ist das:

Die Prozedur hat noch mehr Code. Bevor das label erstellt wird, wird in eine PaintBox im selben Formular ein Polygon eingezeichent. Dieses wird jedoch nicht immer wieder neu gezeichnet?
Deshalb nehme ich an, dass die Prozedur auch nicht immer wieder neu geladen wird. Oder flällt das bei einem Polygone einfach nicht auf.

Ich werde jetzt mal ver suchen, es über den Debugger rauszubekommen.

Matze 1. Dez 2004 15:29

Re: Problem mit Label
 
:hi: Herzlich willkommen in der DP! :party:

Rufst du den Code (ungewollt) in einer Schleife auf, sodass er mehrmals ausgeführt wird?

ibp 1. Dez 2004 15:36

Re: Problem mit Label
 
wenn die zimmernummer immer gleich bleibt, dann würde es beim 2. label eine fehlermeldung geben, da es ja schon ein label mit diesem namen gibt!!!

stoermi 1. Dez 2004 15:43

Re: Problem mit Label
 
Die Zimmernummer ist eigentlich immer die selbe. Das wundert mich ja gerade. Eine Fehlermeldung kommt nicht.

Wenn er das Label aber nicht immer neu erstellt, warum läuft der Prozessor dann so hoch? Nehm ich oben genannten Code raus, passiert das nicht!
Und warum zittert das Label dann? So ne Art blinken.

Liegt es vielleicht daran, das das Label oben auf einer PaintBox drauf liegt?
Also das HotelForm besteht aus zwei TabSheets. Im einen Tabsheet wird eine PaintBox gezeichnet und darauf ein Polygon gezeichnet. Und hier oben drauf soll das Label dargestellt werden.

Könnte es daran liegen?

Neutral General 1. Dez 2004 15:45

Re: Problem mit Label
 
Ist die procedure vielleicht in einem Timer ?
Dann wäre es ja kein Wunder :roll:

stoermi 1. Dez 2004 15:47

Re: Problem mit Label
 
Alos ich habe keinen Timer deklariert.

ibp 1. Dez 2004 15:49

Re: Problem mit Label
 
wie wäre es mal mit ein wenig mehr code?

Sharky 1. Dez 2004 15:51

Re: Problem mit Label
 
Zitat:

Zitat von stoermi
Alos ich habe keinen Timer deklariert.

Ohne etwas mehr Quellcode (wo kommt z.B. zimmerNummer her?) kann man da nicht viel sagen.

stoermi 1. Dez 2004 15:58

Re: Problem mit Label
 
Es geht um ein Hotelverwaltungsprogramm für die Uni. Bin aber naoch am Anfang...

Hier die Formular-Klasse in der 2 Beispielzimmer erstellt werden:

Code:
unit main;

interface

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

type
  THotelForm = class(TForm)
    MainMenu1: TMainMenu;
    PageControl1: TPageControl;
    Programm1: TMenuItem;
    Anicht1: TMenuItem;
    Beenden1: TMenuItem;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    PaintBox1: TPaintBox;
    procedure HotelFormCreate (Sender : TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  HotelForm: THotelForm;

implementation

{$R *.dfm}

uses zimmer, einzelzimmer, doppelzimmer, appartment, suite;

procedure THotelForm.HotelFormCreate(Sender: TObject);
var xy, yz : array[0..8] of ShortString;
    vRand, hRand : Integer;
    myZimmer, myZimmer2 : TZimmer;
begin
  {Plan-Fläche zeichnen - Hindergrund: Weiß}
  PaintBox1.Canvas.Brush.Color := clWhite;
  PaintBox1.Canvas.Rectangle(3,3,PaintBox1.Width-6,PaintBox1.Height-6);

  xy[0] := '101';
  xy[1] := '100';
  xy[2] := '100';
  xy[3] := '200';
  xy[4] := '100';
  xy[5] := '200';
  xy[6] := '200';
  xy[7] := '100';
  xy[8] := '200';

  yz[0] := '102';
  yz[1] := '300';
  yz[2] := '100';
  yz[3] := '400';
  yz[4] := '100';
  yz[5] := '400';
  yz[6] := '200';
  yz[7] := '300';
  yz[8] := '200';

  vRand := 30;
  hRand := 30;

  myZimmer := TSuite.Create(xy);
  myZimmer.einzeichnen(hRand, vRand);

  myZimmer2 := TDoppelzimmer.Create(yz);
  myZimmer2.einzeichnen(hRand, vRand);

end;

end.

Hier die Klasse Zimmer

Code:
unit zimmer;

interface

uses Classes, Graphics, SysUtils, StdCtrls, Types;

type
  TZimmer = class (TComponent)
  private
  protected
    x1,y1,x2,y2,x3,y3,x4,y4 : Integer;         //Positionspunkte des Zimmers
    grundpreis : Currency;                     //Zimmergrundpreis
    bettPreis : Currency;                      //Preis pro Bett;
  public
    zimmerNummer : ShortString;
    constructor Create (werte : array of ShortString); virtual;  //Konstrucktor
    function betten : Integer; virtual;                             //Bettenanzahl
    function preis : Currency; virtual;                             //Zimmerpreis
    function hindergrund : TColor; virtual;                        //Hindergundfarbe für Plan
    procedure einzeichnen (hRand, vRand : Integer); virtual;
  published
  end;

implementation

uses main;

constructor TZimmer.Create(werte : array of ShortString);
begin
  inherited create(NIL);
  zimmerNummer := werte[0];    //Zimmernummer
  x1 := StrToInt (werte[1]);   //Punkte aus Array auslesen
  y1 := StrToInt (werte[2]);
  x2 := StrToInt (werte[3]);
  y2 := StrToInt (werte[4]);
  x3 := StrToInt (werte[5]);
  y3 := StrToInt (werte[6]);
  x4 := StrToInt (werte[7]);
  y4 := StrToInt (werte[8]);
  grundpreis := 50.0;          //Zimmergrundpreis
  bettPreis := 25.0;           //Bettpreis
end;

function TZimmer.betten : Integer;
begin
  result := 1;
end;

function TZimmer.preis : Currency;
begin
  result := grundpreis + (betten * bettPreis);
end;

function TZimmer.hindergrund : TColor;
begin
  result := $FFFFFF;
end;

procedure TZimmer.einzeichnen (hRand, vRand : Integer);
var zimmerEcken : array[1..4] of TPoint;
    i : Integer;
    ok : boolean;
    newLabel : TLabel;
begin
  zimmerEcken[1] := point(x1 + hRand, y1 + vRand);
  zimmerEcken[2] := point(x2 + hRand, y2 + vRand);
  zimmerEcken[3] := point(x3 + hRand, y3 + vRand);
  zimmerEcken[4] := point(x4 + hRand, y4 + vRand);

  HotelForm.PaintBox1.Canvas.Brush.Color := hindergrund;
  HotelForm.PaintBox1.Canvas.Polygon(zimmerEcken);


  newLabel := TLabel.Create(nil);
  with newLabel as TLabel do
  begin
    Parent := HotelForm.TabSheet2;
    Name := 'Label_'+zimmerNummer;
    Caption := zimmerNummer;
    Left := round((x1+x3)/2)+hRand-round(Width/2);
    Top := round((y1+y3)/2)+hRand-round(Height/2);
    Alignment := taCenter;
    Layout := tlCenter;
    Transparent := True;
    Visible := True;
  end;

end;

end.

shmia 1. Dez 2004 16:27

Re: Problem mit Label
 
1.) Paintbox und TLabel passen nicht zusammen
du musst direkt auf dem Canvas deinen Text ausgeben:
Canvas.TextOut(hRand, vrand, zimmerNummer);
2.) deine Klasse TZimmer braucht die Eigenschaft Canvas, damit es von aussen mitgeteilt bekommt,
worauf es sich selbst zeichnen soll.
Es darf kein Zugriff von TZimmer auf Hotelform stattfinden!
Stichwort: Obejktorientiertes Programmieren, Kapselung

stoermi 1. Dez 2004 16:55

Re: Problem mit Label
 
Zitat:

Zitat von shmia
1.) Paintbox und TLabel passen nicht zusammen
du musst direkt auf dem Canvas deinen Text ausgeben:
Canvas.TextOut(hRand, vrand, zimmerNummer);

Okay, ist ne Möglichkeit. Aber TLabel wird ja nicht direkt in die PaintBax gezeichnet, sondern auf das Formular, wo auch eine PaintBox vorhanden ist. Die Überschneiden sich dann nur. Das sollte ja gehen, oder?
Zitat:

Zitat von shmia
2.) deine Klasse TZimmer braucht die Eigenschaft Canvas, damit es von aussen mitgeteilt bekommt, worauf es sich selbst zeichnen soll.

Damit kann ich im moment nichts anfangen. Heißt das, die Klasse Zimmer soll ein Canvas-Objekt bekommen, oder wie? Und wie bekomme ich das dann auf das Formular?
Zitat:

Zitat von shmia
Es darf kein Zugriff von TZimmer auf Hotelform stattfinden!
Stichwort: Obejktorientiertes Programmieren, Kapselung

Ja, dass dachte ich mir schon. Aber da es trotzdem funktioniert hat, habe ich es verwendet. Stellt sich wieder das Problem, wie bekomme ich aus der Klasse Zimmer etwas ins Formular gezeichnet?

Luckie 1. Dez 2004 17:34

Re: Problem mit Label
 
Folgendermaßen: TZimmer bekommt ein Bitmap. Auf dieses wird gezeichnet. Dann bekommt TZimmer eine Eigenschaft, die das Bitmap zurückgibt. Dann wird das Bitmap eben bei Bedarf immer (OnPaint, OnCreate) auf die Paintbox kopiert. So mit verschwindet das gezeichnete auch nicht mehr, wenn die Paintbox überdeckt wurde.

Andere Möglichkeit:
Delphi-Quellcode:
type
  TDummy = class
  private
    FCanvas: TCanvas
  public
    constructor create(Canvas: TCanvas);
  end;
Aufruf:
Delphi-Quellcode:
  Dummy.Create(Paintbox1.Canvas);
Zweiter Möglichkeit ist aber nicht so schön.

stoermi 2. Dez 2004 10:48

Re: Problem mit Label
 
Hallo Lucki!

Ich habe mir jetzt deine erste Möglichkeit mal genauer angeschaut, raus gekommen ist folgendes:

Code:
unit zimmer;

...

type
  TZimmer = class (TComponent)
  private
  protected
    zimmerEcken : array[1..4] of TPoint;
    ...
    function getPlanBild : TBitmap;
  public
    constructor Create (werte : array of ShortString); virtual;  //Konstrucktor
    ...
    property planBild : TBitmap Read getPlanBild;
  published
  end;

implementation

...

function TZimmer.getPlanBild : TBitmap;
var planZimmer : TBitmap;
begin
  planZimmer := TBitmap.Create;
  planZimmer.Width := 784;
  planZimmer.Height := 518;
  planZimmer.Canvas.Brush.Color := clWhite;
  planZimmer.Canvas.Rectangle(0,0,784,518);
  planZimmer.Canvas.Brush.Color := hindergrund;
  planZimmer.Canvas.Polygon(zimmerEcken);
  result := planZimmer;
end;

end.
und der Aufrauf in der Formular Unit:

Code:
PaintBox1.Canvas.BrushCopy(rect, myZimmer.planBild, rect, clWhite);
Leider wird jedoch nichts angezeigt.
Liege ich denn mit meinem Versuch ganz falsch?

Tschau

stoermi 2. Dez 2004 11:08

Re: Problem mit Label
 
Hab grad noch mal etwas rumprobiert - und jetzt funktioniert es doch...

Aber, das Problem liegt jetzt darin, dass ich ja auf meinem HotelPlan nicht nur ein Zimmer zeichnen möchte, sondern alle Zimmer des Hotels.
Das heißt, ich müßte ja verschiedene Bitmaps aus den vorhandenen ZimmerObjekten in die PaintBox kopieren.
Kann man es realisieren, dass mir aus dem Bitmap nur das Polygon für das Zimmer gezeigt wird?
Es gibt doch die Eigenschaft Transparent. Jedoch hab ich schon verschiedenes versucht und nie hat es geklappt. Die Bitmaps werden immer überlagert, so dass nur das letzte angezeigt wird.

Danke für eure gute Hilfe bisher und hoffentlich auch im weiteren...

Tschau

stoermi 2. Dez 2004 11:54

Re: Problem mit Label
 
Okay, hab es jetzt hin bekommen!
Hab immer versucht mit brush.color rumzudoktern und nicht an brush.stylegedacht.
Jetzt funktioniert es, wie gewollt.

Trotzdem danke noch mal!


Alle Zeitangaben in WEZ +1. Es ist jetzt 09:29 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