Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Sonstige Fragen zu Delphi (https://www.delphipraxis.net/19-sonstige-fragen-zu-delphi/)
-   -   Delphi Icons verbrauchen alle Resourcen... (https://www.delphipraxis.net/15247-icons-verbrauchen-alle-resourcen.html)

FriFra 25. Jan 2004 00:26


Icons verbrauchen alle Resourcen...
 
Ich weiss, dass ich irgendwo etwas falsch mache, zumindest fängt bei wiederholter Ausführung der folgenden Funktion der Rechner irgendwann komplett an zu spinnen... obwohl eigentlich alles jeweils korrekt freigegeben wird.

Delphi-Quellcode:
procedure TForm1.SetIcon(Loading, Ignoring, Stopped, Plugin:
  boolean);
  function CombineIcons(FrontIcon, BackIcon: HIcon): HIcon;
  var
    WinDC: HDC;
    FrontInfo: TIconInfo;
    FrontDC: HDC;
    FrontSv: HBITMAP;
    BackInfo: TIconInfo;
    BackDC: HDC;
    BackSv: HBITMAP;
    BmpObj: tagBitmap;
  begin
    WinDC := GetDC(0);

    GetIconInfo(FrontIcon, FrontInfo);
    FrontDC := CreateCompatibleDC(WinDC);
    FrontSv := SelectObject(FrontDC, FrontInfo.hbmMask);

    GetIconInfo(BackIcon, BackInfo);
    BackDC := CreateCompatibleDC(WinDC);
    BackSv := SelectObject(BackDC, BackInfo.hbmMask);

    GetObject(FrontInfo.hbmMask, SizeOf(BmpObj), @BmpObj);
    BitBlt(BackDC, 0, 0, BmpObj.bmWidth, BmpObj.bmHeight, FrontDC, 0, 0,
      SRCAND);

    SelectObject(BackDC, BackInfo.hbmColor);
    DrawIconEx(BackDC, 0, 0, FrontIcon, 0, 0, 0, 0, DI_NORMAL);

    Result := CreateIconIndirect(BackInfo);

    SelectObject(FrontDC, FrontSv);
    DeleteDC(FrontDC);
    SelectObject(BackDC, BackSv);
    DeleteDC(BackDC);
    ReleaseDC(0, WinDC);
    DeleteObject(FrontInfo.hbmColor);
    DeleteObject(FrontInfo.hbmMask);
    DeleteObject(BackInfo.hbmColor);
    DeleteObject(BackInfo.hbmMask);
    DeleteObject(FrontSv);
    DeleteObject(BackSv);
  end;
var
  RS: TResourceStream;
  sI: string;
  Ico: array[0..8] of TIcon;
  n: integer;
begin
  for n := 0 to High(Ico) do
    Ico[n] := TIcon.Create;

  try
    StrPLCopy(IconData.szTip, '[' + Label2.Caption + ']'#13 + 'WAN-IP: ' +
      Edit3.Text + #13 + 'LAN-IP: ' + Edit4.Text, 63);

    if G_IP = '0.0.0.0'#0 then
      sI := 'I_Inactive'
    else if G_IP = '0.0.0.0' then
      sI := 'I_Offline'
    else
      sI := 'I_Online';
    try
      RS := TResourceStream.Create(0, sI + GetIconSufix, RT_RCDATA);
      RS.Position := 0;
      Ico[0].LoadFromStream(RS);
    finally
      RS.Free;
    end;

    { Ladeanzeige }
    if Loading then
      sI := 'I_Loading'
    else
      sI := 'I_Blank';
    try
      RS := TResourceStream.Create(0, sI + GetIconSufix, RT_RCDATA);
      RS.Position := 0;
      Ico[1].LoadFromStream(RS);
    finally
      RS.Free;
    end;
    Ico[2].Handle := CombineIcons(Ico[1].Handle, Ico[0].Handle);

    if Ignoring then
      sI := 'I_Ignoring'
    else
      sI := 'I_Blank';
    try
      RS := TResourceStream.Create(0, sI + GetIconSufix, RT_RCDATA);
      RS.Position := 0;
      Ico[3].LoadFromStream(RS);
    finally
      RS.Free;
    end;
    Ico[4].Handle := CombineIcons(Ico[3].Handle, Ico[2].Handle);

    if Stopped then
      sI := 'I_Stop'
    else
      sI := 'I_Blank';
    try
      RS := TResourceStream.Create(0, sI + GetIconSufix, RT_RCDATA);
      RS.Position := 0;
      Ico[5].LoadFromStream(RS);
    finally
      RS.Free;
    end;
    Ico[6].Handle := CombineIcons(Ico[5].Handle, Ico[4].Handle);

    if Plugin then
      sI := 'I_Plugin'
    else
      sI := 'I_Blank';
    try
      RS := TResourceStream.Create(0, sI + GetIconSufix, RT_RCDATA);
      RS.Position := 0;
      Ico[7].LoadFromStream(RS);
    finally
      RS.Free;
    end;
    Ico[8].Handle := CombineIcons(Ico[7].Handle, Ico[6].Handle);

    DestroyIcon(TNA_Icon.Handle);
    TNA_Icon.Assign(Ico[8]);
    DestroyIcon(IconData.hIcon);
    IconData.hIcon := TNA_Icon.Handle;

    { Statusanzeige }
    DestroyIcon(Image1.Picture.Icon.Handle);
    Image1.Picture.Icon.Handle := IconData.hIcon;
    Image1.Repaint;
    Edit3.Text := G_IP;
    Label7.Caption := G_IT;

    if G_IP = '0.0.0.0'#0 then
      Label2.Caption := 'undefined'
    else if G_IP = '0.0.0.0' then
      Label2.Caption := 'Offline'
    else
      Label2.Caption := 'Online';

    if IsMinimized = True then
      Shell_NotifyIcon(NIM_MODIFY, @IconData);

  finally
    for n := 0 to High(Ico) do
    begin
      Ico[n].ReleaseHandle;
      DestroyIcon(Ico[n].Handle);
      FreeAndNil(Ico[n]);
    end;
    IconReady := True;
  end;
end;
Update: Ich verwende jetzt einen Array of Icon um eine bessere Übersichtlichkeit zu erreichen

MrKnogge 25. Jan 2004 00:33

Re: Icons verbrauchen alle Resourcen...
 
Stürtzt einfaqch alles ab, oder gibts auch Fehlermeldungen ?

Nur so:
Warum verwendest du keine Arrays?
Wäre doch übersichtlicher.

FriFra 25. Jan 2004 00:38

Re: Icons verbrauchen alle Resourcen...
 
Es läuft eine Zeit lang alles normal (Das Icon wird sehr häufig gewechselt...) irgendwann ist das Icon Blank und das Programm wird nur noch mit Grafikfehlern angezeigt... Popupmenüs (auch anderer Programme poppen auf wo sie "wollen"... Fenster (alle laufenden Programme) werden falsch gezeichnet... Es können keine Programme mehr gestartet werden...
Nach "Abschuss" meines Programmes wird es besser, aber wirklich helfen tut nur ein kompletter Neustart (Win XP pro) :cry:

MrKnogge 25. Jan 2004 00:48

Re: Icons verbrauchen alle Resourcen...
 
Also das was erstellt wird, wird auch wieder freigegeben,
könnte es auch an der Ressource liegen?

Greifst du eventuell noch mit einer anderen Procedure auf die Ressource zu ?

FriFra 25. Jan 2004 00:50

Re: Icons verbrauchen alle Resourcen...
 
Zitat:

Zitat von MrKnogge
Greifst du eventuell noch mit einer anderen Procedure auf die Ressource zu ?

Nein, das tue ich nicht.

FriFra 25. Jan 2004 17:19

Re: Icons verbrauchen alle Resourcen...
 
Ich habe die Procedure nochmal überarbeitet und verwende jetzt einen Array of Icon ;) ...

Die Function CombineIcons habe ich NICHT im Verdacht, da diese schon längere Zeit im SwissDelphiCenter veröffentlicht ist und noch niemand derartige Probleme hatte...


Alle Zeitangaben in WEZ +1. Es ist jetzt 16:59 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz