Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Programmieren allgemein (https://www.delphipraxis.net/40-programmieren-allgemein/)
-   -   BitBtl nach Auslagerung in eine Klasse nicht mehr lauffähig (https://www.delphipraxis.net/129894-bitbtl-nach-auslagerung-eine-klasse-nicht-mehr-lauffaehig.html)

BAMatze 27. Feb 2009 12:33


BitBtl nach Auslagerung in eine Klasse nicht mehr lauffähig
 
Hallo wieder mal,

hab wieder ein kleines Problem. Habe eine sich bewegendes Bild in meiner HauptUnit. Dieses hab ich jetzt der übersichthalber und besseren Handhabung in eine extra Klasse ausgelagert. Allerdings wird dieses jetzt nicht mehr angezeigt. Könnt ihr mal schauen, ob ihr einen Fehler seht?
Weiterhin habe ich eine Frage zu dem Event. Ich nutze einen Timer in meiner Klasse, der das Bild zeichnet (alle 50ms) und mit dem Event sage ich dem Hauptprogramm, dass es fertig ist und dargestellt werden soll. Gibt es eine Möglichkeit, diesen Timer zu umgehen, also dass trotzdem eine periodisch Zeichnung statt findet, aber ohne Timer?

Hier die ausgelagerte Klasse:
Delphi-Quellcode:
Type TBild_fertig_gezeichnet = procedure of Object;

Type TLadebalken = class
  Bild_fertig_gezeichnet: TBild_fertig_gezeichnet;
  private
    iLaenge, iHoehe, iPos: integer;
    privbmp: TBitmap;
    CHintergrundFarbe, CBalkenFarbe: TColor;
    Bewegungstimer: TTimer;
    procedure Bild_loeschen;
    procedure Bild_neu_zeichnen;
    procedure Bild_senden;
    procedure Bewegungssim(Sender: TObject);
  public
    constructor create;
    destructor Destroy;
    property HintergrundFarbe: TColor read CHintergrundFarbe write CHintergrundFarbe;
    property Balkenfarbe: TColor read CBalkenFarbe write CBalkenFarbe;
    property Bild_zeichnen: TBild_fertig_gezeichnet read Bild_fertig_gezeichnet write Bild_fertig_gezeichnet;
    property BMP: TBitmap read privbmp write privbmp;
    property Laenge: integer read iLaenge write iLaenge;
    property Hoehe: integer read iHoehe write iHoehe;
end;

implementation

{////////////////////////////////////////////////////////////////////////////////////}
{/                              Ladebalken-Funktionen                              /}
{////////////////////////////////////////////////////////////////////////////////////}

constructor TLadebalken.create;
begin
  inherited create;
  privbmp := TBitmap.Create;
  privbmp.Height := iHoehe;
  privbmp.Width := iLaenge;
  Bewegungstimer := TTimer.Create(nil);
  Bewegungstimer.Interval := 50;
  Bewegungstimer.OnTimer := Bewegungssim;
  CHintergrundFarbe := RGB(250,250,220);
  CBalkenFarbe := RGB(0,0,255);
  iPos := -30;
end;

procedure TLadebalken.Bild_loeschen;
var i: integer;
begin
  for i := 0 to iHoehe do
    begin
      privbmp.Canvas.Pen.Color := CHintergrundFarbe;
      privbmp.Canvas.MoveTo(0,i);
      privbmp.Canvas.LineTo(iLaenge,i);
    end;
end;

procedure TLadebalken.Bild_neu_zeichnen;
var i: integer;
begin
  for i := 0 to iHoehe do
    begin
      privbmp.Canvas.Pen.Color := CBalkenFarbe;
      privbmp.Canvas.MoveTo(iPos,i);
      privbmp.Canvas.LineTo(iPos+30,i);
    end;
  Bild_senden;
end;

procedure TLadebalken.Bild_senden;
begin
  if assigned(Bild_fertig_gezeichnet) then Bild_fertig_gezeichnet;
end;

procedure TLadebalken.Bewegungssim;
begin
  Bild_loeschen;
  Bild_neu_zeichnen;
  iPos := iPos + 1;
  if iPos >= iLaenge then iPos := -30;
end;

destructor TLadebalken.Destroy;
begin
  privbmp.Free;
  Bewegungstimer.Free;
end;

end.
Hier die wichtigen Aufrufe in meiner HauptUnit:
Delphi-Quellcode:
type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    PB_Ladestatus: TPaintBox;
    GroupBox1: TGroupBox;
    Label2: TLabel;
    Label1: TLabel;
    procedure Fehlerweiterleitung(const iFehlercode: integer);
    procedure Bild_empfangen;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PB_LadestatusPaint(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  Ladebalken: TLadebalken;
  Unterthread: THUnterthread;
  Fehler: TFehler;
  Protokoll: TProtokoll;

implementation

procedure TForm1.FormCreate(Sender: TObject);
begin
  Ladebalken := TLadebalken.create;
  Ladebalken.Bild_fertig_gezeichnet := Bild_empfangen;
  Ladebalken.Hoehe := PB_Ladestatus.Height;
  Ladebalken.Laenge := PB_Ladestatus.Width;
  Fehler := TFehler.Create;
  Protokoll := TProtokoll.create;
  GroupBox1.DoubleBuffered := true;
  Unterthread_erzeugen;
end;

procedure TForm1.PB_LadestatusPaint(Sender: TObject);
begin
  BitBlt(PB_Ladestatus.Canvas.Handle, 0, 0, PB_Ladestatus.width, PB_Ladestatus.Height,
  Ladebalken.BMP.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TForm1.Bild_empfangen;
begin
  PB_Ladestatus.Repaint; // <-- diese Funktion wird wie gewollt ausgeführt, aber es erfolgt keine Darstellung in der PaintBox "PB_Ladestatus"
end;

end.

nuclearping 27. Feb 2009 12:45

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
Gib privbmp beim Erstellen mal ein Pixelformat.

BAMatze 27. Feb 2009 12:49

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
Zitat:

Zitat von nuclearping
Gib privbmp beim Erstellen mal ein Pixelformat.

Hab
Delphi-Quellcode:
privbmp.PixelFormat := pf32Bit;
ergänzt aber keine Änderung

nuclearping 27. Feb 2009 12:51

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
Und statt Ladebalken.BMP.Canvas.Handle Ladebalken.BMP.Handle?

BAMatze 27. Feb 2009 12:56

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
Zitat:

Zitat von nuclearping
Und statt Ladebalken.BMP.Canvas.Handle Ladebalken.BMP.Handle?

Leider auch nicht

BAMatze 27. Feb 2009 13:31

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
Hmm ok hab jetzt einiges mal selber versucht, hab vor allem mal das privbmp als public deklariert, aber auch dies führte nicht wirklich zum Erfolg. Anscheinend steckt der Fehler entweder in meinem Zeichen oder in der BitBtl-Anweisung.

BAMatze 27. Feb 2009 13:40

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
Kann es eventuell sein, dass es ein Kompatibilitätsproblem hier gibt? wenn ich ein Bild direkt wieder von der Form erstelle, funktioniert alles einwandfrei. Oder muss das Zeichnen in der Unit des Bildes geschehen?

Fussball-Robby 27. Feb 2009 13:54

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
Delphi-Quellcode:
  privbmp.Height := iHoehe;
  privbmp.Width := iLaenge;
Werden iHoehe und iLaenge irgendwo gesetzt? Ich konnte keine Zuweisung entdecken. Eventuell klappt BitBlt, aber das Bitmap ist 0x0 Pixel groß.

Gruß

Edit: Mist.. Werden ja im Form Create gesetzt, habe ich übersehen... Aber du könntest ja mal debuggen, vielleicht liegt es nicht an BitBlt sondern an einer falschen Zuweisung etc..

Edit2: Aber Moment mal! Die Größe der Bitmap wird im Create der Klasse geändert, zu diesem Zeitpunkt sind iHoehe und iLaenge noch nicht gesetzt! iHoehe und iLaenge werden später zwar verändert, die Größe der Bitmap damit aber nicht. Es wäre wohl sinnvoll, einen Setter für iHoehe und iLaenge zu schreiben, in welchem dann die Größe der Bitmap geändert wird.

Muetze1 27. Feb 2009 13:56

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
...und gib endlich (nach den x Beiträgen hier) das override; beim Destruktor an.

Zitat:

Zitat von Fussball-Robby
Edit: Mist.. Werden ja im Form Create gesetzt, habe ich übersehen... Aber du könntest ja mal debuggen, vielleicht liegt es nicht an BitBlt sondern an einer falschen Zuweisung etc..

Und wo kann bitte was den Membern/Properties zuweisen, wenn diese im Konstruktor gesetzt werden? Vor diesem hast du keine Instanz, danach wurde es schon verwendet...

BAMatze 27. Feb 2009 14:06

Re: BitBtl nach Auslagerung in eine Klasse nicht mehr lauffä
 
@Muetze1 und Fussball-Robby hattet recht, da gab es ein Problem beim setzen der Bildhöhe und Bildbreite. Danke euch für die Hilfe. Problem ist behoben.


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