![]() |
Transparentes Control flimmert
Liste der Anhänge anzeigen (Anzahl: 1)
Warum flimmert folgende Komponente?
Es wird ein Lauftext dargestellt wobei beim ersten zeichnen der Hintergrundgespeichert wird. Und dann bei jedem zeichnen wieder raufkopiert wird. Ich rufe nicht repaint oder invalidate auf also hat da auch nichts mit de Hintergund löschen Message zu tun. Doublepuffer hilft ebenfalls nicht. mfg Code der Klasse:
Delphi-Quellcode:
unit U_Lauftext;
interface uses Windows, Messages, Classes, Graphics, Controls, ExtCtrls, SysUtils, forms; type TLauftext = class(TGraphicControl) private Fbild: TBitmap; FTextleft: integer; FTimer: TTimer; FParentHintergrund: TBitmap; FNureinmal: boolean; procedure OnTimer(Sender: TObject); public procedure Paint; override; constructor Create(NewParent: TWincontrol; newleft,newtop,breite,hoehe: integer); reintroduce; virtual; destructor Destroy; override; end; implementation constructor TLauftext.Create(NewParent: TWincontrol; newleft,newtop,breite,hoehe: integer); begin inherited Create(NewParent); parent := NewParent; width := breite; height := hoehe; left := newleft; top := newtop; FBild := TBitmap.create; FBild.Width := Width; FBild.Height := Height; FParentHintergrund := TBitmap.create; FParentHintergrund.Width := width; FParentHintergrund.Height := height; FNureinmal := false; FTimer := TTimer.create(self); FTimer.Interval := 55; FTimer.OnTimer := OnTimer; FTimer.Enabled := true; end; destructor TLauftext.destroy; begin Fbild.Free; FParentHintergrund.Free; FTimer.free; inherited; end; procedure TLauftext.OnTimer(Sender: TObject); begin IF FTextleft > fbild.Canvas.TextWidth('test dsgfsgfksdgfsdfgsdfksfgdksdfgksdfg test!!!!!') then begin FTextleft := -width; end; FTextleft:= FTextleft+1; paint; end; procedure TLauftext.paint; var zspeicher: string; begin inherited; IF not FNureinmal then BitBlt(FParentHintergrund.canvas.handle, 0, 0, Width, height, canvas.handle, 0, 0, srccopy); FNureinmal := true; //Hintergrund kopieren BitBlt(fbild.canvas.handle, 0, 0, Width, height, FParentHintergrund.canvas.handle, 0, 0, srccopy); fbild.Canvas.Brush.Style := bsclear; fbild.Canvas.font.color := clred; zspeicher := 'test dsgfsgfksdgfsdfgsdfksfgdksdfgksdfg test!!!!!'; fbild.Canvas.TextOut(0-FTextleft,1,zspeicher); BitBlt(canvas.handle, 0, 0, Width, height, fbild.canvas.handle, 0, 0, srccopy); end; end. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 10:02 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