cxtextedit.pas

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

      if ALineCount > 0 then
      begin
        if ARowCount > ALineCount then
          ARowCount := ALineCount;
      end
      else
        if (AEditSizeProperties.MaxLineCount > 0) and (ARowCount > AEditSizeProperties.MaxLineCount) then
          ARowCount := AEditSizeProperties.MaxLineCount;
      if ARowCount = 0 then
        Result.cx := 0
      else
        Result.cx := cxGetLongestTextRowWidth(ATextRows, ARowCount);
      ATextRows := nil;
      Result.cy := ACanvas.TextHeight('Zg');
      if ALineCount > 0 then
        Result.cy := Result.cy * ALineCount;
    end;
    if AAlignment <> nil then
      Result.cx := Result.cx + 1;
    if ACorrectWidth then
      Result.cx := Result.cx + ASizeCorrection.cx;
    if Result.cy > 0 then
      Result.cy := Result.cy + ASizeCorrection.cy;
  end;

begin
  if AEditSizeProperties.Width >= 0 then
    Result := GetAutoHeightSize
  else
    Result := GetBestFitSize;
end;

function GetTextEditDrawTextOffset(AViewData: TcxCustomEditViewData): TRect;
begin
  Result := AViewData.EditContentParams.Offsets;
  if not AViewData.IsInplace and (AViewData is TcxCustomTextEditViewData) then
    with AViewData as TcxCustomTextEditViewData do
      if TcxCustomTextEditProperties(Properties).EditingStyle in [esFixedList, esNoEdit] then
      begin
        if AViewData.VertAlignment = taTopJustify then
        begin
          Inc(Result.Top);
          Dec(Result.Bottom);
        end;
        if AViewData.HorzAlignment = taRightJustify then
          Inc(Result.Right)
        else
          Inc(Result.Left);
      end;
end;

function GetTextEditDrawTextOffset(AAlignment: TAlignment; AIsInplace: Boolean): TRect; // deprecated
begin
  Result := EditContentDefaultOffsets[AIsInplace];
end;

procedure PrepareTextRows(ACanvas: TCanvas; var TextOutData: TcxTextOutData;
  AText: PcxCaptionChar; var R: TRect; AFormat: TcxTextOutFormat; ASelStart,
  ASelLength: Integer; ASelBackgroundColor, ASelTextColor: TColor;
  AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0);

  procedure InternalPrepareTextRows;
  var
    ATextLength: Integer;
  begin
    TextOutData.RowCount := 0;
    TextOutData.TextRows := nil;
    ATextLength := StrLen(AText);
    if ATextLength = 0 then
      Exit;
    TextOutData.TextParams := cxCalcTextParams(ACanvas.Handle, AFormat);
    TextOutData.TextRect := cxPrepareRect(R, TextOutData.TextParams, ALeftIndent,
      ARightIndent);

    if not IsRectEmpty(TextOutData.TextRect) then
    begin
      TextOutData.ForceEndEllipsis := not cxMakeTextRows(ACanvas.Handle, (AText), TextOutData.TextRect, TextOutData.TextParams, TextOutData.TextRows, TextOutData.RowCount, AMaxLineCount);
      if TextOutData.RowCount <> 0 then
      begin
        if (AMaxLineCount > 0) and (TextOutData.RowCount >= AMaxLineCount) then
        begin
          TextOutData.RowCount := AMaxLineCount;
          with TextOutData.TextParams do
            TextOutData.ForceEndEllipsis := TextOutData.ForceEndEllipsis and EndEllipsis and EditControl and not SingleLine;
        end
        else
          TextOutData.ForceEndEllipsis := False;

        cxPlaceTextRows(ACanvas.Handle, TextOutData.TextRect, TextOutData.TextParams, TextOutData.TextRows, TextOutData.RowCount);
        if (ASelStart < 0) or (ASelStart >= ATextLength) then
          ASelLength := 0
        else
          if (ASelLength + ASelStart) > ATextLength then
            ASelLength := ATextLength - ASelStart;

        TextOutData.SelStart := ASelStart;
        TextOutData.SelLength := ASelLength;
        TextOutData.SelBackgroundColor := ASelBackgroundColor;
        TextOutData.SelTextColor := ASelTextColor;
      end;
    end;
  end;

begin
  TextOutData.Initialized := True;
  InternalPrepareTextRows;
end;

procedure InternalTextOut(ACanvas: TCanvas; AViewInfo: TcxCustomTextEditViewInfo;
  AText: PcxCaptionChar; var R: TRect; AFormat: TcxTextOutFormat; ASelStart,
  ASelLength: Integer; ASelBackgroundColor, ASelTextColor: TColor;
  AMaxLineCount: Integer = 0; ALeftIndent: Integer = 0; ARightIndent: Integer = 0);
begin
  if not AViewInfo.TextOutData.Initialized then
    PrepareTextRows(ACanvas, AViewInfo.TextOutData, AText, R, AFormat, ASelStart,
    ASelLength, ASelBackgroundColor, ASelTextColor, AMaxLineCount, ALeftIndent,
    ARightIndent);
  TCanvasAccess(ACanvas).RequiredState([csFontValid]);
  with AViewInfo.TextOutData do
    cxTextRowsOutHighlight(ACanvas.Handle, TextRect, TextParams, TextRows,
    RowCount, SelStart, SelLength, SelBackgroundColor, SelTextColor, ForceEndEllipsis);
end;

procedure PrepareTextEditDrawTextFlags(ACanvas: TcxCanvas; AViewData: TcxCustomTextEditViewData;
  AViewInfo: TcxCustomTextEditViewInfo);
var
  ADrawTextOffset: TRect;
  AFlags: DWORD;
  R: TRect;
  ATextHeight: Integer;
  ATextParams: TcxTextParams;
  ATextRows: TcxTextRows;
  ARowCount: Integer;
begin
  if AViewData.Style.GetVisibleFont = nil then
    Exit;
  ACanvas.Font := AViewData.Style.GetVisibleFont;
  with AViewInfo do
  begin
    DrawTextFlags := AViewData.GetDrawTextFlags;
    AFlags := DrawTextFlags and not CXTO_SINGLELINE or
      CXTO_WORDBREAK or CXTO_EDITCONTROL or CXTO_CALCROWCOUNT;
    R := Rect(0, 0, TextRect.Right - TextRect.Left, MaxInt);
    ADrawTextOffset := AViewData.GetDrawTextOffset;
    Inc(R.Right, ADrawTextOffset.Left + ADrawTextOffset.Right);
    Dec(R.Right, AViewData.GetEditContentSizeCorrection.cx);
    Dec(R.Right, AViewData.ContentOffset.Left + AViewData.ContentOffset.Right);
    if TcxCustomTextEditProperties(AViewData.Properties).Alignment.Horz = taRightJustify then
      Inc(R.Right);
    ATextParams := cxCalcTextParams(ACanvas.Canvas, AFlags);
// TODO optimize
    cxMakeTextRows(ACanvas.Canvas, PcxCaptionChar(Text), R, ATextParams, ATextRows, ARowCount);
    ATextHeight := ARowCount * ATextParams.RowHeight;
    if ARowCount > 1 then
    begin
      DrawTextFlags := DrawTextFlags and not CXTO_SINGLELINE or
        CXTO_WORDBREAK or CXTO_EDITCONTROL;
      if ATextHeight > TextRect.Bottom - TextRect.Top then
        DrawTextFlags := DrawTextFlags and not CXTO_BOTTOM
          and not CXTO_CENTER_VERTICALLY or CXTO_TOP;
    end;
    ATextRows := nil;
  end;
end;

procedure InsertThousandSeparator(var S: string);

  function IsDigitChar(C: Char): Boolean;
  begin
    Result := C in ['0'..'9'];
  end;

var
  I, J: Integer;
  ACaption: string;
  APrefix, ASuffix: string;
begin
  APrefix := TrimRight(S);
  ASuffix := Copy(S, Length(APrefix) + 1, Length(S) - Length(APrefix));
  APrefix := TrimLeft(S);
  APrefix := Copy(S, 1, Length(S) - Length(APrefix));
  S := Trim(S);
  ACaption := RemoveExponentialPart(S);
  RemoveThousandSeparator(S);
  I := Pos(DecimalSeparator, S);
  if I = 0 then
    I := Length(S)
  else
    Dec(I);
  J := 0;
  while (I > 1) and IsDigitChar(S[I - 1]) do
  begin
    Inc(J);
    if J = 3 then
    begin
      Insert(ThousandSeparator, S, I);
      J := 0;
    end;
    Dec(I);
  end;
  S := APrefix + S + ACaption + ASuffix;
end;

function RemoveExponentialPart(var S: string): string;
var
  APos: Integer;
begin
  APos := Pos('E', UpperCase(S));
  if APos > 0 then
  begin
    Result := Copy(S, APos, Length(S) - APos + 1);
    Delete(S, APos, Length(S) - APos + 1);
  end
  else
    Result := '';
end;

procedure RemoveThousandSeparator(var S: string);
var
  APos: Integer;
begin
  repeat
    APos := Pos(ThousandSeparator, S);
    if APos <> 0 then
      Delete(S, APos, 1);
  until APos = 0;
end;

procedure SaveTextEditState(ATextEdit: IcxInnerTextEdit;
  ASaveText: Boolean;
  var APrevState: TcxCustomInnerTextEditPrevState);
begin
  with APrevState do
  begin
    IsPrevTextSaved := ASaveText;
    if ASaveText then
      PrevText := ATextEdit.EditValue;
    PrevSelStart := ATextEdit.SelStart;
    PrevSelLength := ATextEdit.SelLength;
  end;
end;

procedure SeparateDigitGroups(AEdit: TcxCustomTextEdit);

  function IsValidNumber(S: string): Boolean;
  var
    AValue: Extended;
  begin
    RemoveThousandSeparator(S);
    Result := (S <> '') and TextToFloat(PChar(S), AValue, fvExtended);
  end;

  function GetRealCaretPos: Integer;
  var
    I: Integer;
  begin
    Result := 0;
    for I := 1 to AEdit.SelStart do
      if AEdit.Text[I] <> ThousandSeparator then
        Inc(Result);
  end;

  procedure SetRealCaretPos(APrevCaretPos: Integer);
  var
    I: Integer;
    S: string;
  begin
    S := AEdit.Text;
    for I := 1 to Length(S) do
    begin
      if S[I] <> ThousandSeparator then
        Dec(APrevCaretPos);
      if APrevCaretPos = 0 then
      begin
        AEdit.SelStart := I;
        Break;
      end;
    end;
  end;

var
  ACaretPos: Integer;
  S: string;
begin
  S := AEdit.Text;
  InsertThousandSeparator(S);
  if IsValidNumber(S) then
  begin
    ACaretPos := GetRealCaretPos;
    AEdit.SetInternalDisplayValue(S);
    SetRealCaretPos(ACaretPos);
  end;
end;

{ TcxCustomInnerTextEditHelper }

constructor TcxCustomInnerTextEditHelper.Create(AEdit: TcxCustomInnerTextEdit);
begin
  inherited Create(nil);
  FEdit := AEdit;
  FAlignmentLock := False;
end;

// IcxContainerInnerControl
function TcxCustomInnerTextEditHelper.GetControlContainer: TcxContainer;
begin
  Result := Edit.Container;
end;

function TcxCustomInnerTextEditHelper.GetControl: TWinControl;
begin
  Result := Edit;
end;

// IcxCustomInnerEdit
function TcxCustomInnerTextEditHelper.CallDefWndProc(AMsg: UINT; WParam: WPARAM;
  LParam: LPARAM): LRESULT;