jvbehaviorlabel.pas

East make Tray Icon in delphi

  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;

procedure TJvLabelScroll.SetPadding(Value: Boolean);
var
  Tmp: TCaption;
begin
  FPadding := Value;
  Tmp := '';
  while OwnerLabel.Canvas.TextWidth(Tmp) < OwnerLabel.Width do
    Tmp := Tmp + ' ';
  if Value then
    OwnerLabel.EffectText := OwnerLabel.Caption + Tmp
  else
    OwnerLabel.EffectText := OwnerLabel.Caption;
end;

procedure TJvLabelScroll.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 := Interval;
  SetPadding(Padding);
  OwnerLabel.UseEffectText := True;
  FTimer.Enabled := True;
end;

procedure TJvLabelScroll.Stop;
begin
  FreeAndNil(FTimer);
  OwnerLabel.UseEffectText := False;
  inherited Stop;
end;

//=== { TJvLabelAppear } =====================================================

constructor TJvLabelAppear.Create(ALabel: TJvCustomBehaviorLabel);
begin
  inherited Create(ALabel);
  FDelay := 100;
  FInterval := 20;
  FPixels := 3;
  FAppearFrom := drFromRight;
end;

procedure TJvLabelAppear.DoTimerEvent(Sender: TObject);
var
  FWidth, FHeight: Integer;
  FSuspend: Boolean;
begin
  FWidth := FOriginalRect.Right - FOriginalRect.Left;
  FHeight := FOriginalRect.Bottom - FOriginalRect.Top;
  FSuspend := False;
  if FFirst then
  begin
    case FAppearFrom of
      drFromRight:
        begin
          OwnerLabel.Left := FParent.ClientWidth;
          OwnerLabel.Width := 0;
        end;
      drFromLeft:
        OwnerLabel.Left := -OwnerLabel.Width;
      drFromTop:
        OwnerLabel.Top := -OwnerLabel.Height;
      drFromBottom:
        begin
          OwnerLabel.Top := FParent.ClientHeight;
          OwnerLabel.Height := 0;
        end;
    end;
    OwnerLabel.Visible := True;
    FFirst := False;
  end;

  case FAppearFrom of
    drFromRight:
      begin
        if Abs(OwnerLabel.Left - FOriginalRect.Left) < Pixels then
        begin
          OwnerLabel.Left := FOriginalRect.Left;
          FSuspend := True;
        end
        else
          OwnerLabel.Left := OwnerLabel.Left - Pixels;
        if OwnerLabel.Width <> FWidth then
        begin
          if OwnerLabel.Left + FWidth < FParent.ClientWidth then
            OwnerLabel.Width := FWidth
          else
            OwnerLabel.Width := FParent.ClientWidth - OwnerLabel.Left - 2;
        end;
      end;
    drFromLeft:
      if Abs(OwnerLabel.Left - FOriginalRect.Left) < Pixels then
      begin
        OwnerLabel.Left := FOriginalRect.Left;
        FSuspend := True;
      end
      else
        OwnerLabel.Left := OwnerLabel.Left + Pixels;
    drFromTop:
      if Abs(OwnerLabel.Top - FOriginalRect.Top) < Pixels then
      begin
        OwnerLabel.Top := FOriginalRect.Top;
        FSuspend := True;
      end
      else
        OwnerLabel.Top := OwnerLabel.Top + Pixels;
    drFromBottom:
      begin
        if Abs(OwnerLabel.Top - FOriginalRect.Top) < Pixels then
        begin
          OwnerLabel.Top := FOriginalRect.Top;
          FSuspend := True;
        end
        else
          OwnerLabel.Top := OwnerLabel.Top - Pixels;
        if OwnerLabel.Height <> FHeight then
        begin
          if OwnerLabel.Top + FHeight < FParent.ClientHeight then
            OwnerLabel.Height := FHeight
          else
            OwnerLabel.Height := FParent.ClientHeight - OwnerLabel.Top - 2;
        end;
      end;
  end;
  FTimer.Interval := Interval;
  if FSuspend then
    Active := False
  else
    FTimer.Enabled := True;
end;

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

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

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

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

//=== { TJvLabelTyping } =====================================================

constructor TJvLabelTyping.Create(ALabel: TJvCustomBehaviorLabel);
begin
  inherited Create(ALabel);
  FInterval := 100;
  FMakeErrors := True;
end;

procedure TJvLabelTyping.DoTimerEvent(Sender: TObject);
var
  Tmp: TCaption;
  I: Integer;
begin
  FTimer.Enabled := False;
  if FTextPos <= Length(OwnerLabel.Caption) then
  begin
    Tmp := Copy(OwnerLabel.Caption, 1, FTextPos - 1);
    I := Random(10);
    if (I = 7) and MakeErrors then
      Tmp := Tmp + Char(Ord(OwnerLabel.Caption[FTextPos]) - Random(10))
    else
      Tmp := Tmp + OwnerLabel.Caption[FTextPos];
    if (MakeErrors) and (I <> 7) then
      FTimer.Interval := Interval
    else
      FTimer.Interval := Interval * 2;
    OwnerLabel.EffectText := Tmp;
    OwnerLabel.Repaint;
    Inc(FTextPos);
    FTimer.Enabled := True;
  end
  else
    Active := False;
end;

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

procedure TJvLabelTyping.SetMakeErrors(const Value: Boolean);
begin
  if FMakeErrors <> Value then
  begin
    Suspend;
    FMakeErrors := Value;
    Resume;
  end;
end;

procedure TJvLabelTyping.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 := Interval;
  Randomize;
  OwnerLabel.EffectText := '';
  OwnerLabel.UseEffectText := True;
  FTextPos := 1;
  FTimer.Enabled := True;
end;

procedure TJvLabelTyping.Stop;
begin
  FreeAndNil(FTimer);
  OwnerLabel.UseEffectText := False;
  inherited Stop;
end;

//=== { TJvLabelSpecial } ====================================================

constructor TJvLabelSpecial.Create(ALabel: TJvCustomBehaviorLabel);
begin
  inherited Create(ALabel);
  FInterval := 20;
end;

procedure TJvLabelSpecial.DoTimerEvent(Sender: TObject);
begin
  FTimer.Enabled := False;
  if FTextPos < Length(OwnerLabel.Caption) then
  begin
    if FCharValue > Ord(OwnerLabel.Caption[FTextPos]) then
    begin
      Inc(FTextPos);
      FCharValue := 32;
    end;
    OwnerLabel.EffectText := Copy(OwnerLabel.Caption, 1, FTextPos) + Char(FCharValue);
    OwnerLabel.Repaint;
    Inc(FCharValue);
    FTimer.Enabled := True;
  end
  else
    Active := False;
end;

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

procedure TJvLabelSpecial.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;
  FTextPos := 1;
  FCharValue := 32;
  OwnerLabel.EffectText := '';
  OwnerLabel.UseEffectText := True;
  FTimer.Interval := Interval;
  FTimer.Enabled := True;
end;

procedure TJvLabelSpecial.Stop;
begin
  FreeAndNil(FTimer);
  OwnerLabel.UseEffectText := False;
  inherited Stop;
end;

//=== { TJvLabelCodeBreaker } ================================================

constructor TJvLabelCodeBreaker.Create(ALabel: TJvCustomBehaviorLabel);
begin
  inherited Create(ALabel);
  FInterval := 10;
end;

procedure TJvLabelCodeBreaker.DoTimer(Sender: TObject);
begin
  FTimer.Enabled := False;
  if (FCurrentPos > Length(FScratchPad)) or (FCurrentPos > Length(DecodedText)) then
  begin
    OwnerLabel.EffectText := DecodedText;
    OwnerLabel.Repaint;
    Active := False;
    OwnerLabel.UseEffectText := False;
    Exit;
  end
  else
  if FScratchPad[FCurrentPos] <> DecodedText[FCurrentPos] then
  begin
    {$IFDEF VCL}
    FScratchPad[FCurrentPos] := Char(32 + Random(Ord(DecodedText[FCurrentPos]) + 10));
    {$ENDIF VCL}
    {$IFDEF VisualCLX}
    FScratchPad[FCurrentPos] := WideChar(32 + Random(Ord(DecodedText[FCurrentPos]) + 10));
    {$ENDIF VisualCLX}
    //    OwnerLabel.EffectText := Copy(OwnerLabel.Caption, 1, FCurrentPos - 1) +
    //      FScratchPad[FCurrentPos] + Copy(OwnerLabel.Caption, FCurrentPos + 1, MaxInt);
        // (p3) this is the same without the copying...
    OwnerLabel.EffectText := FScratchPad;
    OwnerLabel.Repaint;
  end
  else
    Inc(FCurrentPos);
  // (p3) this seems unnecessary since we have an Interval property
//  Sleep(FInterval);
  FTimer.Enabled := True;
end;

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

procedure TJvLabelCodeBreaker.Start;
begin
  inherited Start;
  FCurrentPos := 1;
  if (Interval > 0) and (OwnerLabel.Caption <> '') and (DecodedText <> '') then
  begin
    FScratchPad := OwnerLabel.Caption;
    FTimer := TTimer.Create(nil);
    FTimer.Enabled := False;
    FTimer.OnTimer := DoTimer;
    FTimer.Interval := Interval;
    FTimer.Enabled := True;
    OwnerLabel.UseEffectText := True;
  end
  else
    Active := False;
end;

procedure TJvLabelCodeBreaker.Stop;
begin
  FreeAndNil(FTimer);
  OwnerLabel.Caption := OwnerLabel.EffectText;
  OwnerLabel.UseEffectText := False;
  inherited Stop;
end;

initialization
  {$IFDEF UNITVERSIONING}
  RegisterUnitVersion(HInstance, UnitVersioning);
  {$ENDIF UNITVERSIONING}
  // (ahuser) registration is done in the constructor the first time it is called

finalization
  FreeAndNil(AllBehaviorOptions);
  {$IFDEF UNITVERSIONING}
  UnregisterUnitVersion(HInstance);
  {$ENDIF UNITVERSIONING}

end.