Prozentualer Fortschritt als Text in ProgressBar...

[FriFra]

Irgend etwas an meiner procedure "frisst" Systemresourcen... Der Speicherverbrauch ist normal, aber es kommt auf einigen Rechnern zu Abstürzen mit der Meldung "Systemresourcen erschöpft". Wenn ich die procedure nicht benutze indem ich das "Umbiegen" der WndProc auskommentiere tritt das Problem nicht mehr auf

Delphi-Quellcode:

procedure TTest_Main.FormCreate(Sender: TObject);
var
 ...
begin
  ...
  OldProgressWndProc := ProgressBar1.WindowProc;
  ProgressBar1.WindowProc := ProgressWndProc;
  ...
end;  


procedure TTest_Main.ProgressWndProc(var Msg: TMessage);
var
  dc: HDC;
  rect: TRect;
  myfont: Cardinal;
  Text: string;
begin
  OldProgressWndProc(Msg);

  if ((Msg.Msg = 1026) or (Msg.Msg = WM_PAINT)) and (ProgressBar1.Min = 0) then
    // Wenn die Progressbar neugezeichnet wurde,
    // und somit die Zahl weg ist: Prozentzahl neu draufpinseln
  begin
    if (ProgressBar1.Max = 0) or (ProgressBar1.Position = 0) then
      Text := '0%'
    else if ProgressBar1.Max = ProgressBar1.Position then
      Text := '100%'
    else
      Text := IntToStr(Trunc(100 / ProgressBar1.Max * ProgressBar1.Position)) +
        '%';
    dc := GetWindowDC(Progressbar1.Handle);
    try
      rect := ProgressBar1.ClientRect;
      //InvalidateRect(Progressbar1.Handle, @rect, True);
      myfont := CreateFont(-11, 0, 0, 0, 0, 0, 0, 0, ANSI_CHARSET,
        OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH,
        'Verdana');
      if suiSkinEngine1.Active = True then
        SetBkMode(dc, TRANSPARENT);
      SetTextColor(dc, clBlack);
      SelectObject(dc, myfont);
      DrawText(dc, PChar(Text), length(Text), rect, DT_SINGLELINE or DT_VCENTER
        or DT_CENTER);
    finally
      ReleaseDC(Progressbar1.Handle, dc);
    end;
  end;
end;