Собственно столкнулся с такой проблемой, решил в проекте использовать dbgrideh, поскольку это весьма продвинутый грид ,который использую в проектах на delphi,
но при работе в Lazarus , встретился с некоторыми косяками кодировки , которые разработчики никак не могут поправить. В частности криво работает подсветка найденного текста.
Нашел код отвечающий за отрисовку, но никак не могу заставить его нормально выводить символы, подскажите как можно это поправить.
- Код: Выделить всё
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;