freepascal.ru

Доброго времени суток, комрады

В рантайм меняю размеры сплэша из доп.потока таким образом

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

procedure TFrmMain.LMMyMsg(var Msg: TLMessage);
var
  AText: String;
  ARect: TRect;
  h: Integer; //height of the drawn text
  AFlag: UINT;
  SplashCenterPnt: TPoint;
  DiffHeight: Integer;//difference between a splash height and textcontainer height
begin
  ARect:= Rect(-500,0, FrmSplash.sttTextCont.Width - 500,0);
  AText:= String(NativeInt(Msg.lParam));

  with Self.Canvas do
  begin
    //uses LCLType
    AFlag:=
      DT_NOCLIP
      or DT_WORDBREAK
      or DT_LEFT
      ;
    //uses LCLIntf
    h:= DrawText(Handle,PChar(AText),-1, ARect, AFlag);

    { TODO : it's not work for linux GTK2. Why? }
    with FrmSplash do
    begin
      sttTextCont.Caption:= '';
      SplashCenterPnt.y:= Top + Height div 2;//a middle splash height
      DiffHeight:= Height - sttTextCont.Height;
      Height:= h + 15 + DiffHeight;
      Top:= SplashCenterPnt.y - Height div 2;
      Repaint;
      InMsgStr:= AText;
    end;
  end;
end;   

На винде и убунту все рисуется корректно, а на Дебиан (GTK2) облом



Как победить? Буду благодарен за любые идеи

зы: IDE r.57265, fpc r.38156, Win7 x64/Deb 9.2 i386(GTK2)

Добавлено спустя 12 часов 8 минут 1 секунду:
Удалось почти решить альтернативной перерисовкой окна под GTK2 (увы, процесс перерисовки хорошо заметен на глаз)

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

  with Self.Canvas do
  begin
    //uses LCLType
    AFlag:= DT_CALCRECT or DT_WORDBREAK or DT_LEFT;

    //uses LCLIntf
    h:= DrawText(Handle,PUTF8Char(AText),UTF8Length(AText), ARect, AFlag);
  end;

  with FrmSplash do
  begin
    sttTextCont.Caption:= '';
    SplashCenterPnt.y:= Top + Height div 2;//a middle splash height
    DiffHeight:= Height - sttTextCont.Height;
    Height:= h + 15 + DiffHeight;

    {$IFDEF LCLGTK2}
    DoSetBounds(Left,SplashCenterPnt.y - Height div 2,Width,Height);
    {$ELSE}
    Top:= SplashCenterPnt.y - Height div 2;
    {$ENDIF}

    InMsgStr:= AText;
  end;