mwcustomedit.pas

来自「本人买的<<VC++项目开发实例>>源代码配套光盘.」· PAS 代码 · 共 1,920 行 · 第 1/5 页

procedure TmwCustomEdit.KeyPress(var Key: Char);
begin
  {$IFDEF MWE_MBCSSUPPORT}
  if (fImeCount > 0) then begin
    Dec(fImeCount);
    Exit;
  end;
  {$ENDIF}
  if Assigned(OnKeyPress) then
    OnKeyPress(Self, Key);

  if fProcChar = Key then
    fProcChar := #0
  else
    CommandProcessor(ecChar, Key, nil);
end;

function TmwCustomEdit.LeftSpaces(const Line: string): Integer;
var
  p: PChar;
begin
  p := pointer(Line);
  if Assigned(p) and (mweoAutoIndent in fOptions) then begin
    Result := 0;
    while p^ in [#1..#32] do begin
      Inc(p);
      Inc(Result);
    end;
  end else
    Result := 0;
end;

procedure TmwCustomEdit.LinesChanging(Sender: TObject);
begin
  Include(fStateFlags, mwsfLinesChanging);
end;

procedure TmwCustomEdit.LinesChanged(Sender: TObject);
begin
  Exclude(fStateFlags, mwsfLinesChanging);
  if HandleAllocated then begin
    UpdateScrollBars(FALSE);
    SetBlockBegin(CaretXY);
    InvalidateRect(Handle, @fInvalidateRect, False);
    FillChar(fInvalidateRect, SizeOf(TRect), 0);
  end;
end;

procedure TmwCustomEdit.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  bWasSel: boolean;
  bStartDrag: boolean;
begin
  if (Button = mbRight) and (Shift = [ssRight]) and
    Assigned(PopupMenu) and SelAvail
    then
    exit;
  bWasSel := false;
  bStartDrag := FALSE;
  if Button = mbLeft then begin
    if ssDouble in Shift then Exit;
    if SelAvail then begin
        //remember selection state, as it will be cleared later
      bWasSel := true;
      fDragBlockBegin := BlockBegin;
      fDragBlockEnd := BlockEnd;
      fMouseDownX := X;
      fMouseDownY := Y;
    end;
  end;
  inherited MouseDown(Button, Shift, X, Y);
  ComputeCaret(X, Y);
  if Button = mbLeft then begin
    MouseCapture := True;
      //if mousedown occured in selected block then begin drag operation
    Exclude(fStateFlags, mwsfWaitForDragging);
    if bWasSel and (mweoDragDropEditing in fOptions) and
      IsPointInSelection(CaretXY)
      then
      bStartDrag := TRUE;
  end;
  if (Button = mbLeft) and bStartDrag then
    Include(fStateFlags, mwsfWaitForDragging)
  else begin
    if not (mwsfDblClicked in fStateFlags) then begin
      if ssShift in Shift then
        SetBlockEnd(CaretXY)
      else
        SetBlockBegin(CaretXY);
    end;
  end;
  Windows.SetFocus(Handle);
end;

procedure TmwCustomEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  bDoSleep: boolean;
  nDelta: integer;

  function IsInEditRect(bGetCoor: boolean): boolean;
  var
    ptMouse: TPoint;
  begin
    if bGetCoor then begin
      GetCursorPos(ptMouse);
      ptMouse := ScreenToClient(ptMouse);
      X := ptMouse.X;
      Y := ptMouse.Y;
    end;
    Result := (X >= fGutterWidth) and (X < ClientWidth) and
      (Y >= 0) and (Y < ClientHeight);
  end;

begin
  inherited MouseMove(Shift, x, y);
  if MouseCapture and (mwsfWaitForDragging in fStateFlags) and not ReadOnly then
    begin
    if (Abs(fMouseDownX - X) >= GetSystemMetrics(SM_CXDRAG)) or
      (Abs(fMouseDownY - Y) >= GetSystemMetrics(SM_CYDRAG)) then begin
      Exclude(fStateFlags, mwsfWaitForDragging);
      BeginDrag(false);
    end;
  end
  else begin
    if not (mwsfInScrollLoop in fStateFlags) and
      (ssLeft in Shift) and MouseCapture
      then begin
      Include(fStateFlags, mwsfInScrollLoop);
      try
        if IsInEditRect(FALSE) then ComputeCaret(X, Y);
        SetBlockEnd(CaretXY);
        // InScrollLoop is to prevent reentrancy of this code block here
        Application.ProcessMessages;
        // we have to constantly update the mouse position!
        while MouseCapture and not IsInEditRect(TRUE) do begin
          bDoSleep := TRUE;
          // changes to line / column in one go
          IncPaintLock;
          try
            // horizontal scrolling
            if X < fGutterWidth then begin
              nDelta := fGutterWidth - X;
              if nDelta < 10 then LeftChar := LeftChar - 1
              else LeftChar := LeftChar - 8;
              if nDelta >= 42 then bDoSleep := FALSE;
              CaretX := LeftChar;
              SetBlockEnd(CaretXY);
            end else if X > ClientWidth then begin
              nDelta := X - ClientWidth;
              if nDelta < 10 then LeftChar := LeftChar + 1
              else LeftChar := LeftChar + 8;
              if nDelta >= 42 then bDoSleep := FALSE;
              CaretX := LeftChar + CharsInWindow;
              SetBlockEnd(CaretXY);
            end;
            // vertical scrolling
            if Y < 0 then begin
              if Y <= -10 then TopLine := TopLine - LinesInWindow
              else TopLine := TopLine - 1;
              if Y <= -42 then bDoSleep := FALSE;
              CaretY := TopLine;
              SetBlockEnd(CaretXY);
            end else if Y > ClientHeight then begin
              nDelta := Y - ClientHeight;
              if nDelta >= 10 then TopLine := TopLine + LinesInWindow
              else TopLine := TopLine + 1;
              if nDelta >= 42 then bDoSleep := FALSE;
              CaretY := TopLine + LinesInWindow - 1;
              SetBlockEnd(CaretXY);
            end;
          finally
            DecPaintLock;
            Update;
          end;
          // paint and update cursor and so on...
          Application.ProcessMessages;
          if bDoSleep then Sleep(100);
        end;
      finally
        Exclude(fStateFlags, mwsfInScrollLoop);
      end;
    end;
  end;
end;

procedure TmwCustomEdit.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if (Button = mbRight) and (Shift = [ssRight]) and Assigned(PopupMenu)
    then exit;
  MouseCapture := False;
  if fStateFlags * [mwsfDblClicked, mwsfWaitForDragging] = [mwsfWaitForDragging]
  then begin
    ComputeCaret(X, Y);
    SetBlockBegin(CaretXY);
    SetBlockEnd(CaretXY);
    Exclude(fStateFlags, mwsfWaitForDragging);
  end;
  Exclude(fStateFlags, mwsfDblClicked);
end;

// Complete rewrite of the painting code again. Removed Brads code with the
// Windows regions, since it made painting selected text very slow (the lines
// were scanned twice by the assigned highlighter) - on my system it took up to
// threetimes as long to paint the window if everything was selected.
// Splitting the paint into two operations caused weird effects on slower
// systems when scrolling in the column selection mode.
// The new code features the following:
// - No more doublebuffering of the drawing operations. The bitmap member has
//   been removed completely.
// - The highlighters don't touch the canvas of the control any more. Instead
//   the active token attribute is read from the highlighter, and only the
//   necessary changes to the font and the brush are made. This removes a lot
//   of color changes for selected text. Also the font color for spaces is
//   ignored, since no chars are visible anyway.
// - Tokens with the same font and brush attributes (also depending on the
//   selection state) are concatenated and painted in one go, this reduces
//   the number of ExtTextOut calls.
// - New event to assign special font and background colors to a line. Can be
//   used to paint breakpoint or current lines like seen in the Delphi IDE.
// - The font width array for the ExtTextOut calls is dynamically allocated
//   (only the maximum number of visible chars, not fCharsInWindow) and filled
//   with the fCharWidth value. This should save memory... Thanks to James
//   Jacobson for spotting this one.

// A lot of changes have been made by Tohru Hanai before the new version was
// released. Speed is now considerably higher, thanks to the new text painter
// classes and the changes in the client area invalidation code.
// I did however not mark the changes, but removed all the commented out lines
// for the sake of clarity. Please consider the painting code a joint effort of
// Tohru and me. The gains in speed come mostly from Tohrus new code.

procedure TmwCustomEdit.Paint;
var
  rcClip, rcDraw: TRect;
  nL1, nL2, nC1, nC2: integer;
begin
  // Get the invalidated rect. Compute the invalid area in lines / columns.
  rcClip := Canvas.ClipRect;
  // columns
  nC1 := LeftChar;
  if (rcClip.Left > fGutterWidth + 2) then
    Inc(nC1, (rcClip.Left - fGutterWidth - 2) div CharWidth);
  nC2 := nC1 +
    (rcClip.Right - fGutterWidth - 2 + CharWidth - 1) div CharWidth;
  // lines
  nL1 := Max(TopLine + rcClip.Top div fTextHeight, TopLine);
  nL2 := Min(TopLine + (rcClip.Bottom + fTextHeight - 1) div fTextHeight,
    Lines.Count);
  // Now paint everything while the caret is hidden.
  HideCaret;
  try
    // First paint the gutter area if it was (partly) invalidated.
    if (rcClip.Left < fGutterWidth) then begin
      rcDraw := rcClip;
      rcDraw.Right := fGutterWidth;
      PaintGutter(rcDraw, nL1, nL2);
    end;
    // Then paint the text area if it was (partly) invalidated.
    if (rcClip.Right > fGutterWidth) then begin
      rcDraw := rcClip;
      rcDraw.Left := Max(rcDraw.Left, fGutterWidth);
      PaintTextLines(rcDraw, nL1, nL2, nC1, nC2);
    end;
    // If there is a custom paint handler call it.
    if Assigned(fOnPaint) then begin
      Font.Assign(Font);
      Brush.Color := Color;
      fOnPaint(Self, Canvas);
    end;
  finally
    UpdateCaret;
  end;
end;

procedure TmwCustomEdit.PaintGutter(AClip: TRect; FirstLine, LastLine: integer);
var
  i, iLine: integer;
  rcLine: TRect;
  bHasOtherMarks: boolean;
  aGutterOffs: PIntArray;
  s: string;
  dc: HDC;

  procedure DrawMark(iMark: integer);
  var
    iLine: integer;
  begin
    if Assigned(fBookMarkOpt.BookmarkImages) and not Marks[i].InternalImage then
      begin
      if Marks[iMark].ImageIndex <= fBookMarkOpt.BookmarkImages.Count then begin
        iLine := Marks[iMark].Line - TopLine;
        with fBookMarkOpt do
          BookmarkImages.Draw(Canvas, LeftMargin + aGutterOffs^[iLine],
            iLine * fTextHeight, Marks[iMark].ImageIndex);
        Inc(aGutterOffs^[iLine], fBookMarkOpt.XOffset);
      end;
    end else begin
      if Marks[iMark].ImageIndex in [0..9] then begin
        iLine := Marks[iMark].Line - TopLine;
        if not Assigned(fInternalImage) then
          fInternalImage := TmwInternalImage.Create('mweInternalImages', 10);
        fInternalImage.DrawMark(Canvas, Marks[iMark].ImageIndex,
          fBookMarkOpt.LeftMargin + aGutterOffs^[iLine],
          iLine * fTextHeight, fTextHeight);
        Inc(aGutterOffs^[iLine], fBookMarkOpt.XOffset);
      end;
    end;
  end;

begin
  // Changed to use fTextDrawer.BeginDrawing and fTextDrawer.EndDrawing only
  // when absolutely necessary.  Note: Never change brush / pen / font of the
  // canvas inside of this block (only through methods of fTextDrawer)!
  Canvas.Brush.Color := Gutter.Color;
  // If we have to draw the line numbers then we don't want to erase
  // the background first. Do it line by line with TextRect instead
  // and fill only the area after the last visible line.
  dc := Canvas.Handle;
  if fGutter.ShowLineNumbers then begin
    fTextDrawer.BeginDrawing(dc);
    try
      fTextDrawer.SetBackColor(fGutter.Color);
      fTextDrawer.SetForeColor(Self.Font.Color);
      fTextDrawer.Style := [];
      // prepare the rect initially
      rcLine := AClip;
      rcLine.Right := Max(rcLine.Right, fGutterWidth - 2);
      rcLine.Bottom := (FirstLine - TopLine) * fTextHeight;
      for iLine := FirstLine to LastLine do begin
        // next line rect
        rcLine.Top := rcLine.Bottom;
        Inc(rcLine.Bottom, fTextHeight);
        // erase the background and draw the line number string in one go
        s := fGutter.FormatLineNumber(iLine);
        Windows.ExtTextOut(DC, fGutter.LeftOffset, rcLine.Top, ETO_OPAQUE,
          @rcLine, PChar(s), Length(s), nil);
      end;
      // now erase the remaining area if any
      if AClip.Bottom > rcLine.Bottom then begin
        rcLine.Top := rcLine.Bottom;
        rcLine.Bottom := AClip.Bottom;
        with rcLine do
          fTextDrawer.ExtTextOut(Left, Top, ETO_OPAQUE, rcLine, nil, 0);
      end;
    finally
      fTextDrawer.EndDrawing;
    end;
  end else
    InternalFillRect(dc, AClip);
  // the gutter separator if visible
  if AClip.Right >= fGutterWidth - 2 then
    with Canvas do begin
      Pen.Color := clBtnHighlight;
      Pen.Width := 1;
      with AClip do begin
        MoveTo(fGutterWidth - 2, Top);
        LineTo(fGutterWidth - 2, Bottom);
        Pen.Color := clBtnShadow;
        MoveTo(fGutterWidth - 1, Top);
        LineTo(fGutterWidth - 1, Bottom);
      end;
    end;
  // now the gutter marks
  if BookMarkOptions.GlyphsVisible and (Marks.Count > 0) then begin
    aGutterOffs := AllocMem((fLinesInWindow + 1) * SizeOf(integer));
    try
      // Instead of making a two pass loop we look while drawing the bookmarks
      // whether there is any other mark to be drawn
      bHasOtherMarks := FALSE;
      for i := 0 to Marks.Count - 1 do begin
        if not Marks[i].Visible or (Marks[i].Line < FirstLine) or
          (Marks[i].Line > LastLine)
          then continue;
        if Marks[i].IsBookmark then bHasOtherMarks := TRUE
        else DrawMark(i);
      end;
      if bHasOtherMarks then for i := 0 to Marks.Count - 1 do
          with Marks[i] do
            if Visible and IsBookmark and