out of system resources bei erzeugen und löschen von pal

[sharpals]

HILFE, ich habe hier eine ärgerliche meldung.

[out of system resources ]

Ich habe in meinem EMu das problem,daß ich die farben einer DIB ändern muß und zwar via palette.


Nach etwa 100000 wechseln kommt eben die meldung.

Kann es sein, daß die objekte immer weiter in den speicher wandern ?

Oder kennt jemand eine lösung die palette ändern, ohne das objekt zu löschen und dann neu zu erzeugen ?

nun habe ich folgensed codiert

Delphi-Quellcode:

//SelectPalette(DIBDC,DIBhpalette,false);
            if DIBhpalette <> 0 then DeleteObject(DIBhpalette);

            initpal(pal_entrys);
            CreatePalette(PLogPalette(@aNewHPalette)^);
            SelectPalette(DIBDC,DIBhpalette,false);

bzw urspünglich

Delphi-Quellcode:

 pal_changed = 1
     then
       begin
            pal_changed:=0;
            DestroyDIBSurf;
           

            initpal(pal_entrys); // hier wird kein objekt erzeugt
           
            CreateDIBSurf(aNewHPalette,DIBWidth,DIBHeight);
       end;
end;

[Muetze1]

CreatePalette() liefert dir ein logisches Palettenhandle zurück, was du aber anscheinend überhaupt nicht abspeicherst oder weiter verwendest - und somit auch nicht freigibst.

[sharpals]

hallo, es wir beim erstenmal bei dem start des emus erzeugt und verwendet.

due updates werden danach ausgeführt.


start :

Delphi-Quellcode:

procedure CreateDIBSurf(oNewHPalette:TMyLogPalette; aW, aH: Word);
var lp1 : integer;
begin
  DIBbits      := nil;
  DIBhandle    := 0;
  OLDPalette   := 0;
  DIBhpalette  := CreatePalette(PLogPalette(@oNewHPalette)^);
  DIBDC        := CreateCompatibleDC(0);
  if palset <> 0 then OLDPalette:= SelectPalette(DIBDC, DIBhpalette, true);
  with DIBheader do begin
    with bmiHeader do begin
      biSize          := sizeof(TGDIBitMapInfoHeader);
      biWidth         := aW;
      biHeight        := aH;
      biPlanes        := 1;
      biBitCount      := 8;
      biCompression   := BI_RGB;
      biSizeImage     := 0;
      biXPelsPerMeter := 0;
      biYPelsPerMeter := 0;
      biClrUsed       := 0;
      biClrImportant  := 0;
    end;
    for lp1:=0 to 255 do BMIcolors[lp1] := (lp1+0) and 255; { pal_indices }
  end;

  DIBWidth   := aW;
  DIBHeight  := aH;
  DIBWidth_b := ((DIBWidth+3) shr 2) shl 2;
  DIBSize    := DIBWidth_b*DIBHeight;
  DIBWidth   := ((DIBWidth+3) shr 2) shl 2;

  if OLDHandle<>0 then SelectObject(DIBDC, OLDHandle);
  if DIBhandle<>0 then DeleteObject(DIBhandle);

  DIBheader.BMIheader.biWidth  := DIBWidth;
  DIBheader.BMIheader.biHeight :=-DIBHeight;  { Top down for me please...}
  { the minus sign may or may not be necessary on your machine - I'm not sure }
  { without it - the DIB is bottom up - See old WinG documentation            }
  DIBhandle := CreateDIBSection(DIBDC,pBitmapInfo(@DIBheader)^,DIB_PAL_COLORS,DIBbits,0,0);
  OLDHandle := SelectObject(DIBDC,DIBhandle);

  fillchar(dirty_line,1024,0); // zerro draw all lines !!!
  dirty_lines_on:=0;    // = 1 it will bee use dirty lines

end;

und am ende

Delphi-Quellcode:

procedure DestroyDIBSurf;
begin
  if OLDHandle<>0    then SelectObject(DIBDC, OLDHandle);
  if DIBhandle<>0    then DeleteObject(DIBhandle);

  if DIBhpalette<>0 then  SelectPalette(DIBDC,DIBhpalette,false);
  if DIBhpalette<>0  then DeleteObject(DIBhpalette);


  DeleteDC(DIBDC);
end;

wechsel der palette

Delphi-Quellcode:

procedure update_pal;
begin
    if pal_changed = 1
     then
       begin
            pal_changed:=0;
            DestroyDIBSurf;
            //SelectPalette(DIBDC,DIBhpalette,false);
            //DeleteObject(DIBhpalette);

            initpal(pal_entrys); // hier werden nur neu werte                      ugewiesen
            //CreatePalette(PLogPalette(@aNewHPalette)^);
            //SelectPalette(DIBDC,DIBhpalette,false);
            CreateDIBSurf(aNewHPalette,DIBWidth,DIBHeight);
       end;
end;