Einzelnen Beitrag anzeigen

EDatabaseError

Registriert seit: 11. Mai 2005
Ort: Göppingen
1.238 Beiträge
 
Delphi 2007 Professional
 
#1

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

  Alt 14. Jul 2006, 13:39
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
Angehängte Dateien
Dateityp: exe deskchk_150.exe (379,0 KB, 34x aufgerufen)
Tobias
It's not a bug, it's a feature.
  Mit Zitat antworten Zitat