![]() |
Flimmer-Problem Bitte schnell helfen muss montag fertig sein
Liste der Anhänge anzeigen (Anzahl: 1)
Hi, Leute
Ich hab ein schlimmes Flimmer-Problem, ich beschreibs euch mal kurz: Auf Form1 läuft im MediaPlayer ein Video, Display und DisplayRect ist Panel1. Dann wird auf Tastendruck ein Inhaltsverzeichnis eingeblendet. Als erstes wird per AlphaBlend Form2, welches komplett schwarz ist, halbtransparent über Form1 eingeblendet, somit herrscht dann ein Verdunklungseffekt. Dann wird Form3 mit dem PNG-Bild des Inhaltsverzeichnis per AlphaBlend über Form 2 geblendet. Das Problem ist: Form 2 und 3 Flimmern ohne Ende, die Verdunklung ist somit nicht sichtbar und Form3 flackert ständig. Bis gestern hat noch alles wunderbar geklappt, jetzt funktioniert's auf einmal nicht mehr. Meine Frage: Wie krieg ich dieses Flimmern weg? Habs schon mit DoubleBuffered probiert, funktioniert aber nicht. Das Ganze muss ich aber bis zu meinem Referat am Montag fertigstellen, bitte helft mir schnell. Ich schick euch hier mal meinen Code (sorry sehr unordentlich und noch einges an Müll drin^^) und die Dazugehörige .exe sowie .dpr, die Videos hab ich aus Zeit-und-Dateigröße-Gründen weggelassen (sie sind nicht so wichtig, einfach 4 beliebige .avi-Dateien ins Unterverzeichnis Videos, nummeriert von 01 bis 04): Unit 1:
Delphi-Quellcode:
Unit2:
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, pngimage, GR32_PNG, GR32, GR32_Image, ExtCtrls, StdCtrls, MPlayer, Unit2, Unit3; const Bpp = Graphics.pf32bit; type TForm1 = class(TForm) MediaPlayer1: TMediaPlayer; MediaPlayer2: TMediaPlayer; Panel1: TPanel; Timer1: TTimer; Timer2: TTimer; MediaPlayer3: TMediaPlayer; MediaPlayer4: TMediaPlayer; procedure FormCreate(Sender: TObject); procedure MediaPlayer1Notify(Sender: TObject); procedure MediaPlayer2Notify(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure Timer2Timer(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end; var Form1: TForm1; Overlay: TBitmap32; Situation: Integer; Alpha: Boolean; OutlinePNG: String; implementation {$R *.dfm} function ChangeRes(X, Y: Integer; Frequency: Byte; FullScreen: Boolean): Boolean; var DevMode: TDeviceMode; begin // Initialisieren EnumDisplaySettings(nil, 0, DevMode); DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_DISPLAYFREQUENCY; DevMode.dmDisplayFrequency := Frequency; DevMode.dmPelsWidth := X; DevMode.dmPelsHeight := Y; // Auflösung ändern if FullScreen then Result := ChangeDisplaySettings(DevMode, CDS_FULLSCREEN) = DISP_CHANGE_SUCCESSFUL else Result := ChangeDisplaySettings(DevMode, 0) = DISP_CHANGE_SUCCESSFUL; end; procedure TForm1.FormCreate(Sender: TObject); begin Form1.DoubleBuffered := true; MediaPlayer1.DoubleBuffered:=true; MediaPlayer2.DoubleBuffered:=true; MediaPlayer3.DoubleBuffered:=true; MediaPlayer4.DoubleBuffered:=true; Panel1.DoubleBuffered:=true; If not ChangeRes(800, 600, 0, True) then begin MessageBox(0, 'Das Ändern der Auflösung ist fehlgeschlagen.', 'Fehler:', MB_OK or MB_ICONERROR); Exit; end; Form1.WindowState := wsMaximized; MediaPlayer1.FileName:='Videos\01.avi'; MediaPlayer1.open; MediaPlayer1.Display:=Panel1; MediaPlayer1.DisplayRect:=Panel1.ClientRect; MediaPlayer2.FileName:='Videos\02.avi'; MediaPlayer2.open; MediaPlayer2.Display:=Panel1; MediaPlayer2.DisplayRect:=Panel1.ClientRect; MediaPlayer1.Play; Situation:=1; end; procedure TForm1.MediaPlayer1Notify(Sender: TObject); begin if MediaPlayer1.Position = MediaPlayer1.Length then begin MediaPlayer2.Play; end; end; procedure TForm1.MediaPlayer2Notify(Sender: TObject); begin if MediaPlayer2.Position = MediaPlayer2.Length then begin MediaPlayer2.Play; end; end; procedure TForm1.Timer1Timer(Sender: TObject); var i:Integer; LPNG: TPNGObject; begin for i:=0 to 100 do begin Form2.AlphaBlendValue:=i; if i=100 then begin Timer1.Enabled:=false; OutlinePNG:=GetCurrentDir() + '\outline.png'; //GR32_PNG.LoadBitmap32FromPNG(Form3.Image321.Bitmap, OutlinePNG, Alpha); //GR32_PNG.LoadPNGintoBitmap32(Form3.Image321.Bitmap, OutlinePNG, Alpha); //Form3.Image321.Bitmap.DrawMode:=dmBlend; LPNG := TPNGObject.Create; try LPNG.LoadFromFile('outline.png'); Form3.Image1.Picture.Graphic:=LPNG; finally LPNG.Free; end; Form3.AlphaBlend := true; Form3.AlphaBlendValue := 0; Form3.Show; Timer2.Enabled:=true; end; end; end; procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char); begin if Situation=1 then begin Form2.AlphaBlend := true; Form3.AlphaBlend := true; Form2.AlphaBlendValue := 0; Form2.Show; Timer1.Enabled := true; end; if Situation=2 then begin MediaPlayer3.Stop; MediaPlayer3.Rewind; MediaPlayer4.FileName:='Videos\04.avi'; MediaPlayer4.open; MediaPlayer4.Display:=Panel1; MediaPlayer4.DisplayRect:=Panel1.ClientRect; MediaPlayer4.Play; end; end; procedure TForm1.Timer2Timer(Sender: TObject); var i: Integer; begin for i:=0 to 255 do begin Form3.AlphaBlendValue:=i; if i=255 then begin Timer2.Enabled:=false; end; end; end; end.
Delphi-Quellcode:
Unit 3:
unit Unit2;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm2 = class(TForm) private { Private-Deklarationen } public { Public-Deklarationen } end; var Form2: TForm2; implementation {$R *.dfm} end.
Delphi-Quellcode:
unit Unit3;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, pngimage, pnglang, pngextra, GR32_Image; type TForm3 = class(TForm) Image1: TImage; Timer1: TTimer; Timer2: TTimer; procedure Timer1Timer(Sender: TObject); procedure FormKeyPress(Sender: TObject; var Key: Char); procedure Timer2Timer(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end; var Form3: TForm3; implementation uses Unit2, Unit1; {$R *.dfm} procedure TForm3.Timer1Timer(Sender: TObject); var i: Integer; begin for i:=0 to 255 do begin Form3.AlphaBlendValue:=255-i; if i<155 then begin Form2.AlphaBlendValue:=100+i; end; if i=255 then begin Timer1.Enabled:=false; Form1.MediaPlayer2.Stop; Form1.MediaPlayer1.Stop; Form1.MediaPlayer2.Rewind; Form1.MediaPlayer1.Rewind; Form1.MediaPlayer3.FileName:='Videos\03.avi'; Form1.MediaPlayer3.open; Form1.MediaPlayer3.Display:=Form1.Panel1; Form1.MediaPlayer3.DisplayRect:=Form1.Panel1.ClientRect; Timer2.Enabled:=true; end; end; end; procedure TForm3.FormKeyPress(Sender: TObject; var Key: Char); begin Timer1.Enabled := true; end; procedure TForm3.Timer2Timer(Sender: TObject); var i: Integer; begin for i:=0 to 255 do begin Form2.AlphaBlendValue:=255-i; if i=255 then begin Timer2.Enabled:=false; Form3.Close; Form1.MediaPlayer3.Play; Form2.Close; Situation := 2; end; end; end; end. |
Re: Flimmer-Problem Bitte schnell helfen muss montag fertig
Das Flimmern kommt zu Stande, weil der Videoinhalt direkt in den Grafikspeicher geschrieben wird. Das wird sich bei der Vermischung von Hardwarebeschleunigung und Standardkomponenten nicht verhindern lassen.
Die einzige Möglichkeit wäre, alles hardwarebeschleunigt auszugeben. Ein interessantes Projekt aus der DP wäre ![]() |
Re: Flimmer-Problem Bitte schnell helfen muss montag fertig
Super, danke, kleine Frage:
Ist nun die Einblendu9ng oder das Video Softwarebeschleunigt, also im Klartext: Was muss ich auf Hardwarebeschleunigung umstellen? |
Re: Flimmer-Problem Bitte schnell helfen muss montag fertig
Wahrscheinlich ist das Video hardwarebeschleunigt. "Softwarebeschleunigt" gibt es nicht ;)
Hardwarebeschleunigt heißt, da wo das Video hin soll, wird erstmal eine pinke Fläche gemalt. Knallpink. Nachdem alles zusammengezeichnet wurde geht das ganze an die Grafikkarte (irgendwie muss das ja zum Monitor) und die legt dann an die Stelle wo das ganze Pink ist noch das Video drauf. Und "alles hardwarebeschleunigt auszugeben" hieße, die einblendungsgeschichte neu zu schreiben. Du hast also 3 Möglichkeiten: 1. Die Hardwarebeschleunigung des Videos ausschalten (k.A. ob das geht) 2. Auf das Ein/Ausblenden verzichten 3. Die Hardwarebeschleunigung am PC auszuschalten. ( [google]"hardwarebeschleunigung ausschalten"[/google] ) |
Re: Flimmer-Problem Bitte schnell helfen muss montag fertig
OK, ich probier das mit dem Ausschalten der Hardwarebeschleunigung mal und melde mich dann wieder, das ganze wird mal ne Präsentation mit Beamer für die Schule^^
|
Re: Flimmer-Problem Bitte schnell helfen muss montag fertig
Gaaaaanz gaaaaanz vielen Dank!
Es funktioniert ohne Hardwarebeschleunigung einwandfrei. |
Re: Flimmer-Problem Bitte schnell helfen muss montag fertig
Btw: Pass auf mit der Änderung der Bildschirmauflösung! Ich hatte mal ein selbstgeschriebenes Quiz bei einer Präsentation einbringen wollen, aber der Beamer unterstütze wohl die Auflösung nicht und stürzte ab... also skalier lieber deine GUI.
|
Re: Flimmer-Problem Bitte schnell helfen muss montag fertig
Ok, danke ich werd einbauen, dass man per parameter wahlweise die änderung der Auflöung ausschalten kann
|
Re: Flimmer-Problem Bitte schnell helfen muss montag fertig
Und erst Beamer-Ausgabe aktivieren bevor du dein Programm startest. Hatte schon sehr komische Effekte wenn die Programme vor dem Umschalten auf Beamer (mit Umschaltung Auflösung und 16:10 -> 4:3) schon gestartet waren.
|
Alle Zeitangaben in WEZ +1. Es ist jetzt 19:07 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