⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvlabel.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  ColorShadow: TColor;
  X, Y: Integer;
begin
  Text := GetLabelCaption;
  if (Flags and DT_CALCRECT <> 0) and ((Text = '') or FShowAccelChar and
    (Text[1] = '&') and (Text[2] = #0)) then
    Text := Text + ' ';
  if not FShowAccelChar then
    Flags := Flags or DT_NOPREFIX;
  Flags := Flags or EllipsisFlags[TextEllipsis];
  Flags := DrawTextBiDiModeFlags(Flags);
  if MouseOver then
    Canvas.Font := HotTrackFont
  else
  begin
    Canvas.Font := Font;
    Canvas.Font.Color := GetDefaultFontColor;
  end;
  PosShadow := FShadowPos;
  SizeShadow := FShadowSize;
  ColorShadow := FShadowColor;
  if not Enabled then
  begin
    if (FShadowSize = 0) and NewStyleControls then
    begin
      PosShadow := spRightBottom;
      SizeShadow := 1;
    end;
    Canvas.Font.Color := clGrayText;
    ColorShadow := clBtnHighlight;
  end;
  if IsValidImage then
    Inc(Rect.Left, GetImageWidth + Spacing);
  {$IFDEF VisualCLX}
  Canvas.Start;
  RequiredState(Canvas, [csHandleValid, csFontValid]);
  try
  {$ENDIF VisualCLX}
    if Angle <> 0 then
      DrawAngleText(Rect, Flags, IsValidImage, SizeShadow, ColorToRGB(ColorShadow), PosShadow)
    else
      DrawShadowText(Canvas, PChar(Text), Length(Text), Rect, Flags,
        SizeShadow, ColorToRGB(ColorShadow), PosShadow);
  {$IFDEF VisualCLX}
  finally
    Canvas.Stop;
  end;
  {$ENDIF VisualCLX}
  // (p3) draw image here since it can potentionally change background and font color
  if IsValidImage and (Flags and DT_CALCRECT = 0) then
  begin
    X := MarginLeft;
    case Layout of
      tlTop:
        Y := MarginTop;
      tlBottom:
        Y := Height - Images.Height - MarginBottom;
    else
      Y := (Height - Images.Height) div 2;
    end;
    if Y < MarginTop then
      Y := MarginTop;
    Images.Draw(Canvas, X, Y, ImageIndex, {$IFDEF VisualCLX} itImage, {$ENDIF} Enabled);
  end;
end;

procedure TJvCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
begin
  if ProviderActive then
    DoProviderDraw(Rect, Flags)
  else
    DoDrawCaption(Rect, Flags);
end;

{$IFDEF VCL}
procedure TJvCustomLabel.DrawAngleText(var Rect: TRect; Flags: Word; HasImage: Boolean;
  ShadowSize: Byte; ShadowColor: TColorRef; ShadowPos: TShadowPosition);
var
  Text: array [0..4096] of Char;
  LogFont, NewLogFont: TLogFont;
  NewFont: HFont;
  TextX, TextY, ShadowX, ShadowY: Integer;
  Phi: Real;
  Angle10: Integer;
  w, h: Integer;
  CalcRect: Boolean;
begin
  Angle10 := Angle * 10;
  CalcRect := (Flags and DT_CALCRECT <> 0);
  StrLCopy(@Text, PChar(GetLabelCaption), SizeOf(Text) - 1);
  if CalcRect and ((Text[0] = #0) or ShowAccelChar and
    (Text[0] = '&') and (Text[1] = #0)) then
    StrCopy(Text, ' ');
  if MouseOver then
    Canvas.Font := HotTrackFont
  else
    Canvas.Font := Font;
  if GetObject(Font.Handle, SizeOf(TLogFont), @LogFont) = 0 then
    RaiseLastOSError;
  NewLogFont := LogFont;
  NewLogFont.lfEscapement := Angle10;
  NewLogFont.lfOutPrecision := OUT_TT_ONLY_PRECIS;
  NewFont := CreateFontIndirect(NewLogFont);
  {
    (p3) unnecessary
    OldFont := SelectObject(Canvas.Font.Handle, NewFont);
    DeleteObject(OldFont);
    ...this does the same thing:
  }
  Canvas.Font.Handle := NewFont;
  Phi := Angle10 * Pi / 1800;
  if not AutoSize then
  begin
    w := Rect.Right - Rect.Left;
    h := Rect.Bottom - Rect.Top;
    TextX := Trunc(0.5 * w - 0.5 * Canvas.TextWidth(Text) * Cos(Phi) -
      0.5 * Canvas.TextHeight(Text) * Sin(Phi));
    TextY := Trunc(0.5 * h - 0.5 * Canvas.TextHeight(Text) * Cos(Phi) +
      0.5 * Canvas.TextWidth(Text) * Sin(Phi));
  end
  else
  begin
    w := 4 + Trunc(Canvas.TextWidth(Text) * Abs(Cos(Phi)) + Canvas.TextHeight(Text) * Abs(Sin(Phi)));
    h := 4 + Trunc(Canvas.TextHeight(Text) * Abs(Cos(Phi)) + Canvas.TextWidth(Text) * Abs(Sin(Phi)));
    TextX := 2;
    if (Angle10 > 900) and (Angle10 < 2700) then
      TextX := TextX + Trunc(Canvas.TextWidth(Text) * Abs(Cos(Phi)));
    if Angle10 > 1800 then
      TextX := TextX + Trunc(Canvas.TextHeight(Text) * Abs(Sin(Phi)));
    TextY := 2;
    if Angle10 < 1800 then
      TextY := TextY + Trunc(Canvas.TextWidth(Text) * Abs(Sin(Phi)));
    if (Angle10 > 900) and (Angle10 < 2700) then
      TextY := TextY + Trunc(Canvas.TextHeight(Text) * Abs(Cos(Phi)));
  end;

  if CalcRect then
  begin
    Rect.Right := Rect.Left + w;
    Rect.Bottom := Rect.Top + h;
    if HasImage then
      Inc(Rect.Right, Images.Width);
    Inc(Rect.Right, MarginLeft + MarginRight);
    Inc(Rect.Bottom, MarginTop + MarginBottom);
  end
  else
  begin
    if HasImage then
      Inc(TextX, Images.Width);
    Inc(TextX, MarginLeft);
    Inc(TextY, MarginTop);
    if ShadowSize > 0 then
    begin
      ShadowX := TextX;
      ShadowY := TextY;
      case ShadowPos of
        spLeftTop:
          begin
            Dec(ShadowX, ShadowSize);
            Dec(ShadowY, ShadowSize);
          end;
        spRightBottom:
          begin
            Inc(ShadowX, ShadowSize);
            Inc(ShadowY, ShadowSize);
          end;
        spLeftBottom:
          begin
            Dec(ShadowX, ShadowSize);
            Inc(ShadowY, ShadowSize);
          end;
        spRightTop:
          begin
            Inc(ShadowX, ShadowSize);
            Dec(ShadowY, ShadowSize);
          end;
      end;
      Canvas.Font.Color := ShadowColor;
      Canvas.TextOut(ShadowX, ShadowY, Text);
    end;
    Canvas.Font.Color := Self.Font.Color;
    if not Enabled then
    begin
      Canvas.Font.Color := clBtnHighlight;
      Canvas.TextOut(TextX + 1, TextY + 1, Text);
      Canvas.Font.Color := clBtnShadow;
    end;
    Canvas.TextOut(TextX, TextY, Text);
  end;
end;
{$ENDIF VCL}

{$IFDEF VisualCLX}
//
// TODO: replace TextOutAngle by DrawText(...., Angle) (asn)
//
procedure TJvCustomLabel.DrawAngleText(var Rect: TRect; Flags: Word; HasImage: Boolean;
  ShadowSize: Byte; ShadowColor: TColorRef; ShadowPos: TShadowPosition);
const // (ahuser) no function known for these
  XOffsetFrame = 0;
  YOffsetFrame = 0;
var
  Text: array [0..4096] of Char;
  TextX, TextY: Integer;
  Phi: Real;
  w, h: Integer;
  CalcRect: Boolean;
begin
  CalcRect := (Flags and DT_CALCRECT <> 0);
  StrLCopy(@Text, PChar(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
    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 * Canvas.TextWidth(Text) * Cos(Phi) -
        0.5 * Canvas.TextHeight(Text) * Sin(Phi));
      TextY := Trunc(0.5 * h - 0.5 * Canvas.TextHeight(Text) * Cos(Phi) +
        0.5 * Canvas.TextWidth(Text) * Sin(Phi));
    end
    else
    begin
      w := 4 + Trunc(Canvas.TextWidth(Text) * Abs(Cos(Phi)) + Canvas.TextHeight(Text) * Abs(Sin(Phi)));
      h := 4 + Trunc(Canvas.TextHeight(Text) * Abs(Cos(Phi)) + Canvas.TextWidth(Text) * Abs(Sin(Phi)));
      TextX := 3;
      TextY := 3;
      if Angle <= 90 then
      begin
        TextX := TextX + Trunc(Canvas.TextHeight(Text) * Sin(Phi) / 2);
        TextY := TextY + Trunc(Canvas.TextWidth(Text) * Sin(Phi) + Canvas.TextHeight(Text) * Cos(Phi) / 2);
      end
      else
      if Angle >= 270 then
        TextX := 3 - Trunc(Canvas.TextHeight(Text) * Sin(Phi) / 2)
      else
      if Angle <= 180 then
      begin
        TextX := ClientWidth - 3 - Trunc(Canvas.TextHeight(Text) * Sin(Phi) / 2);
        TextY := ClientHeight - 3 + Ceil(Canvas.TextHeight(Text) * Cos(Phi));
      end
      else // (180 - 270)
      begin
        TextX := ClientWidth - 3 + Ceil(Canvas.TextHeight(Text) * Sin(Phi) / 2);
        TextY := TextY + Ceil(Canvas.TextHeight(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 TJvCustomLabel.Paint;
var
  Rect,CalcRect: TRect;
  DrawStyle: Integer;
  InteriorMargin: Integer;
begin
  InteriorMargin := 0;
  if not Enabled and not (csDesigning in ComponentState) then
    FDragging := False;
  with Canvas do
  begin
    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;
        FrameRounded(Canvas, ClientRect, FrameColor, RoundedFrame);
        {$IFDEF VCL}
        if not Transparent then // clx: TODO
          FloodFill(ClientRect.Left + 1, ClientRect.Top + RoundedFrame, FrameColor, fsBorder);
        {$ENDIF VCL}
      end;
    end;
    Rect := ClientRect;
    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 TJvCustomLabel.Loaded;
begin
  inherited Loaded;
  Provider.Loaded;
  FNeedsResize := True;
  AdjustBounds;
end;

procedure TJvCustomLabel.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 TJvCustomLabel.HotFontChanged(Sender: TObject);
begin
  if MouseOver then
    Invalidate;
end;

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

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

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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -