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 var
  97     Len: Integer;
  98     LenUC: Integer;
  99     BufUC: PWideChar;
 100     BufSJ: array[0..16] of AnsiChar;
 101     UseDefChar: LongBool;
 102     Cnt: Integer;
 103     TextSJ: AnsiString;
 104     TextUC: WideString;
 105 begin
 106     TextUC := GetWideText;
 107     BufUC := PWideChar(TextUC);
 108     Len := Length(TextUC);
 109     LenUC := Len + 1;
 110
 111     WideCharToMultiByte(CP_ACP, 0, BufUC, LenUC, nil, 0, nil, @UseDefChar);
 112     if (UseDefChar = False) then begin
 113         Result := AnsiString(BufUC);
 114     end else begin
 115         for Cnt := 0 to Len do
 116         begin
 117             ZeroMemory(@BufSJ, 16);
 118             WideCharToMultiByte(CP_ACP, 0, @BufUC[Cnt], 1, BufSJ, 16, nil, @UseDefChar);
 119             if (UseDefChar = False) then begin
 120                 TextSJ := TextSJ + AnsiString(BufSJ);
 121             end else begin
 122                 TextSJ := TextSJ + Format('&#%d;', [Ord(BufUC[Cnt])]);
 123             end;
 124         end;
 125         Result := TextSJ;
 126     end;
 127 end;
 128
 129 procedure TWideMemo.SetEncodeText(SrcText: AnsiString);
 130 var
 131     CodePos: Integer;
 132     TextSJ: AnsiString;
 133     TextUC: WideString;
 134     CodeSJ: AnsiString;
 135     CodeVal: Integer;
 136 begin
 137     TextSJ := SrcText;
 138     while Length(TextSJ) > 0 do begin
 139         CodePos := AnsiPos('&#', TextSJ);
 140         if (CodePos < 1) then begin
 141             TextUC := TextUC + WideString(TextSJ);
 142             Break;
 143         end;
 144         if (CodePos > 1) then begin
 145             TextUC := TextUC + WideString(Copy(TextSJ, 1, CodePos - 1));
 146             Delete(TextSJ, 1, CodePos - 1);
 147         end;
 148         CodePos := AnsiPos(';', TextSJ);
 149         if (CodePos < 1) then begin
 150             TextUC := TextUC + WideString(TextSJ);
 151             Break;
 152         end;
 153         CodeSJ := Copy(TextSJ, 3, CodePos - 3);
 154         CodeVal := StrToIntDef(CodeSJ, 0);
 155         if ((CodeVal < 1) or (CodeVal > $FFFF)) then begin
 156             TextUC := TextUC + WideString(Copy(TextSJ, 1, CodePos));
 157         end else begin
 158             TextUC := TextUC + WideString(WideChar(CodeVal));
 159         end;
 160         Delete(TextSJ, 1, CodePos);
 161     end;
 162
 163     SetWindowTextW(Handle, PWideChar(TextUC));
 164 end;
 165
 166 procedure TWideMemo.InsertText(InsText: WideString);
 167 var
 168     LenUC: Integer;
 169     BufUC: PWideChar;
 170     BufUCSize: Integer;
 171 //    SelS: LongWord;
 172 //    SelE: LongWord;
 173 //    FullText: WideString;
 174 //    AftCurPos: LongInt;
 175     MemHandle: HGLOBAL;
 176     CopySize: Integer;
 177 begin
 178 (*
 179     FullText := GetWideText;
 180
 181     SelS := 0;
 182     SelE := 0;
 183     SendMessageW(Handle, EM_GETSEL, WPARAM(@SelS), LPARAM(@SelE));
 184
 185     if (SelS <> SelE) then
 186         Delete(FullText, SelS + 1, SelE - SelS);
 187     Insert(InsText, FullText, SelS + 1);
 188
 189     SetWindowTextW(Handle, PWideChar(FullText));
 190
 191     AftCurPos := LongInt(SelS) + Length(InsText);
 192
 193     SendMessageW(Handle, EM_SETSEL, AftCurPos, AftCurPos);
 194 *)
 195
 196     LenUC := Length(InsText);
 197     CopySize := LenUC * SizeOf(WideChar);
 198     BufUCSize := (LenUC + 1) * SizeOf(WideChar);
 199     MemHandle := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, BufUCSize);
 200     BufUC := GlobalLock(MemHandle);
 201     ZeroMemory(BufUC, BufUCSize);
 202     CopyMemory(BufUC, PWideChar(InsText), CopySize);
 203     GlobalUnlock(MemHandle);
 204
 205     if (OpenClipboard(Handle) = True) then begin
 206         EmptyClipboard;
 207         SetClipboardData(CF_UNICODETEXT, MemHandle);
 208         CloseClipboard;
 209
 210         SendMessageW(Handle, WM_PASTE, 0, 0);
 211     end else begin
 212         GlobalFree(MemHandle);
 213     end;
 214     Change;
 215 end;
 216
 217 end.