・「板一覧更新」で削除要請板のURLを強制的に変更する機能を追加

[gikonavigoeson/gikonavi.git] / WideMemo.pas

diff --git a/WideMemo.pas b/WideMemo.pas
index 40a230e..5bf94bb 100644 (file)
--- a/WideMemo.pas
+++ b/WideMemo.pas
@@ -10,13 +10,18 @@ type
 
     TWideMemo = class(TMemo)
 private
+    function GetWideText: WideString;
     function GetEncodeText: AnsiString;
     procedure SetEncodeText(SrcText: AnsiString);
+    function SetClipboard(SrcText: WideString): Boolean;
+    function GetClipboard(IsClear: Boolean): WideString;
 protected
     procedure CreateWindowHandle(const Params: TCreateParams); override;
 public
     constructor Create(AOwner: TComponent); override;
-    procedure InsertText(SrcText: AnsiString);
+    procedure Free;
+    procedure InsertText(InsText: WideString);
+    procedure QuotePaste(QuoteStr: AnsiString);
     property EncodeText: AnsiString read GetEncodeText write SetEncodeText;
 end;
 
@@ -28,47 +33,79 @@ begin
     inherited Create(AOwner);
 end;
 
+procedure TWideMemo.Free;
+begin
+    inherited Free;
+end;
+
 procedure TWideMemo.CreateWindowHandle(const Params: TCreateParams);
-//var
-//    ClassName: WideString;
+var
+    ClassName: WideString;
 begin
     with Params do
     begin
-//        ClassName := WideString(WinClassName);
-//        WindowHandle := CreateWindowExW(ExStyle, PWideChar(ClassName), '', Style,
-        WindowHandle := CreateWindowExW(ExStyle, 'EDIT', '', Style,
+        ClassName := WideString(WinClassName);
+        WindowHandle := CreateWindowExW(ExStyle, PWideChar(ClassName), '', Style,
                                         X, Y, Width, Height, WndParent, 0,
                                         HInstance, Param);
-//        SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
+        SendMessage(WindowHandle, WM_SETTEXT, 0, Longint(Caption));
     end;
 end;
 
+function TWideMemo.GetWideText: WideString;
+var
+//    Len: Integer;
+//    LenUC: Integer;
+//    BufUC: PWideChar;
+//    BufUCSize: Integer;
+    PosS: LongWord;
+    PosE: LongWord;
+begin
+//    Len := GetWindowTextLengthW(Handle);
+//    Len := Perform(WM_GETTEXTLENGTH, 0, 0);
+//    LenUC := Len + 1;
+//    BufUCSize := LenUC * SizeOf(WideChar);
+//    BufUC := AllocMem(BufUCSize);
+//    ZeroMemory(BufUC, BufUCSize);
+//    GetWindowTextW(Handle, BufUC, LenUC);
+//    SendMessageW(Handle, WM_GETTEXT, WPARAM(LenUC), LPARAM(BufUC));
+//    Result := WideString(BufUC);
+//    FreeMem(BufUC);
+
+       SendMessage(Handle, EM_GETSEL, WPARAM(@PosS), LPARAM(@PosE));
+       SendMessage(Handle, EM_SETSEL, 0, GetWindowTextLengthW(Handle));
+       SendMessage(Handle, WM_COPY, 0, 0);
+       SendMessage(Handle, EM_SETSEL, WPARAM(PosS), LPARAM(PosE));
+
+    Result := GetClipboard(True);
+end;
+
 function TWideMemo.GetEncodeText: AnsiString;
+const
+    _WC_NO_BEST_FIT_CHARS = $400;
 var
     Len: Integer;
     LenUC: Integer;
     BufUC: PWideChar;
-    BufUCSize: Integer;
     BufSJ: array[0..16] of AnsiChar;
     UseDefChar: LongBool;
     Cnt: Integer;
     TextSJ: AnsiString;
+    TextUC: WideString;
 begin
-    Len := GetWindowTextLengthW(Handle);
+    TextUC := GetWideText;
+    BufUC := PWideChar(TextUC);
+    Len := Length(TextUC);
     LenUC := Len + 1;
-    BufUCSize := LenUC * SizeOf(WideChar);
-    BufUC := AllocMem(BufUCSize);
-    ZeroMemory(BufUC, BufUCSize);
-    GetWindowTextW(Handle, BufUC, LenUC);
 
-    WideCharToMultiByte(CP_ACP, 0, BufUC, LenUC, nil, 0, nil, @UseDefChar);
+    WideCharToMultiByte(CP_ACP, _WC_NO_BEST_FIT_CHARS, BufUC, LenUC, nil, 0, nil, @UseDefChar);
     if (UseDefChar = False) then begin
         Result := AnsiString(BufUC);
     end else begin
-        for Cnt := 0 to Len do
+        for Cnt := 0 to Len - 1 do
         begin
             ZeroMemory(@BufSJ, 16);
-            WideCharToMultiByte(CP_ACP, 0, @BufUC[Cnt], 1, BufSJ, 16, nil, @UseDefChar);
+            WideCharToMultiByte(CP_ACP, _WC_NO_BEST_FIT_CHARS, @BufUC[Cnt], 1, BufSJ, 16, nil, @UseDefChar);
             if (UseDefChar = False) then begin
                 TextSJ := TextSJ + AnsiString(BufSJ);
             end else begin
@@ -77,7 +114,6 @@ begin
         end;
         Result := TextSJ;
     end;
-    FreeMem(BufUC);
 end;
 
 procedure TWideMemo.SetEncodeText(SrcText: AnsiString);
@@ -117,26 +153,66 @@ begin
     SetWindowTextW(Handle, PWideChar(TextUC));
 end;
 
-procedure TWideMemo.InsertText(SrcText: AnsiString);
+function TWideMemo.SetClipboard(SrcText: WideString): Boolean;
 var
     LenUC: Integer;
     BufUC: PWideChar;
     BufUCSize: Integer;
-    SelS: LongWord;
-    SelE: LongWord;
-    FullText: WideString;
-    InsText: WideString;
-    AftCurPos: LongInt;
+    MemHandle: HGLOBAL;
+    CopySize: Integer;
 begin
-    InsText := WideString(SrcText);
-
-    LenUC := GetWindowTextLengthW(Handle) + 1;
-    BufUCSize := LenUC * SizeOf(WideChar);
-    BufUC := AllocMem(BufUCSize);
+    LenUC := Length(SrcText);
+    CopySize := LenUC * SizeOf(WideChar);
+    BufUCSize := (LenUC + 1) * SizeOf(WideChar);
+    MemHandle := GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, BufUCSize);
+    BufUC := GlobalLock(MemHandle);
     ZeroMemory(BufUC, BufUCSize);
-    GetWindowTextW(Handle, BufUC, LenUC);
-    FullText := WideString(BufUC);
-    FreeMem(BufUC);
+    CopyMemory(BufUC, PWideChar(SrcText), CopySize);
+    GlobalUnlock(MemHandle);
+
+    if (OpenClipboard(Handle) = True) then begin
+        EmptyClipboard;
+        SetClipboardData(CF_UNICODETEXT, MemHandle);
+        CloseClipboard;
+        Result := True;
+    end else begin
+        GlobalFree(MemHandle);
+        Result := False;
+    end;
+end;
+
+function TWideMemo.GetClipboard(IsClear: Boolean): WideString;
+var
+    TextGet: WideString;
+    MemHandle: HGLOBAL;
+    TextP: PWideChar;
+begin
+    if (OpenClipboard(Handle) = True) then begin
+        MemHandle := GetClipboardData(CF_UNICODETEXT);
+        if (MemHandle <> 0) then begin
+            TextP := PWideChar(GlobalLock(MemHandle));
+            if not (TextP = nil) then begin
+                TextGet := WideString(TextP);
+                GlobalUnlock(MemHandle);
+            end;
+        end;
+        if (IsClear = True) then
+            EmptyClipboard;
+        CloseClipboard;
+    end;
+    Result := TextGet;
+end;
+
+procedure TWideMemo.InsertText(InsText: WideString);
+var
+//    SelS: LongWord;
+//    SelE: LongWord;
+//    FullText: WideString;
+//    AftCurPos: LongInt;
+    TextOrg: WideString;
+begin
+(*
+    FullText := GetWideText;
 
     SelS := 0;
     SelE := 0;
@@ -151,6 +227,46 @@ begin
     AftCurPos := LongInt(SelS) + Length(InsText);
 
     SendMessageW(Handle, EM_SETSEL, AftCurPos, AftCurPos);
+*)
+
+    TextOrg := GetClipboard(False);
+
+    if (SetClipboard(InsText) = True) then begin
+
+        SendMessageW(Handle, WM_PASTE, 0, 0);
+
+        SetClipboard(TextOrg);
+    end;
+
+    Change;
+end;
+
+procedure TWideMemo.QuotePaste(QuoteStr: AnsiString);
+var
+    TextDst: WideString;
+    TextSrc: WideString;
+    QuoteUC: WideString;
+    RetChar: WideString;
+    Ret: Integer;
+begin
+    TextSrc := GetClipboard(False);
+    QuoteUC := QuoteStr;
+    RetChar := AnsiString(#13#10);
+
+    while (Length(TextSrc) > 0) do begin
+        Ret := Pos(RetChar, TextSrc);
+        if (Ret < 1) then begin // \89ü\8ds\82È\82µ
+            TextDst := TextDst + QuoteUC + TextSrc;
+            Break;
+        end;
+
+        // \89ü\8ds\82Ü\82Å\82Ì1\8ds
+        TextDst := TextDst + QuoteUC + Copy(TextSrc, 1, Ret + 1);
+        Delete(TextSrc, 1, Ret + 1);
+    end;
+
+    if (Length(TextDst) > 0) then
+        InsertText(TextDst);
 end;
 
 end.