Dream 中文化 第二版(0分)

J

jiichen

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2000-09-07

• #1

{
DreamMemo v3.51 中文改善方案
2000-09-07
}

// dcstring.pas
procedure TCustomMemoSource.Navigate(ADeltaLine, ADeltaChar : integer);
var
ALen : integer;
{ JC 變數 }
s:string;
i,
m:integer;
begin
{ JC 改編
解決游標會移至中文字之中間的問題 }
s:=GetTextAt(GetCurChar + ADeltaChar , GetCurLine + ADeltaLine);
i:=1;
m:=GetCurChar+ADeltaChar+1;
// m = 游標移動後之落點
begin
while i<length(s)do
begin
if (s>=#$81) and (s<=#$fe) then
if (s[i+1]>=#$40) and (s[i+1]<=#$fe) then
begin
inc(i);
// 預測中文字之落點
end;
inc(i);
if i=m then
// 符合的話，表中文字未被分成兩半，直接跳出
break;
if (i > m) then
begin
if ADeltaChar>0 then
ADeltaChar:=ADeltaChar+1
else
ADeltaChar:=ADeltaChar-1;
break;
end;
end;
end;
{ ------------- JC End ------------------}
if ADeltaLine <> 0 then
DiscardTrailingTabs(false);
if not FManualPosition then
GetNavigation(ADeltaLine, ADeltaChar);
with FPositiondo
begin
if ADeltaLine < 0 then
ADeltaLine := max(- LinePos, ADeltaLine);
if ADeltaChar < 0 then
ADeltaChar := max(- CharPos, ADeltaChar);
ADeltaLine := ChangeDeltaLine(ADeltaLine);
if (soLimitEOL in FOptions) then
begin
ALen := Length(Strings[LinePos + ADeltaLine]);
if (CharPos + ADeltaChar > ALen ) then
ADeltaChar := - CharPos + ALen
end;

if soCursorAlwaysOnTabs in FOptions then
CheckDeltaChar(LinePos + ADeltaLine, CharPos, ADeltaChar);
if (ADeltaChar = 0) and (ADeltaLine = 0) and not FGotoBookMark then
exit;
begin
Update(acNavigate);
if ADeltaLine <> 0 then
DiscardTrailingTabs(false);
if FAllowUndo then
with CreateNewUndoRecord(soNavigate)^do
begin
FDeltaLine := ADeltaLine;
FDeltaChar := ADeltaChar;
end;

inc(CharPos, ADeltaChar);
inc(LinePos, ADeltaLine);
EndUpdate;
end;

{原作
if ADeltaLine <> 0 then
DiscardTrailingTabs(false);
if not FManualPosition then
GetNavigation(ADeltaLine, ADeltaChar);
with FPositiondo
begin
if ADeltaLine < 0 then
ADeltaLine := max(- LinePos, ADeltaLine);
if ADeltaChar < 0 then
ADeltaChar := max(- CharPos, ADeltaChar);
ADeltaLine := ChangeDeltaLine(ADeltaLine);
if (soLimitEOL in FOptions) then
begin
ALen := Length(Strings[LinePos + ADeltaLine]);
if (CharPos + ADeltaChar > ALen ) then
ADeltaChar := - CharPos + ALen
end;

if soCursorAlwaysOnTabs in FOptions then
CheckDeltaChar(LinePos + ADeltaLine, CharPos, ADeltaChar);
if (ADeltaChar = 0) and (ADeltaLine = 0) and not FGotoBookMark then
exit;
begin
Update(acNavigate);
if ADeltaLine <> 0 then
DiscardTrailingTabs(false);
if FAllowUndo then
with CreateNewUndoRecord(soNavigate)^do
begin
FDeltaLine := ADeltaLine;
FDeltaChar := ADeltaChar;
end;

inc(CharPos, ADeltaChar);
inc(LinePos, ADeltaLine);
EndUpdate;
end;
}
end;



// dcmemo.pas
function TCustomDCMemo.PaintString(var R : TRect;
var BaseLine : integer;
const S, ColorS : string;
begChar, endChar, CurLine, CurWrapLine, CurPos, CurStyle : integer;
SkipColors, CalcRect, CalcSymbols : boolean) : integer;
var
SLen : integer;
curchar : integer;
scolor : integer;
ncolor : integer;
ccount : integer;
ARight : integer;
W : integer;
ADescent : integer;
selchanged : boolean;
_insel : boolean;
oldColor : integer;
OldBkColor : integer;
_MarkedText : boolean;
MarkedChanged : boolean;
TextRect : TRect;
tm : TTextMetric;
{ JC 變數 }
ji,
jm,
jcc:integer;
{-----------------------------------------------}
function _GetColor(cchar : integer) : integer;
begin
if cchar <= length(ColorS) then
begin
result := {ValidateColorStyle}(byte(Colors[cchar]));
if not (moColorSyntax in Options) and HighLightUrls and (result <> cUrlTextStyle) then
result := 0;
do
GetColorStyle(Point(cchar, CurLine), result);
end
else
result := -1;
end;

{-----------------------------------------------}
begin
result := 0;
FCurFont := 0;
FCurStyle := 0;
TextRect := R;
ARight := R.Right;
if CalcRect then
BaseLine := 0;
ADescent := 0;
with TextRectdo
Right := Left;
SLen := Min(Length(S), endChar);
curchar := begChar;
oldColor := GetTextColor(GetDrawDC);
OldBkColor := GetBkColor(GetDrawDC);
while curchar < SLendo
begin
ccount := 0;
scolor := _GetColor(curChar + 1);
_insel := not CalcRect and InSelection(curchar + CurPos - 1, CurLine);
selchanged := false;
_MarkedText := InFoundRect(curchar + CurPos - 1, CurLine);
MarkedChanged := false;
repeat
while (ccount < Slen - curchar) and (_GetColor(curchar + ccount + 1) = scolor)do
begin
inc(ccount);
if not CalcRect and InSelection(curchar + ccount + CurPos - 1, CurLine) <> _insel then
begin
selchanged := true;
break;
end;
if not CalcRect and InFoundRect(curchar + ccount + CurPos - 1, CurLine) <> _MarkedText then
begin
MarkedChanged := true;
break;
end;
end;

ncolor := _GetColor(curchar + ccount + 1);
if selchanged or MarkedChanged or (ccount = Slen - curchar) then
break;
if EqualStyles(scolor, ncolor, SkipColors or (_inSel and not selchanged) or _MarkedText) then
scolor := ncolor
else
break;
until false;
{ JC start}
ji:=1;
jcc:=0;
jm:=-1;
while ji<length(s)do
begin
{ if ji=(curchar+1) then
begin
jm:=0;
end;
}
if (s[ji]>=#$81) and (s[ji]<=#$fe) then
if (s[ji+1]>=#$40) and (s[ji+1]<=#$fe) then
begin
inc(ji);
// 預測中文字之落點
end;
inc(ji);

if ji=(ccount+1) then
// 符合的話，表中文字未被分成兩半，直接跳出
begin
break;
end;

if ji>(ccount+1) then
begin
jcc:=1;
break;
end;
end;
{ JC end }
if SkipColors then
FCurFont := SetColorFromStyle(scolor, CurStyle, OldColor, OldBkColor, _insel, SkipColors, CalcRect)
else
FCurFont := SetColorFromStyle(scolor, CurStyle, 0, 0, _insel, SkipColors, CalcRect);
FCurStyle := scolor;
if _MarkedText then
SetDCColor(FMatchColor, FMatchBackColor);
with TextRectdo
begin
if FUseMonoFont then
begin
TextRect := Bounds(Left, Top, ccount * CharWidth, LineHeight);
UpdateCharSp(ccount);
end
else
TextRect := Rect(Right, R.Top, Right, R.Bottom);
_TextOut(TextRect, BaseLine, CurWrapLine, Left, Top, @(s[curchar + 1 ]), ccount+jcc, CalcRect);
{ 原作
_TextOut(TextRect, BaseLine, CurWrapLine, Left, Top, @(s[curchar + 1]), ccount, CalcRect);}
if CalcSymbols and (TextRect.Right > ARight) then
begin
if R.Bottom - R.Top = 0 then
R.Bottom := max(R.Bottom, Bottom);
R.Right := TextRect.Left;
break;
end;

if not FUseMonoFont then
begin
R.Bottom := max(R.Bottom, Bottom);
R.Right := Right;
with GetFontInfo(FCurFont)^do
begin
BaseLine := max(BaseLine, Ascent);
ADescent := Max(ADescent, Descent);
end;
if FPrintPageSize.X <> 0 then
W := FPrintPageSize.X
else
W := ClientWidth;
if not (CalcRect or CalcSymbols) and (TextRect.Right >= W) then
break;
end
else
Left := Right;
end;
inc(curchar, ccount);
inc(result, ccount);
end;
if FUseMonoFont then
R.Right := TextRect.Right
else
if CalcRect and not FUseMonoFont then
R.Bottom := max(R.Bottom, ADescent + BaseLine);
if not CalcRect and (result <> 0) then
with GetFontInfo(FCurFont)^do
inc(R.Right, OverHang);
//- OverHang div 7);
SetColorFromStyle(-1, 0, 0, 0, false, SkipColors, CalcRect);
SetDCColor(OldColor, OldBkColor);
end;


function TCustomDCMemo.FindWordBreak(LinePos : integer;
var Pos, BaseLine : integer;
var R : TRect) : string;
var
i : integer;
idx : integer;
Len : integer;
s : string;
ColorS : string;
{ JC 變數 }
ji:integer;
begin
{ JC 改編
}
if FUseMonoFont then
begin
Len := FWbCount;
s := Lines[LinePos];
R := Rect(0, 0, 0, 0);
BaseLine := 0;
end
else
begin
GetStrData(LinePos, S, ColorS);
R := Rect(0, 0, GetWrapMargin - GetPaintX, LineHeight);
len := Max(SymbolsDrawn(LinePos, Pos, copy(S, Pos, length(s) - Pos + 1), copy(ColorS, Pos, length(ColorS) - Pos + 1),
BaseLine, R, true) - 1, 1);
end;

if length(s) - Pos > Len then
begin
idx := -1;
for i := Len + Posdo
wnto Posdo
if s in GetSource.DelimSet then
begin
idx := i;
break;
end;
if idx = -1 then
idx := Len + Pos;
// 原作中，此時 idx 已決定了分隔的位置，
// 故藉此判斷是否 idx 為中文字之一半。
ji:=1;
while ji<length(s)do
begin
if (s[ji]>=#$81) and (s[ji]<=#$fe) then
if (s[ji+1]>=#$40) and (s[ji+1]<=#$fe) then
begin
inc(ji);
// 預測中文字之落點
end;
inc(ji);
if ji = (idx+1) then
break;
if ji > (idx+1) then
begin
dec(idx);
// 運行至此步驟則表示， idx 所指為中文字之一半
break;
end;
end;

result := Copy(s, Pos, idx - Pos + 1);
if not FUseMonoFont then
R.BottomRight := CalcStringSize(S, ColorS, Pos - 1, idx - Pos + 1, BaseLine);
Pos := idx + 1;
end
else
begin
result := Copy(s, Pos, length(s) - Pos + 1);
Pos := length(s) + 1;
end;



{ ------------------ JC End -------------------- }
{ 原作
if FUseMonoFont then
begin
Len := FWbCount;
s := Lines[LinePos];
R := Rect(0, 0, 0, 0);
BaseLine := 0;
end
else
begin
GetStrData(LinePos, S, ColorS);
R := Rect(0, 0, GetWrapMargin - GetPaintX, LineHeight);
len := Max(SymbolsDrawn(LinePos, Pos, copy(S, Pos, length(s) - Pos + 1), copy(ColorS, Pos, length(ColorS) - Pos + 1),
BaseLine, R, true) - 1, 1);
end;
if length(s) - Pos > Len then
begin
idx := -1;
for i := Len + Posdo
wnto Posdo
if s in GetSource.DelimSet then
begin
idx := i;
break;
end;
if idx = -1 then
idx := Len + Pos;
result := Copy(s, Pos, idx - Pos + 1);
if not FUseMonoFont then
R.BottomRight := CalcStringSize(S, ColorS, Pos - 1, idx - Pos + 1, BaseLine);
Pos := idx + 1;
end
else
begin
result := Copy(s, Pos, length(s) - Pos + 1);
Pos := length(s) + 1;
end;
}
end;

{
改善至此，尚餘下左邊邊界時有亂碼，無法解決，
右邊邊界解決方案為：原作做好 Rect 及字串字數，
只需判斷中文為一半時，則增加其字串字數，便解決了，
然左邊卻無法依此方式，留給高手吧！
}

 

F

fcputao

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2000-09-17

• #2

这是什么软件?

 

Z

Zephyr

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2000-09-17

• #3

你的方法是适用于BIG5码的吧？
其实我本人认为用mwCustomEdit效果更好，它已经内建支持MBCS了，功能上也比
Dream Memo强一些，建议你改用这个构件。

 

J

jiichen

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2000-09-17

• #4

我是以 第一個字母 81<=A<=FE
第二個字母 40<=B<=FE
來判別中文字，以此範圍的話，應該簡繁皆適用！

 

B

bodhisattva

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2000-09-17

• #5

你要干什么？嘿！嘿！

 

Z

Zephyr

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2000-09-17

• #6

不好意思，我没认真想想就发表意见了。

 

J

Jams

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2000-09-18

• #7

>>

 

W

wjiachun

Unregistered / Unconfirmed

GUEST, unregistred user!

• 2000-10-27

• #8

接受答案了.