cxlabel.pas

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

  function GetTextDrawingParameters(ACanvas: TCanvas; ADrawingRect: TRect;
    AAngle: Integer; out AStep: TSize): TPoint;

    procedure CalcRotatedTextPos(ACanvas: TCanvas);
    var
     ARect: TRect;
     AText: string;
    begin
      if AAngle <> 0 then
      begin
        ARect := ADrawingRect;
        Dec(ARect.Right, DepthDeltaSize.cx);
        Dec(ARect.Bottom, DepthDeltaSize.cy);
        AText := Text;
        if ShowAccelChar then
          AText := RemoveAccelChars(AText);
        cxDrawText(ACanvas.Handle, AText, ADrawingRect, DT_CALCRECT or DT_NOPREFIX);

        Result.X := Round(
          (ARect.Left + ARect.Right)/2 -
          RectWidth(ADrawingRect) / 2  * Cos(AAngle * PI / 180) -
          RectHeight(ADrawingRect) / 2 * Sin(AAngle * PI / 180));
        Result.Y := Round(
          (ARect.Top + ARect.Bottom)/2 +
          RectWidth(ADrawingRect) / 2  * Sin(AAngle * PI / 180) -
          RectHeight(ADrawingRect) / 2 * Cos(AAngle * PI / 180));
      end;
    end;

    function GetSignByValue(AValue: Longint): ShortInt;
    begin
      Result := 0;
      if AValue = 0 then
        Exit;
      if AValue > 0 then
        Result := 1
      else
        Result := -1;
    end;

  var
    ALabelStyleOffset: Integer;
  begin
    Result := Point(0, 0);
    CalcRotatedTextPos(ACanvas);
    AStep := Size(0, 0);
    ALabelStyleOffset := GetLabelStyleOffset;
    if (LabelEffect <> cxleNormal) and (FDepth <> 0) then
    begin
      AStep := DepthDeltaSize;
      if Orientation in [cxoRight, cxoRightTop, cxoRightBottom] then
      begin
        Inc(Result.X, DepthDeltaSize.cx + ALabelStyleOffset);
        AStep.cx := -AStep.cx;
      end;
      if Orientation in [cxoBottom, cxoLeftBottom , cxoRightBottom] then
      begin
        Inc(Result.Y, DepthDeltaSize.cy + ALabelStyleOffset);
        AStep.cy := -AStep.cy;
      end;
      if LabelEffect in [cxleFun, cxleExtrude] then
      begin
         AStep.cx := GetSignByValue(AStep.cx);
         AStep.cy := GetSignByValue(AStep.cy);
      end;
    end;
  end;

  procedure DrawActualText(ACanvas: TcxCanvas; const ADrawingRect: TRect;
    const APosition: TPoint; AIsTextRotated: Boolean);
  var
    ATextRect: TRect;
    AText: string;
  begin
    ATextRect := ADrawingRect;
    if not AIsTextRotated then
    begin
      Dec(ATextRect.Right, DepthDeltaSize.cx);
      Dec(ATextRect.Bottom, DepthDeltaSize.cy);
      OffsetRect(ATextRect, APosition.X, APosition.Y);
      ACanvas.DrawText(Text, ATextRect,
        PrepareTextFlag(0, Alignment.Horz, TcxAlignmentVert(Ord(Alignment.Vert)),
          (epoShowEndEllipsis in PaintOptions) and IsInplace,
          WordWrap, 0, False, ShowAccelChar));
    end
    else
    begin
      AText := Text;
      if ShowAccelChar then
        AText := RemoveAccelChars(AText);
      ExtTextOut(ACanvas.Handle, APosition.X, APosition.Y, 0,
        @ATextRect, PChar(AText),
        Length(AText), nil);
    end;
  end;

  procedure DrawLabelEffect(ACanvas: TcxCanvas; const ADrawingRect: TRect;
    var AStartPos: TPoint; const AStep: TSize; AIsTextRotated: Boolean);
  var
    AIterationCount, I: Integer;
  begin
    if (LabelEffect = cxleNormal) or (FDepth = 0) then
      Exit;
    if AStep.cx <> 0 then
      AIterationCount := FDepth div Abs(AStep.cx)
    else
      AIterationCount := FDepth div Abs(AStep.cy);
    if LabelEffect <> cxleFun then
      ACanvas.Font.Color := ShadowedColor;
    for I := 1 to AIterationCount do
    begin
      if LabelEffect = cxleFun then
        ACanvas.Font.Color :=
          GetColor(BackgroundColor, ShadowedColor, I, AIterationCount);
      DrawActualText(ACanvas, ADrawingRect, AStartPos, AIsTextRotated);
      Inc(AStartPos.X, AStep.cx);
      Inc(AStartPos.Y, AStep.cy);
    end;
  end;

  procedure DrawConventionalizedText(ACanvas: TcxCanvas; ARect: TRect;
    const APosition: TPoint; AGlyph: TBitmap; AIsTrueType: Boolean;
    AIsTextRotated: Boolean);

    procedure DrawFilledText(XPosOffset, YPosOffset: Integer;
      AGlyphOnly: Boolean = False);
    begin
      if not AGlyph.Empty and AIsTrueType and (AGlyph.Width > 0) and
        (AGlyph.Height > 0) then
      begin
        BeginPath(ACanvas.Handle);
        DrawActualText(ACanvas, ARect, Point(APosition.X + XPosOffset,
          APosition.Y + YPosOffset), AIsTextRotated);
        EndPath(ACanvas.Handle);
        SelectClipPath(ACanvas.Handle, RGN_COPY);
        ACanvas.FillRect(ARect, AGlyph);
        SelectClipRgn(ACanvas.Handle, 0);
      end
      else
        if not AGlyphOnly then
          DrawActualText(ACanvas, ARect, Point(APosition.X + XPosOffset,
            APosition.Y + YPosOffset), AIsTextRotated);
    end;

  begin
    ACanvas.Font.Color := TextColor;
    case LabelStyle of
      cxlsNormal:
        DrawFilledText(0, 0);
      cxlsRaised:
      begin
        ACanvas.Font.Color :=  clBtnHighlight;
        DrawActualText(ACanvas, ARect, APosition,
          AIsTextRotated);
        if Font.Size >= 12 then
        begin
          ACanvas.Font.Color := clBtnShadow;
          DrawActualText(ACanvas, ARect, Point(APosition.X + 2, APosition.Y + 2),
            AIsTextRotated);
        end;
        ACanvas.Font.Color := TextColor;
        DrawFilledText(1, 1);
      end;
      cxlsLowered:
      begin
        if Font.Size >= 12 then
        begin
          ACanvas.Font.Color :=  clBtnShadow;
          DrawActualText(ACanvas, ARect, APosition,
            AIsTextRotated);
        end;
        ACanvas.Font.Color := clBtnHighlight;
        DrawActualText(ACanvas, ARect, Point(APosition.X + 2, APosition.Y + 2),
          AIsTextRotated);
        ACanvas.Font.Color := TextColor;
        DrawFilledText(1, 1);
      end;
      cxlsOutLine:
      begin
        DrawFilledText(0, 0, AIsTrueType);
        if AIsTrueType then
        begin
          BeginPath(ACanvas.Handle);
          DrawActualText(ACanvas, ARect, APosition, AIsTextRotated);
          EndPath(ACanvas.Handle);
          ACanvas.Pen.Color := TextColor;
          ACanvas.Pen.Width := FPenWidth;
          StrokePath(ACanvas.Handle);
          ACanvas.Pen.Width := 1;
        end;
      end;
    end;
  end;

  procedure AdjustTextPosWithLabelStyle(var APosition: TPoint;
    const AStep: TSize);
  var
    ALabelStyleOffset: Integer;
  begin
    ALabelStyleOffset := GetLabelStyleOffset;
    if AStep.cx < 0 then
      Dec(APosition.X, ALabelStyleOffset);
    if AStep.cy < 0 then
      Dec(APosition.Y, ALabelStyleOffset);
  end;

  procedure AdjustTextRectWithOffset(var ATextRect: TRect);
  begin
    if IsInplace then
      with DrawTextOffsets do
      begin
        Inc(ATextRect.Left, Left);
        Inc(ATextRect.Top, Top);
        Dec(ATextRect.Right, Right);
        Dec(ATextRect.Bottom, Bottom);
      end
    else
      if BorderStyle <> ebsNone then
        InflateRect(ATextRect, -TextFromBorderOffset, 0);
  end;

  procedure InternalDrawLabel(ADrawCanvas: TcxCanvas;
    const ABackgroundRect, ATextRect: TRect; const AParentBackgroundOffset: TPoint);
  var
    AIsTrueType: Boolean;
    ARealAngle: Integer;
    AStep: TSize;
    AStartPos: TPoint;
  begin
    DrawBackground(ADrawCanvas, ABackgroundRect, AParentBackgroundOffset);

    AIsTrueType := AdjustCanvasFont(ADrawCanvas.Canvas, Font, FAngle);
    ARealAngle := Integer(AIsTrueType) * FAngle;
    ARealAngle := (ARealAngle mod 360 + 360) mod 360;
    AStartPos := GetTextDrawingParameters(ADrawCanvas.Canvas, ATextRect,
      ARealAngle, AStep);
    ADrawCanvas.Brush.Style := bsClear;
    DrawLabelEffect(ADrawCanvas, ATextRect, AStartPos, AStep, ARealAngle <> 0);
    AdjustTextPosWithLabelStyle(AStartPos, AStep);
    DrawConventionalizedText(ADrawCanvas, ATextRect, AStartPos, FGlyph,
      AIsTrueType, ARealAngle <> 0);
    ADrawCanvas.Brush.Style := bsSolid;
  end;

  function InplaceOffsetChanged: Boolean;
  begin
    Result := (FInplaceOffset.X <> Left) or (FInplaceOffset.Y <> Top);
    if Result then
    begin
      FInplaceOffset.X := Left;
      FInplaceOffset.Y := Top;
    end;
  end;

var
  ABitmapCanvas: TcxCanvas;
  AContentRect, ATextRect: TRect;
  APrevLogFont: TLogFont;
begin
  SaveCanvasFont(ACanvas, APrevLogFont);
  try
    AContentRect := LabelTextRect;
    ATextRect := LabelTextRect;
    AdjustTextRectWithOffset(ATextRect);
    if not IsInplace and Transparent and (csPaintCopy in Edit.ControlState) then
      InternalDrawLabel(ACanvas, AContentRect, ATextRect, AContentRect.TopLeft)
    else
    begin
      if not IsInplace and NativeStyle then
        GetThemeBackgroundContentRect(OpenTheme(totEdit), ACanvas.Handle,
          EP_EDITTEXT, NativeState, Bounds, AContentRect);
      if InplaceOffsetChanged or FIsDrawBitmapDirty or Transparent then
      begin
        FDrawBitmap.Width := RectWidth(AContentRect);
        FDrawBitmap.Height := RectHeight(AContentRect);
        ABitmapCanvas := TcxCanvas.Create(FDrawBitmap.Canvas);
        OffsetRect(ATextRect, -AContentRect.Left, -AContentRect.Top);
        try
          InternalDrawLabel(ABitmapCanvas, Rect(0, 0, FDrawBitmap.Width, FDrawBitmap.Height),
            ATextRect, AContentRect.TopLeft);
        finally
          FreeAndNil(ABitmapCanvas);
        end;
        FIsDrawBitmapDirty := False;
      end;
      BitBlt(ACanvas.Handle, AContentRect.Left, AContentRect.Top,
        FDrawBitmap.Width, FDrawBitmap.Height, FDrawBitmap.Canvas.Handle, 0, 0, SRCCOPY);
     end;
  finally
    RestoreCanvasFont(ACanvas, APrevLogFont);
  end;
end;

procedure TcxCustomLabelViewInfo.SetBackgroundColor(Value: TColor);
begin
  inherited SetBackgroundColor(Value);
  FIsDrawBitmapDirty := True;
end;

{ TcxCustomLabelViewData }

procedure TcxCustomLabelViewData.CalculateLabelViewInfoProps(AViewInfo: TcxCustomEditViewInfo);
begin
  with TcxCustomLabelViewInfo(AViewInfo) do
  begin
    LabelEffect := Properties.LabelEffect;
    LabelStyle := Properties.LabelStyle;
    Orientation := Properties.Orientation;
    Depth := Properties.Depth;
    ShadowedColor := Properties.ShadowedColor;
    ShowAccelChar := Properties.ShowAccelChar;
    Angle := Properties.Angle;
    PenWidth := Properties.PenWidth;
    WordWrap := Properties.WordWrap;
    Alignment.Assign(Properties.Alignment);
    Glyph := Properties.Glyph;
  end;
end;

procedure TcxCustomLabelViewData.Calculate(ACanvas: TcxCanvas; const ABounds: TRect;
  const P: TPoint; Button: TcxMouseButton; Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo;
  AIsMouseEvent: Boolean);
var
  ALabelViewInfo: TcxCustomLabelViewInfo;
begin
  inherited Calculate(ACanvas, ABounds, P, Button, Shift, AViewInfo, AIsMouseEvent);
  if ((ABounds.Bottom >= MaxInt) or (ABounds.Right >= MaxInt)) and IsInplace then
    Exit;
  ALabelViewInfo := TcxCustomLabelViewInfo(AViewInfo);
  {Standart properties}
  ALabelViewInfo.IsEditClass := GetIsEditClass;
  ALabelViewInfo.DrawSelectionBar := False;
  ALabelViewInfo.HasPopupWindow := False;
  ALabelViewInfo.DrawTextFlags := GetDrawTextFlags;
  if AreVisualStylesMustBeUsed(ALabelViewInfo.NativeStyle, totButton) and
    (ALabelViewInfo.BorderStyle = ebsNone) then
    ALabelViewInfo.NativeStyle := False;
  if not IsInplace then
    ALabelViewInfo.Transparent := TcxCustomLabel(Edit).Transparent;
  {Label properties}
  CalculateLabelViewInfoProps(ALabelViewInfo);
  ALabelViewInfo.DepthDeltaSize := Properties.CalculateDepthDelta;
  ALabelViewInfo.TextRect := AViewInfo.ClientRect;
  ALabelViewInfo.LabelTextRect := AViewInfo.ClientRect;
  CalculateCustomLabelViewInfo(ACanvas, Self, ALabelViewInfo);
  if not IsInplace then ALabelViewInfo.DrawSelectionBar := False;

  if Edit <> nil then
    ALabelViewInfo.LeftTop := Point(Edit.Left, Edit.Top);

  ALabelViewInfo.DrawTextOffsets := GetTextEditDrawTextOffset(Self);

  ALabelViewInfo.FIsDrawBitmapDirty := True;
end;

procedure TcxCustomLabelViewData.EditValueToDrawValue(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue; AViewInfo: TcxCustomEditViewInfo);
begin
  TcxCustomLabelViewInfo(AViewInfo).Text := EditValueToDisplayText(AEditValue);
end;

function TcxCustomLabelViewData.GetEditContentSize(ACanvas: TcxCanvas;
  const AEditValue: TcxEditValue; const AEditSizeProperties: TcxEditSizeProperties): TSize;

  function CalculateLabelTextSize(ACanvas: TcxCanvas; const AText: string;
    const ATextRect: TRect; AAngle: Integer; ADepthSize,
      AContentSizeCorrection: TSize; ALabelStyleOffset: Integer; AIsInplace,
        AWordWrap, AShowAccelChar: Boolean): TSize;
  var
    ARealAngle, ATextFlag, ATextWidth: Integer;
    ARealText: string;
    ARect: TRect;
    ARealWordWrap: Boolean;
  begin
    ARect := Rect(0, 0, RectWidth(ATextRect), RectHeight(ATextRect));
    ARealAngle := (AAngle mod 360 + 360) mod 360;
    ARealWordWrap := AWordWrap and (ARealAngle = 0);
    if ARect.Right < 0 then
    begin
      if AIsInplace then
        ARealWordWrap := False;
    end
    else
    begin
      Dec(ARect.Right, ADepthSize.cx + ALabelStyleOffset);
      if (Style.BorderStyle <> ebsNone) and not AIsInplace then
        Dec(ARect.Right, TextFromBorderOffset * 2);
      if AIsInplace then
        Dec(ARect.Right, AContentSizeCorrection.cx);
    end;
    ATextFlag := PrepareTextFlag(DT_CALCRECT, TAlignment(0),
      TcxAlignmentVert(0), False,
      ARealWordWrap, 0, True, AShowAccelChar and (ARealAngle = 0));
    ARealText := AText;
    if (ARealAngle <> 0) and AShowAccelChar then
      ARealText := RemoveAccelChars(AText);
    cxDrawText(ACanvas.Handle, ARealText, ARect, ATextFlag);
    if ARealAngle <> 0 then
    begin
      ATextWidth := ARect.Right;
      ARect.Right := Trunc(Abs(ARect.Right * Cos(ARealAngle * PI / 180)) +
        Abs(ARect.Bottom * Sin(ARealAngle  * PI / 180)) + 0.5);
      ARect.Bottom := Trunc(Abs(ATextWidth * Sin(ARealAngle * PI / 180)) +
        Abs(ARect.Bottom * Cos(ARealAngle  * PI / 180)) + 0.5);
    end;
    Result.cx := ARect.Right;
    Result.cy := ARect.Bottom;
    Result.cx := Result.cx + ADepthSize.cx + ALabelStyleOffset;
    Result.cy := Result.cy + ADepthSize.cy + ALabelStyleOffset;
    if (Style.BorderStyle <> ebsNone) and not AIsInplace then
      Result.cx := Result.cx + TextFromBorderOffset * 2;
    if AIsInplace then
    begin
      Result.cx := Result.cx + AContentSizeCorrection.cx;
      Result.cy := Result.cy + AContentSizeCorrection.cy;
    end;
  end;

var
  ADisplayText: string;
  ALabelStyleOffset: Integer;
  APrevLogFont: TLogFont;
  ARealAngle: Integer;
  ASizeDelta: TSize;
begin
  SaveCanvasFont(ACanvas, APrevLogFont);
  try
    Result := Size(0, 0);
    if Edit <> nil then
      ADisplayText := TcxCustomLabel(Edit).ViewInfo.Text
    else
      ADisplayText := EditValueToDisplayText(AEditValue);
    if ADisplayText = '' then
      ADisplayText := ' ';
    Result.cx := AEditSizeProperties.Width;
    ARealAngle := Integer(AdjustCanvasFont(ACanvas.Canvas, Style.GetVisibleFont, Properties.Angle)) *
      Properties.Angle;
    ASizeDelta := Properties.CalculateDepthDelta;
    if Properties.LabelStyle in [cxlsRaised, cxlsLowered] then
    begin
      if ACanvas.Font.Size >= 12 then
        ALabelStyleOffset := 2
      else
        ALabelStyleOffset := 1;
    end
    else
      ALabelStyleOffset := 0;

    with Properties do
      Result := CalculateLabelTextSize(ACanvas, ADisplayText,
        Rect(0, 0, Result.cx, Result.cy), ARealAngle, ASizeDelta,
        Self.GetEditContentSizeCorrection, ALabelStyleOffset, IsInplace,
        WordWrap, Properties.ShowAccelChar);
  finally