tntjvlabel.pas

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

  if (Button = mbLeft) and Enabled then
    FDragging := True;
end;

procedure TTntJvCustomLabel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging and (Button = mbLeft) then
    FDragging := False;
  UpdateTracking;
end;

procedure TTntJvCustomLabel.UpdateTracking;
var
  OldValue, OtherDragging: Boolean;
begin
  OldValue := MouseOver;
  OtherDragging :=
    {$IFDEF VCL}
    KeyPressed(VK_LBUTTON)
    {$IFDEF COMPILER6_UP}
    or Mouse.IsDragging
    {$ENDIF COMPILER6_UP}
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    DragActivated
    {$ENDIF VisualCLX}
    ;

  MouseOver := Enabled and not OtherDragging and
    (FindDragTarget(Mouse.CursorPos, True) = Self) and IsForegroundTask;
  if MouseOver <> OldValue then
    Invalidate;
end;

procedure TTntJvCustomLabel.FocusChanged(AControl: TWinControl);
var
  Active: Boolean;
begin
  Active := Assigned(FFocusControl) and (AControl = FFocusControl);
  if FFocused <> Active then
  begin
    FFocused := Active;
    if FShowFocus then
      Invalidate;
  end;
  inherited FocusChanged(AControl);
end;

procedure TTntJvCustomLabel.TextChanged;
begin
  inherited TextChanged;
  NonProviderChange;
  Invalidate;
  FNeedsResize := True;
  AdjustBounds;
end;

procedure TTntJvCustomLabel.FontChanged;
begin
  inherited FontChanged;
  FNeedsResize := True;
  AdjustBounds;
  UpdateTrackFont(HotTrackFont, Font, FHotTrackFontOptions);
end;

function TTntJvCustomLabel.WantKey(Key: Integer; Shift: TShiftState;
  const KeyText: WideString): Boolean;
begin
  Result := (FFocusControl <> nil) and Enabled and ShowAccelChar and
    IsAccel(Key, GetLabelCaption) and (ssAlt in Shift);
  if Result then
    if FFocusControl.CanFocus then
      FFocusControl.SetFocus;
end;

procedure TTntJvCustomLabel.EnabledChanged;
begin
  inherited EnabledChanged;
  UpdateTracking;
end;

procedure TTntJvCustomLabel.MouseEnter(Control: TControl);
var
  NeedRepaint: Boolean;
  OtherDragging:Boolean;
begin
  if csDesigning in ComponentState then
    Exit;

  if not MouseOver and Enabled and IsForegroundTask then
  begin
    OtherDragging :=
      {$IFDEF VCL}
      KeyPressed(VK_LBUTTON)
      {$IFDEF COMPILER6_UP}
      or Mouse.IsDragging
      {$ENDIF COMPILER6_UP}
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      DragActivated
      {$ENDIF VisualCLX}
      ;
    NeedRepaint := not Transparent and
      (
      {$IFDEF JVCLThemesEnabled}
      ThemeServices.ThemesEnabled or
      {$ENDIF JVCLThemesEnabled}
      (FHotTrack  and not (FDragging or OtherDragging)));

    inherited MouseEnter(Control); // set MouseOver

    if NeedRepaint then
      Invalidate;
  end;
end;

procedure TTntJvCustomLabel.MouseLeave(Control: TControl);
var
  NeedRepaint: Boolean;
  OtherDragging: Boolean;
begin
  if csDesigning in ComponentState then
    Exit;
  if  MouseOver and Enabled then
  begin
    OtherDragging :=
      {$IFDEF VCL}
      KeyPressed(VK_LBUTTON)
      {$IFDEF COMPILER6_UP}
      or Mouse.IsDragging
      {$ENDIF COMPILER6_UP}
      {$ENDIF VCL}
      {$IFDEF VisualCLX}
      DragActivated
      {$ENDIF VisualCLX}
      ;

    NeedRepaint := not Transparent and
      (
      {$IFDEF JVCLThemesEnabled}
      ThemeServices.ThemesEnabled or
      {$ENDIF JVCLThemesEnabled}
      (FHotTrack  and (FDragging or not OtherDragging)));

    inherited MouseLeave(Control); // set MouseOver

    if NeedRepaint then
      Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetImageIndex(Value: TImageIndex);
begin
  if FImageIndex <> Value then
  begin
    if IsValidImage then
      NonProviderChange;
    FNeedsResize := True;
    FImageIndex := Value;
    AdjustBounds;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetImages(Value: TCustomImageList);
begin
  if FImages <> Value then
  begin
    NonProviderChange;
    if FImages <> nil then
    begin
      FImages.RemoveFreeNotification(Self);
      FImages.UnRegisterChanges(FChangeLink);
    end;
    FImages := Value;
    if FImages <> nil then
    begin
      FImages.FreeNotification(Self);
      FImages.RegisterChanges(FChangeLink);
    end;
    if AutoSize then
    begin
      FNeedsResize := True;
      AdjustBounds;
    end
    else
      Invalidate;
  end;
end;

function TTntJvCustomLabel.GetImageHeight: Integer;
begin
  Result := 0;
  if not ProviderActive and IsValidImage then
    Result := Images.Height;
end;

procedure TTntJvCustomLabel.SetConsumerService(Value: TJvDataConsumer);
begin
end;

function TTntJvCustomLabel.ProviderActive: Boolean;
begin
  Result := (Provider <> nil) and (Provider.ProviderIntf <> nil);
end;

procedure TTntJvCustomLabel.ConsumerServiceChanged(Sender: TJvDataConsumer;
  Reason: TJvDataConsumerChangeReason);
begin
  if ProviderActive or (Reason = ccrProviderSelect) then
  begin
    FNeedsResize := True;
    AdjustBounds;
  end;
end;

procedure TTntJvCustomLabel.NonProviderChange;
begin
  { TODO 3 -oJVCL -cPROVIDER : Causes AV at designtime when trying to change Images property }
  if ProviderActive then
    Provider.Provider := nil;
end;

function TTntJvCustomLabel.GetImageWidth: Integer;
begin
  Result := 0;
  if not ProviderActive and IsValidImage then
    Result := Images.Width;
end;

procedure TTntJvCustomLabel.SetHotTrackFont(Value: TFont);
begin
  FHotTrackFont.Assign(Value);
end;

procedure TTntJvCustomLabel.Click;
var
  HasBeenHandled: Boolean;
  TmpItem: IJvDataItem;
  ItemHandler: IJvDataItemBasicAction;
begin
  HasBeenHandled := False;
  if ProviderActive then
  begin
    Provider.Enter;
    try
      TmpItem := (Provider as IJvDataConsumerItemSelect).GetItem;
      if (TmpItem <> nil) and Supports(TmpItem, IJvDataItemBasicAction, ItemHandler) then
        HasBeenHandled := ItemHandler.Execute(Self);
    finally
      Provider.Leave;
    end;
  end;
  if not HasBeenHandled then
  begin
    inherited Click;
    if AutoOpenURL and (URL <> '') then
      OpenObject(URL);
  end;
end;

procedure TTntJvCustomLabel.SetAngle(Value: TJvLabelRotateAngle);
begin
  if FAngle <> Value then
  begin
    FAngle := Value;
    if FAngle < 0 then
      Inc(FAngle, 360);
    FNeedsResize := AutoSize;
    AdjustBounds;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.DoImagesChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TTntJvCustomLabel.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    if AutoSize then
    begin
      FNeedsResize := True;
      AdjustBounds;
    end
    else
      Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetHotTrackFontOptions(Value: TJvTrackFontOptions);
begin
  if FHotTrackFontOptions <> Value then
  begin
    FHotTrackFontOptions := Value;
    UpdateTrackFont(HotTrackFont, Font, FHotTrackFontOptions);
  end;
end;

function TTntJvCustomLabel.GetHotTrack: Boolean;
begin
  Result := FHotTrack;
end;

function TTntJvCustomLabel.GetHotTrackFont: TFont;
begin
  Result := FHotTrackFont;
end;

function TTntJvCustomLabel.GetHotTrackFontOptions: TJvTrackFontOptions;
begin
  Result := FHotTrackFontOptions;
end;

function TTntJvCustomLabel.GetHotTrackOptions: TJvHotTrackOptions;
begin
  Result := FHotTrackOptions;
end;

procedure TTntJvCustomLabel.SetHotTrack(Value: Boolean);
begin
  FHotTrack := Value;
end;

procedure TTntJvCustomLabel.SetHotTrackOptions(Value: TJvHotTrackOptions);
begin
  if (FHotTrackOptions <> Value) and (Value <> nil) then
    FHotTrackOptions.Assign(Value);
end;

procedure TTntJvCustomLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  FNeedsResize := (ALeft <> Left) or (ATop <> Top) or (AWidth <> Width) or (AHeight <> Height);
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TTntJvCustomLabel.SetTextEllipsis(Value: TJvTextEllipsis);
begin
  if Value <> FTextEllipsis then
  begin
    FTextEllipsis := Value;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetFrameColor(const Value: TColor);
begin
  if FFrameColor <> Value then
  begin
    FFrameColor := Value;
    Invalidate;
  end;
end;

procedure TTntJvCustomLabel.SetRoundedFrame(const Value: Integer);
begin
  if FRoundedFrame <> Value then
    if (Value < Height div 2) and (Value >= 0) then
    begin
      FRoundedFrame := Value;
      Invalidate;
    end;
end;

(***
procedure FrameRounded(Canvas: TCanvas; ARect: TRect; AColor: TColor; R: Integer);
begin
  // Draw Frame with round corners
  with Canvas, ARect do
  begin
    Pen.Color := AColor;
    Dec(Right);
    Dec(Bottom);
    Polygon(
     [Point(Left + R, Top),
      Point(Right - R, Top),
      Point(Right, Top + R),
      Point(Right, Bottom - R),
      Point(Right - R, Bottom),
      Point(Left + R, Bottom),
      Point(Left, Bottom - R),
      Point(Left, Top + R),
      Point(Left + R, Top)]);
    Inc(Right);
    Inc(Bottom);
  end;
end;
***)

function TTntJvCustomLabel.IsValidImage: Boolean;
begin
  Result := (Images <> nil) and (ImageIndex >= 0);
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.