jvqbehaviorlabel.pas

East make Tray Icon in delphi

  BehaviorOptionsClass: TJvLabelBehaviorOptionsClass);
begin
  if AllBehaviorOptions = nil then
  begin
    AllBehaviorOptions := TStringList.Create;
    AllBehaviorOptions.Sorted := True;
  end;
  if AllBehaviorOptions.IndexOf(Name) >= 0 then
    Exit;
  //    raise Exception.CreateFmt('Options %s already registered!',[Name]); // can't raise here: we are probably in an initialization section
  AllBehaviorOptions.AddObject(Name, TObject(BehaviorOptionsClass));
end;

//=== { TJvLabelBehavior } ===================================================

constructor TJvLabelBehavior.Create(ALabel: TJvCustomBehaviorLabel);
begin
  if ALabel = nil then
    raise EJVCLException.CreateResFmt(@RsENeedBehaviorLabel, [ClassName]);
  inherited Create;
  FLabel := ALabel;
  FActive := False;
end;

destructor TJvLabelBehavior.Destroy;
begin
  FTemporary := True;
  Stop;
  inherited Destroy;
end;

procedure TJvLabelBehavior.OwnerResize;
begin
  //
end;

procedure TJvLabelBehavior.Resume;
begin
  Active := FTmpActive;
  FTemporary := False;
end;

procedure TJvLabelBehavior.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
  begin
    if FActive then
      Stop;
    FActive := Value;
    if FActive then
      Start;
  end;
end;

procedure TJvLabelBehavior.Start;
begin
  if not FTemporary then
    OwnerLabel.DoStart;
end;

procedure TJvLabelBehavior.Stop;
begin
  if not FTemporary then
    OwnerLabel.DoStop;
end;

procedure TJvLabelBehavior.Suspend;
begin
  FTmpActive := Active;
  FTemporary := True;
  Active := False;
end;

//=== { TJvCustomBehaviorLabel } =============================================

constructor TJvCustomBehaviorLabel.Create(AComponent: TComponent);
begin
 // registration
  if not Assigned(AllBehaviorOptions) then
  begin
    RegisterLabelBehaviorOptions(RsNoneCaption, TJvLabelNone);
    RegisterLabelBehaviorOptions('Blinking', TJvLabelBlink);
    RegisterLabelBehaviorOptions('Bouncing', TJvLabelBounce);
    RegisterLabelBehaviorOptions('Scrolling', TJvLabelScroll);
    RegisterLabelBehaviorOptions('Typing', TJvLabelTyping);
    RegisterLabelBehaviorOptions('Appearing', TJvLabelAppear);
    RegisterLabelBehaviorOptions('Special', TJvLabelSpecial);
    RegisterLabelBehaviorOptions('CodeBreaker', TJvLabelCodeBreaker);
  end;

  inherited Create(AComponent);
  FBehavior := RsNoneCaption;
  FUseEffectText := False;
  FEffectText := '';
end;

destructor TJvCustomBehaviorLabel.Destroy;
begin
  FreeAndNil(FOptions);
  inherited Destroy;
end;

procedure TJvCustomBehaviorLabel.DoStart;
begin
  if Assigned(FOnStart) then
    FOnStart(Self);
end;

procedure TJvCustomBehaviorLabel.DoStop;
begin
  if Assigned(FOnStop) then
    FOnStop(Self);
end;




function TJvCustomBehaviorLabel.GetText: TCaption;
begin
  if UseEffectText then
    Result := EffectText
  else
    Result := inherited GetText;
end;


function TJvCustomBehaviorLabel.BehaviorStored: Boolean;
begin
  Result := FBehavior <> RsNoneCaption;
end;

function TJvCustomBehaviorLabel.GetOptions: TJvLabelBehavior;
begin
  if FOptions = nil then
  begin
    // (p3) this doesn't update Options in the OI at DT (unless you collapse/expand the property)
    FOptions := GetLabelBehaviorOptionsClass(FBehavior).Create(Self);
    UpdateDesigner;
  end;
  Result := FOptions;
end;

procedure TJvCustomBehaviorLabel.Resize;
begin
  inherited Resize;
  BehaviorOptions.OwnerResize;
end;

procedure TJvCustomBehaviorLabel.SetBehavior(const Value: TJvLabelBehaviorName);
var
  S: TStringList;
begin
  if FBehavior <> Value then
  begin
    S := TStringList.Create;
    try
      GetRegisteredLabelBehaviorOptions(S);
      if S.IndexOf(Value) < 0 then
        Exit;
    finally
      S.Free;
    end;
    // (p3) this doesn't update Options in the OI at DT (unless you collapse/expand the property)
    FBehavior := Value;
    FreeAndNil(FOptions);
    UpdateDesigner;
  end;
end;

procedure TJvCustomBehaviorLabel.SetOptions(const Value: TJvLabelBehavior);
begin
  if Value = nil then
    Behavior := ''
  else
  if (FOptions = nil) or (FOptions.ClassType <> Value.ClassType) then
    Behavior := GetLabelBehaviorName(TJvLabelBehaviorOptionsClass(Value.ClassType));
  UpdateDesigner;
end;

procedure TJvCustomBehaviorLabel.SetUseEffectText(const Value: Boolean);
begin
  if Value <> FUseEffectText then
  begin
    FUseEffectText := Value;
    if ComponentState * [csLoading, csDestroying] = [] then
      Repaint;
  end;
end;

procedure TJvCustomBehaviorLabel.UpdateDesigner;
var
  F: TCustomForm;
begin
  if csDesigning in ComponentState then
  begin
    F := GetParentForm(Self);  
    if (F <> nil) and (F.DesignerHook <> nil) then
      F.DesignerHook.Modified; 
  end;
end;

//=== { TJvLabelBlink } ======================================================

constructor TJvLabelBlink.Create(ALabel: TJvCustomBehaviorLabel);
begin
  inherited Create(ALabel);
  ALabel.EffectText := '';
  FDelay := 100;
  FInterval := 400;
end;

procedure TJvLabelBlink.DoTimerEvent(Sender: TObject);
begin
  FTimer.Enabled := False;
  FTimer.Interval := FInterval;
  FToggled := not FToggled;
  OwnerLabel.UseEffectText := FToggled;
  FTimer.Enabled := FInterval > 0;
end;

procedure TJvLabelBlink.SetDelay(const Value: Cardinal);
begin
  if FDelay <> Value then
  begin
    Suspend;
    FDelay := Value;
    Resume;
  end;
end;

procedure TJvLabelBlink.SetInterval(const Value: Cardinal);
begin
  if FInterval <> Value then
  begin
    Suspend;
    FInterval := Value;
    Resume;
  end;
end;

procedure TJvLabelBlink.Start;
begin
  inherited Start;
  if OwnerLabel.ComponentState * [csLoading, csDestroying] <> [] then
    Exit;
  if FTimer = nil then
  begin
    FTimer := TTimer.Create(nil);
    FTimer.Enabled := False;
    FTimer.OnTimer := DoTimerEvent;
  end;
  FTimer.Interval := FDelay;
  FToggled := False;
  if FDelay = 0 then
    FDelay := 1;
  FTimer.Enabled := True; // not (csDesigning in OwnerLabel.ComponentState);
end;

procedure TJvLabelBlink.Stop;
begin
  if FTimer <> nil then
  begin
    FreeAndNil(FTimer);
    OwnerLabel.UseEffectText := False;
  end;
  inherited Stop;
end;

//=== { TJvLabelBounce } =====================================================

constructor TJvLabelBounce.Create(ALabel: TJvCustomBehaviorLabel);
begin
  inherited Create(ALabel);
  FInterval := 20;
  FPixels := 6;
end;

procedure TJvLabelBounce.DoTimerEvent(Sender: TObject);
begin
  FTimer.Enabled := False;
  if Pixels = 0 then
    Pixels := Random(8);
  with OwnerLabel do
    case FDirection of
      0:
        if (Left - Pixels <= 0) or (Top + Height + Pixels >= FParent.ClientHeight) then
        begin
          FDirection := Random(4);
          //            Pixels := Random(8);
        end
        else
        begin
          Left := Left - Pixels;
          Top := Top + Pixels;
        end;
      1:
        if (Top + Height + Pixels >= FParent.ClientHeight) or
          (Left + Width + Pixels >= FParent.ClientWidth) then
        begin
          FDirection := Random(4);
          //            Pixels := Random(8);
        end
        else
        begin
          Top := Top + Pixels;
          Left := Left + Pixels;
        end;
      2:
        if (Left - Pixels <= 0) or (Top - Pixels <= 0) then
        begin
          FDirection := Random(4);
          //            Pixels := Random(8);
        end
        else
        begin
          Left := Left - Pixels;
          Top := Top - Pixels;
        end;
      3:
        if (Left + Width + Pixels > FParent.ClientWidth) or (Top - Pixels <= 0) then
        begin
          FDirection := Random(4);
          //            Pixels := Random(8);
        end
        else
        begin
          Left := Left + Pixels;
          Top := Top - Pixels;
        end;
    end;
  FTimer.Enabled := True;
end;

procedure TJvLabelBounce.SetInterval(const Value: Cardinal);
begin
  if FInterval <> Value then
  begin
    Suspend;
    FInterval := Value;
    if FInterval <= 0 then
      FInterval := 20;
    Resume;
  end;
end;

procedure TJvLabelBounce.SetPixels(const Value: Integer);
begin
  if FPixels <> Value then
  begin
    Suspend;
    FPixels := Value;
    if FPixels <= 0 then
      FPixels := 6;
    Resume;
  end;
end;

procedure TJvLabelBounce.Start;
begin
  if OwnerLabel.ComponentState * [csLoading, csDestroying] <> [] then
    Exit;
  FParent := OwnerLabel.Parent;
  if FParent = nil then
    raise EJVCLException.CreateResFmt(@RsENoOwnerLabelParent, [ClassName]);
  inherited Start;
  FOriginalRect := OwnerLabel.BoundsRect;
  Randomize;
  if FTimer = nil then
  begin
    FTimer := TTimer.Create(nil);
    FTimer.Enabled := False;
    FTimer.OnTimer := DoTimerEvent;
  end;
  FTimer.Interval := Interval;
  FTimer.Enabled := True;
end;

procedure TJvLabelBounce.Stop;
begin
  FreeAndNil(FTimer);
  if not IsRectEmpty(FOriginalRect) then
    OwnerLabel.BoundsRect := FOriginalRect;
  inherited Stop;
end;

//=== { TJvLabelScroll } =====================================================

constructor TJvLabelScroll.Create(ALabel: TJvCustomBehaviorLabel);
begin
  inherited Create(ALabel);
  FInterval := 50;
  FDirection := sdLeftToRight;
end;

procedure TJvLabelScroll.DoTimerEvent(Sender: TObject);
var
  Tmp: TCaption;
begin
  FTimer.Enabled := False;
  if OwnerLabel.Caption <> '' then
  begin
    Tmp := OwnerLabel.EffectText;
    if FDirection = sdLeftToRight then
      Tmp := Tmp[Length(Tmp)] + Copy(Tmp, 1, Length(Tmp) - 1)
    else
      Tmp := Copy(Tmp, 2, Length(Tmp) - 1) + Tmp[1];
    OwnerLabel.EffectText := Tmp;
    OwnerLabel.Repaint;
  end;
  FTimer.Enabled := True;
end;

procedure TJvLabelScroll.SetDirection(const Value: TJvLabelScrollDirection);
begin
  if FDirection <> Value then
  begin
    Suspend;
    FDirection := Value;
    Resume;
  end;
end;

procedure TJvLabelScroll.SetInterval(const Value: Cardinal);
begin
  if FInterval <> Value then
  begin
    Suspend;
    FInterval := Value;
    Resume;
  end;
end;