jvgflyingtext.pas

East make Tray Icon in delphi

        FR.Left, FR.Top, FR.Width, FR.Height,
        FScaledTxtBitmap.Canvas.Handle, FP.X, FP.Y, SRCCOPY);

      CreateBitmapExt(FResBitmap.Canvas.Handle, FPartTxtBitmap, ClientRect,
        0, 0, fwoNone, fdsDefault, FTransparent, 0, clBlack);
    end;
    BitBlt(Canvas.Handle, 0, 0, FResBitmap.Width, FResBitmap.Height,
      FResBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  end;
  FOldShift := FShift;
  FShift.X := FShift.X + FStepShift.X;
  FShift.Y := FShift.Y + FStepShift.Y;

  if csDesigning in ComponentState then
    with Canvas do
    begin
      Pen.Color := clBlack;
      Pen.Style := psDash;
      Brush.Style := bsClear;
      Rectangle(0, 0, Width, Height);
    end;

end;

procedure TJvgFlyingText.OnTimerProc(Sender: TObject);
begin
  if FText.Count = 0 then
  begin
    Active := False;
    Exit;
  end;

  if FDirection = fsdRaising then
  begin
    FScaledWidth := (FScaledWidth * FStepScaleFactor);
    FScaledHeight := (FScaledHeight * FStepScaleFactor);
    FOldScaledWidth := FScaledWidth;
    FOldScaledHeight := FScaledHeight;
  end
  else { fsdRecession }
  begin
    FOldScaledWidth := FScaledWidth;
    FOldScaledHeight := FScaledHeight;
    FScaledWidth := (FScaledWidth / FStepScaleFactor);
    FScaledHeight := (FScaledHeight / FStepScaleFactor);
  end;

  if (FScaledWidth < (FTxtBitmap.Width * FScalePercent / 100)) or
    (FScaledWidth > FTxtBitmap.Width) or
    (FScaledHeight < (FTxtBitmap.Height * FScalePercent / 100)) or
    (FScaledHeight > FTxtBitmap.Height) then
  begin
    if Assigned(FOnTextLineChanging) then
      FOnTextLineChanging(Self, FCurTextLine);
    if FCurTextLine < Text.Count - 1 then
      Inc(FCurTextLine)
    else
    begin
      FCurTextLine := 0;
      if not FCycled then
      begin
        Active := False;
        BuildBitmaps;
        Exit;
      end;
    end;
    BuildTxtBitmap;
  end
  else
    FNeedRepaintBackground := False;

  Repaint;
end;

procedure TJvgFlyingText.RepaintBackground; //...for users
begin
  FNeedRepaintBackground := True;
  Repaint;
end;

procedure TJvgFlyingText.RemakeBackground; //...for users
begin
  FNeedRemakeBackground := True;
  Repaint;
end;

procedure TJvgFlyingText.CalcTxtBitmapWidth;
var
  Size: TSize;
begin
  //if Text.Count <= FCurTextLine then Exit;
  with FTxtBitmap do
  begin
    GetTextExtentPoint32(Canvas.Handle, PChar(Text[FCurTextLine]),
      Length(Text[FCurTextLine]), Size);
    Width := Size.cx + FThreeDGradient.Depth;
    Height := Size.cy + FThreeDGradient.Depth;
    FShift := Point(0, 0);
    FOldShift := FShift;
  end;
end;

procedure TJvgFlyingText.BuildTxtBitmap;
var
  R: TRect;
  I, X, Y: Integer;
begin
  //if (not Assigned(Text))or(FText.Count=0) then Exit;
  FTxtBitmap.Canvas.Font.Assign(FResultFont);
  if Text.Count <> 0 then
    CalcTxtBitmapWidth
  else
  begin
    FTxtBitmap.Width := 0;
    FTxtBitmap.Height := 0;
  end;
  R := Rect(0, 0, FTxtBitmap.Width, FTxtBitmap.Height);

  FTxtBitmap.Canvas.Brush.Color := clBlack;
  FTxtBitmap.Canvas.Brush.Style := bsSolid;
  FTxtBitmap.Canvas.FillRect(R);

  case FView3D.Horizontal of
    fhaLeft:
      X := 0;
    fhaCenter:
      X := FThreeDGradient.Depth div 2;
  else {fhaRight}
    X := FThreeDGradient.Depth;
  end;
  case FView3D.Vertical of
    fvaTop:
      Y := 0;
    fvaCenter:
      Y := FThreeDGradient.Depth div 2;
  else {fvaBottom}
    Y := FThreeDGradient.Depth;
  end;

  SetBkMode(FTxtBitmap.Canvas.Handle, Integer(TRANSPARENT));
  for I := 0 to FThreeDGradient.Depth - 1 do
  begin
    if FThreeDGradient.GType = fgtFlat then
      FThreeDGradient.TextOut(FTxtBitmap.Canvas.Handle, Text[FCurTextLine],
        R, X, Y)
    else
    begin {fgt3D}
      FTxtBitmap.Canvas.Font.Color
        := FThreeDGradient.GetColorFromGradientLine(FThreeDGradient.Depth,
        I);
      FTxtBitmap.Canvas.TextOut(X, Y, Text[FCurTextLine]);
    end;
    if X < (FThreeDGradient.Depth div 2) then
      Inc(X)
    else
      Dec(X);
    if Y < (FThreeDGradient.Depth div 2) then
      Inc(Y)
    else
      Dec(Y);
  end;
  FGradient.TextOut(FTxtBitmap.Canvas.Handle, Text[FCurTextLine], R, X, Y);

  {.calc scaling.}
  if FDirection = fsdRaising then
  begin
    FScaledWidth := (FTxtBitmap.Width * FScalePercent / 100);
    FScaledHeight := (FTxtBitmap.Height * FScalePercent / 100);
    FScaledHeight := FScaledHeight + 2;
  end
  else { fsdRecession }
  begin
    FScaledHeight := FTxtBitmap.Height;
    FScaledWidth := FTxtBitmap.Width;
  end;
  FOldScaledWidth := FScaledWidth;
  FOldScaledHeight := FScaledHeight;

  if FClearOldText then
  begin
    R := Rect(0, 0, FPartTxtBitmap.Width, FPartTxtBitmap.Height);
    FPartTxtBitmap.Canvas.FillRect(R);
  end;

  R := Rect(0, 0, FTxtBitmap.Width, FTxtBitmap.Height);
  FScaledTxtBitmap.Width := FTxtBitmap.Width;
  FScaledTxtBitmap.Height := FTxtBitmap.Height;
  FScaledTxtBitmap.Canvas.FillRect(R);

  FNeedRepaintBackground := True;
end;

procedure TJvgFlyingText.BuildBitmaps;
var
  R: TRect;
  FOldTimer: Boolean;
begin
  if not FLoaded then
  begin
    //    FPartTxtBitmap.Width:=Width; FPartTxtBitmap.Height:=Height;
    FResBitmap.Width := Width;
    FResBitmap.Height := Height;
    Exit;
  end;

  FOldTimer := FTimer.Enabled;
  FTimer.Enabled := False;
  if FNeedRemakeBackground then
  begin
    // PrepareBackground
//    BringParentWindowToTop(Self);
    FBackgrBitmap.Width := Width;
    FBackgrBitmap.Height := Height;

    //..prepare tabula rasa
    if FTransparent then
      FBackgrBitmap.Canvas.Brush.Color := Parent.Brush.Color
    else
      FBackgrBitmap.Canvas.Brush.Color := FBackgrColor;
    FBackgrBitmap.Canvas.Brush.Style := bsSolid;
    FBackgrBitmap.Canvas.FillRect(ClientRect);

    if FTransparent then
      GetParentImageRect(Self, Bounds(Left, Top, Width, Height),
        FBackgrBitmap.Canvas.Handle);
    // PrepareBackground
  //    if (FResBitmap.Width or FResBitmap.Height)<>0 then
  //      BitBlt( FBackgrBitmap.Canvas.Handle, 0, 0,
  //        Width, Height, Canvas.Handle, 0, 0, SRCCOPY);
  end;

  //  if FTransparent then ShowWindow(Handle,SW_SHOW);

  BuildTxtBitmap;

  R := Rect(0, 0, FResBitmap.Width, FResBitmap.Height);
  FResBitmap.Canvas.FillRect(R);
  FTimer.Enabled := FOldTimer;
  FNeedRemakeBackground := False;
end;

procedure TJvgFlyingText.WMSize(var Msg: TWMSize);
begin
  FNeedRemakeBackground := True;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.OnParamsChanged(Sender: TObject);
begin
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.Repaint_;
//var R: TRect;
begin
  if FLoaded then
    Repaint;
  //  R:=Rect(0,0,Width,Height);
  //  InvalidateRect(Handle,@R,False);
end;

procedure TJvgFlyingText.SetHorAlign(Value: TglHorAlign);
begin
  FHorAlign := Value;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.SetVertAlign(Value: TglVertAlign);
begin
  FVertAlign := Value;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.SetTransparent(Value: Boolean);
begin
  FTransparent := Value;
  FNeedRemakeBackground := True;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.SetBackgrColor(Value: TColor);
begin
  FBackgrColor := Value;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.SetInteriorOffset(Value: Word);
begin
  FInteriorOffset := Value;
end;

procedure TJvgFlyingText.SetScalePercent(Value: TSpPercent);
begin
  FScalePercent := Value;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.SetStepScaleFactor(Value: Single);
begin
  if Value < 1 then
    Value := 1;
  if Value > 2 then
    Value := 2;
  FStepScaleFactor := Value;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.SetResultFont(Value: TFont);
begin
  if Value <> nil then
    FResultFont.Assign(Value);
  BuildBitmaps;
end;

procedure TJvgFlyingText.SetTimerInterval(Value: Word);
begin
  FTimerInterval := Value;
  FTimer.Interval := FTimerInterval;
end;

procedure TJvgFlyingText.SetActive(Value: Boolean);
begin
  FActive := Value;
  if not (csDesigning in ComponentState) then
    FTimer.Enabled := FActive;
end;

function TJvgFlyingText.GetText: TStrings;
begin
  Result := FText;
end;

procedure TJvgFlyingText.SetText(Value: TStrings);
var
  OldActive: Boolean;
  I: Integer;
begin
  OldActive := FActive;
  Active := False;
  if Assigned(Value) then
    FText.Assign(Value);
  FCurTextLine := 0;
  if FText.Count <> 0 then
    for I := 0 to FText.Count - 1 do
      FText[I] := Trim(FText[I]);
  BuildBitmaps;
  Repaint_;
  Active := OldActive;
end;

procedure TJvgFlyingText.SetFastDraw(Value: Boolean);
begin
  if FFastDraw = Value then
    Exit;
  FFastDraw := Value;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.SetDirection(Value: TglScalingDir);
begin
  if FDirection = Value then
    Exit;
  FDirection := Value;
  if csDesigning in ComponentState then
  begin
    BuildBitmaps;
    Repaint_;
  end;
end;

procedure TJvgFlyingText.SetShowTextWhilePassive(Value: Boolean);
begin
  if FShowTextWhilePassive = Value then
    Exit;
  FShowTextWhilePassive := Value;
  BuildBitmaps;
  Repaint_;
end;

procedure TJvgFlyingText.SetVisible(Value: Boolean);
begin
  if FVisible = Value then
    Exit;
  FVisible := Value;
  inherited Visible := FVisible;
  if FVisible then
  begin
    BuildBitmaps;
    Repaint_;
  end;
end;

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

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.