cxmemo.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,016 行 · 第 1/4 页

  FHelper := TcxCustomInnerMemoHelper.Create(Self);
  FInternalUpdating := False;
  FIsCreating := False;
end;

destructor TcxCustomInnerMemo.Destroy;
begin
  FreeAndNil(FHelper);
  inherited Destroy;
end;

procedure TcxCustomInnerMemo.DragDrop(Source: TObject; X, Y: Integer);
begin
  Container.DragDrop(Source, Left + X, Top + Y);
end;

function TcxCustomInnerMemo.ExecuteAction(Action: TBasicAction): Boolean;
begin
  Result := inherited ExecuteAction(Action) or
    Container.DataBinding.ExecuteAction(Action);
end;

function TcxCustomInnerMemo.UpdateAction(Action: TBasicAction): Boolean;
begin
  Result := inherited UpdateAction(Action) or
    Container.DataBinding.UpdateAction(Action);
end;

{$IFDEF DELPHI5}
function TcxCustomInnerMemo.CanFocus: Boolean;
begin
  Result := Container.CanFocusEx;
end;
{$ENDIF}

procedure TcxCustomInnerMemo.DefaultHandler(var Message);
begin
  if not Container.InnerControlDefaultHandler(TMessage(Message)) then
    inherited DefaultHandler(Message);
end;

procedure TcxCustomInnerMemo.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if not FIsCreating and (FLockBoundsCount = 0) then
  begin
    Container.LockAlignControls(True);
    try
      inherited SetBounds(ALeft, ATop, AWidth, AHeight);
    finally
      Container.LockAlignControls(False);
    end;
  end;
end;

procedure TcxCustomInnerMemo.Click;
begin
  inherited Click;
  Container.Click;
end;

procedure TcxCustomInnerMemo.DblClick;
begin
  inherited DblClick;
  Container.DblClick;
end;

procedure TcxCustomInnerMemo.DoEnter;
begin
  inherited DoEnter;
  if FAutoSelect then
    SelectAll
end;

procedure TcxCustomInnerMemo.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Container.DragOver(Source, Left + X, Top + Y, State, Accept);
end;

procedure TcxCustomInnerMemo.KeyDown(var Key: Word; Shift: TShiftState);
begin
  FInternalUpdating := False;
  Container.KeyDown(Key, Shift);
  if Key = 0 then
    FInternalUpdating := True
  else
    inherited KeyDown(Key, Shift);
end;

procedure TcxCustomInnerMemo.KeyPress(var Key: Char);
begin
  FInternalUpdating := False;
//  if not WantTabs and ((Key = Char(VK_TAB))) then
//    Key := #0;
  Container.KeyPress(Key);
  if Key = #0 then
    FInternalUpdating := True
  else
    inherited KeyPress(Key);
end;

procedure TcxCustomInnerMemo.KeyUp(var Key: Word; Shift: TShiftState);
begin
  FInternalUpdating := False;
  if not WantTabs and ((Key = VK_TAB)) then
    Key := 0;
  Container.KeyUp(Key, Shift);
  if Key = 0 then
    FInternalUpdating := True
  else
    inherited KeyUp(Key, Shift);
end;

procedure TcxCustomInnerMemo.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  with Container do
  begin
    InnerControlMouseDown := True;
    try
      MouseDown(Button, Shift, X + Self.Left, Y + Self.Top);
    finally
      InnerControlMouseDown := False;
    end;
  end;
end;

procedure TcxCustomInnerMemo.MouseLeave(AControl: TControl);
begin
  Container.ShortRefreshContainer(True);
end;

procedure TcxCustomInnerMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseMove(Shift, X, Y);
  Container.MouseMove(Shift, X + Left, Y + Top);
end;

procedure TcxCustomInnerMemo.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  Container.MouseUp(Button, Shift, X + Left, Y + Top);
end;

procedure TcxCustomInnerMemo.CreateHandle;
begin
  Container.ClearSavedChildControlRegions;
  inherited CreateHandle;
end;

procedure TcxCustomInnerMemo.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params.WindowClass do
  begin
    style := style and not CS_VREDRAW;
    if (ScrollBars in [ssHorizontal, ssBoth]) or not WordWrap then
      style := style and not CS_HREDRAW;
  end;
end;

procedure TcxCustomInnerMemo.CreateWindowHandle(const Params: TCreateParams);
begin
  BeginInternalTextSetting;
  try
    inherited CreateWindowHandle(Params); // do not handle WM_SETTEXT from inherited CreateWindowHandle
  finally
    EndInternalTextSetting;
  end;
  Lines.Text := Text;
  Container.SetScrollBarsParameters;
end;

procedure TcxCustomInnerMemo.WndProc(var Message: TMessage);
begin
  if Container.InnerControlMenuHandler(Message) then
    Exit;
  Container.InternalSpellCheckerHandler(Message);
  if ((Message.Msg = WM_LBUTTONDOWN) or (Message.Msg = WM_LBUTTONDBLCLK)) and
    (Container.DragMode = dmAutomatic) and not Container.IsDesigning then
      Container.BeginAutoDrag
  else
    inherited WndProc(Message);
end;

// IcxContainerInnerControl
function TcxCustomInnerMemo.GetControl: TWinControl;
begin
  Result := Self;
end;

function TcxCustomInnerMemo.GetControlContainer: TcxContainer;
begin
  Result := Container;
end;

// IcxInnerEditHelper
function TcxCustomInnerMemo.GetHelper: IcxCustomInnerEdit;
begin
  Result := Helper;
end;

procedure TcxCustomInnerMemo.BeginInternalTextSetting;
begin
  Inc(FInternalTextSettingCount);
end;

procedure TcxCustomInnerMemo.EndInternalTextSetting;
begin
  Dec(FInternalTextSettingCount);
end;

function TcxCustomInnerMemo.IsInternalTextSetting: Boolean;
begin
  Result := FInternalTextSettingCount > 0;
end;

function TcxCustomInnerMemo.GetContainer: TcxCustomMemo;
begin
  Result := TcxCustomMemo(Owner);
end;

procedure TcxCustomInnerMemo.WMClear(var Message: TMessage);
begin
  if Container.FInternalAction then
    inherited
  else
    if not ReadOnly then
      with Container do
      begin
        KeyboardAction := True;
        try
          ClearSelection;
        finally
          KeyboardAction := False;
        end;
      end;
end;

procedure TcxCustomInnerMemo.WMCut(var Message: TMessage);
begin
  with Container do
  begin
    KeyboardAction := True;
    try
      if not Self.ReadOnly then
        CutToClipboard
      else
        CopyToClipboard;
    finally
      KeyboardAction := False;
    end;
  end;
end;

procedure TcxCustomInnerMemo.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  if Container.TabsNeeded and (GetKeyState(VK_CONTROL) >= 0) then
    Message.Result := Message.Result or DLGC_WANTTAB;
  if FEscapePressed then
    Message.Result := Message.Result and not DLGC_WANTALLKEYS;
end;

procedure TcxCustomInnerMemo.WMKeyDown(var Message: TWMKeyDown);
var
  AKey: Word;
  APrevState: TcxCustomInnerTextEditPrevState;
  AShiftState: TShiftState;
begin
  SaveTextEditState(Helper, True, APrevState);
  FInternalUpdating := False;
  inherited;
  Container.UpdateScrollBarsParameters;
  if FInternalUpdating then
    Exit;

  AShiftState := KeyDataToShiftState(Message.KeyData);
  if not CheckTextEditState(Helper, APrevState) and (Message.CharCode <> 0) and
    (Message.CharCode <> VK_UP) and (Message.CharCode <> VK_DOWN) then
  begin
    AShiftState := KeyDataToShiftState(Message.KeyData);
    AKey := Message.CharCode;
    Container.DoAfterKeyDown(AKey, AShiftState);
    Message.CharCode := AKey;
  end;
end;

procedure TcxCustomInnerMemo.WMKillFocus(var Message: TWMKillFocus);
begin
  inherited;
  if not(csDestroying in ComponentState) then
    Container.FocusChanged;
end;

procedure TcxCustomInnerMemo.WMNCPaint(var Message: TWMNCPaint);

  function GetScrollBarRect(AScrollBarKind: TScrollBarKind): TRect;
  const
    AScrollBarObjects: array [TScrollBarKind] of Longword = (OBJID_HSCROLL, OBJID_VSCROLL);
  var
    AScrollBarInfo: TcxScrollBarInfo;
    AScrollBarState: DWORD;
  begin
    Result := cxEmptyRect;
    if (csDestroying in ComponentState) or not HandleAllocated then
      Exit;
    if not cxGetScrollBarInfo(Handle, Integer(AScrollBarObjects[AScrollBarKind]),
        AScrollBarInfo) then
      Exit;
    AScrollBarState := AScrollBarInfo.rgstate[0];
    if AScrollBarState and (STATE_SYSTEM_INVISIBLE or STATE_SYSTEM_OFFSCREEN) <> 0 then
      Exit;
    with AScrollBarInfo.rcScrollBar do
    begin
      Result.TopLeft := ScreenToClient(TopLeft);
      Result.Right := Result.Left + Right - Left;
      Result.Bottom := Result.Top + Bottom - Top;
    end;
    OffsetRect(Result, cxContainerMaxBorderWidth, cxContainerMaxBorderWidth);
  end;

  function GetSizeGripRect: TRect;
  var
    RH, RV: TRect;
  begin
    Result := cxEmptyRect;
    RH := GetScrollBarRect(sbHorizontal);
    if IsRectEmpty(RH) then
      Exit;
    RV := GetScrollBarRect(sbVertical);
    if IsRectEmpty(RV) then
      Exit;
    Result := Rect(RV.Left, RH.Top, RV.Right, RH.Bottom);
  end;

  procedure FillSizeGrip;
  var
    ABrush: HBRUSH;
    ADC: HDC;
    R: TRect;
  begin
    if ScrollBars <> ssBoth then
      Exit;
    R := GetSizeGripRect;
    if not IsRectEmpty(R) then
    begin
      ABrush := 0;
      ADC := GetWindowDC(Handle);
      try
        with Container.LookAndFeel do
          ABrush := CreateSolidBrush(ColorToRGB(Painter.DefaultSizeGripAreaColor));
        FillRect(ADC, R, ABrush);
      finally
        if ABrush <> 0 then
          DeleteObject(ABrush);
        ReleaseDC(Handle, ADC);
      end;
    end;
  end;

var
  A: Integer;
begin
  if not UsecxScrollBars then
  begin
    inherited;
    Exit;
  end;
  A := GetWindowLong(Handle, GWL_STYLE);
  A := A and not(WS_HSCROLL or WS_VSCROLL);
  SetWindowLong(Handle, GWL_STYLE, A);
  inherited;
  A := GetWindowLong(Handle, GWL_STYLE);
  if ScrollBars in [ssHorizontal, ssBoth] then
    A := A or WS_HSCROLL;
  if ScrollBars in [ssVertical, ssBoth] then
    A := A or WS_VSCROLL;
  SetWindowLong(Handle, GWL_STYLE, A);
  FillSizeGrip;
end;

procedure TcxCustomInnerMemo.WMPaint(var Message: TWMPaint);
begin
  inherited;
  Container.DoDrawMisspelleds;
end;

procedure TcxCustomInnerMemo.WMPaste(var Message: TMessage);
begin
  if not ReadOnly then
    with Container do
    begin
      KeyboardAction := True;
      try
        PasteFromClipboard;
      finally
        KeyboardAction := False;
      end;
    end;
end;

procedure TcxCustomInnerMemo.WMSetFocus(var Message: TWMSetFocus);
begin
  inherited;
  if not(csDestroying in ComponentState) and (Message.FocusedWnd <> Container.Handle) then
    Container.FocusChanged;
end;

procedure TcxCustomInnerMemo.WMSetFont(var Message: TWMSetFont);
begin
  inherited;
  if (*Container.IsInplace and *)NewStyleControls then
    SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, 0);
end;

procedure TcxCustomInnerMemo.WMSetText(var Message: TWMSetText);
begin
  inherited;
  if IsInternalTextSetting then
    Exit;
  BeginInternalTextSetting;
  try
    Container.InternalEditValue := string(Message.Text);
  finally
    EndInternalTextSetting;
  end;
end;

procedure TcxCustomInnerMemo.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  Container.SetScrollBarsParameters;
  inherited;
end;

procedure TcxCustomInnerMemo.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
  inherited;
  Container.SetScrollBarsParameters;
end;

procedure TcxCustomInnerMemo.EMReplaceSel(var Message: TMessage);
var
  APrevLParam: Integer;
  S: string;
begin
  S := PChar(Message.LParam);
  CorrectLineBreaks(S);

  APrevLParam := Message.LParam;
  Message.LParam := Integer(PChar(S));
  try
    inherited;
    Container.SynchronizeEditValue;
  finally
    Message.LParam := APrevLParam;
  end;
end;

procedure TcxCustomInnerMemo.EMSetSel(var Message: TMessage);
begin
  inherited;
  if Assigned(OnSelChange) then
    OnSelChange(Self);
end;

procedure TcxCustomInnerMemo.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if Message.lParam = 0 then
    MouseLeave(Self)
  else
    MouseLeave(TControl(Message.lParam));
end;

procedure TcxCustomInnerMemo.CNKeyDown(var Message: TWMKeyDown);
begin
  if Message.CharCode = VK_ESCAPE then
    FEscapePressed := True;
  try
    inherited;
  finally
    FEscapePressed := False;
  end;
end;

procedure TcxCustomInnerMemo.WMIMEComposition(var Message: TMessage);
begin
  if Container.DoEditing then
    inherited;
end;

initialization
  GetRegisteredEditProperties.Register(TcxMemoProperties, scxSEditRepositoryMemoItem);
  FilterEditsController.Register(TcxMemoProperties, TcxFilterMemoHelper);

finalization
  FilterEditsController.Unregister(TcxMemoProperties, TcxFilterMemoHelper);
  
end.