smemo.pas

AlphaControls是一个Delphi标准控件的集合

unit sMemo;
{$I sDefs.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ToolWin, ExtCtrls, sConst, sStyleEdits, sScrollBar, sMessages;

Type

  TVScrollEvent = TNotifyEvent;

  TsMemo = class(TCustomMemo)
  private
    FOnVScroll: TNotifyEvent;
    FOnScrollCaret: TNotifyEvent;
    VSBar : TsScrollBar;
    HSBar : TsScrollBar;
    procedure OnVSBChange(Sender : TObject; OldValue : integer);
    procedure OnHSBChange(Sender : TObject; OldValue : integer);
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMPaint (var Message: TMessage); message WM_PAINT;
    procedure WMMove (var Message: TMessage); message WM_MOVE;
    procedure WMSize (var Message: TMessage); message WM_SIZE;
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMHScroll); message WM_VSCROLL;
    procedure CMEnabledChanged(var Msg : TMessage); message CM_ENABLEDCHANGED;
    procedure WMMouseWheel(var Message: TMessage); message WM_MOUSEWHEEL;
    procedure CNKeyDown(var Message: TWMKey); message CN_KEYDOWN;
    procedure CNKeyUp(var Message: TWMKey); message CN_KEYUP;
    procedure WMMouseDown(var Message: TMessage); message WM_LBUTTONDOWN;
    procedure WMMouseUp(var Message: TMessage); message WM_LBUTTONUP;
    procedure EMScrollCaret (var Message: TMessage); message EM_SETSEL;
    property BorderStyle;
  protected
    FsStyle : TsStyle;
    Down : boolean;
    procedure CreateWnd; override;
    procedure WndProc (var Message: TMessage); override;
  public
    LastControl : boolean;
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Invalidate; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;
    procedure RefreshScrolls;
    procedure RefreshScrollBounds;
    function FirstLineIndex : integer;
  published
    property Align;
    property Alignment;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property Lines;
    property MaxLength;
    property OEMConvert;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property WantReturns;
    property WantTabs;
    property WordWrap;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    Property OnScrollCaret : TNotifyEvent read FOnScrollCaret write FOnScrollCaret;
    Property OnVScroll : TNotifyEvent read FOnVScroll write FOnVScroll;

    property AutoSelect;
    property HelpContext;
    property PasswordChar;
    property Hint;
    property Text;
    property CharCase;

    property sStyle:TsStyle read FsStyle write FsStyle;

    { Published declarations }
  end;

implementation

uses sStyleSimply, sUtils, sMaskData;

constructor TsMemo.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  BorderStyle := bsNone;
  sStyle := TsStyle.Create(Self);
  sStyle.COC := COC_TsMemo;
  OnKeyDown := sStyle.onKeyDown;
//  ParentColor := False;
end;

procedure TsMemo.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params^.rgrc[0], -3, -3);
end;

procedure TsMemo.WMNCPaint(var Message: TMessage);
begin
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
  if not IsValidSkinIndex(sStyle.SkinIndex) then inherited;
  sStyle.RedrawBorder;
end;

procedure TsMemo.Invalidate;
begin
  if Color <> sStyle.GetActiveColor then begin
    Color := sStyle.GetActiveColor;
  end;
  if (csDesigning in ComponentState) and Assigned(FsStyle) then begin
    if not RestrictDrawing then FsStyle.BGChanged := True;
  end;
  inherited;
//  RefreshScrolls;
end;

procedure TsMemo.WndProc(var Message: TMessage);
begin
  if Assigned(FsStyle) then FsStyle.WndProc(Message);
  inherited;
  if (Message.MSG = SM_REMOVESKIN) and not (csDestroying in ComponentState) then begin
    invalidate;
  end;

  if Assigned(sStyle) and IsValidSkinIndex(sStyle.SkinIndex) then begin
    case Message.Msg of
      CM_VISIBLECHANGED : begin
        RefreshScrolls;
      end;
    end;
    if not (csDesigning in ComponentState) then begin
      case Message.Msg of
        WM_MOUSEWHEEL, WM_PASTE, WM_CUT, WM_CLEAR, WM_UNDO, WM_SETTEXT,
        CM_CHANGED, CM_INVALIDATE, CM_CONTROLLISTCHANGE : RefreshScrolls;

        CM_VISIBLECHANGED : begin
          RefreshScrolls;
        end;
        WM_MOUSEMOVE : if Down then RefreshScrolls;
      end;
    end;
  end;
end;

procedure TsMemo.CreateWnd;
begin
  inherited;
  RefreshScrolls;
end;

destructor TsMemo.Destroy;
begin
  FreeAndNil(FsStyle);
  OnKeyDown := nil;
  inherited Destroy;
end;

procedure TsMemo.WMPaint(var Message: TMessage);
begin
  if (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
  inherited;
end;

procedure TsMemo.AfterConstruction;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsMemo.Loaded;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsMemo.WMVScroll(var Message: TWMHScroll);
begin
  inherited;
  RefreshScrolls;
  if Assigned(FOnVScroll) then begin
    FOnVScroll(Self);
  end;
end;

procedure TsMemo.EMScrollCaret(var Message: TMessage);
begin
  inherited;
  if Assigned(FOnScrollCaret) then begin
    FOnScrollCaret(Self);
  end;
end;

function TsMemo.FirstLineIndex: integer;
begin
  Result := LongRec(SendMessage(Handle, EM_GETFIRSTVISIBLELINE, 2, 2)).Lo;
end;

procedure TsMemo.OnHSBChange(Sender: TObject; OldValue : integer);
begin
  SendMessage(Handle, WM_HSCROLL, MakeWParam(SB_THUMBPOSITION, HSBar.Position), 0);
end;

procedure TsMemo.OnVSBChange(Sender: TObject; OldValue : integer);
begin
  SendMessage(Handle, WM_VSCROLL, MakeWParam(SB_THUMBPOSITION, VSBar.Position), 0);
end;

procedure TsMemo.WMHScroll(var Message: TWMHScroll);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsMemo.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsMemo.WMMouseWheel(var Message: TMessage);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsMemo.CNKeyDown(var Message: TWMKey);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsMemo.CNKeyUp(var Message: TWMKey);
begin
  inherited;
  case Message.CharCode of
    VK_UP, VK_DOWN, VK_HOME, VK_END, VK_SCROLL, VK_PRIOR, VK_NEXT : begin
      RefreshScrolls;
    end;
  end;
end;

procedure TsMemo.RefreshScrollBounds;
begin
  if Assigned(VSBar) then begin
    if BiDiMode = bdRightToLeft then begin
      VSBar.Left := Left + 3
    end
    else begin
      VSBar.Left := Left + Width - VSBar.Width - 3;
    end;
    VSBar.Top := Top + 3;
//    Application.ProcessMessages;
  end;
  if Assigned(HSBar) then begin
    HSBar.Left := Left + 3;
    HSBar.Top := Top + Height - HSBar.Height - 3;
//    Application.ProcessMessages;
  end;
end;

procedure TsMemo.RefreshScrolls;
var
  SI_V, SI_H : TScrollInfo;
  SBI_V, SBI_H : TScrollBarInfo;
begin
  if (csCreating in ControlState) or (csDestroying in ComponentState) then Exit;

  SBI_V.cbSize := SizeOf(TScrollBarInfo);
  SBI_H.cbSize := SizeOf(TScrollBarInfo);

  SI_V.cbSize := SizeOf(TScrollInfo);
  SI_V.fMask := SIF_ALL;
  SI_H.cbSize := SizeOf(TScrollInfo);
  SI_H.fMask := SIF_ALL;

  if not sSkinData.Active or not Visible or (Width < 16) or (Height < 16) then begin
    if Assigned(VSBar) then FreeAndNil(VSBar);
    if Assigned(HSBar) then FreeAndNil(HSBar);
    Exit;
  end;

  // Prepare vertical scrollbar
  if GetScrollInfo(Handle, SB_VERT, SI_V) and GetScrollBarInfo(Handle, Integer(OBJID_VSCROLL), SBI_V) then begin
    if (VSBar = nil) and
         sSkinData.Active and Visible and (Width >= 16) and (Height >= 16) and
           not (SBI_V.rgstate[0] = STATE_SYSTEM_INVISIBLE) then begin
      VSBar := TsScrollBar.Create(Self);
      VSBar.LinkedControl := Self;
      VSBar.OnChange := OnVSBChange;
      VSBar.DrawingForbidden := True;
      VSBar.Parent := Parent;
      VSBar.Visible := True;
      VSBar.TabStop := False;
      VSBar.Kind := sbVertical;
      VSBar.Width := WidthOf(SBI_V.rcScrollBar);
      VSBar.Smooth := True;
    end else if not (sSkinData.Active and not (SBI_V.rgstate[0] = STATE_SYSTEM_INVISIBLE)) or (ScrollBars = ssNone) then FreeAndNil(VSBar);

    if Assigned(VSBar) then begin
      VSBar.DrawingForbidden := True;
      VSBar.Height := HeightOf(SBI_V.rcScrollBar);
      VSBar.Enabled := not (SBI_V.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) and Enabled;
      if (SI_V.nMax < SI_V.nMin) or (SI_V.nMax - integer(SI_V.nPage) + 1 = 0) then begin
        VSBar.Max := 1;
        VSBar.Min := 0;
        VSBar.PageSize := SI_V.nPage;
        VSBar.Position := -1;
      end
      else begin
        VSBar.Max := SI_V.nMax - integer(SI_V.nPage) + 1;
        VSBar.Min := SI_V.nMin;
        VSBar.Position := SI_V.nPos;
        VSBar.PageSize := SI_V.nPage;
        if VSBar.PageSize > 0 then VSBar.LargeChange := VSBar.PageSize else VSBar.LargeChange := 1;
      end;
      VSBar.DrawingForbidden := False;
    end;
  end;

  // Prepare horizontal scrollbar
  if GetScrollInfo(Handle, SB_HORZ, SI_H) and GetScrollBarInfo(Handle, Integer(OBJID_HSCROLL), SBI_H) then begin
    if (HSBar = nil) and
         sSkinData.Active and Visible and (Width >= 16) and (Height >= 16) and
           not (SBI_H.rgstate[0] = STATE_SYSTEM_INVISIBLE) then begin
      HSBar := TsScrollBar.Create(Self);
      HSBar.LinkedControl := Self;
      HSBar.OnChange := OnHSBChange;
      HSBar.DrawingForbidden := True;
      HSBar.Parent := Parent;
//      HSBar.ParentSStyle := sStyle;
      HSBar.Visible := True;
      HSBar.TabStop := False;
      HSBar.Kind := sbHorizontal;
      HSBar.Height := HeightOf(SBI_H.rcScrollBar);
      HSBar.Smooth := True;
//      HSBar.BringToFront;
    end else if not (sSkinData.Active and not (SBI_H.rgstate[0] = STATE_SYSTEM_INVISIBLE)) or (ScrollBars = ssNone) then FreeAndNil(HSBar);

    if Assigned(HSBar) then begin
      HSBar.DrawingForbidden := True;
      HSBar.Width := WidthOf(SBI_H.rcScrollBar);
      HSBar.Enabled := not (SBI_H.rgstate[0] = STATE_SYSTEM_UNAVAILABLE) and Enabled;
      if (SI_H.nMax < SI_H.nMin) or (SI_h.nMax - integer(SI_H.nPage) + 1 = 0) then begin
        HSBar.Max := 1;
        HSBar.Min := 0;
        HSBar.PageSize := SI_H.nPage;
        HSBar.Position := -1;
      end
      else begin
        HSBar.Max := SI_H.nMax - integer(SI_H.nPage) + 1;
        HSBar.Min := SI_H.nMin;
        HSBar.Position := SI_H.nPos;
        HSBar.PageSize := SI_H.nPage;
        if HSBar.PageSize > 0 then HSBar.LargeChange := HSBar.PageSize else HSBar.LargeChange := 1;
      end;
      HSBar.DrawingForbidden := False;
    end;
  end;
  RefreshScrollBounds;
end;

procedure TsMemo.WMMove(var Message: TMessage);
begin
  inherited;
  RefreshScrolls;
end;

procedure TsMemo.WMMouseDown(var Message: TMessage);
begin
  inherited;
  Down := True;
end;

procedure TsMemo.WMMouseUp(var Message: TMessage);
begin
  Down := False;
  inherited;
end;

procedure TsMemo.WMSize(var Message: TMessage);
begin
  inherited;
  RefreshScrolls;
end;

end.