DeskCHK - Ein kleines Prog. zum überprüfen des Bildschirms

[EDatabaseError]

Hier habe ich ein kleines Programm das den Bildschirm auf Pixelfehler überprüft.

Hier ist die Prozedur mit der ich die Farben durchgehe:

Delphi-Quellcode:

procedure ScreenCheck(TestForm:TForm;StateLabel: TLabel);
var
  r,g,b: Integer;
begin
 StateLabel.Caption := 'Begin secuence...';
 StateLabel.Update;
 sleep(100);
 r := 0;
 g := 0;
 b := 0;
 for r := 0 to 255 do
  begin
   StateLabel.Caption := 'R='+Inttostr(r)+' G='+inttostr(g)+' B='+Inttostr(b);
   StateLabel.Update;
   TestForm.Color := RGB(r,g,b);
   TestForm.Update;
   sleep(10);
  end;
 r := 0;
 g := 0;
 b := 0;
 for g := 0 to 255 do
  begin
   StateLabel.Caption := 'R='+Inttostr(r)+' G='+inttostr(g)+' B='+Inttostr(b);
   StateLabel.Update;
   TestForm.Color := RGB(r,g,b);
   TestForm.Update;
   sleep(10);
  end;
 r := 0;
 g := 0;
 b := 0;
 for b := 0 to 255 do
  begin
   StateLabel.Caption := 'R='+Inttostr(r)+' G='+inttostr(g)+' B='+Inttostr(b);
   StateLabel.Update;
   TestForm.Color := RGB(r,g,b);
   TestForm.Update;
   sleep(10);
  end;
 StateLabel.Caption := '...finished';
end;

Delphi-Quellcode:

procedure ScreenCheck(TestForm:TForm;StateLabel: TLabel);
var
  r,g,b,i,ii: Integer;
begin
 StateLabel.Caption := 'Begin sequence...';
 StateLabel.Update;
 sleep(100);
 r := 0;
 g := 0;
 b := 0;
 for r := 0 to 255 do
  begin
   if r < 123 then StateLabel.Font.Color := clWhite else StateLabel.Font.Color := clBlack;
   StateLabel.Caption := 'R='+Inttostr(r)+' G='+inttostr(g)+' B='+Inttostr(b);
   StateLabel.Update;
   TestForm.Color := RGB(r,g,b);
   TestForm.Update;
   sleep(10);
  end;
 r := 0;
 g := 0;
 b := 0;
 for g := 0 to 255 do
  begin
   if g < 123 then StateLabel.Font.Color := clWhite else StateLabel.Font.Color := clBlack;
   StateLabel.Caption := 'R='+Inttostr(r)+' G='+inttostr(g)+' B='+Inttostr(b);
   StateLabel.Update;
   TestForm.Color := RGB(r,g,b);
   TestForm.Update;
   sleep(10);
  end;
 r := 0;
 g := 0;
 b := 0;
 for b := 0 to 255 do
  begin
   if b < 123 then StateLabel.Font.Color := clWhite else StateLabel.Font.Color := clBlack;
   StateLabel.Caption := 'R='+Inttostr(r)+' G='+inttostr(g)+' B='+Inttostr(b);
   StateLabel.Update;
   TestForm.Color := RGB(r,g,b);
   TestForm.Update;
   sleep(10);
  end;
 r := 255;
 g := 255;
 b := 255;
 TestForm.Color := RGB(r,g,b);
 for i := 0 to screen.Width do
   for ii := 0 to screen.height do
    begin
     StateLabel.Caption := 'W=' + IntToStr(i) + ' H='+IntToStr(ii);
     StateLabel.Update;
     TestForm.Canvas.Pixels[i,ii] := clBlack;
     Application.ProcessMessages;
    end;
 r := 255;
 g := 255;
 b := 255;
 TestForm.Color := RGB(r,g,b);
 StateLabel.Caption := '...finished';
end;

Bitte testen und Meinung schreiben.

Mfg
Tobi

[Daniel G]

Joar... Funktioniert. Abgesehen von diesem kleinen Schönheitsfehler:

Zitat:

Begin secquence

[EDatabaseError]

:mrgreen: joa... :wall: mein fehler... werde ich ändern

[Daniel G]

Gut wäre natürlich auch, wenn es ein paar Muster auf den Bildschirm zeichnen würde und den Bildschirm auch einmal komplett weiß machen würde.

[ManuMF]

Hallo,

es dürfte wohl kein allzu großer Aufwand sein, in der Schleife noch die Schriftfarbe des Labels anzupassen, da sie bei dunklen Farben nicht lesbar ist. Ansonsten ganz gut.

:stupid: Fehlen nur noch ein paar Funktionen wie in DPT (Dead Pixel Tester), das Prog kann noch Farben nach Wahl, Muster etc. darstellen. Aber ich kenne das aus eigener Erfahrung, das geht weit über den eigentlichen Sinn des Programms hinaus... ;-)

Gruß,
ManuMF

[EDatabaseError]

Neue Version online...
ich teste jetzt jedes Pixel einzeln durch (dauert ein bissel und zieht richtig CPU)
+alles was oben kritisiert wurde geändert