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

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