rvcharcase.pas

richviewaction 1.58 需要richview 1.9.46

{*******************************************************}
{                                                       }
{       RichView                                        }
{       RVChangeCharCase - procedure for changing       }
{       character case of the selected text             }
{                                                       }
{       Copyright (c) Sergey Tkachenko                  }
{       [e-mail]                               }
{       http://www.trichview.com                        }
{                                                       }
{*******************************************************}

unit RVCharCase;

interface
uses Windows, SysUtils,
  RVStyle, RVEdit, RVUni, RVItem;

{
  Limitations:
    - requires WinNT/2k/XP for Unicode text (otherwise, skips Unicode)
    - for non-Unicode text, works correctly only for the main language of Windows
    - does not work with selected tables/cells
}

type
  TRVCharCase = (rvccLowerCase, rvccUpperCase, rvccTitleWord);

// Changes char case
procedure RVChangeCharCase(rve: TCustomRichViewEdit; CharCase: TRVCharCase);
// Returns information about selected text
procedure RVGetCharCase(rve: TCustomRichViewEdit;
  var AllUpperCase, AllLowerCase: Boolean);

implementation

{------------------------------------------------------------------------------}

function ChangeCharCase(const prevs, s: String; TextStyle: TFontInfo;
  CharCase: TRVCharCase): String;
var unitext: PRVWordArray;
    i: Integer;
    Change: Boolean;
begin
  if Length(s)=0 then begin
    Result := s;
    exit;
  end;
  case CharCase of
    rvccLowerCase:
      if TextStyle.Unicode then
        if RVNT then begin
          SetString(Result, PChar(s), Length(s));
          CharLowerBuffW(Pointer(Result), Length(s) div 2);
          end
        else
          Result := s
      else
       Result := AnsiLowerCase(s);
    rvccUpperCase:
      if TextStyle.Unicode then
        if RVNT then begin
          SetString(Result, PChar(s), Length(s));
          CharUpperBuffW(Pointer(Result), Length(s) div 2);
          end
        else
          Result := s
      else
       Result := AnsiUpperCase(s);
    rvccTitleWord:
      if TextStyle.Unicode then
        if RVNT then begin
          SetString(Result, PChar(s), Length(s));
          CharLowerBuffW(Pointer(Result), Length(s) div 2);
          unitext := PRVWordArray(PChar(Result));
          Change := True;
          if prevs<>'' then
            Change := not IsCharAlphaNumericW(
              WideChar(PWordArray(PChar(prevs))[Length(prevs) div 2-1]));
          for i := 0 to Length(s) div 2 -1 do
            if not IsCharAlphaNumericW(WideChar(unitext[i])) then
              Change := True
            else if Change then begin
              CharUpperBuffW(Pointer(@(unitext[i])), 1);
              Change := False;
            end;
          end
        else
          Result := s
      else begin
        Result := AnsiLowerCase(s);
        Change := True;
        if prevs<>'' then
          Change := not IsCharAlphaNumericA(prevs[Length(prevs)]);
        for i := 1 to Length(Result) do
          if not IsCharAlphaNumericA(Result[i]) then
            Change := True
          else if Change then begin
            CharUpperBuffA(Pointer(@(Result[i])), 1);
            Change := False;
          end;
      end;
  end;
end;

procedure RVChangeCharCase(rve: TCustomRichViewEdit; CharCase: TRVCharCase);
var i, ItemNo1, ItemNo2, Offs1, Offs2: Integer;
    AItemNo1, AItemNo2, AOffs1, AOffs2: Integer;
    TextStyles: TFontInfos;
    ItemOptions: TRVItemOptions;
    s, s1, s2: String;
begin
  TextStyles := rve.Style.TextStyles;
  rve := rve.TopLevelEditor;
  rve.BeginUndoGroup(rvutModifyItem);
  rve.SetUndoGroupMode(True);
  LockWindowUpdate(rve.Handle);
  try
    rve.GetSelectionBounds(ItemNo1, Offs1, ItemNo2, Offs2, True);
    rve.GetSelectionBounds(AItemNo1, AOffs1, AItemNo2, AOffs2, False);
    if ItemNo2<>ItemNo1 then begin
      if rve.GetItemStyle(ItemNo1)>=0 then begin
        ItemOptions := rve.GetItem(ItemNo1).ItemOptions;
        s  := rve.GetItemText(ItemNo1);
        s1 := RVU_Copy(s, 1, Offs1-1, ItemOptions);
        s2 := RVU_Copy(s, Offs1, Length(s), ItemOptions);
        if s2<>'' then begin
          s2 := ChangeCharCase(s1, s2, TextStyles[rve.GetItemStyle(ItemNo1)], CharCase);
          rve.SetItemTextEd(ItemNo1, s1+s2);
        end;
      end;
      for i := ItemNo1+1 to ItemNo2-1 do
        if rve.GetItemStyle(i)>=0 then begin
          s  := rve.GetItemText(i);
          s := ChangeCharCase('', s, TextStyles[rve.GetItemStyle(i)], CharCase);
          rve.SetItemTextEd(i, s);
        end;
      if rve.GetItemStyle(ItemNo2)>=0 then begin
        ItemOptions := rve.GetItem(ItemNo2).ItemOptions;
        s  := rve.GetItemText(ItemNo2);
        s1 := RVU_Copy(s, 1, Offs2-1, ItemOptions);
        s2 := RVU_Copy(s, Offs2, Length(s), ItemOptions);
        if s1<>'' then begin
          s1 := ChangeCharCase('', s1, TextStyles[rve.GetItemStyle(ItemNo2)], CharCase);
          rve.SetItemTextEd(ItemNo2, s1+s2);
        end;
      end
      end
    else begin
      ItemOptions := rve.GetItem(ItemNo1).ItemOptions;
      s  := rve.GetItemText(ItemNo1);
      s1 := RVU_Copy(s, 1, Offs1-1, ItemOptions);
      s2 := RVU_Copy(s, Offs2, Length(s), ItemOptions);
      s  := RVU_Copy(s, Offs1, Offs2-Offs1, ItemOptions);
      s := ChangeCharCase(s1, s, TextStyles[rve.GetItemStyle(ItemNo1)], CharCase);
      rve.SetItemTextEd(ItemNo1, s1+s+s2);
    end;
  finally
    LockWindowUpdate(0);
    rve.SetUndoGroupMode(False);
    rve.SetSelectionBounds(AItemNo1, AOffs1, AItemNo2, AOffs2);
  end;
end;
{------------------------------------------------------------------------------}
// Assigns AllUpperCase to false, if there are lower-case characters
// Assigns AllLowerCase to false, if there are upper-case characters
// Returns (AllUpperCase or AllLowerCase)
function GetCharCase(const s: String; Unicode: Boolean;
  var AllUpperCase, AllLowerCase: Boolean): Boolean;
var unitext: PRVWordArray;
    i: Integer;
    Upper, Lower: Boolean;
    ch: Char;
    wch: WideChar;
begin
  if (Length(s)=0) or (Unicode and not RVNT) then begin
    Result := (AllUpperCase or AllLowerCase);
    exit;
  end;
  Upper := False;
  Lower := False;
  if not Unicode then
    for i := 1 to Length(s) do begin
      ch := s[i];
      if IsCharAlpha(ch) then begin
        if IsCharLower(ch) then
          Lower := True;
        if IsCharUpper(ch) then
          Upper := True;
        if Upper and Lower then
          break;
      end;
    end
  else begin
    unitext := PRVWordArray(PChar(s));
    for i := 0 to (Length(s) div 2)-1 do begin
      wch := WideChar(unitext[i]);
      if IsCharAlphaW(wch) then begin
        if IsCharLowerW(wch) then
          Lower := True;
        if IsCharUpperW(wch) then
          Upper := True;
        if Upper and Lower then
          break;
      end
    end;
  end;
  if Upper then
    AllLowerCase := False;
  if Lower then
    AllUpperCase := False;
  Result := (AllUpperCase or AllLowerCase);
end;
{------------------------------------------------------------------------------}
procedure RVGetCharCase(rve: TCustomRichViewEdit;
  var AllUpperCase, AllLowerCase: Boolean);
var i, ItemNo1, ItemNo2, Offs1, Offs2: Integer;
    TextStyles: TFontInfos;
    ItemOptions: TRVItemOptions;
    s: String;
begin
  TextStyles := rve.Style.TextStyles;
  rve := rve.TopLevelEditor;
  AllUpperCase := True;
  AllLowerCase := True;
  rve.GetSelectionBounds(ItemNo1, Offs1, ItemNo2, Offs2, True);
  if ItemNo2<>ItemNo1 then begin
    if rve.GetItemStyle(ItemNo1)>=0 then begin
      ItemOptions := rve.GetItem(ItemNo1).ItemOptions;
      s  := rve.GetItemText(ItemNo1);
      s := RVU_Copy(s, Offs1, Length(s), ItemOptions);
      GetCharCase(s, rvioUnicode in ItemOptions, AllUpperCase, AllLowerCase);
    end;
    if (AllUpperCase or AllLowerCase) then
      for i := ItemNo1+1 to ItemNo2-1 do
        if rve.GetItemStyle(i)>=0 then begin
          s  := rve.GetItemText(i);
          if not GetCharCase(s, TextStyles[rve.GetItemStyle(i)].Unicode, AllUpperCase, AllLowerCase) then
           break;
        end;
    if (AllUpperCase or AllLowerCase) and (rve.GetItemStyle(ItemNo2)>=0) then begin
      ItemOptions := rve.GetItem(ItemNo2).ItemOptions;
      s  := rve.GetItemText(ItemNo2);
      s := RVU_Copy(s, 1, Offs2-1, ItemOptions);
      GetCharCase(s, rvioUnicode in ItemOptions, AllUpperCase, AllLowerCase)
    end;
    end
  else begin
    ItemOptions := rve.GetItem(ItemNo1).ItemOptions;
    s  := rve.GetItemText(ItemNo1);
    s  := RVU_Copy(s, Offs1, Offs2-Offs1, ItemOptions);
    GetCharCase(s, rvioUnicode in ItemOptions, AllUpperCase, AllLowerCase)
  end;
end;

end.