areruler.pas

来自「delphi编程控件」· PAS 代码 · 共 768 行 · 第 1/2 页

  LineTo(DC, X, Y2);
  DeleteObject(Pen);
  ReleaseDC(0, DC);
end;

procedure TAutoRichEditRuler.DrawInchMarks;
var
  I, X, MinX: Integer;
begin
  with Canvas do
  begin
    Pen.Color := clBtnShadow;
    for I := -10 to 40 do
    begin
      X := LeftMargin + MulDiv(I, FPixelsPerInch, 2);
      with FRichEdit.Paragraph do
        if LeftIndent > 0 then MinX := TwipsToPixels(FirstIndentInTwips)
        else MinX := TwipsToPixels(FirstIndentInTwips + LeftIndentInTwips);
      Inc(MinX, LeftMargin);
      if X < 0 then Continue;
      if X < MinX then Pen.Color := clBtnFace
      else Pen.Color := clBtnShadow;
      if (X >= ClientWidth) or (X >= RightMargin) then Break;
      MoveTo(X, ClientHeight - 5);
      LineTo(X, ClientHeight - 2);
    end;
  end;
end;

// Result is in hundredth of centimetre
function TAutoRichEditRuler.PixelsToCm(Value: Integer): Integer;
begin
  Result := MulDiv(Value, 254, FPixelsPerInch);
end;

function TAutoRichEditRuler.PixelsToTwips(Value: Integer): Integer;
begin
  Result := MulDiv(Value, 1440, FPixelsPerInch);
end;

function TAutoRichEditRuler.TwipsToPixels(Value: Integer): Integer;
begin
  Result := MulDiv(Value, FPixelsPerInch, 1440);
end;

function TAutoRichEditRuler.GetDraggingMark: TWinControl;
begin
  case DragType of
    dtFirstIndent: Result := FFirstIndentMark;
    dtLeftIndent, dtOffset: Result := FLeftIndentMark;
    dtRightIndent: Result := FRightIndentMark;
  else Result := nil;
  end;
end;

function TAutoRichEditRuler.GetLeftMargin: Integer;
var
  R: TRect;
begin
  if FRichEdit = nil then Result := 0
  else
  begin
    SendMessage(FRichEdit.Handle, EM_GETRECT, 0, Longint(@R));
    Result := ScreenToClient(FRichEdit.ClientToScreen(R.TopLeft)).X - 1;
  end;
end;

function TAutoRichEditRuler.GetRightMargin: Integer;
var
  R: TRect;
begin
  if FRichEdit = nil then Result := 0
  else
  begin
    SendMessage(FRichEdit.Handle, EM_GETRECT, 0, Longint(@R));
    Result := ScreenToClient(FRichEdit.ClientToScreen(R.BottomRight)).X;
  end;
end;

procedure TAutoRichEditRuler.SetBorderStyle(Value: TAutoRichEditRulerBorderStyle);
begin
  if BorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TAutoRichEditRuler.SetDragType(Value: TAutoRichEditRulerDragType);
begin
  if FDragType <> Value then
  begin
    FDragType := Value;
    if FRichEdit = nil then FDragType := dtNone;
  end;
end;

procedure TAutoRichEditRuler.SetRichEdit(Value: TAutoRichEdit);
begin
  if FRichEdit <> Value then
  begin
    if FRichEdit <> nil then FRichEdit.Ruler := nil;
    FRichEdit := Value;
    if FRichEdit = nil then
    begin
      FFirstIndentMark.Left := 0;
      FLeftIndentMark.Left := 0;
      FRightIndentMark.Left := 0;
    end
    else FRichEdit.Ruler := Self;
    RichEditChanged(True);
  end;
end;

procedure TAutoRichEditRuler.WMEraseBkGnd(var Message: TWMEraseBkGnd);
begin
  Message.Result := 1;
end;

procedure TAutoRichEditRuler.WMMove(var Message: TWMMove);
begin
  inherited;
  RichEditChanged(True);
end;

procedure TAutoRichEditRuler.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  if BorderStyle <> rbsNone then
    InflateRect(Message.CalcSize_Params^.rgrc[0], -1, -1);
  inherited;
end;

procedure TAutoRichEditRuler.WMNCPaint(var Message: TWMNCPaint);
const
  BorderStyles: array[Boolean] of Integer =
    (BDR_SUNKENOUTER, BDR_RAISEDINNER);
var
  DC: HDC;
  R: TRect;
begin
  if FBorderStyle = rbsNone then Exit;
  DC := GetWindowDC(Handle);
  try
    GetWindowRect(Handle, R);
    OffsetRect(R, -R.Left, -R.Top);
    DrawEdge(DC, R, BorderStyles[FBorderStyle = rbsRaised], BF_RECT);
  finally
    ReleaseDC(Handle, DC);
  end;
end;

procedure TAutoRichEditRuler.WMSize(var Message: TWMSize);
var
  AHeight: Integer;
begin
  inherited;
  AHeight := 5 + 6;
  if BorderStyle <> rbsNone then Inc(AHeight, 2 * 1);
  Inc(AHeight, Canvas.TextHeight('0'));
  Height := AHeight;
end;

procedure TAutoRichEditRuler.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style or WS_CLIPCHILDREN;
end;

procedure TAutoRichEditRuler.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (DragType <> dtNone) and (FRichEdit <> nil) then
  begin
    with DraggingMark do X := Left + Width div 2;
    DrawDragLine(ClientToScreenX(X));
  end;
end;

procedure TAutoRichEditRuler.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Mark: TWinControl;
  W, NewLeft, FINewLeft: Integer;

  function RoundMarkPos(Value: Integer): Integer;
  begin
    Result := LeftMargin +
      CmToPixels(Round(PixelsToCm(Value - LeftMargin) / 25) * 25);
  end;

begin
  inherited MouseMove(Shift, X, Y);
  if DragType <> dtNone then
  begin
    X := RoundMarkPos(X);
    Mark := DraggingMark;
    if FPrevDragX = -1 then
      FPrevDragX := ClientToScreenX(Mark.Left + Mark.Width div 2);
    NewLeft := X - Mark.Width div 2;
    if DragType = dtLeftIndent then
      with FFirstIndentMark, FRichEdit.Paragraph do
        FINewLeft := RoundMarkPos(NewLeft + Width div 2 -
          TwipsToPixels(LeftIndentInTwips)) - Width div 2;
    // check new values
    W := CmToPixels(150);
    case DragType of
      dtFirstIndent:
        if FRightIndentMark.Left - NewLeft < W then Exit;
      dtLeftIndent, dtOffset:
        if (FRightIndentMark.Left - NewLeft < W) or
          ((DragType = dtLeftIndent) and
           (FRightIndentMark.Left - FINewLeft < W)) then Exit;
      dtRightIndent:
        if (NewLeft - FFirstIndentMark.Left < W) or
          (NewLeft - FLeftIndentMark.Left < W) then Exit;
    end;
    // set new values and update dragline
    Mark.Left := NewLeft;
    if DragType = dtLeftIndent then
      FFirstIndentMark.Left := FINewLeft;
    if FRichEdit <> nil then
    begin
      X := ClientToScreenX(X);
      if FPrevDragX <> X then
      begin
        DrawDragLine(FPrevDragX);
        DrawDragLine(X);
        FPrevDragX := X;
      end;
    end;
  end;
end;

procedure TAutoRichEditRuler.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  PrevValue: Integer;

  function RoundPixelsToTwips(Value: Integer): Integer;
  begin
    Result := CmToTwips(Round(PixelsToCm(Value) / 25) * 25);
  end;

begin
  if DragType <> dtNone then
  begin
    if FPrevDragX = -1 then
      with DraggingMark do
        DrawDragLine(ClientToScreenX(Left + Width div 2))
    else DrawDragLine(FPrevDragX);
    if FPrevDragX > -1 then
    begin
      FPrevDragX := ScreenToClient(Point(FPrevDragX, 0)).X;
      with FRichEdit.Paragraph do
        case DragType of
          dtFirstIndent:
            begin
              PrevValue := FirstIndentInTwips;
              FLockRichEditUpdate := True;
              FirstIndentInTwips :=
                RoundPixelsToTwips(FPrevDragX - LeftMargin);
              FLockRichEditUpdate := False;
              LeftIndentInTwips := LeftIndentInTwips -
                (FirstIndentInTwips - PrevValue);
            end;
          dtLeftIndent:
            FirstIndentInTwips :=
              RoundPixelsToTwips(FPrevDragX - LeftMargin) -
                LeftIndentInTwips;
          dtRightIndent:
            RightIndentInTwips := PixelsToTwips(RightMargin - FPrevDragX);
          dtOffset:
            LeftIndentInTwips :=
              RoundPixelsToTwips(FPrevDragX - LeftMargin) -
                FirstIndentInTwips;
        end;
    end;
  end;
  FPrevDragX := -1;
  DragType := dtNone;
  inherited MouseUp(Button, Shift, X, Y);
end;

procedure TAutoRichEditRuler.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FRichEdit) then
    AutoRichEdit := nil;
end;

procedure TAutoRichEditRuler.Paint;
var
  R, R1: TRect;
  C, I, X: Integer;
  S: string;
begin
  inherited Paint;
  with Canvas do
  begin
    R := ClientRect;
    Brush.Color := clBtnFace;
    FillRect(R);
    InflateRect(R, 0, -5);
    Dec(R.Bottom);
    // center part of the ruler
    R.Left := LeftMargin + 1;
    R.Right := RightMargin - 1;
    Brush.Color := clWindow;
    FillRect(R);
    // left part of the ruler
    R1 := R;
    R1.Right := R1.Left - 2;
    R1.Left := 0;
    Brush.Color := clBtnShadow;
    FillRect(R1);
    // right part of the ruler
    R1 := R;
    R1.Left := R1.Right + 3;
    R1.Right := ClientWidth;
    FillRect(R1);
    // scale of numbers and marks in cm
    C := (R.Top + R.Bottom) div 2;
    Brush.Style := bsClear;
    Pen.Color := clWindowText;
    Font.Color := clWindowText;
    R1 := R;
    for I := -100 to 100 do
    begin
      if I = -100 then
        R1.Left := LeftMargin + CmToPixels((I - 1) * 100)
      else
        R1.Left := R1.Right;
      R1.Right := LeftMargin + CmToPixels(I * 100);
      if R1.Right + 20 < 0 then Continue;
      X := LeftMargin + CmToPixels((I - 1) * 100 + 25);
      MoveTo(X, C - 1);
      LineTo(X, C + 1);
      X := LeftMargin + CmToPixels((I - 1) * 100 + 50);
      MoveTo(X, C - 2);
      LineTo(X, C + 3);
      X := LeftMargin + CmToPixels((I - 1) * 100 + 75);
      MoveTo(X, C - 1);
      LineTo(X, C + 1);
      if I <> 0 then
      begin
        S := IntToStr(Abs(I));
        R1.Left := R1.Right - TextWidth(S) div 2;
        DrawText(Handle, PChar(S), Length(S), R1,
          DT_NOCLIP or DT_SINGLELINE or DT_VCENTER);
      end;
      if R1.Right >= ClientWidth then Break;
    end;
    Brush.Style := bsSolid;
    // scale of marks in inch
    if FRichEdit <> nil then DrawInchMarks;
  end;
end;

procedure TAutoRichEditRuler.RichEditChanged(Redraw: Boolean);
begin
  if FLockRichEditUpdate then Exit;
  if Redraw then Repaint;
  if FRichEdit <> nil then
    with FRichEdit.Paragraph do
    begin
      // first indent mark
      FFirstIndentMark.Left := LeftMargin +
        TwipsToPixels(FirstIndentInTwips) - FFirstIndentMark.Width div 2;
      // left indent mark
      FLeftIndentMark.Left := LeftMargin +
        TwipsToPixels(FirstIndentInTwips + LeftIndentInTwips) -
        FLeftIndentMark.Width div 2;
      // right indent mark
      FRightIndentMark.Left := RightMargin -
        TwipsToPixels(RightIndentInTwips) - FRightIndentMark.Width div 2;
      // scale of marks in inch
      DrawInchMarks;
    end;
end;

end.