cxmemo.pas

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

      if (S[I] = #13) and (S[I + 1] = #10) then
        Inc(I);
      Inc(I);
    end;
end;

procedure DrawMemo(ACanvas: TcxCanvas; AViewInfo: TcxCustomMemoViewInfo);
var
  AText: PcxCaptionChar;
begin
  with AViewInfo do
  begin
    AText := PcxCaptionChar(Text);
    if Length(AText) = 0 then
      Exit;
    ACanvas.Font := Font;
    ACanvas.Font.Color := TextColor;
    InternalTextOut(ACanvas.Canvas, AViewInfo, AText, TextRect, DrawTextFlags,
      SelStart, SelLength, SelBackgroundColor, SelTextColor, MaxLineCount);
  end;
end;

procedure ExtractFirstLine(var AText: WideString; AMaxLength: Integer = 0);
var
  ALength, I: Integer;
begin
  ALength := Length(AText);
  if (AMaxLength > 0) and (ALength > AMaxLength) then
    ALength := AMaxLength;
  for I := 1 to ALength do
    if (AText[I] = #10) or (AText[I] = #13) then
    begin
      SetLength(AText, I - 1);
      Break;
    end;
  if Length(AText) > ALength then
    SetLength(AText, ALength);
end;

procedure SetMemoCaretPos(AMemo: TCustomMemo; const Value: TPoint);
var
  ACharIdx: Integer;
begin
  ACharIdx := SendMessage(AMemo.Handle, EM_LINEINDEX, Value.Y, 0) + Value.X;
  SendMessage(AMemo.Handle, EM_SETSEL, ACharIdx, ACharIdx);
end;

{ TcxCustomMemoViewInfo }

procedure TcxCustomMemoViewInfo.DrawText(ACanvas: TcxCanvas);
begin
  DrawMemo(ACanvas, Self);
end;

{ TcxCustomMemoViewData }

function TcxCustomMemoViewData.GetDrawTextFlags: DWORD;
const
  AAlignmentFlagMap: array [TAlignment] of DWORD = (CXTO_LEFT,
    CXTO_RIGHT, CXTO_CENTER_HORIZONTALLY);
begin
  Result := Integer(CXTO_EDITCONTROL);
  with Properties do
    if not (ScrollBars in [ssHorizontal, ssBoth]) and WordWrap then
      Result := Result or CXTO_WORDBREAK or CXTO_CHARBREAK;
  Result := Result or AAlignmentFlagMap[Properties.Alignment];
  Result := Result or CXTO_PREVENT_LEFT_EXCEED or CXTO_EXPANDTABS;
end;

function TcxCustomMemoViewData.GetDrawTextOffset: TRect;
begin
  Result := EditContentDefaultOffsets[IsInplace];
end;

function TcxCustomMemoViewData.GetEditContentSizeCorrection: TSize;
begin
  with GetDrawTextOffset do
    Result := Size(Left + Right, Top + Bottom);
end;

function TcxCustomMemoViewData.GetMaxLineCount: Integer;
begin
  if Properties.VisibleLineCount > 0 then
    Result := Properties.VisibleLineCount
  else
    Result := inherited GetMaxLineCount;
end;

function TcxCustomMemoViewData.InternalGetEditConstantPartSize(
  ACanvas: TcxCanvas; AIsInplace: Boolean;
  AEditSizeProperties: TcxEditSizeProperties; var MinContentSize: TSize;
  AViewInfo: TcxCustomEditViewInfo): TSize;
var
  AContentHeight: Integer;
begin
  Result := inherited InternalGetEditConstantPartSize(ACanvas, AIsInplace,
    AEditSizeProperties, MinContentSize, AViewInfo);
  if (Edit <> nil) and (Properties.ScrollBars in [ssHorizontal, ssBoth]) then
    Result.cy := Result.cy + GetScrollBarSize.cy;
  if Properties.VisibleLineCount > 0 then
  begin
    ACanvas.Font := Style.GetVisibleFont;
    AContentHeight := ACanvas.TextHeight('Zg') * Properties.VisibleLineCount +
      GetEditContentSizeCorrection.cy;
    if MinContentSize.cy < AContentHeight then
      MinContentSize.cy := AContentHeight;
  end;
end;

function TcxCustomMemoViewData.InternalGetEditContentSize(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue; const AEditSizeProperties: TcxEditSizeProperties): TSize;
begin
  Result := GetTextEditContentSize(ACanvas, Self, EditValueToDisplayText(AEditValue),
    GetDrawTextFlags, AEditSizeProperties, Properties.VisibleLineCount);
end;

function TcxCustomMemoViewData.GetProperties: TcxCustomMemoProperties;
begin
  Result := TcxCustomMemoProperties(FProperties);
end;

{ TcxCustomMemoProperties }

constructor TcxCustomMemoProperties.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner);
  inherited Alignment.Vert := taTopJustify;
  AutoSelect := False;
  FScrollBars := ssNone;
  FWantReturns := True;
  FWordWrap := True;
end;

procedure TcxCustomMemoProperties.Assign(Source: TPersistent);
begin
  if Source is TcxCustomMemoProperties then
  begin
    BeginUpdate;
    try
      inherited Assign(Source);
      with Source as TcxCustomMemoProperties do
      begin
        Self.ScrollBars := ScrollBars;
        Self.VisibleLineCount := VisibleLineCount;
        Self.WantReturns := WantReturns;
        Self.WantTabs := WantTabs;
        Self.WordWrap := WordWrap;
      end;
    finally
      EndUpdate;
    end
  end
  else
    inherited Assign(Source);
end;

class function TcxCustomMemoProperties.GetContainerClass: TcxContainerClass;
begin
  Result := TcxMemo;
end;

function TcxCustomMemoProperties.GetDisplayText(const AEditValue: TcxEditValue;
  AFullText: Boolean = False; AIsInplace: Boolean = True): WideString;
begin
  Result := inherited GetDisplayText(AEditValue);
  if AFullText then
    Exit;
  ExtractFirstLine(Result, cxMemoMaxDisplayTextLength);
end;

class function TcxCustomMemoProperties.GetViewInfoClass: TcxContainerViewInfoClass;
begin
  Result := TcxCustomMemoViewInfo;
end;

function TcxCustomMemoProperties.GetEditValueSource(AEditFocused: Boolean): TcxDataEditValueSource;
begin
  if (IDefaultValuesProvider <> nil) and IDefaultValuesProvider.IsBlob then
    Result := evsValue
  else
    Result := evsText;
end;

class function TcxCustomMemoProperties.GetViewDataClass: TcxCustomEditViewDataClass;
begin
  Result := TcxCustomMemoViewData;
end;

function TcxCustomMemoProperties.InnerEditNeedsTabs: Boolean;
begin
  Result := WantTabs;
end;

function TcxCustomMemoProperties.IsMultiLine: Boolean;
begin
  Result := True;
end;

function TcxCustomMemoProperties.GetAlignment: TAlignment;
begin
  Result := inherited Alignment.Horz;
end;

function TcxCustomMemoProperties.IsAlignmentStored: Boolean;
begin
  Result := inherited Alignment.IsHorzStored;
end;

procedure TcxCustomMemoProperties.SetAlignment(Value: TAlignment);
begin
  inherited Alignment.Horz := Value;
end;

procedure TcxCustomMemoProperties.SetScrollBars(Value: TScrollStyle);
begin
  if Value <> FScrollBars then
  begin
    FScrollBars := Value;
    Changed;
  end;
end;

procedure TcxCustomMemoProperties.SetVisibleLineCount(Value: Integer);
begin
  if Value < 0 then
    Value := 0;
  if Value <> FVisibleLineCount then
  begin
    FVisibleLineCount := Value;
    Changed;
  end;
end;

procedure TcxCustomMemoProperties.SetWantReturns(Value: Boolean);
begin
  if Value <> FWantReturns then
  begin
    FWantReturns := Value;
    Changed;
  end;
end;

procedure TcxCustomMemoProperties.SetWantTabs(Value: Boolean);
begin
  if Value <> FWantTabs then
  begin
    FWantTabs := Value;
    Changed;
  end;
end;

procedure TcxCustomMemoProperties.SetWordWrap(Value: Boolean);
begin
  if Value <> FWordWrap then
  begin
    FWordWrap := Value;
    Changed;
  end;
end;

{ TcxCustomMemo }

procedure TcxCustomMemo.ClearSelection;
var
  APrevKeyboardAction: Boolean;
begin
  if SelLength = 0 then
    Exit;
  if Focused and not DoEditing then
    Exit;
  APrevKeyboardAction := KeyboardAction;
  KeyboardAction := Focused;
  try
    FInternalAction := True;
    try
      InnerMemo.ClearSelection;
    finally
      FInternalAction := False;
    end;
    InternalSynchronizeEditValue;
  finally
    KeyboardAction := APrevKeyboardAction;
  end;
end;

procedure TcxCustomMemo.CutToClipboard;
begin
  if SelLength = 0 then
    Exit;
  InnerTextEdit.CopyToClipboard;
  ClearSelection;
end;

class function TcxCustomMemo.GetPropertiesClass: TcxCustomEditPropertiesClass;
begin
  Result := TcxCustomMemoProperties;
end;

function TcxCustomMemo.IsEditClass: Boolean;
begin
  Result := True;
end;

procedure TcxCustomMemo.AdjustInnerEdit;
var
  AFont: TFont;
  AInnerControl: TWinControlAccess;
begin
  if (InnerControl = nil) or FIsCreating then
    Exit;
  AInnerControl := TWinControlAccess(InnerControl);
  InnerEdit.LockBounds(True);
  try
    AInnerControl.Color := ViewInfo.BackgroundColor;
    AFont := TFont.Create;
    try
      AFont.Assign(ActiveStyle.GetVisibleFont);
      AFont.Color := ViewInfo.TextColor;
      AssignFonts(AInnerControl.Font, AFont);
    finally
      FreeAndNil(AFont);
    end;
  finally
    InnerEdit.LockBounds(False);
  end;
end;

procedure TcxCustomMemo.AdjustInnerEditPosition;
var
  AInnerEditBounds: TRect;
  R: TRect;
begin
  if (InnerTextEdit = nil) or FInnerEditPositionAdjusting then
    Exit;
  FInnerEditPositionAdjusting := True;
  try
    R := ViewInfo.ClientRect;
    AInnerEditBounds := Rect(R.Left - cxContainerMaxBorderWidth, R.Top - cxContainerMaxBorderWidth,
      R.Right - R.Left + cxContainerMaxBorderWidth * 2, R.Bottom - R.Top + cxContainerMaxBorderWidth * 2);
    with AInnerEditBounds do
      if not EqualRect(InnerEdit.Control.BoundsRect, Rect(Left, Top, Left + Right, Top + Bottom)) then
        InnerEdit.Control.SetBounds(Left, Top, Right, Bottom);
    AlignControls(InnerEdit.Control, R);
  finally
    FInnerEditPositionAdjusting := False;
  end;
end;

function TcxCustomMemo.CanAutoSize: Boolean;
begin
  Result := not IsInplace and (ActiveProperties.VisibleLineCount > 0);
end;

function TcxCustomMemo.CanKeyDownModifyEdit(Key: Word; Shift: TShiftState): Boolean;
begin
  Result := inherited CanKeyDownModifyEdit(Key, Shift) or
    CanMemoKeyModifyEdit(Key, Shift, False);
end;

function TcxCustomMemo.CanScrollLineWithoutScrollBars(
  ADirection: TcxDirection): Boolean;
begin
  Result := ADirection in [dirUp, dirDown];
end;

procedure TcxCustomMemo.ChangeHandler(Sender: TObject);
begin
  inherited ChangeHandler(Sender);
  UpdateScrollBarsParameters;
end;

procedure TcxCustomMemo.DoEditKeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited DoEditKeyDown(Key, Shift);
  if Key = 0 then
    Exit;

  if ((Char(Key) = 'a') or (Char(Key) = 'A')) and (ssCtrl in Shift) and
    (Shift * [ssAlt, ssShift] = []) and (Lines.Count > 0) then
  begin
    if InnerControl is TCustomEdit then
      TCustomEdit(InnerControl).SelectAll;
    DoAfterKeyDown(Key, Shift);
    Key := 0;
  end;
end;

procedure TcxCustomMemo.EnabledChanged;
begin
  inherited;
  SetScrollBarsParameters;
end;

procedure TcxCustomMemo.FontChanged;
begin
  inherited FontChanged;
  SetScrollBarsParameters;
end;

function TcxCustomMemo.GetInnerEditClass: TControlClass;
begin
  Result := TcxCustomInnerMemo;
end;

procedure TcxCustomMemo.Initialize;
begin
  inherited Initialize;
  Width := 185;
  Height := 89;
end;

procedure TcxCustomMemo.InitializeViewData(AViewData: TcxCustomEditViewData);
begin
  inherited InitializeViewData(AViewData);
  AViewData.HScrollBar := nil;
  AViewData.VScrollBar := nil;
end;

function TcxCustomMemo.IsCheckAsYouTypeSupports: Boolean;
begin
  Result := IsTextInputMode; 
end;

procedure TcxCustomMemo.KeyDown(var Key: Word; Shift: TShiftState);
var
  AKey: Word;
begin
  AKey := TranslateKey(Key);
  if IsInplace and (AKey = VK_RETURN) and ((ssCtrl in Shift) and not ActiveProperties.WantReturns or
      not (ssCtrl in Shift) and ActiveProperties.WantReturns) then
    DoEditKeyDown(Key, Shift)
  else
    inherited KeyDown(Key, Shift);
end;

function TcxCustomMemo.NeedsScrollBars: Boolean;
begin
  Result := FCanCreateScrollBars and (ActiveProperties <> nil) and
    (ActiveProperties.ScrollBars <> ssNone);
end;

procedure TcxCustomMemo.PropertiesChanged(Sender: TObject);
begin
  if PropertiesChangeLocked then
    Exit;
  if InnerMemo.ScrollBars <> ActiveProperties.ScrollBars then
  begin
    FCanCreateScrollBars := True;
    CheckNeedsScrollBars;
    InnerMemo.ScrollBars := ActiveProperties.ScrollBars;
    if HandleAllocated then
      RecreateWnd;
    if InnerControl.HandleAllocated then
      TWinControlAccess(InnerControl).RecreateWnd;
  end;
  InnerMemo.WantReturns := ActiveProperties.WantReturns;
  InnerMemo.WantTabs := ActiveProperties.WantTabs;
  InnerMemo.WordWrap := ActiveProperties.WordWrap;
  inherited PropertiesChanged(Sender);
end;

procedure TcxCustomMemo.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Lines.Count > 0 then
    PrepareEditValue(Text, FEditValue, InternalFocused);
end;

procedure TcxCustomMemo.Scroll(AScrollBarKind: TScrollBarKind; AScrollCode: TScrollCode;
  var AScrollPos: Integer);
const
  ALineCounts: array[Boolean] of Integer = (-1, 1);
begin
  if AScrollBarKind = sbHorizontal then
  begin
    InnerMemo.CallDefWndProc(WM_HSCROLL,
      Word(AScrollCode) + Word(AScrollPos) shl 16, HScrollBar.Handle);
    AScrollPos := GetScrollPos(InnerControl.Handle, SB_HORZ);
  end
  else
  begin
    if AScrollCode in [scLineDown, scLineUp] then
      SendMessage(InnerControl.Handle, EM_LINESCROLL, 0,
        ALineCounts[AScrollCode = scLineDown])
    else
      InnerMemo.CallDefWndProc(WM_VSCROLL,
        Word(AScrollCode) + Word(AScrollPos) shl 16, VScrollBar.Handle);
    AScrollPos := GetScrollPos(InnerControl.Handle, SB_VERT);
  end;
  SetScrollBarsParameters;
end;

function TcxCustomMemo.SendActivationKey(Key: Char): Boolean;
begin
  Result := not(TranslateKey(Word(Key)) = VK_RETURN);
end;

procedure TcxCustomMemo.SetSelText(const Value: TCaption);
var
  ANewValue: string;
  ANewValueLength: Integer;
  APrevKeyboardAction, ACheckAsYouType: Boolean;
begin
  ANewValue := Value;