WideMemo.pas

   1 unit WideMemo;
   2
   3 interface
   4
   5 uses
   6     Messages, Windows, Controls, StdCtrls, SysUtils, Classes, Types;
   7
   8 type
   9     TWideMemo = class;
  10
  11     TWideMemo = class(TMemo)
  12 private
  13     function GetEncodeText: AnsiString;
  14     procedure SetEncodeText(SrcText: AnsiString);
  15 protected
  16     procedure CreateWindowHandle(const Params: TCreateParams); override;
  17 public
  18     constructor Create(AOwner: TComponent); override;
  19     procedure InsertText(SrcText: AnsiString);
  20     property EncodeText: AnsiString read GetEncodeText write SetEncodeText;
  21 end;
  22
  23
  24 implementation
  25
  26 constructor TWideMemo.Create(AOwner: TComponent);
  27 begin
  28     inherited Create(AOwner);
  29 end;
  30
  31 procedure TWideMemo.CreateWindowHandle(const Params: TCreateParams);
  32 //var
  33 //    ClassName: WideString;
  34 begin
  35     with Params do
  36     begin
  37 //        ClassName := WideString(WinClassName);
  38 //        WindowHandle := CreateWindowExW(ExStyle, PWideChar(ClassName), '', Style,
  39         WindowHandle := CreateWindowExW(ExStyle, 'EDIT', '', Style,
  40                                         X, Y, Width, Height, WndParent, 0,
  41                                         HInstance, Param);
  42 //        SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
  43     end;
  44 end;
  45
  46 function TWideMemo.GetEncodeText: AnsiString;
  47 var
  48     Len: Integer;
  49     LenUC: Integer;
  50     BufUC: PWideChar;
  51     BufUCSize: Integer;
  52     BufSJ: array[0..16] of AnsiChar;
  53     UseDefChar: LongBool;
  54     Cnt: Integer;
  55     TextSJ: AnsiString;
  56 begin
  57     Len := GetWindowTextLengthW(Handle);
  58     LenUC := Len + 1;
  59     BufUCSize := LenUC * SizeOf(WideChar);
  60     BufUC := AllocMem(BufUCSize);
  61     ZeroMemory(BufUC, BufUCSize);
  62     GetWindowTextW(Handle, BufUC, LenUC);
  63
  64     WideCharToMultiByte(CP_ACP, 0, BufUC, LenUC, nil, 0, nil, @UseDefChar);
  65     if (UseDefChar = False) then begin
  66         Result := AnsiString(BufUC);
  67     end else begin
  68         for Cnt := 0 to Len do
  69         begin
  70             ZeroMemory(@BufSJ, 16);
  71             WideCharToMultiByte(CP_ACP, 0, @BufUC[Cnt], 1, BufSJ, 16, nil, @UseDefChar);
  72             if (UseDefChar = False) then begin
  73                 TextSJ := TextSJ + AnsiString(BufSJ);
  74             end else begin
  75                 TextSJ := TextSJ + Format('&#%d;', [Ord(BufUC[Cnt])]);
  76             end;
  77         end;
  78         Result := TextSJ;
  79     end;
  80     FreeMem(BufUC);
  81 end;
  82
  83 procedure TWideMemo.SetEncodeText(SrcText: AnsiString);
  84 var
  85     CodePos: Integer;
  86     TextSJ: AnsiString;
  87     TextUC: WideString;
  88     CodeSJ: AnsiString;
  89     CodeVal: Integer;
  90 begin
  91     TextSJ := SrcText;
  92     while Length(TextSJ) > 0 do begin
  93         CodePos := AnsiPos('&#', TextSJ);
  94         if (CodePos < 1) then begin
  95             TextUC := TextUC + WideString(TextSJ);
  96             Break;
  97         end;
  98         if (CodePos > 1) then begin
  99             TextUC := TextUC + WideString(Copy(TextSJ, 1, CodePos - 1));
 100             Delete(TextSJ, 1, CodePos - 1);
 101         end;
 102         CodePos := AnsiPos(';', TextSJ);
 103         if (CodePos < 1) then begin
 104             TextUC := TextUC + WideString(TextSJ);
 105             Break;
 106         end;
 107         CodeSJ := Copy(TextSJ, 3, CodePos - 3);
 108         CodeVal := StrToIntDef(CodeSJ, 0);
 109         if ((CodeVal < 1) or (CodeVal > $FFFF)) then begin
 110             TextUC := TextUC + WideString(Copy(TextSJ, 1, CodePos));
 111         end else begin
 112             TextUC := TextUC + WideString(WideChar(CodeVal));
 113         end;
 114         Delete(TextSJ, 1, CodePos);
 115     end;
 116
 117     SetWindowTextW(Handle, PWideChar(TextUC));
 118 end;
 119
 120 procedure TWideMemo.InsertText(SrcText: AnsiString);
 121 var
 122     LenUC: Integer;
 123     BufUC: PWideChar;
 124     BufUCSize: Integer;
 125     SelS: LongWord;
 126     SelE: LongWord;
 127     FullText: WideString;
 128     InsText: WideString;
 129     AftCurPos: LongInt;
 130 begin
 131     InsText := WideString(SrcText);
 132
 133     LenUC := GetWindowTextLengthW(Handle) + 1;
 134     BufUCSize := LenUC * SizeOf(WideChar);
 135     BufUC := AllocMem(BufUCSize);
 136     ZeroMemory(BufUC, BufUCSize);
 137     GetWindowTextW(Handle, BufUC, LenUC);
 138     FullText := WideString(BufUC);
 139     FreeMem(BufUC);
 140
 141     SelS := 0;
 142     SelE := 0;
 143     SendMessageW(Handle, EM_GETSEL, WPARAM(@SelS), LPARAM(@SelE));
 144
 145     if (SelS <> SelE) then
 146         Delete(FullText, SelS + 1, SelE - SelS);
 147     Insert(InsText, FullText, SelS + 1);
 148
 149     SetWindowTextW(Handle, PWideChar(FullText));
 150
 151     AftCurPos := LongInt(SelS) + Length(InsText);
 152
 153     SendMessageW(Handle, EM_SETSEL, AftCurPos, AftCurPos);
 154 end;
 155
 156 end.