areruler.pas

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

unit ARERuler;

interface

uses
  Windows, Messages, Classes, Controls, Forms, ARichEd;

type
  TFirstIndentMark = class(TCustomControl)
  protected
    procedure CreateWnd; override;
    procedure Paint; override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TLeftIndentMark = class(TCustomControl)
  protected
    procedure CreateWnd; override;
    procedure Paint; override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TRightIndentMark = class(TCustomControl)
  protected
    procedure CreateWnd; override;
    procedure Paint; override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TAutoRichEditRulerBorderStyle = (rbsNone, rbsRaised, rbsLowered);
  TAutoRichEditRulerDragType =
    (dtNone, dtFirstIndent, dtLeftIndent, dtRightIndent, dtOffset);

  TAutoRichEditRuler = class(TCustomControl)
  private
    FBorderStyle: TAutoRichEditRulerBorderStyle;
    FDragType: TAutoRichEditRulerDragType;
    FFirstIndentMark: TFirstIndentMark;
    FLeftIndentMark: TLeftIndentMark;
    FLockRichEditUpdate: Boolean;
    FPixelsPerInch: Integer;
    FPrevDragX: Integer;
    FRichEdit: TAutoRichEdit;
    FRightIndentMark: TRightIndentMark;

    function ClientToScreenX(Value: Integer): Integer;
    function CmToPixels(Value: Integer): Integer;
    function CmToTwips(Value: Integer): Integer;
    procedure DrawDragLine(X: Integer);
    procedure DrawInchMarks;
    function PixelsToCm(Value: Integer): Integer;
    function PixelsToTwips(Value: Integer): Integer;
    function TwipsToPixels(Value: Integer): Integer;

    function GetDraggingMark: TWinControl;
    function GetLeftMargin: Integer;
    function GetRightMargin: Integer;
    procedure SetBorderStyle(Value: TAutoRichEditRulerBorderStyle);
    procedure SetDragType(Value: TAutoRichEditRulerDragType);
    procedure SetRichEdit(Value: TAutoRichEdit);

    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;

    property DraggingMark: TWinControl read GetDraggingMark;
    property DragType: TAutoRichEditRulerDragType read FDragType
      write SetDragType;
    property LeftMargin: Integer read GetLeftMargin;
    property RightMargin: Integer read GetRightMargin;
  public
    constructor Create(AOwner: TComponent); override;
    procedure RichEditChanged(Redraw: Boolean); virtual;
  published
    property Align;
    property AutoRichEdit: TAutoRichEdit read FRichEdit write SetRichEdit;
    property BorderStyle: TAutoRichEditRulerBorderStyle read FBorderStyle
      write SetBorderStyle default rbsNone;
  end;

implementation

uses
  SysUtils, Graphics;

const
  sAutoRichEditRulerFirstIndentHint = 'First Line Indent';
  sAutoRichEditRulerLeftIndentHint = 'Left Indent';
  sAutoRichEditRulerRightIndentHint = 'Right Indent';

{ TFirstIndentMark }

constructor TFirstIndentMark.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csOpaque];
  Hint := sAutoRichEditRulerFirstIndentHint;
  ShowHint := True;
  Width := 9;
  Height := 8;
end;

procedure TFirstIndentMark.CreateWnd;
var
  P: array[1..6] of TPoint;
  FRegion: HRGN;
begin
  inherited;
  P[1] := Point(5, 8);
  P[2] := Point(0, 3);
  P[3] := Point(0, 0);
  P[4] := Point(9, 0);
  P[5] := Point(9, 3);
  P[6] := Point(4, 8);
  FRegion := CreatePolygonRgn(P, 6, WINDING);
  SetWindowRgn(Handle, FRegion, False);
end;

procedure TFirstIndentMark.Paint;
var
  P: array[1..6] of TPoint;
begin
  inherited Paint;
  with Canvas do
  begin
    P[1] := Point(4, 7);
    P[2] := Point(0, 3);
    P[3] := Point(0, 0);
    P[4] := Point(8, 0);
    P[5] := Point(8, 3);
    P[6] := P[1];
    Pen.Color := clBlack;
    Polyline(P);
    // draw highlight parts
    P[1] := Point(3, 5);
    P[2] := Point(1, 3);
    P[3] := Point(1, 1);
    P[4] := Point(7, 1);
    Pen.Color := clBtnHighlight;
    Polyline(Slice(P, 4));
  end;
end;

procedure TFirstIndentMark.WndProc(var Message: TMessage);
begin
  with TWMMouse(Message) do
    if (Msg = WM_LBUTTONDOWN) or (Msg = WM_MOUSEMOVE) then
    begin
      if Msg = WM_LBUTTONDOWN then
        TAutoRichEditRuler(Parent).DragType := dtFirstIndent;
      Pos := PointToSmallPoint(
        Parent.ScreenToClient(ClientToScreen(SmallPointToPoint(Pos))));
      Result := SendMessage(Parent.Handle, Msg, Keys, Longint(Pos));
    end
    else
      if (Msg = WM_LBUTTONDBLCLK) and
        (TAutoRichEditRuler(Parent).AutoRichEdit <> nil) then
        TAutoRichEditRuler(Parent).AutoRichEdit.ParagraphDialog
      else inherited;
  if Message.Msg = WM_MOVE then Top := 2;
end;

{ TLeftIndentMark }

constructor TLeftIndentMark.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csOpaque];
  Hint := sAutoRichEditRulerLeftIndentHint;
  ShowHint := True;
  Width := 9;
  Height := 14;
end;

procedure TLeftIndentMark.CreateWnd;
var
  P: array[1..6] of TPoint;
  FRegion: HRGN;
begin
  inherited;
  P[1] := Point(4, 0);
  P[2] := Point(0, 4);
  P[3] := Point(0, 14);
  P[4] := Point(9, 14);
  P[5] := Point(9, 4);
  P[6] := Point(5, 0);
  FRegion := CreatePolygonRgn(P, 6, WINDING);
  SetWindowRgn(Handle, FRegion, False);
end;

procedure TLeftIndentMark.Paint;
var
  P: array[1..6] of TPoint;
begin
  inherited Paint;
  with Canvas do
  begin
    P[1] := Point(4, 0);
    P[2] := Point(0, 4);
    P[3] := Point(0, 13);
    P[4] := Point(8, 13);
    P[5] := Point(8, 4);
    P[6] := P[1];
    Pen.Color := clBlack;
    Polyline(P);
    MoveTo(1, 7);
    LineTo(8, 7);
    // draw highlight parts
    P[1] := Point(4, 1);
    P[2] := Point(1, 4);
    P[3] := Point(1, 6);
    Pen.Color := clBtnHighlight;
    Polyline(Slice(P, 3));
    P[1] := Point(1, 11);
    P[2] := Point(1, 8);
    P[3] := Point(7, 8);
    Polyline(Slice(P, 3));
  end;
end;

procedure TLeftIndentMark.WndProc(var Message: TMessage);
begin
  with TWMMouse(Message) do
    if (Msg = WM_LBUTTONDOWN) or (Msg = WM_MOUSEMOVE) then
    begin
      if Msg = WM_LBUTTONDOWN then
        with TAutoRichEditRuler(Parent) do
          if HiWord(Message.lParam) < 7 then DragType := dtOffset
          else DragType := dtLeftIndent;
      Pos := PointToSmallPoint(
        Parent.ScreenToClient(ClientToScreen(SmallPointToPoint(Pos))));
      Result := SendMessage(Parent.Handle, Msg, Keys, Longint(Pos));
    end
    else
      if (Msg = WM_LBUTTONDBLCLK) and
        (TAutoRichEditRuler(Parent).AutoRichEdit <> nil) then
        TAutoRichEditRuler(Parent).AutoRichEdit.ParagraphDialog
      else inherited;
  if Message.Msg = WM_MOVE then Top := 10;
end;

{ TRightIndentMark }

constructor TRightIndentMark.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csOpaque];
  Hint := sAutoRichEditRulerRightIndentHint;
  ShowHint := True;
  Width := 9;
  Height := 8;
end;

procedure TRightIndentMark.CreateWnd;
var
  P: array[1..6] of TPoint;
  FRegion: HRGN;
begin
  inherited;
  P[1] := Point(4, 0);
  P[2] := Point(0, 4);
  P[3] := Point(0, 8);
  P[4] := Point(9, 8);
  P[5] := Point(9, 4);
  P[6] := Point(5, 0);
  FRegion := CreatePolygonRgn(P, 6, WINDING);
  SetWindowRgn(Handle, FRegion, False);
end;

procedure TRightIndentMark.Paint;
var
  P: array[1..6] of TPoint;
begin
  inherited Paint;
  with Canvas do
  begin
    P[1] := Point(4, 0);
    P[2] := Point(0, 4);
    P[3] := Point(0, 7);
    P[4] := Point(8, 7);
    P[5] := Point(8, 4);
    P[6] := P[1];
    Pen.Color := clBlack;
    Polyline(P);
    // draw highlight parts
    P[1] := Point(4, 1);
    P[2] := Point(1, 4);
    P[3] := Point(1, 6);
    Pen.Color := clBtnHighlight;
    Polyline(Slice(P, 3));
  end;
end;

procedure TRightIndentMark.WndProc(var Message: TMessage);
begin
  with TWMMouse(Message) do
    if (Msg = WM_LBUTTONDOWN) or (Msg = WM_MOUSEMOVE) then
    begin
      if Msg = WM_LBUTTONDOWN then
        TAutoRichEditRuler(Parent).DragType := dtRightIndent;
      Pos := PointToSmallPoint(
        Parent.ScreenToClient(ClientToScreen(SmallPointToPoint(Pos))));
      Result := SendMessage(Parent.Handle, Msg, Keys, Longint(Pos));
    end
    else
      if (Msg = WM_LBUTTONDBLCLK) and
        (TAutoRichEditRuler(Parent).AutoRichEdit <> nil) then
        TAutoRichEditRuler(Parent).AutoRichEdit.ParagraphDialog
      else inherited;
  if Message.Msg = WM_MOVE then Top := 10;
end;

{ TAutoRichEditRuler }

constructor TAutoRichEditRuler.Create(AOwner: TComponent);
var
  DC: HDC;
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque];
  FBorderStyle := rbsNone;
  FFirstIndentMark := TFirstIndentMark.Create(Self);
  FFirstIndentMark.Parent := Self;
  FLeftIndentMark := TLeftIndentMark.Create(Self);
  FLeftIndentMark.Parent := Self;
  FPrevDragX := -1;
  FRightIndentMark := TRightIndentMark.Create(Self);
  FRightIndentMark.Parent := Self;
  Width := 220;
  DC := GetDC(0);
  FPixelsPerInch := GetDeviceCaps(DC, LOGPIXELSX);
  ReleaseDC(0, DC);
end;

function TAutoRichEditRuler.ClientToScreenX(Value: Integer): Integer;
begin
  Result := ClientToScreen(Point(Value, 0)).X;
end;

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

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

procedure TAutoRichEditRuler.DrawDragLine(X: Integer);
var
  Y1, Y2: Integer;
  DC: HDC;
  Pen: HPEN;
begin
  with FRichEdit do
  begin
    Y1 := ClientToScreen(Point(0, 0)).Y;
    Y2 := Y1 + ClientHeight;
  end;
  DC := GetWindowDC(0);
  SetROP2(DC, R2_NOTXORPEN);
  Pen := CreatePen(PS_DOT, 1, COLOR_WINDOWTEXT);
  SelectObject(DC, Pen);
  MoveToEx(DC, X, Y1, nil);