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 GetWideText: WideString;
  14     function GetEncodeText: AnsiString;
  15     procedure SetEncodeText(SrcText: AnsiString);
  16 protected
  17     procedure CreateWindowHandle(const Params: TCreateParams); override;
  18 public
  19     constructor Create(AOwner: TComponent); override;
  20     procedure Free;
  21     procedure InsertText(InsText: WideString);
  22     property EncodeText: AnsiString read GetEncodeText write SetEncodeText;
  23 end;
  24
  25
  26 implementation
  27
  28 constructor TWideMemo.Create(AOwner: TComponent);
  29 begin
  30     inherited Create(AOwner);
  31 end;
  32
  33 procedure TWideMemo.Free;
  34 begin
  35     inherited Free;
  36 end;
  37
  38 procedure TWideMemo.CreateWindowHandle(const Params: TCreateParams);
  39 var
  40     ClassName: WideString;
  41 begin
  42     with Params do
  43     begin
  44         ClassName := WideString(WinClassName);
  45         WindowHandle := CreateWindowExW(ExStyle, PWideChar(ClassName), '', Style,
  46                                         X, Y, Width, Height, WndParent, 0,
  47                                         HInstance, Param);
  48         SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
  49     end;
  50 end;
  51
  52 function TWideMemo.GetWideText: WideString;
  53 var
  54 //    Len: Integer;
  55 //    LenUC: Integer;
  56 //    BufUC: PWideChar;
  57 //    BufUCSize: Integer;
  58     PosS: LongWord;
  59     PosE: LongWord;
  60     TextUC: WideString;
  61     MemHandle: HGLOBAL;
  62     TextP: PWideChar;
  63 begin
  64 //    Len := GetWindowTextLengthW(Handle);
  65 //    Len := Perform(WM_GETTEXTLENGTH, 0, 0);
  66 //    LenUC := Len + 1;
  67 //    BufUCSize := LenUC * SizeOf(WideChar);
  68 //    BufUC := AllocMem(BufUCSize);
  69 //    ZeroMemory(BufUC, BufUCSize);
  70 //    GetWindowTextW(Handle, BufUC, LenUC);
  71 //    SendMessageW(Handle, WM_GETTEXT, WPARAM(LenUC), LPARAM(BufUC));
  72 //    Result := WideString(BufUC);
  73 //    FreeMem(BufUC);
  74
  75         SendMessage(Handle, EM_GETSEL, WPARAM(@PosS), LPARAM(@PosE));
  76         SendMessage(Handle, EM_SETSEL, 0, GetWindowTextLengthW(Handle));
  77         SendMessage(Handle, WM_COPY, 0, 0);
  78         SendMessage(Handle, EM_SETSEL, WPARAM(PosS), LPARAM(PosE));
  79
  80     if (OpenClipboard(Handle) = True) then begin
  81         MemHandle := GetClipboardData(CF_UNICODETEXT);
  82         if (MemHandle <> 0) then begin
  83             TextP := PWideChar(GlobalLock(MemHandle));
  84             if not (TextP = nil) then begin
  85                 TextUC := WideString(TextP);
  86                 GlobalUnlock(MemHandle);
  87             end;
  88         end;
  89         EmptyClipboard;
  90         CloseClipboard;
  91     end;
  92     Result := TextUC;
  93 end;
  94
  95 function TWideMemo.GetEncodeText: AnsiString;
  96 const
  97     _WC_NO_BEST_FIT_CHARS = $400;
  98 var
  99     Len: Integer;
 100     LenUC: Integer;
 101     BufUC: PWideChar;
 102     BufSJ: array[0..16] of AnsiChar;
 103     UseDefChar: LongBool;
 104     Cnt: Integer;
 105     TextSJ: AnsiString;
 106     TextUC: WideString;
 107 begin
 108     TextUC := GetWideText;
 109     BufUC := PWideChar(TextUC);
 110     Len := Length(TextUC);
 111     LenUC := Len + 1;
 112
 113     WideCharToMultiByte(CP_ACP, _WC_NO_BEST_FIT_CHARS, BufUC, LenUC, nil, 0, nil, @UseDefChar);
 114     if (UseDefChar = False) then begin
 115         Result := AnsiString(BufUC);
 116     end else begin
 117         for Cnt := 0 to Len - 1 do
 118         begin
 119             ZeroMemory(@BufSJ, 16);
 120             WideCharToMultiByte(CP_ACP, _WC_NO_BEST_FIT_CHARS, @BufUC[Cnt], 1, BufSJ, 16, nil, @UseDefChar);
 121             if (UseDefChar = False) then begin
 122                 TextSJ := TextSJ + AnsiString(BufSJ);
 123             end else begin
 124                 TextSJ := TextSJ + Format('&#%d;', [Ord(BufUC[Cnt])]);
 125             end;
 126         end;
 127         Result := TextSJ;
 128     end;
 129 end;
 130
 131 procedure TWideMemo.SetEncodeText(SrcText: AnsiString);
 132 var
 133     CodePos: Integer;
 134     TextSJ: AnsiString;
 135     TextUC: WideString;
 136     CodeSJ: AnsiString;
 137     CodeVal: Integer;
 138 begin
 139     TextSJ := SrcText;
 140     while Length(TextSJ) > 0 do begin
 141         CodePos := AnsiPos('&#', TextSJ);
 142         if (CodePos < 1) then begin
 143             TextUC := TextUC + WideString(TextSJ);
 144             Break;
 145         end;
 146         if (CodePos > 1) then begin
 147             TextUC := TextUC + WideString(Copy(TextSJ, 1, CodePos - 1));
 148             Delete(TextSJ, 1, CodePos - 1);
 149         end;
 150         CodePos := AnsiPos(';', TextSJ);
 151         if (CodePos < 1) then begin
 152             TextUC := TextUC + WideString(TextSJ);
 153             Break;
 154         end;
 155         CodeSJ := Copy(TextSJ, 3, CodePos - 3);
 156         CodeVal := StrToIntDef(CodeSJ, 0);
 157         if ((CodeVal < 1) or (CodeVal > $FFFF)) then begin
 158             TextUC := TextUC + WideString(Copy(TextSJ, 1, CodePos));
 159         end else begin
 160             TextUC := TextUC + WideString(WideChar(CodeVal));
 161         end;
 162         Delete(TextSJ, 1, CodePos);
 163     end;
 164
 165     SetWindowTextW(Handle, PWideChar(TextUC));
 166 end;
 167
 168 procedure TWideMemo.InsertText(InsText: WideString);
 169 var
 170     LenUC: Integer;
 171     BufUC: PWideChar;
 172     BufUCSize: Integer;
 173 //    SelS: LongWord;
 174 //    SelE: LongWord;
 175 //    FullText: WideString;
 176 //    AftCurPos: LongInt;
 177     MemHandle: HGLOBAL;
 178     CopySize: Integer;
 179 begin
 180 (*
 181     FullText := GetWideText;
 182
 183     SelS := 0;
 184     SelE := 0;
 185     SendMessageW(Handle, EM_GETSEL, WPARAM(@SelS), LPARAM(@SelE));
 186
 187     if (SelS <> SelE) then
 188         Delete(FullText, SelS + 1, SelE - SelS);
 189     Insert(InsText, FullText, SelS + 1);
 190
 191     SetWindowTextW(Handle, PWideChar(FullText));
 192
 193     AftCurPos := LongInt(SelS) + Length(InsText);
 194
 195     SendMessageW(Handle, EM_SETSEL, AftCurPos, AftCurPos);
 196 *)
 197
 198     LenUC := Length(InsText);
 199     CopySize := LenUC * SizeOf(WideChar);
 200     BufUCSize := (LenUC + 1) * SizeOf(WideChar);
 201     MemHandle := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, BufUCSize);
 202     BufUC := GlobalLock(MemHandle);
 203     ZeroMemory(BufUC, BufUCSize);
 204     CopyMemory(BufUC, PWideChar(InsText), CopySize);
 205     GlobalUnlock(MemHandle);
 206
 207     if (OpenClipboard(Handle) = True) then begin
 208         EmptyClipboard;
 209         SetClipboardData(CF_UNICODETEXT, MemHandle);
 210         CloseClipboard;
 211
 212         SendMessageW(Handle, WM_PASTE, 0, 0);
 213     end else begin
 214         GlobalFree(MemHandle);
 215     end;
 216     Change;
 217 end;
 218
 219 end.