//不要怪我用变态的方法
//解决先//pas
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, AppEvnts, StdCtrls;type
  TForm1 = class(TForm)
    RichEdit1: TRichEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    function CurrText: TTextAttributes;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure SendKey(const mKey: Word; mShiftState: TShiftState; mCount: Integer = 1); overload;
const
  cExtended: set of Byte = [VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_HOME,
    VK_END, VK_PRIOR, VK_NEXT, VK_INSERT, VK_DELETE];  procedure pKeyboardEvent(mKey, mScanCode: Byte; mFlags: Longint);
  var
    vKeyboardMsg: TMsg;
  begin
    keybd_event(mKey, mScanCode, mFlags, 0);
    while PeekMessage(vKeyboardMsg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE) do begin
      TranslateMessage(vKeyboardMsg);
      DispatchMessage(vKeyboardMsg);
    end;
  end; { pKeyboardEvent }  procedure pSendKeyDown(mKey: Word; mGenUpMsg: Boolean);
  var
    vScanCode: Byte;
    vNumState: Boolean;
    vKeyBoardState: TKeyboardState;
  begin
    if (mKey = VK_NUMLOCK) then begin
      vNumState := ByteBool(GetKeyState(VK_NUMLOCK) and 1);
      GetKeyBoardState(vKeyBoardState);
      if vNumState then
        vKeyBoardState[VK_NUMLOCK] := (vKeyBoardState[VK_NUMLOCK] and not 1)
      else vKeyBoardState[VK_NUMLOCK] := (vKeyBoardState[VK_NUMLOCK] or 1);
      SetKeyBoardState(vKeyBoardState);
      Exit;
    end;    vScanCode := Lo(MapVirtualKey(mKey, 0));
    if (mKey in cExtended) then begin
      pKeyboardEvent(mKey, vScanCode, KEYEVENTF_EXTENDEDKEY);
      if mGenUpMsg then
        pKeyboardEvent(mKey, vScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
    end else begin
      pKeyboardEvent(mKey, vScanCode, 0);
      if mGenUpMsg then pKeyboardEvent(mKey, vScanCode, KEYEVENTF_KEYUP);
    end;
  end; { pSendKeyDown }  procedure pSendKeyUp(mKey: Word);
  var
    vScanCode: Byte;
  begin
    vScanCode := Lo(MapVirtualKey(mKey, 0));
    if mKey in cExtended then
      pKeyboardEvent(mKey, vScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
    else pKeyboardEvent(mKey, vScanCode, KEYEVENTF_KEYUP);
  end; { pSendKeyUp }var
  I: Integer;
begin
  for I := 1 to mCount do begin
    if ssShift in mShiftState then pSendKeyDown(VK_SHIFT, False);
    if ssCtrl in mShiftState then pSendKeyDown(VK_CONTROL, False);
    if ssAlt in mShiftState then pSendKeyDown(VK_MENU, False);
    pSendKeyDown(mKey, True);
    if ssShift in mShiftState then pSendKeyUp(VK_SHIFT);
    if ssCtrl in mShiftState then pSendKeyUp(VK_CONTROL);
    if ssAlt in mShiftState then pSendKeyUp(VK_MENU);
  end;
end; { SendKey }function TForm1.CurrText: TTextAttributes;
begin
  if RichEdit1.SelLength > 0 then Result := RichEdit1.SelAttributes
  else Result := RichEdit1.DefAttributes;
end;procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
  vCaretPot: TPoint;
begin
  Randomize;
  RichEdit1.SetFocus;
  for I := 0 to RichEdit1.Lines.Count - 1 do begin
    vCaretPot := Point(0, I);
    RichEdit1.CaretPos := vCaretPot;
    SendKey(VK_END, [ssShift]);
    CurrText.Color := RGB(Random(256), Random(256), Random(256));
  end;
end;procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  RichEdit1.Lines.Insert(RichEdit1.CaretPos.Y, '是不是这样');
end;end.//dfm
object Form1: TForm1
  Left = 192
  Top = 106
  Width = 544
  Height = 375
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object RichEdit1: TRichEdit
    Left = 16
    Top = 16
    Width = 457
    Height = 233
    Font.Charset = GB2312_CHARSET
    Font.Color = clWindowText
    Font.Height = -11
    Font.Name = 'MS Sans Serif'
    Font.Style = []
    Lines.Strings = (
      '11111111111111111'
      '22222222222222222'
      '33333333333333333'
      '44444444444444444'
      '55555555555555555'
      '66666666666666666'
      '77777777777777777')
    ParentFont = False
    TabOrder = 0
    WordWrap = False
    OnMouseDown = RichEdit1MouseDown
  end
  object Button1: TButton
    Left = 64
    Top = 280
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 1
    OnClick = Button1Click
  end
end