freepascal.ru

Код: Выделить всё

  function THubModule.FreezeInMemory: boolean;
  begin
    Result:= true;
    if f_frozen then exit;
    f_frozen:= true;

    MOVE(chepersy.Cps, SavedChepersyState, sizeof(chepersy.Cps)); //включая диспетчер памяти инстансов и всю информацию о зарегистрированных классах
    FillChar(chepersy.Cps, sizeof(chepersy.Cps), 0); // NO deinit!

    SavedState:= Mother^.Module.State - [msa_MustUnload];
    FillChar(Mother^.Module.State, sizeof(Mother^.Module.State), 0);

    SavedLogClass:= MyLogClass;
    MyLogClass:= nil;

    if Module = Self then Module:= nil;
    HubModule:= Self;
    Mother^.Module.HubState:= _hubInert;
    Mother^.Module.HubPrevState:= _hubInert;
  end;

  procedure THubModule.UnFreezeFromMemory;
  begin
    if not f_frozen then Die('Cannot unfreeze, not frozen.');
    if not chepersy.Cps.IsDone then begin
      Mother^.State.StateTrashedRestartRequired:= true;
      Die(RuEn(
        'FATAL: предыдущий модуль не завершил работу с %0',
        'FATAL: the previous module failed to close the %0'
      ), [ChepersyTitle]);
    end;
    MOVE(SavedChepersyState, chepersy.Cps, sizeof(chepersy.Cps));
    Mother^.Module.State:= SavedState;
    MyLogClass:= THubLogic;
    f_frozen:= false;
    Module:= Self;
  end;

Код: Выделить всё

var
   a, b: T;
procedure fpc_finalize(data, typeInfo: pointer); [external name 'FPC_FINALIZE'];
function fpc_addref(data, typeInfo: pointer): SizeInt; [external name 'FPC_ADDREF'];

fpc_finalize(@b, TypeInfo(T));
// ↑ Или просто Finalize(b), если переменная b типизирована, а не скрыта за голым указателем.
// ↑ Или изкоробочное FinalizeArray(@b, TypeInfo(T), 1).
Move(a, b, sizeof(T));
fpc_addref(@b, TypeInfo(T)); // Нет аналога из коробки.

Код: Выделить всё

procedure  TCaptureThread.Execute;
begin
while (not Terminated) do begin
IF (bmp <> Nil ) and UPDATE  Then begin  UPDATE:=False;
ProcessRUN :=True;
CaptureForm.CreateSnapshotPlusWH(bmp,R_W,R_H,unit6.FHandle,RS);
Tbmp:=bmp; Tbmp.Canvas.Draw(0, 0 ,bmp);
ProcessRUN :=False;
 end
end
end;  

Код: Выделить всё

Function BitmapTest(var TB:TBitmap; Mode:TPixelFormat;
   F_Free:Boolean=true):Boolean ;
   Var
   CB:TBitmap;
   Begin
    Result:= tb.PixelFormat=mode ;
   if not Result then
   begin
   CB:=TBitmap.Create;
   cb.PixelFormat:=Mode;
   cb.SetSize(tb.Width,tb.Height);
   Cb.Canvas.Draw(0,0,TB);
   if F_Free then tb.free;
   Tb:=CB;
   end
   end;

Код: Выделить всё

function GlErrorCodeToString(c: GLenum): Utf16String;
begin
  case c of
    GL_INVALID_ENUM: Result:= 'GL_INVALID_ENUM';
    GL_INVALID_VALUE: Result:= 'GL_INVALID_VALUE';
    GL_INVALID_OPERATION: Result:= 'GL_INVALID_OPERATION';
    GL_STACK_OVERFLOW: Result:= 'GL_STACK_OVERFLOW';
    GL_STACK_UNDERFLOW: Result:= 'GL_STACK_UNDERFLOW';
    GL_OUT_OF_MEMORY: Result:= 'GL_OUT_OF_MEMORY';
    GL_INVALID_FRAMEBUFFER_OPERATION_EXT: Result:= 'GL_INVALID_FRAMEBUFFER_OPERATION_EXT';
    GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT: Result:= 'GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT';
    GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT: Result:= 'GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT';
    GL_FRAMEBUFFER_INCOMPLETE_DUPLICATE_ATTACHMENT_EXT: Result:= 'GL_FRAMEBUFFER_INCOMPLETE_DUPLICATE_ATTACHMENT_EXT';
    GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT: Result:= 'GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT';
    GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT: Result:= 'GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT';
    GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT: Result:= 'GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT';
    GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT: Result:= 'GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT';
    GL_FRAMEBUFFER_UNSUPPORTED_EXT: Result:= 'GL_FRAMEBUFFER_UNSUPPORTED_EXT';
    GL_FRAMEBUFFER_STATUS_ERROR_EXT: Result:= 'GL_FRAMEBUFFER_STATUS_ERROR_EXT';
  else
    Result:= RuEn('код', 'code') + ' ' + IntToHex(c, 8) + 'h';
  end;
end;  

Код: Выделить всё

ProcessRUN :=True;