DbgridEh, подсветка найденного текста

Вопросы программирования и использования среды Lazarus.

Модератор: Модераторы

DbgridEh, подсветка найденного текста

Сообщение DYUMON » 06.09.2017 22:06:57

День добрый всем.
Собственно столкнулся с такой проблемой, решил в проекте использовать dbgrideh, поскольку это весьма продвинутый грид ,который использую в проектах на delphi,
но при работе в Lazarus , встретился с некоторыми косяками кодировки , которые разработчики никак не могут поправить. В частности криво работает подсветка найденного текста.
ehlib.png

Нашел код отвечающий за отрисовку, но никак не могу заставить его нормально выводить символы, подскажите как можно это поправить.
Код: Выделить всё
procedure DrawHighlightedSubTextEh(C: TCanvas; AR: TRect; X, Y: Integer;
  const T: string; A: TAlignment; La:TTextLayout; ML:Boolean; EE: Boolean;
  L, R: Integer; rlr: Boolean; const S: String; CI, WW, SOS: Boolean; HC: TColor; Pos: Integer;
  PosC: TColor; var ofv: Integer);
var
  SP: TIntegerDynArray;
  cex: TIntegerDynArray;
  i, nlp, olp, Line, wpxl, sw: Integer;
  lsa: array of lire;
  da: array of dptr;
  ddr: TRect;
  gtdu: Integer;
  ufdu: Integer;
  Options: Longint;
  RectWidth: Integer;
  MaxChars: Integer;
  StringSize: TSize;
  OldBColor, OldFColor: TColor;
  RTLS: Boolean;
  flh, TopExtra: Integer;

  function tw(Sp, L: Integer): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := Sp to Sp+L-1 do
      Inc(Result, cex[i]);
  end;

  procedure mdarff(Pos: Integer);
  var
    Len: Integer;
    im: Integer;
    dapos: Integer;
  begin
    Len := Length(S);

    for im := 0 to Length(lsa)-1 do
    begin
      if (lsa[im].st <= Pos) and (lsa[im].st + lsa[im].le > Pos) then
      begin
        SetLength(da, Length(da)+1);
        dapos := Length(da)-1;
        da[dapos].X := tw(lsa[im].st, Pos-lsa[im].st);
        da[dapos].Y := StringSize.cy * im;
        da[dapos].StrStart := Pos;
        da[dapos].StrLength := Len;
        da[dapos].gtdu := gtdu;
        da[dapos].liw := lsa[im].pwi;
        if A = taLeftJustify then
          da[dapos].lis := X
        else if A = taRightJustify then
          da[dapos].lis := AR.Right - AR.Left - lsa[im].pwi - X - 1
        else if A = taCenter then
          da[dapos].lis := (AR.Right - AR.Left - lsa[im].pwi) div 2;
      end else
       ofv := ofv + 1;
    end;
  end;

  function IsRTLS: Boolean;
{$IFDEF EH_LIB_12}
  var
    MapLocale: LCID;
    arr: array of Integer;
{$ENDIF}
  begin
    Result := False;
    if T = '' then Exit;

{$IFDEF EH_LIB_12}
    if CheckWin32Version(5, 1) then
      MapLocale := LOCALE_INVARIANT
    else
      MapLocale := LOCALE_SYSTEM_DEFAULT;

    SetLength(arr, 1);
    arr[0] := 0;
    GetStringTypeEx(MapLocale, CT_CTYPE2, PWideChar(T), 1, arr[0]);

    if arr[0] in [C2_RIGHTTOLEFT, C2_ARABICNUMBER] then
      Result := True;
{$ENDIF}
  end;

begin
  ofv := 0;
  if not GetAllStrEntry(T, S, SP, CI, WW, SOS) then
    Exit;

  RTLS := IsRTLS;
  ufdu := DT_CALCRECT or DT_LEFT or DT_NOPREFIX;
  ddr := Rect(0, 0, 1, 0);
  DrawTextEh(C.Handle, T, Length(T), ddr, ufdu);
  gtdu := ddr.Right - ddr.Left;

  if La <> tlTop then
  begin
    ddr := Rect(0, 0, AR.Right - AR.Left, 0);
    ufdu := DT_CALCRECT or DT_LEFT or DT_NOPREFIX or DT_WORDBREAK;
    DrawTextEh(C.Handle, T, Length(T), ddr, ufdu);
    flh := ddr.Bottom - ddr.Top;
    TopExtra := ((AR.Bottom - AR.Top) div 2) - (flh div 2);
  end else
    TopExtra := Y;

  RectWidth := AR.Right - AR.Left - X*2;
  SetLength(cex, Length(T));
  GetTextExtentExPoint(C.Handle, PChar(T), Length(T),
   10000, //      RectWidth,
   @MaxChars, @cex[0], StringSize);

  for i := Length(T)-1 downto 1 do cex[i] := cex[i] - cex[i-1];

  olp := 0;
  Line := 0;
  while True do
  begin
    nlp := geli(T, olp, RectWidth, wpxl, cex, ML);
    SetLength(lsa, Line+1);
    lsa[Line].st := olp;
    lsa[Line].le := nlp - olp + 1;
    lsa[Line].pwi := wpxl;
    Inc(Line);
    if nlp >= Length(T)-1 then
      Break;
    olp := nlp+1;
    if not ML then Break;
  end;

  for i := 0 to Length(SP)-1 do
    mdarff(SP[i]);

  OldBColor := C.Brush.Color;
  OldFColor := C.Font.Color;
  C.Brush.Color := HC;
  C.Font.Color := clWindowText;
  for i := 0 to Length(da)-1 do
  begin
    Options := ETO_CLIPPED;
    ddr := Rect(da[i].X + AR.Left + da[i].lis, da[i].Y + AR.Top + TopExtra, 0, 0);
    sw := tw(da[i].StrStart, da[i].StrLength);
    ddr.Right := ddr.Left + sw;

    ddr.Bottom := ddr.Top + StringSize.cy;

    if RTLS then
    begin
      ddr.Left := AR.Left + da[i].lis + da[i].liw - da[i].X - sw;
      ddr.Right := ddr.Left + sw;
    end;

    Windows.ExtTextOut(C.Handle,
      ddr.Left, ddr.Top, Options, @ddr,
      @T[da[i].StrStart+1], da[i].StrLength, nil);
    if (ddr.Left > AR.Right) or (ddr.Top > AR.Bottom) then
      ofv := ofv + 1;
  end;

  C.Brush.Color := OldBColor;
  C.Font.Color := OldFColor;
end;

У вас нет необходимых прав для просмотра вложений в этом сообщении.
Аватара пользователя
DYUMON
постоялец
 
Сообщения: 179
Зарегистрирован: 11.03.2009 13:32:54

Re: DbgridEh, подсветка найденного текста

Сообщение kit » 07.09.2017 09:43:31

Нужно менять кодировку подсвеченого текста. Но, поскольку там таких проблем много, лучше перейти на TRxDBGrid
kit
постоялец
 
Сообщения: 104
Зарегистрирован: 29.09.2016 09:39:07

Re: DbgridEh, подсветка найденного текста

Сообщение DYUMON » 07.09.2017 19:03:27

Да я использую в некоторых проектах уже TRxDBGrid, но тут перекладываю delphi проект поэтому , хочу оставить dbgrideh.
Аватара пользователя
DYUMON
постоялец
 
Сообщения: 179
Зарегистрирован: 11.03.2009 13:32:54

Re: DbgridEh, подсветка найденного текста

Сообщение Лекс Айрин » 07.09.2017 19:32:14

DYUMON писал(а):Windows.ExtTextOut(C.Handle,
ddr.Left, ddr.Top, Options, @ddr,
@T[da[i].StrStart+1], da[i].StrLength, nil);
if (ddr.Left > AR.Right) or (ddr.Top > AR.Bottom) then
ofv := ofv + 1;

судя по всему, косяк в этом фрагменте.

тебе просто надо выбрать юникодный вариант этой функции. Насколько я помню, это будет ExtTextOutW ( есть еще кариант с A на конце.)
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 4097
Зарегистрирован: 19.02.2013 16:54:51

Re: DbgridEh, подсветка найденного текста

Сообщение vitaly_l » 07.09.2017 19:41:46

DYUMON писал(а):хочу оставить dbgrideh

Попробуйте преобразовать переменную T к кодировке WinCP
в самом-самом начале после строчки if T = '' then Exit;
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3075
Зарегистрирован: 31.01.2012 16:41:41

Re: DbgridEh, подсветка найденного текста

Сообщение DYUMON » 07.09.2017 20:56:54

Частично срабатывает такой вариант
Код: Выделить всё
tt:=pchar(UTF8ToCP1251(T)); 
Windows.ExtTextOut(C.Handle,ddr.Left, ddr.Top, Options, @ddr,@TT[da[i].StrStart+1]  , da[i].StrLength, nil); 

grid2.png
У вас нет необходимых прав для просмотра вложений в этом сообщении.
Аватара пользователя
DYUMON
постоялец
 
Сообщения: 179
Зарегистрирован: 11.03.2009 13:32:54

Re: DbgridEh, подсветка найденного текста

Сообщение vitaly_l » 07.09.2017 21:08:39

DYUMON писал(а):tt:=pchar(UTF8ToCP1251(T)); 

не так 100% не будет работать, т.к проверяет в UTF, а выводит в WinCP и поэтому захватывает лишние символы.

Вот так работает? (нужно это делать в самом начале функции)
Код: Выделить всё
T:=UTF8ToCP1251(T);

или лучше вот эту: (нужно это делать в самом начале функции)
Код: Выделить всё
T:=UTF8ToWinCP(T);

Если не работает, то попробуйте заменить ExtTextOut на ExtTextOutW в изначальном варианте

Добавлено спустя 22 минуты:
Либо можно ещё вот такой костыль поставить,
там где уже работает tt:=pchar(UTF8ToCP1251(T));
перед запуском ExtTextOut - поставьте вот это:
Код: Выделить всё
da[i].StrLength := da[i].StrLength div 2;

тогда выделение у русских символов - будет выделять точнее.
Аватара пользователя
vitaly_l
долгожитель
 
Сообщения: 3075
Зарегистрирован: 31.01.2012 16:41:41

Re: DbgridEh, подсветка найденного текста

Сообщение Лекс Айрин » 08.09.2017 09:05:09

vitaly_l писал(а):не так 100% не будет работать, т.к проверяет в UTF, а выводит в WinCP и поэтому захватывает лишние символы.


вообще-то это скорее ansi/

vitaly_l писал(а):тогда выделение у русских символов - будет выделять точнее.


Ага.. а если английские, то будет корежить.
Аватара пользователя
Лекс Айрин
долгожитель
 
Сообщения: 4097
Зарегистрирован: 19.02.2013 16:54:51

Re: DbgridEh, подсветка найденного текста

Сообщение pupsik » 08.09.2017 21:32:44

dbgrideh, поскольку это весьма продвинутый грид
не спорю... НО: платный. Поэтому: с поддержкой.

Т.е....
Иначе: зачем тогда платить?
Т.е. он деньгу получил и усё? Или стащили?

Ведь на оф.форуме уже мелькала данная тема. Плюс, вроде как, нашли причину...
pupsik
энтузиаст
 
Сообщения: 1011
Зарегистрирован: 20.08.2014 16:20:13

Re: DbgridEh, подсветка найденного текста

Сообщение DYUMON » 08.09.2017 23:46:41

В последнем релизе ничего не сменилось. На офф форуме была такая тема, он там тоже не показали чего править.
Аватара пользователя
DYUMON
постоялец
 
Сообщения: 179
Зарегистрирован: 11.03.2009 13:32:54

Re: DbgridEh, подсветка найденного текста

Сообщение pupsik » 09.09.2017 00:29:41

DYUMON показали/не показали... Если вы заплатили то имеете право на поддержку. Стучитесь к разрабу.
В принципе, на форуме, вроде как указали "где рыть" (не факт). По логике - явно недосмотр с кодировкой (не учтена специфика лазаря... хотя.... ХЕ, вроде как, то же не на вин сидит).

п.с.
Нашел код отвечающий за отрисовку, но никак не могу заставить его нормально выводить . символы, подскажите как можно это поправить.
судя по коду... ожидается анси, а не ютф8.

Скармливать для поиска 1251 пробовали? Т.е. ваш "тест", или "проверка" преобразовать в 1251... По идее не должно сработать (но есть авось :))
pupsik
энтузиаст
 
Сообщения: 1011
Зарегистрирован: 20.08.2014 16:20:13


Вернуться в Lazarus

Кто сейчас на конференции

Сейчас этот форум просматривают: Yandex [Bot] и гости: 2

Рейтинг@Mail.ru