mwcustomedit.pas

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

{$R mwCustomEdit.RES}

uses mwExport, mwHTMLExport, mwRTFExport;

procedure Register;
begin
  RegisterComponents(MWS_ComponentsPage, [TmwCustomEdit]);
end;

function maxPoint(P1, P2: TPoint): TPoint;
begin
  Result := P1;
  if (P2.y > P1.y) or ((P2.y = P1.y) and (P2.x > P1.x)) then Result := P2;
end;

function minPoint(P1, P2: TPoint): TPoint;
begin
  Result := P1;
  if (P2.y < P1.y) or ((P2.y = P1.y) and (P2.x < P1.x)) then Result := P2;
end;

function Roundoff(X: Extended): Longint;
begin
  if (x >= 0) then begin
    Result := Trunc(x + 0.5)
  end else begin
    Result := Trunc(x - 0.5);
  end;
end;

{ TmwEditList }

function TmwEditList.Add(const S: string): Integer;
begin
  BeginUpdate;
  Result := inherited Add(S);
  if Assigned(FOnAdded) then FOnAdded(Self);
  EndUpdate;
end;

procedure TmwEditList.AddStrings(Strings: TStrings);
var
  I: Integer;
begin
  BeginUpdate;
  try
    for I := 0 to Strings.Count - 1 do
      inherited Add(Strings[I]);
    if Assigned(fOnScanRanges) then
      fOnScanRanges(Self);
  finally
    EndUpdate;
  end;
end;

procedure TmwEditList.Assign(Source: TPersistent);
begin
  BeginLoading;
  try
    inherited Assign(Source);
  finally
    EndLoading;
  end;
end;

procedure TmwEditList.BeginLoading;
begin
  Inc(nLoading);
end;

procedure TmwEditList.Clear;
begin
  if Assigned(fOnCleared) then fOnCleared(Self);
  inherited Clear;
  if (nLoading = 0) and (Count = 0) then Add('');
end;

procedure TmwEditList.Delete(Index: Integer);
begin
  BeginUpdate;
  if (Index = 0) and (Count = 1) then
    inherited Put(0, '')
  else
    inherited Delete(Index);
  if Assigned(FOnDeleted) then fOnDeleted(Index);
  EndUpdate;
end;

procedure TmwEditList.EndLoading;
begin
  if (nLoading > 0) then begin
    Dec(nLoading);
    if (nLoading = 0) and (Count = 0) then Add('');
  end;
end;

procedure TmwEditList.Insert(Index: Integer; const S: string);
begin
  BeginUpdate;
  inherited Insert(Index, S);
  if Assigned(FOnInserted) then fOnInserted(Index);
  EndUpdate;
end;

procedure TmwEditList.LoadFromStream(Stream: TStream);
var
  evtOnAdded: TNotifyEvent;
begin
  BeginLoading;
  BeginUpdate;
  try
    if Assigned(fOnScanRanges) then begin
      evtOnAdded := fOnAdded;
      try
        fOnAdded := nil;
        inherited LoadFromStream(Stream);
        fOnScanRanges(Self);
      finally
        fOnAdded := evtOnAdded;
      end;
    end else
      inherited LoadFromStream(Stream);
  finally
    EndLoading;
    EndUpdate;
  end;
end;

procedure TmwEditList.Put(Index: Integer; const S: string);
begin
  BeginUpdate;
  inherited Put(Index, S);
  if Assigned(FOnPutted) then fOnPutted(Index);
  EndUpdate;
end;

procedure TmwEditList.SetTextStr(const Value: string);
begin
  BeginUpdate;
  inherited SetTextStr(Value);
  if Assigned(FOnLoaded) then FOnLoaded(Self);
  EndUpdate;
end;

{ TmwCustomEdit }

procedure TmwCustomEdit.ComputeCaret(X, Y: Integer);
{$IFDEF MWE_MBCSSUPPORT}
var
  pt: TPoint;
  s: string;
  f: Single;
  {$ENDIF}
begin
  {$IFDEF MWE_MBCSSUPPORT}
  f := (X + LeftChar * fCharWidth - fGutterWidth - 2) / fCharWidth;
  pt := Point(Roundoff(f), Y div fTextHeight + TopLine);
  if ((pt.Y - 1) < Lines.Count) then begin
    s := Lines[pt.Y - 1];
    if (Length(s) >= pt.x) and (ByteType(s, pt.X) = mbTrailByte) then
      if Frac(f) >= 0.5 then
        Dec(pt.X)
      else
        Inc(pt.X);
  end;
  fMBCSStepAside := False;
  CaretXY := pt;
  {$ELSE}
  CaretXY := Point(
    Roundoff((X + LeftChar * fCharWidth - FGutterWidth - 2) / fCharWidth),
    Y div fTextHeight + TopLine
    );
  {$ENDIF}
end;

procedure TmwCustomEdit.DoCopyToClipboard(const SText: string);
var
  Mem: HGLOBAL;
  P: PChar;
  SLen: integer;
  Failed: boolean;
begin
  if SText <> '' then begin
    Failed := TRUE; // assume the worst.
    SLen := Length(SText);
    // Open and Close are the only TClipboard methods we use because TClipboard
    // is very hard (impossible) to work with if you want to put more than one
    // format on it at a time.
    Clipboard.Open;
    try
      // Clear anything already on the clipboard.
      EmptyClipboard;
      // Put it on the clipboard as normal text format so it can be pasted into
      // things like notepad or Delphi.
      Mem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, SLen + 1);
      if Mem <> 0 then begin
        P := GlobalLock(Mem);
        try
          if P <> nil then begin
            Move(PChar(SText)^, P^, SLen + 1);
            // Put it on the clipboard in text format
            Failed := SetClipboardData(CF_TEXT, Mem) = 0;
          end;
        finally
          GlobalUnlock(Mem);
        end;
      end;
      // Don't free Mem!  It belongs to the clipboard now, and it will free it
      // when it is done with it.
      if not Failed then begin
        // Copy it in our custom format so we know what kind of block it is.
        // That effects how it is pasted in.
        Mem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, SLen +
          SizeOf(TSelectionMode) + 1);
        P := GlobalLock(Mem);
        try
          if P <> nil then begin
            // Our format:  TSelectionMode value followed by text.
            PSelectionMode(P)^ := SelectionMode;
            inc(P, SizeOf(TSelectionMode));
            Move(PChar(SText)^, P^, SLen + 1);
            Failed := SetClipboardData(mwEditClipboardFormat, Mem) = 0;
          end;
        finally
          GlobalUnlock(Mem);
        end;
        // Don't free Mem!  It belongs to the clipboard now, and it will free it
        // when it is done with it.
      end;
    finally
      Clipboard.Close;
      if Failed then
        raise EmwEditError.Create('Clipboard copy operation failed');
    end;
  end;
end;

procedure TmwCustomEdit.CopyToClipboard;
var
  SText: string;
begin
  if SelAvail then begin
    SText := SelText;
    DoCopyToClipboard(SText);
  end;
end;

procedure TmwCustomEdit.CutToClipboard;
var
  SText: string;
begin
  if SelAvail then begin
    SText := SelText;
    DoCopyToClipboard(SText);
    FUndoList.AddChange(mwcrDelete, fBlockBegin, fBlockEnd, PChar(SText),
      SelectionMode);
    LockUndo;
    SelText := '';
    UnLockUndo;
  end;
end;

constructor TmwCustomEdit.Create(AOwner: TComponent);
begin
  fLines := TmwEditList.Create;
  fFontDummy := TFont.Create;
  fUndoList := TUndoList.Create(self);
  fRedoList := TUndoList.Create(self);
  inherited Create(AOwner);
  {$IFDEF MWE_COMPILER_4_UP}
  DoubleBuffered := false;
  {$ENDIF}
  if not (csDesigning in ComponentState) then fLines.Add('');
  TmwEditList(fLines).OnAdded := ListAdded;
  TmwEditList(fLines).OnCleared := ListCleared;
  TmwEditList(fLines).OnDeleted := ListDeleted;
  TmwEditList(fLines).OnInserted := ListInserted;
  TmwEditList(fLines).OnLoaded := ListLoaded;
  TmwEditList(fLines).OnPutted := ListPutted;
  TmwEditList(fLines).OnScanRanges := ListScanRanges;
  fSelectedColor := TmwSelectedColor.Create;
  fSelectedColor.OnChange := SelectedColorsChanged;
  fBookMarkOpt := TmwBookMarkOpt.Create(Self);
  fBookMarkOpt.OnChange := BookMarkOptionsChanged;
// fRightEdge has to be set before FontChanged is called for the first time
  fRightEdge := 80;
  fGutter := TmwGutter.Create;
  fGutter.OnChange := GutterChanged;
  fGutterWidth := fGutter.Width;
  fTextOffset := fGutterWidth + 2;
  ControlStyle := ControlStyle + [csOpaque, csSetCaption];
  Height := 150;
  Width := 200;
  Cursor := crIBeam;
  Color := clWindow;
  fFontDummy.Name := 'Courier New';
  fFontDummy.Size := 10;
  {$IFDEF MWE_COMPILER_3_UP}
  fFontDummy.CharSet := DEFAULT_CHARSET;
  {$ENDIF}
  fTextDrawer := TheTextDrawer.Create([fsBold], fFontDummy);
  Font.Assign(fFontDummy);
  Font.OnChange := FontChanged;
  FontChanged(nil);
  ParentFont := False;
  ParentColor := False;
  TabStop := True;
  TStringList(Lines).OnChanging := LinesChanging;
  TStringList(Lines).OnChange := LinesChanged;
  fInserting := True;
  fMaxLeftChar := 1024;
  fScrollBars := ssBoth;
  fBorderStyle := bsSingle;
  fInsertCaret := ctVerticalLine;
  fOverwriteCaret := ctBlock;
  FSelectionMode := smNormal;
  fKeystrokes := TmwKeyStrokes.Create(Self);
  fMarkList := TMarkList.Create(self);
  fMarkList.OnChange := MarkListChange;
  SetDefaultKeystrokes;
  fRightEdgeColor := clSilver;
  {$IFDEF MWE_MBCSSUPPORT}
  fImeCount := 0;
  fMBCSStepAside := False;
  {$ENDIF}
  fWantTabs := False;
  fTabWidth := 8;
  // find / replace
  fTSearch := TmwEditSearch.Create;
  fOptions := MWEDIT_DEFAULT_OPTIONS;
end;

procedure TmwCustomEdit.CreateParams(var Params: TCreateParams);
const
  ScrollBar: array[TScrollStyle] of DWORD = (0, WS_HSCROLL, WS_VSCROLL,
    WS_HSCROLL or WS_VSCROLL);
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do begin
    Style := Style or ScrollBar[FScrollBars] or BorderStyles[fBorderStyle]
      or WS_CLIPCHILDREN;
    if NewStyleControls and Ctl3D and (fBorderStyle = bsSingle) then begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TmwCustomEdit.DecPaintLock;
begin
  Dec(fPaintLock);
  if (fPaintLock = 0) and HandleAllocated then begin
    if mwsfScrollbarChanged in fStateFlags then UpdateScrollbars(FALSE);
    if mwsfCaretChanged in fStateFlags then UpdateCaret;
    if fStatusChanges <> [] then StatusChanged([]);
  end;
end;

destructor TmwCustomEdit.Destroy;
begin
  Highlighter := nil;
  fKeyStrokes.Free;
  fFontDummy.Free;
  Lines.Free;
  fSelectedColor.Free;
  fBookMarkOpt.Free;
  fMarkList.Free;
  fUndoList.Free;
  fRedoList.Free;
  fGutter.Free;
  fTextDrawer.Free;
  fInternalImage.Free;
  fTSearch.Free;
  inherited Destroy;
end;

function TmwCustomEdit.GetBlockBegin: TPoint;
begin
  Result := fBlockBegin;
  if fBlockEnd.Y < fBlockBegin.Y then Result := fBlockEnd else
    if fBlockEnd.Y = fBlockBegin.Y then
      if fBlockEnd.X < fBlockBegin.X then Result := fBlockEnd;
end;