tntjvlabel.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

  StrLCopy(@Text, PWideChar(GetLabelCaption), SizeOf(Text) - 1);
  if CalcRect and ((Text[0] = #0) or ShowAccelChar and (Text[0] = '&') and (Text[1] = #0)) then
    StrCopy(Text, ' ');

  Canvas.Start;
  try
    Canvas.Brush.Style := bsClear; // Do not Erase Shadow or Background

    Phi := Angle * Pi / 180;
    if not AutoSize then
    begin
      W := Rect.Right - Rect.Left;
      H := Rect.Bottom - Rect.Top;
      TextX := Trunc(0.5 * W - 0.5 * WideCanvasTextWidth(Canvas,Text) * Cos(Phi) -
        0.5 * WideCanvasTextHeight(Canvas,Text) * Sin(Phi));
      TextY := Trunc(0.5 * H - 0.5 * WideCanvasTextHeight(Canvas,Text) * Cos(Phi) +
        0.5 * WideCanvasTextWidth(Canvas,Text) * Sin(Phi));
    end
    else
    begin
      W := 4 + Trunc(WideCanvasTextWidth(Canvas,Text) * Abs(Cos(Phi)) + WideCanvasTextHeight(Canvas,Text) * Abs(Sin(Phi)));
      H := 4 + Trunc(WideCanvasTextHeight(Canvas,Text) * Abs(Cos(Phi)) + WideCanvasTextWidth(Canvas,Text) * Abs(Sin(Phi)));
      TextX := 3;
      TextY := 3;
      if Angle <= 90 then
      begin
        TextX := TextX + Trunc(WideCanvasTextHeight(Canvas,Text) * Sin(Phi) / 2);
        TextY := TextY + Trunc(WideCanvasTextWidth(Canvas,Text) * Sin(Phi) + WideCanvasTextHeight(Canvas,Text) * Cos(Phi) / 2);
      end
      else
      if Angle >= 270 then
        TextX := 3 - Trunc(WideCanvasTextHeight(Canvas,Text) * Sin(Phi) / 2)
      else
      if Angle <= 180 then
      begin
        TextX := ClientWidth - 3 - Trunc(WideCanvasTextHeight(Canvas,Text) * Sin(Phi) / 2);
        TextY := ClientHeight - 3 + Ceil(WideCanvasTextHeight(Canvas,Text) * Cos(Phi));
      end
      else // (180 - 270)
      begin
        TextX := ClientWidth - 3 + Ceil(WideCanvasTextHeight(Canvas,Text) * Sin(Phi) / 2);
        TextY := TextY + Ceil(WideCanvasTextHeight(Canvas,Text) * Cos(Phi));
      end;
    end;

    if CalcRect then
    begin
      Rect.Right := Rect.Left + W;
      Rect.Bottom := Rect.Top + H;
      if HasImage then
        Inc(Rect.Right, Images.Width);
      InflateRect(Rect, -XOffsetFrame, -YOffsetFrame);
    end
    else
    begin
      if HasImage then
        Inc(TextX, Images.Width);
      Inc(TextX, XOffsetFrame);
      Inc(TextY, YOffsetFrame);

      if not Enabled then
      begin
        Canvas.Font.Color := clBtnHighlight;
        TextOutAngle(Canvas, Angle, TextX + 1, TextY + 1, Text);
        Canvas.Font.Color := clBtnShadow;
        TextOutAngle(Canvas, Angle, TextX, TextY, Text);
      end
      else
        TextOutAngle(Canvas, Angle, TextX, TextY, Text);
    end;
  finally
    Canvas.Stop;
  end;
end;
{$ENDIF VisualCLX}

procedure TTntJvCustomLabel.Paint;
var
  Rect,CalcRect: TRect;
  DrawStyle: Integer;
  InteriorMargin: Integer;
  OldPenColor: TColor;
begin
  InteriorMargin := 0;
  if not Enabled and not (csDesigning in ComponentState) then
    FDragging := False;

  with Canvas do
  begin
    Rect := ClientRect;

    {Inserted by (dejoy) 2005-07-20}
    if Enabled and MouseOver and HotTrack  then
    begin
      if HotTrackOptions.Enabled then
      begin
        Canvas.Brush.Color := HotTrackOptions.Color;
        Canvas.Brush.Style := bsSolid;
        if HotTrackOptions.FrameVisible then
        begin
          OldPenColor := Pen.Color;
          if RoundedFrame = 0 then
          begin
            Canvas.Pen.Color := HotTrackOptions.FrameColor;
            Canvas.Rectangle(0, 0, Width, Height);
          end
          else
          begin
            {$IFDEF VCL}
            if not Transparent then // clx: TODO
              FloodFill(ClientRect.Left + 1, ClientRect.Top + RoundedFrame, HotTrackOptions.FrameColor, fsBorder);
            {$ENDIF VCL}
            FrameRounded(Canvas, ClientRect, HotTrackOptions.FrameColor, RoundedFrame);
          end;
          Canvas.Pen.Color := OldPenColor;
        end
        else
          Canvas.FillRect(Rect);
      end;
    end
    else
    begin
      Canvas.Font := Self.Font;
    {Insert End by (dejoy)}

      Canvas.Brush.Color := Color;
      Canvas.Brush.Style := bsSolid;
      if not Transparent and ((RoundedFrame = 0) or (FrameColor = clNone)) then
        DrawThemedBackground(Self, Canvas, ClientRect)
      else
      if Transparent then
        Canvas.Brush.Style := bsClear;

      if FrameColor <> clNone then
      begin
        if RoundedFrame = 0 then
        begin
          Brush.Color := FrameColor;
          FrameRect({$IFDEF VisualCLX} Canvas, {$ENDIF} ClientRect);
        end
        else
        begin
          Brush.Color := Color;
          {$IFDEF VCL}
          if not Transparent then // clx: TODO
            FloodFill(ClientRect.Left + 1, ClientRect.Top + RoundedFrame, FrameColor, fsBorder);
          {$ENDIF VCL}
          FrameRounded(Canvas, ClientRect, FrameColor, RoundedFrame);
        end;
      end;
    end;

    Inc(Rect.Left, MarginLeft + InteriorMargin);
    Dec(Rect.Right, MarginRight + InteriorMargin);
    Inc(Rect.Top, MarginTop + InteriorMargin);
    Dec(Rect.Bottom, MarginBottom + InteriorMargin);
    InflateRect(Rect, -1, 0);
    DrawStyle := DT_EXPANDTABS or WordWraps[FWordWrap] or
      Alignments[FAlignment];
    { Calculate vertical layout }
    if FLayout <> tlTop then
    begin
      CalcRect := Rect;
      DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
      if FLayout = tlBottom then
        OffsetRect(Rect, 0, Height - CalcRect.Bottom)
      else
        OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
    end;
    Rect.Left := MarginLeft;
    Rect.Right := Rect.Right - MarginRight;
    DoDrawText(Rect, DrawStyle);
    if FShowFocus and Assigned(FFocusControl) and FFocused and
      not (csDesigning in ComponentState) then
    begin
      InflateRect(Rect, 1, 0);
      Brush.Color := Self.Color;
      DrawFocusRect(Rect);
    end;
//    if Angle = 0 then
//      AdjustBounds;
  end;
end;

procedure TTntJvCustomLabel.Loaded;
begin
  inherited Loaded;
  Provider.Loaded;
  FNeedsResize := True;
  AdjustBounds;
end;

procedure TTntJvCustomLabel.AdjustBounds;
var
  DC: HDC;
  X: Integer;
  Rect, R: TRect;
  AAlignment: TAlignment;
begin
  if not (csReading in ComponentState) and AutoSize and FNeedsResize then
  begin
    Rect := ClientRect;
    InflateRect(Rect, -1, 0);
    DC := GetDC(NullHandle);
    Canvas.Handle := DC;
    {$IFDEF VisualCLX}
    Canvas.Start(False);
    try
    {$ENDIF VisualCLX}
      if Angle = 0 then
      begin
        R := Rect;
        Inc(Rect.Left, MarginLeft);
        Inc(Rect.Top, MarginTop);
        Dec(Rect.Right, MarginRight);
        Dec(Rect.Bottom, MarginBottom);
        //InflateRect(Rect, -Margin, -Margin);

        DoDrawText(Rect, DT_EXPANDTABS or DT_CALCRECT or WordWraps[FWordWrap]);

        Dec(Rect.Left, MarginLeft);
        Dec(Rect.Top, MarginTop);
        Inc(Rect.Right, MarginRight);
        Inc(Rect.Bottom, MarginBottom);
        //InflateRect(Rect, Margin, Margin);

        Inc(Rect.Bottom, MarginTop);
      end
      else
        DrawAngleText(Rect, DT_CALCRECT or DT_EXPANDTABS or DT_WORDBREAK or Alignments[Alignment], IsValidImage, 0, 0, spLeftTop);
    {$IFDEF VisualCLX}
    finally
      Canvas.Stop;
    end;
    {$ENDIF VisualCLX}
    Canvas.Handle := NullHandle;
    ReleaseDC(NullHandle, DC);
    InflateRect(Rect, 1, 0);
    X := Left;
    AAlignment := FAlignment;
    if UseRightToLeftAlignment then
      ChangeBiDiModeAlignment(AAlignment);
    if IsValidImage then
    begin
      Rect.Bottom := Max(Rect.Bottom, Rect.Top + GetImageHeight);
//      Inc(Rect.Right, Spacing);
    end;
    if (AAlignment = taRightJustify) and not IsValidImage then
      Inc(X, Width - Rect.Right);
    SetBounds(X, Top, Rect.Right, Rect.Bottom);
  end;
  FNeedsResize := False;
end;

procedure TTntJvCustomLabel.HotFontChanged(Sender: TObject);
begin
  if MouseOver then
    Invalidate;
end;

procedure TTntJvCustomLabel.SetAlignment(Value: TAlignment);
begin
  if FAlignment <> Value then
  begin
    FAlignment := Value;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetAutoSize(Value: Boolean);
begin
  {$IFDEF VCL}
  inherited SetAutoSize(Value);
  {$ENDIF VCL}
  FAutoSize := Value;
  FNeedsResize := FAutoSize;
  AdjustBounds;
end;

procedure TTntJvCustomLabel.SetLayout(Value: TTextLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

function TTntJvCustomLabel.GetMargin: Integer;
begin
  Result := FMarginLeft;
end;

procedure TTntJvCustomLabel.SetMargin(Value: Integer);
begin
  Value := Max(Value, 0);
  if Margin <> Value then
  begin
    MarginLeft := Value;
    MarginTop := Value;
    MarginRight := Value;
    MarginBottom := Value;

    FNeedsResize := True;
    AdjustBounds;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetShadowColor(Value: TColor);
begin
  if Value <> FShadowColor then
  begin
    FShadowColor := Value;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetShadowSize(Value: Byte);
begin
  if Value <> FShadowSize then
  begin
    FShadowSize := Value;
    FNeedsResize := True;
    AdjustBounds;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetShadowPos(Value: TShadowPosition);
begin
  if Value <> FShadowPos then
  begin
    FShadowPos := Value;
    Invalidate;
  end;
end;

function TTntJvCustomLabel.GetTransparent: Boolean;
begin
  Result := not (csOpaque in ControlStyle);
end;

procedure TTntJvCustomLabel.SetFocusControl(Value: TWinControl);
begin
  FFocusControl := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
  if FShowFocus then
    Invalidate;
end;

procedure TTntJvCustomLabel.SetShowAccelChar(Value: Boolean);
begin
  if FShowAccelChar <> Value then
  begin
    FShowAccelChar := Value;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetTransparent(Value: Boolean);
begin
  if Transparent <> Value then
  begin
    {$IFDEF JVCLThemesEnabled}
    if ThemeServices.ThemesEnabled then
      Value := True; // themes aware Labels are always transparent
    {$ENDIF JVCLThemesEnabled}
    if Value then
      ControlStyle := ControlStyle - [csOpaque]
    else
      ControlStyle := ControlStyle + [csOpaque];
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetShowFocus(Value: Boolean);
begin
  if FShowFocus <> Value then
  begin
    FShowFocus := Value;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetWordWrap(Value: Boolean);
begin
  if FWordWrap <> Value then
  begin
    FWordWrap := Value;
    FNeedsResize := True;
    AdjustBounds;
  end;
end;

procedure TTntJvCustomLabel.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
  begin
    if AComponent = FFocusControl then
      FocusControl := nil;
    if AComponent = Images then
      Images := nil;
  end;
end;

procedure TTntJvCustomLabel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);