Einzelnen Beitrag anzeigen

BAMatze

Registriert seit: 18. Aug 2008
Ort: Berlin
759 Beiträge
 
Turbo Delphi für Win32
 
#1

BitBtl nach Auslagerung in eine Klasse nicht mehr lauffähig

  Alt 27. Feb 2009, 13:33
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.
  Mit Zitat antworten Zitat