1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:

[...]
//Graustufenprocedure (aus EDH)
procedure TForm1.GrauStufen(C:TCanvas);
var x, y: integer;
  Color: LongInt;
  R, G, B, Gr: Byte;
begin
  with C do begin
    for x:= ClipRect.Left to ClipRect.Right do
      for y:= ClipRect.Top to ClipRect.bottom do
      begin
        Color:=ColorToRGB(Pixels[x,Y]);

        R := GetRValue(Color);
        G := GetGValue(Color);
        B := GetBValue(Color);

        Gr:= Trunc(B*0.11+G*0.59+R*0.3);
        Pixels[x,Y] := RGB(Gr, Gr, Gr);
      end;
  end;
end;

//Infobox erstellen (abgewandelt aus EDH)
function TForm1.createInfobox():boolean;
var
    tmpHDC: HDC;
    tmpBmp: TBitMap;
begin
result := FALSE;
  try
    tmpHDC:= CreateDC('DISPLAY',nil,nil,nil);
    tmpBmp:= TBitMap.Create();
    tmpBmp.PixelFormat := pfDevice;
      with tmpImg do begin
       Left:= 0;
       Top:= 0;
       Width:= Form1.ClientWidth;
       Height:= Form1.ClientHeight;
       tmpImg.Canvas.Brush.Color:= clBlack;
    end;
    BitBlt(tmpBmp.Canvas.Handle,Form1.left, Form1.Top,Form1.Left+Form1.Width,Form1.Top+Form1.Height,tmpHDC,0,0,SRCCOPY);
    GrauStufen(tmpBmp.Canvas);
    tmpImg.Picture.BitMap := tmpBmp;
    tmpImg.Canvas.TextOut(0,400,'Infbox');
   tmpBmp.Free;
     result:= true;
  except
      result:= FALSE;
  end;
end;
[...]
procedure TForm1.DirChooseBtn1Click(Sender: TObject);
begin
if (createInfobox()) then
  DirStrInput1.Text := 'hat geklappt...eigentlich'
else
  DirStrInput1.Text := 'Die spinnen die Römer :P';
end;
[...]