freepascal.ru

Во вложении скриншот. Проблема в следующем, программа запускается и работает нормально. В ячейках таблицы выводит текст вида "29 января 2016г.". Спустя какое то время, текст превращается в знаки вопроса. В каком направлении искать проблему с кодировкой?

Код вывода текста

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

procedure TFEditorRemd.vstMainTreeGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: String);
var
    Data: PVirtualRecord;
    dbItem:TRemdItem;
    tmp, tmp2:string;
    ColItem:TVirtualTreeColumn;
begin
   try
    if Column<0 then exit;

    dbItem:=nil;
    Data := Sender.GetNodeData(Node);
    CellText := '';
    tmp:='';
    if (Assigned(Data)and Assigned(Data^.Item)) then
    begin
         if (Data^.Item.ClassNameIs(COMPARECLASSNAME_REMD)) then
         begin
           dbItem:=TRemdItem(Data^.Item);
         end;
      end;

      ColItem:=vstMainGetColumnByIndex (Column); //TVirtualTreeColumn;

      if ColItem.ID=vstMainColumnID_LabelName then  //Маркировка
      begin
           if Assigned(dbItem) then
           begin
                tmp:=dbItem.Text;
         end;
      end
      else if ColItem.ID=vstMainColumnID_Date then  //Дата
      begin
           if Assigned(dbItem) then
           begin
                if dbItem.RemdMode=tmStandard then
                begin
                   tmp:=FormatDateTime(UTF8ToSys(FORMATDATETIME_DAY), dbItem.DateOriginal);
                   tmp:=SysToUTF8(tmp);
                end
                else if dbItem.RemdMode=tmEveryDay then
                begin
                    tmp:=FORMATDATETIME_EVERY_DAY2;
                end
                else if dbItem.RemdMode=tmEveryWeek then
                begin
                    tmp:=FORMATDATETIME_EVERY_Week3;
                end
                else if dbItem.RemdMode=tmEveryMonth then
                begin
                    tmp:=formatdatetime(UTF8ToSys(FORMATDATETIME_EVERY_Month2), dbItem.DateOriginal);
                    tmp:=SysToUTF8(tmp);
                end
                else if dbItem.RemdMode=tmEveryYear then
                begin
                    tmp:=formatdatetime(UTF8ToSys(FORMATDATETIME_EVERY_Year2), dbItem.DateOriginal);
                    tmp:=SysToUTF8(tmp);
                end
                else if (dbItem.RemdMode=tmBeginQuarter)then
                begin
                    tmp:=formatdatetime(UTF8ToSys(FORMATDATETIME_QUARTERBEGIN), dbItem.DateOriginal);
                    tmp:=SysToUTF8(tmp);
                end
                else if (dbItem.RemdMode=tmEndQuarter) then
                begin
                    tmp:=formatdatetime(UTF8ToSys(FORMATDATETIME_QUARTEREND), dbItem.DateOriginal);
                    tmp:=SysToUTF8(tmp);
                end;
    end;
      end
      else if ColItem.ID=vstMainColumnID_Time then  //Куда
      begin
           if Assigned(dbItem) then
           begin
               tmp:=FormatDateTime('HH:mm', dbItem.TimeOriginal);
           end;
      end
      else if ColItem.ID=vstMainColumnID_Status then //Марка кабеля
      begin
           if Assigned(dbItem) then
           begin
                if dbItem.Postpone then
                begin
                   tmp:=FormatDateTime('Отложено до dd.mm.yyyy HH:mm', dbItem.NextComplite);
                end
                else
                begin
                    tmp:=FormatDateTime('Было выполнено dd.mm.yyyy HH:mm', dbItem.LastComplite);
                    if dbItem.RemdMode<>tmStandard then
                    begin
                      tmp:=tmp+' '+chr(13)+chr(10);
                      tmp:=tmp+FormatDateTime('Повторение dd.mm.yyyy HH:mm', dbItem.NextComplite);
                    end;
                end;
        end;
      end
      else if ColItem.ID=vstMainColumnID_Comments then //Примечание
      begin
           if Assigned(dbItem) then
           begin
               tmp:=dbItem.Comment;
             end;
      end;

      tmp:=StringReplace(tmp,'\n ',#13,[rfReplaceAll,rfIgnoreCase]);
      tmp:=StringReplace(tmp,'\n',#13,[rfReplaceAll,rfIgnoreCase]);
      tmp:=StringReplace(tmp,'\r ',#13,[rfReplaceAll,rfIgnoreCase]);
      tmp:=StringReplace(tmp,'\r',#13,[rfReplaceAll,rfIgnoreCase]);
      Data^.ViewText[ColItem.ID]:=tmp;
      CellText := tmp;
  except

  end;
end;


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

unit u_lang_res;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

resourcestring

  EVERY_DAY                     ='Каждый день';
  EVERY_Week                    ='Каждую неделю';

  EVERY_Month                   ='Каждый месяц';
  EVERY_Month2                  ='Числа';
  EVERY_Year                    ='Каждый год';
  EVERY_Year2                   ='Ежегодно';

  FORMATDATETIME_EVERY_Month    ='Ежемесячно';
  FORMATDATETIME_EVERY_Month2   ='Каждый месяц \r d числа';
  FORMATDATETIME_EVERY_Month3   ='d числа';
  FORMATDATETIME_EVERY_Year     ='Ежегодно';
  FORMATDATETIME_EVERY_Year2    ='Каждый год \r d mmmm';
  FORMATDATETIME_EVERY_Year3    ='d mmmm';
  FORMATDATETIME_EVERY_Week     ='Еженедельно';
  FORMATDATETIME_EVERY_Week2    ='Каждую неделю';
  FORMATDATETIME_EVERY_Week3    ='Каждую неделю';
  FORMATDATETIME_EVERY_DAY      ='Ежедневно';
  FORMATDATETIME_EVERY_DAY2     ='Каждый день';
  FORMATDATETIME_EVERY_DAY3     ='Каждый день';
  FORMATDATETIME_DAY            ='dd mmmm yyyy';
  FORMATDATETIME_QUARTERBEGIN   ='Начало квартала \r dd mmmm';
  FORMATDATETIME_QUARTEREND     ='Конец квартала \r dd mmmm';

  FORMATPOSTPONE_MIN            ='%d минут';
  FORMATPOSTPONE_HOUR           ='%d часов';
  FORMATPOSTPONE_DAYS           ='%d дней';
  FORMATPOSTPONE_WEEK1          ='%d неделя';
  FORMATPOSTPONE_WEEK2          ='%d недели';
  FORMATPOSTPONE_YEAR           ='%d год';


Очень хитрая проблема. Мне она много крови попортила в своё время.

Лечится так:
В исходниках проекта (соответсвующий твой файл .lpr) после строки

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

  Application.Initialize;

добавь строку

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

  Application.UpdateFormatSettings:=false;

Спасибо большое Не думал что так просто найду того кто видел этот баг.

Монолог для новичков о решении вопроса "Печаль, беда".

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

Application.UpdateFormatSettings   :=False;


Решает проблему, но в процессе разработки наткнулся на проблему чтения нецелых чисел из XML. Класс NativeXml записывает дробные числа в файл с форматированием при помощи запятой, но читать пытается используя точку. Я хотел вставить функции-костыли замены символов, но сославшись на DefaultFormatSettings оказалось что там почему то ничего не инициализировано, без вызова

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

GetFormatSettings;

после вызова последней от Application.UpdateFormatSettings толку ноль. Все обновляется сразу и в программе кругом вопросики.
Немного покопавшись и найдя проблему в связке с WinAPI сделал костыль из переделанной стандартной функции.
В итоге вместо вставки в начале программы

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

GetFormatSettings;
Application.UpdateFormatSettings   :=False;


у меня теперь живет

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

//GetFormatSettings; only for not cyrillic
GetFormatSettingsUTF8Fix
Application.UpdateFormatSettings   :=False;


GetFormatSettingsUTF8Fix - уже мой костыль с переформатированием текста. Банальная замена стандартной функции GetFormatSetting на точно такую же с перекодировкой. Исходник модуля для ее работы ниже.

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

unit FormatSettingsUTF8;
{
    This file is fix for Sysutils Free Pascal unit
    Copyright (c) 2016 by Sharfik
    member of the FreePascal.ru forum

    This unit is distributed on "AsIs" License.

**********************************************************************}
interface

{$MODE objfpc}
{$H+}


uses
  Windows, SysUtils, LazUTF8;

procedure GetLocaleFormatSettingsUTF8(LCID: Integer; var FormatSettings: TFormatSettings);
procedure GetFormatSettingsUTF8Fix;

implementation

function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString;
var
  L: Integer;
  Buf: array[0..255] of Char;
begin
  L := GetLocaleInfoA(LID, LT, Buf, SizeOf(Buf));
  if L > 0 then
  begin
    SetString(Result, @Buf[0], L - 1);
    Result := LazUTF8.WinCPToUTF8(Result); //fix for cyrillic Windows
  end
  else
    Result := Def;
end;

function GetLocaleChar(LID, LT: Longint; Def: Char): Char;
var
  Buf: array[0..3] of Char; // sdate allows 4 chars.
begin
  if GetLocaleInfoA(LID, LT, Buf, sizeof(buf)) > 0 then
  begin
    Result := Buf[0];
    //Result := Result; //need add fix for cyrillic Windows
  end
  else
    Result := Def;
end;

procedure GetFormatSettingsUTF8Fix;
begin
  GetlocaleFormatSettingsUTF8(GetThreadLocale, DefaultFormatSettings);
end;

procedure GetLocaleFormatSettingsUTF8(LCID: Integer; var FormatSettings: TFormatSettings);
var
  HF  : Shortstring;
  LID : Windows.LCID;
  I,Day : longint;
begin
  LID := LCID;
  with FormatSettings do
    begin
  { Date stuff }
      for I := 1 to 12 do
        begin
        ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]);
        LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]);
        end;
      for I := 1 to 7 do
        begin
        Day := (I + 5) mod 7;
        ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]);
        LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]);
        end;
      DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/');
      ShortDateFormat := GetLocaleStr(LID, LOCALE_SSHORTDATE, 'm/d/yy');
      LongDateFormat := GetLocaleStr(LID, LOCALE_SLONGDATE, 'mmmm d, yyyy');
      { Time stuff }
      TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':');
      TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM');
      TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM');
      if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then
        HF:='h'
      else
        HF:='hh';
      // No support for 12 hour stuff at the moment...
      ShortTimeFormat := HF+':nn';
      LongTimeFormat := HF + ':nn:ss';
      { Currency stuff }
      CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, '');
      CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0);
      NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0);
      { Number stuff }
      ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ',');
      DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.');
      CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0);
      ListSeparator := GetLocaleChar(LID, LOCALE_SLIST, ',');
    end;
end;

end.


Напишите о проблеме в http://bugs.freepascal.org