Registriert seit: 11. Mai 2005
Ort: Göppingen
1.238 Beiträge
Delphi 2007 Professional
|
DeskCHK - Ein kleines Prog. zum überprüfen des Bildschirms
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
Tobias It's not a bug, it's a feature.
|
|
Zitat
|