Prozentualer Fortschritt als Text in ProgressBar...

[FriFra]

MIT der Kompo gibt's ja gerade keine Probleme
http://www.frifra.de/Temp/progressbar.jpg

nur wenn die Kompo nicht Aktiv ist, also OHNE Kompo gibts Probleme:
http://www.frifra.de/Temp/progressbar2.jpg

[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;

[Luckie]

Zu jedem SelectObject gehört auch ein DeleteObjert.

[FriFra]

ja wo er recht hat, hat er recht der Luckie , Danke

[FriFra]

Bisher lief alles wunderbar... Jetzt kam ein Update der Skin-Komponente und nun wird mein drüber gemalter Test immer wieder gelöscht (flackern)
Hat jemand eine Idee, wie ich sofort nach dem Neuzeichnen meinenText wiederdrübergebügelt bekomme, ohne dass es fackert?