如何实现文本的分块选取(如UltraEdit等编辑器的列块模式)

Question

就是比如有个本文的内容是
11222333444
55666777888
99111100000我想用鼠标部分(分块)选取其中的
333444
777888
100000如何实现??????
分不多 希望高手能解答

Answer 1

有点可能说得不太明白,就是我是要我的编写的编辑器(用MEMO)有这个功能
而不是借助其他软件来选取文本!

Answer 2

//参考如下代码～～
//按住Alt点鼠标可看见效果，Ctrl+C可复制，其他功能自己加上～～
//没有处理滚动时的情况～～unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    procedure Memo1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    FSelBegin: TPoint;
    FSelEnd: TPoint;
    FCaretBegin: TPoint;
    FCaretEnd: TPoint;
    FChatHeight: Integer;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}uses Math, ClipBrd;procedure TForm1.Memo1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  I: Integer;
  S: string;
  L: Integer;
  T: Integer;
begin
  if not (ssAlt in Shift) then
  begin
    Label1.Visible := False;
    FSelBegin := Point(-1, -1);
    FSelEnd := Point(-1, -1);
    Exit;
  end;
  if FSelBegin.X >= 0 then
  begin
    GetCaretPos(FCaretEnd);
    Label1.Left := Min(FCaretBegin.X, FCaretEnd.X);
    Label1.Top := Min(FCaretBegin.Y, FCaretEnd.Y);
    FSelEnd := TMemo(Sender).CaretPos;
    S := '';
    L := Abs(FSelEnd.X - FSelBegin.X);
    T := Min(FSelBegin.X, FSelEnd.X);
    for I := Min(FSelBegin.Y, FSelEnd.Y) to Max(FSelBegin.Y, FSelEnd.Y) do
      S := S + Copy(TMemo(Sender).Lines[I], T + 1, L) + #13#10;
    Label1.Caption := TrimRight(S);
    Label1.Color := clHighlight;
    Label1.AutoSize := True;
  end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  FSelBegin := Point(-1, -1);
  FSelEnd := Point(-1, -1);  Font.Name := '宋体';
  Font.Size := 9;
  Label1.ShowAccelChar := False;
  Label1.Font.Color := clWhite;
  Label1.Visible := False;
  Label1.Parent := Memo1;
  FChatHeight := Canvas.TextHeight('|');
end;procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if [ssAlt, ssCtrl] * Shift = [] then Label1.Visible := False;
  if Label1.Visible and Label1.AutoSize and
    ([ssCtrl] = Shift) and (Key = Ord('C')) then
  begin
    Clipboard.AsText := Label1.Caption;
    Label1.Visible := False;
    Key := 0;
  end;
  if (FSelBegin.X < 0) and ([ssAlt] = Shift) then
  begin
    FSelBegin := TMemo(Sender).CaretPos;
    Label1.Color := clRed;
    Label1.Caption := '';
    Label1.AutoSize := False;
    Label1.Width := 1;
    Label1.Height := FChatHeight;
    GetCaretPos(FCaretBegin);
    Label1.Left := FCaretBegin.X;
    Label1.Top := FCaretBegin.Y;
    Label1.Visible := True;
  end;
end;end.

Answer 3

谢谢 zswang(伴水清清)(专家门诊清洁工) 
我现在有点事做 稍候再看 消化下就给分...
不过希望还有更好的方法

Answer 4

结帖了。。
zswang(伴水清清)(专家门诊清洁工)   
的方法能实现主要功能，，不过效果不好。。又或者我水平不够修改不好！
唉。