tntjvlabel.pas

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

    TxtWdt := WideCanvasTextWidth(Canvas, Text);
    TxtHgt := WideCanvasTextHeight(Canvas, Text);
  end;
  with Info do
  begin
    TextWidth := Round(Sin(AngleB) * TxtWdt);
    TextGapWidth := Round(Cos(AngleB) * TxtHgt);
    TextHeight := Round(Cos(AngleB) * TxtWdt);
    TextGapHeight := Round(Sin(AngleB) * TxtHgt);
    // Calculate new sizes of component
    TotalWidth := (TextWidth + TextGapWidth);
    TotalHeight := (TextHeight + TextGapHeight);
  end;
  // Calculate draw position of text
  with Rect do
  begin
    X := (Right - Left) / 2;
    Y := (Bottom - Top) / 2;
  end;
  // Calculate Layout and Alignment Position
  //SetTextAlign(Canvas.Handle, TA_LEFT);
  Origin := CalculateAlignment(Alignment, Angle, X, Y, Info);
  if AutoSize then
  begin
    case Angle of
      0..89:
        begin
          Info.PosX := 0;
          Info.PosY := Info.TextHeight;
        end;
      90..179:
        begin
          Info.PosX := Info.TextWidth;
          Info.PosY := Info.TotalHeight;
        end;
      180..269:
        begin
          Info.posX := Info.TotalWidth;
          Info.posY := Info.TextGapHeight;
        end;
    else{270..359}
      Info.PosX := Info.TextGapWidth;
      Info.PosY := 0;
    end;
  end
  else
  begin
    Info.PosX := Origin.X;
    Info.PosY := Origin.Y;
  end;
end;

function DrawShadowTextW(Canvas: TCanvas; Str: PWideChar; Count: Integer; var Rect: TRect;
  Format: Word; ShadowSize: Byte; ShadowColor: TColorRef;
  ShadowPos: TShadowPosition): Integer;
var
  RText, RShadow: TRect;
  Color: TColorRef;
begin
  RText := Rect;
  RShadow := Rect;
  Color := SetTextColor(Canvas.Handle, ShadowColor);
  case ShadowPos of
    spLeftTop:
      OffsetRect(RShadow, -ShadowSize, -ShadowSize);
    spRightBottom:
      OffsetRect(RShadow, ShadowSize, ShadowSize);
    spLeftBottom:
      begin
        {OffsetRect(RText, ShadowSize, 0);}
        OffsetRect(RShadow, -ShadowSize, ShadowSize);
      end;
    spRightTop:
      begin
        {OffsetRect(RText, 0, ShadowSize);}
        OffsetRect(RShadow, ShadowSize, -ShadowSize);
      end;
  end;
  Canvas.Brush.Style := bsClear;
  Result := Tnt_DrawTextW(Canvas.Handle, PWideChar(Str), Count, RShadow, Format);
  if Result > 0 then
    Inc(Result, ShadowSize);
  SetTextColor(Canvas.Handle, Color);
  Tnt_DrawTextW(Canvas.Handle, PWideChar(Str), Count, RText, Format);
  UnionRect(Rect, RText, RShadow);
end;

constructor TTntJvCustomLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFrameColor := clNone;
  FImageIndex := -1;
  FConsumerSvc := TJvDataConsumer.Create(Self, [DPA_RendersSingleItem]);
  FConsumerSvc.OnChanged := ConsumerServiceChanged;
  FChangeLink := TChangeLink.Create;
  FChangeLink.OnChange := DoImagesChange;
  ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  {$IFDEF JVCLThemesEnabled}
  if ThemeServices.ThemesEnabled then
    ControlStyle := ControlStyle - [csOpaque];
  {$ENDIF JVCLThemesEnabled}

  FHotTrack := False;
  // (rom) needs better font handling
  FHotTrackFont := TFont.Create;
  FHotTrackFontOptions := DefaultTrackFontOptions;
  FHotTrackOptions := TJvHotTrackOptions.Create;
  // (rom) needs better font handling
  FHotTrackFont.OnChange := HotFontChanged;

  Width := 65;
  Height := 17;
  FAutoSize := True;
  FSpacing := 4;
  FShowAccelChar := True;
  FShadowColor := clBtnHighlight;
  FShadowSize := 0;
  FShadowPos := spRightBottom;
  FAutoOpenURL := True;
end;

destructor TTntJvCustomLabel.Destroy;
begin
  FChangeLink.Free;
  FHotTrackFont.Free;
  FHotTrackOptions.Free;
  FreeAndNil(FConsumerSvc);
  inherited Destroy;
end;

function TTntJvCustomLabel.GetLabelCaption: WideString;
var
  ItemText: IJvDataItemText;
begin
  if ProviderActive then
  begin
    Provider.Enter;
    try
      if Supports((Provider as IJvDataConsumerItemSelect).GetItem, IJvDataItemText, ItemText) then
        Result := ItemText.Caption
      else
        Result := Caption;
    finally
      Provider.Leave;
    end;
  end
  else
    Result := Caption;
end;

function TTntJvCustomLabel.GetDefaultFontColor: TColor;
begin
  Result := Font.Color;
end;

procedure TTntJvCustomLabel.DoProviderDraw(var Rect: TRect; Flags: Integer);
var
  Tmp: TSize;
  TmpItem: IJvDataItem;
  ItemsRenderer: IJvDataItemsRenderer;
  ItemRenderer: IJvDataItemRenderer;
  DrawState: TProviderDrawStates;
begin
  Provider.Enter;
  try
    if not Enabled then
      DrawState := [pdsDisabled]
    else
      DrawState := [];
    TmpItem := (Provider as IJvDataConsumerItemSelect).GetItem;
    if (TmpItem <> nil) and (Supports(TmpItem.GetItems, IJvDataItemsRenderer, ItemsRenderer) or
      Supports(TmpItem, IJvDataItemRenderer, ItemRenderer)) then
    begin
      Canvas.Brush.Color := Color;
      if MouseOver then
        Canvas.Font := HotTrackFont
      else
        Canvas.Font := Font;
      if (Flags and DT_CALCRECT) <> 0 then
      begin
        if ItemsRenderer <> nil then
          Tmp := ItemsRenderer.MeasureItem(Canvas, TmpItem)
        else
          Tmp := ItemRenderer.Measure(Canvas);
        Rect.Right := Tmp.cx;
        Rect.Bottom := Tmp.cy;
      end
      else
      begin
        if ItemsRenderer <> nil then
          ItemsRenderer.DrawItem(Canvas, Rect, TmpItem, DrawState)
        else
          ItemRenderer.Draw(Canvas, Rect, DrawState);
      end;
    end
    else
      DoDrawCaption(Rect, Flags);
  finally
    Provider.Leave;
  end;
end;

procedure TTntJvCustomLabel.DoDrawCaption(var Rect: TRect; Flags: Integer);
const
  EllipsisFlags: array [TJvTextEllipsis] of Integer =
    (0, DT_WORD_ELLIPSIS, DT_PATH_ELLIPSIS, DT_END_ELLIPSIS);
var
  Text: WideString;
  PosShadow: TShadowPosition;
  SizeShadow: Byte;
  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 and HotTrack 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
      DrawShadowTextW(Canvas, PWideChar(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 TTntJvCustomLabel.DoDrawText(var Rect: TRect; Flags: Integer);
begin
  if ProviderActive then
    DoProviderDraw(Rect, Flags)
  else
    DoDrawCaption(Rect, Flags);
end;

{$IFDEF VCL}
//
// TODO: check if code for VCL is applicable to CLX. If so, make change
//
procedure TTntJvCustomLabel.DrawAngleText(var Rect: TRect; Flags: Word; HasImage: Boolean;
  ShadowSize: Byte; ShadowColor: TColorRef; ShadowPos: TShadowPosition);
var
  Text: array [0..4096] of WideChar;
  LogFont, NewLogFont: TLogFont;
  NewFont: HFont;
  TextX, TextY, ShadowX, ShadowY: Integer;
  Angle10: Integer;
  W, H: Integer;
  Info: TAngleInfo;
  CalcRect: Boolean;
begin
  Angle10 := Angle * 10;
  CalcRect := (Flags and DT_CALCRECT <> 0);
  WStrLCopy(@Text, PWideChar(GetLabelCaption), SizeOf(Text) - 1);
  if CalcRect and ((Text[0] = #0) or ShowAccelChar and
    (Text[0] = '&') and (Text[1] = #0)) then
    WStrCopy(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;
  Canvas.Brush.Style := bsClear; // Do not Erase Shadow or Background

  CalculateAngleInfoW(Canvas, Angle, Text, ClientRect, Info, AutoSize, Alignment);
  W := Info.TotalWidth;
  H := Info.TotalHeight;
  TextX := Info.posX;
  TextY := Info.posY;

  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
    begin
      case Alignment of
        taLeftJustify:
          Inc(TextX, Images.Width);
        taCenter:
          Inc(TextX, Images.Width div 2);
        taRightJustify:
          Inc(TextX, 0);
      end;
    end;
    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;
      WideCanvasTextOut (Canvas, ShadowX, ShadowY, Text);
    end;
    Canvas.Font.Color := Self.Font.Color;
    if not Enabled then
    begin
      Canvas.Font.Color := clBtnHighlight;
      WideCanvasTextOut (Canvas, TextX + 1, TextY + 1, Text);
      Canvas.Font.Color := clBtnShadow;
    end;
    WideCanvasTextOut (Canvas, TextX, TextY, Text);
  end;
end;
{$ENDIF VCL}

{$IFDEF VisualCLX}
//
// TODO: replace TextOutAngle by DrawText(...., Angle) (asn)
//
procedure TTntJvCustomLabel.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 WideChar;
  TextX, TextY: Integer;
  Phi: Real;
  W, H: Integer;
  CalcRect: Boolean;
begin
  CalcRect := (Flags and DT_CALCRECT <> 0);