jvqlabel.pas

East make Tray Icon in delphi

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

procedure TJvCustomLabel.SetTransparent(Value: Boolean);
begin
  if Transparent <> Value then
  begin 
    if Value then
      ControlStyle := ControlStyle - [csOpaque]
    else
      ControlStyle := ControlStyle + [csOpaque];
    Invalidate;
  end;
end;

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

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

procedure TJvCustomLabel.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 TJvCustomLabel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then
    FDragging := True;
  if Button = mbRight then // (ahuser) moved from WMRButtonDown
    UpdateTracking;
end;

procedure TJvCustomLabel.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 TJvCustomLabel.UpdateTracking;
var
  P: TPoint;
  OldValue: Boolean;
begin
  OldValue := MouseOver;
  GetCursorPos(P);
  MouseOver := Enabled and (FindDragTarget(P, True) = Self) and
    IsForegroundTask;
  if MouseOver <> OldValue then
    if MouseOver then
      MouseEnter(Self)
    else
      MouseLeave(Self);
end;

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

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

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

function TJvCustomLabel.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 TJvCustomLabel.EnabledChanged;
begin
  inherited EnabledChanged;
  UpdateTracking;
end;

procedure TJvCustomLabel.VisibleChanged;
begin
  inherited VisibleChanged;
  if Visible then
    UpdateTracking;
end;

procedure TJvCustomLabel.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not MouseOver and Enabled and IsForegroundTask then
  begin
    if HotTrack then
    begin
      FFontSave.Assign(Font);
      Font.Assign(FHotTrackFont);
    end;
    inherited MouseEnter(Control);
  end;
end;

procedure TJvCustomLabel.MouseLeave(Control: TControl);
begin
  if MouseOver then
  begin
    if HotTrack then
      Font.Assign(FFontSave);
    inherited MouseLeave(Control);
  end;
end;

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

procedure TJvCustomLabel.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 TJvCustomLabel.GetImageHeight: Integer;
begin
  Result := 0;
  if not ProviderActive and IsValidImage then
    Result := Images.Height;
end;

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

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

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

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

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

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

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

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

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

procedure TJvCustomLabel.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 TJvCustomLabel.SetTextEllipsis(Value: TJvTextEllipsis);
begin
  if Value <> FTextEllipsis then
  begin
    FTextEllipsis := Value;
    Invalidate;
  end;
end;

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

procedure TJvCustomLabel.SetRoundedFrame(const Value: Integer);
begin
  if FRoundedFrame <> Value then
  begin
    // no negative and too hight value
    if (Value < Height div 2) and (Value >= 0) then
    begin
      FRoundedFrame := Value;
      Invalidate;
    end;
  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 TJvCustomLabel.IsValidImage: Boolean;
begin
  Result := (Images <> nil) and (ImageIndex >= 0);
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQLabel.pas,v $';
    Revision: '$Revision: 1.31 $';
    Date: '$Date: 2005/02/06 14:06:14 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.