jvgflyingtext.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvgFlyingText.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgFlyingText.pas,v 1.20 2005/02/17 10:21:20 marquardt Exp $

unit JvgFlyingText;

{$I jvcl.inc}

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls,
  {$IFDEF USEJVCL}
  JvComponent,
  {$ENDIF USEJVCL}
  JvgTypes, JvgUtils, JvgCommClasses;

type
  TMyRect = record
    Left: Integer;
    Top: Integer;
    Width: Integer;
    Height: Integer;
  end;

  TTextLineChangingEvent = procedure(Sender: TObject; LineNum: Integer) of object;

  {$IFDEF USEJVCL}
  TJvgFlyingText = class(TJvCustomPanel)
  {$ELSE}
  TJvgFlyingText = class(TCustomPanel)
  {$ENDIF USEJVCL}
  private
    FHorAlign: TglHorAlign;
    FVertAlign: TglVertAlign;
    FTransparent: Boolean;
    FBackgrColor: TColor;
    FGradient: TJvgGradient;
    FThreeDGradient: TJvg3DGradient;
    FInteriorOffset: Word;
    FScalePercent: TSpPercent;
    FStepScaleFactor: Single;
    FResultFont: TFont;
    FTimerInterval: Word;
    FActive: Boolean;
    FClearOldText: Boolean;
    FClearOldTextWhileDrawing: Boolean;
    FCycled: Boolean;
    FText: TStringList;
    FView3D: TJvg2DAlign;
    FDirection: TglScalingDir;
    FFastDraw: Boolean;
    FShowTextWhilePassive: Boolean;

    FOnTextLineChanging: TTextLineChangingEvent;

    FR: TMyRect;
    OldFR: TMyRect;
    FP: TPoint;
    OldFP: TPoint;
    FBackgrBitmap: TBitmap;
    FTxtBitmap: TBitmap;
    FResBitmap: TBitmap;
    FScaledTxtBitmap: TBitmap;
    FPartTxtBitmap: TBitmap;
    FNeedRebuildBitmaps: Boolean;
    FTimer: TTimer;
    FScaledWidth: Single;
    FScaledHeight: Single;
    FOldScaledWidth: Single;
    FOldScaledHeight: Single;
    FVisible: Boolean;
    FStepShift: TJvgPointClass;

    FShift: TPoint;
    FOldShift: TPoint;
    FCurTextLine: Word;
    FNeedRepaintBackground: Boolean;
    FNeedRemakeBackground: Boolean;
    FLoaded: Boolean;
    procedure CalcTxtBitmapWidth;
    procedure BuildBitmaps;
    procedure BuildTxtBitmap;
    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure OnParamsChanged(Sender: TObject);
    procedure Repaint_;

    function GetText: TStrings;
    procedure SetHorAlign(Value: TglHorAlign);
    procedure SetVertAlign(Value: TglVertAlign);
    procedure SetTransparent(Value: Boolean);
    procedure SetBackgrColor(Value: TColor);
    procedure SetInteriorOffset(Value: Word);
    procedure SetScalePercent(Value: TSpPercent);
    procedure SetStepScaleFactor(Value: Single);
    procedure SetResultFont(Value: TFont);
    procedure SetTimerInterval(Value: Word);
    procedure SetActive(Value: Boolean);
    procedure SetText(Value: TStrings);
    procedure SetFastDraw(Value: Boolean);
    procedure SetDirection(Value: TglScalingDir);
    procedure SetShowTextWhilePassive(Value: Boolean);
    procedure SetVisible(Value: Boolean);
  protected
    property Color; //...hide
    procedure Paint; override;
  public
    property Canvas;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure OnTimerProc(Sender: TObject);
    procedure RepaintBackground; //...for users
    procedure RemakeBackground; //...for users
  published
    property Anchors;
    property Align;
    property AlignTextHorizontal: TglHorAlign read FHorAlign write SetHorAlign default fhaCenter;
    property AlignTextVertical: TglVertAlign read FVertAlign write SetVertAlign default fvaCenter;
    property Transparent: Boolean read FTransparent write SetTransparent default False;
    property BackgrColor: TColor read FBackgrColor write SetBackgrColor default clBlack;
    property Gradient: TJvgGradient read FGradient write FGradient;
    property Gradient3D: TJvg3DGradient read FThreeDGradient write FThreeDGradient;
    property InteriorOffset: Word read FInteriorOffset write SetInteriorOffset default 0;
    property ScalePercent: TSpPercent read FScalePercent write SetScalePercent default 5;
    property StepScaleFactor: Single read FStepScaleFactor write SetStepScaleFactor;
    property ResultFont: TFont read FResultFont write SetResultFont;
    property TimerInterval: Word read FTimerInterval write SetTimerInterval default 10;
    property Active: Boolean read FActive write SetActive default False;
    property ClearOldText: Boolean read FClearOldText write FClearOldText default True;
    property ClearOldTextWhileDrawing: Boolean
      read FClearOldTextWhileDrawing write FClearOldTextWhileDrawing
      default True;
    property Cycled: Boolean read FCycled write FCycled default False;
    property Text: TStrings read GetText write SetText;
    property FastDraw: Boolean read FFastDraw write SetFastDraw default True;
    property View3D: TJvg2DAlign read FView3D write FView3D;
    property Direction: TglScalingDir read FDirection write SetDirection default fsdRaising;
    property ShowTextWhilePassive: Boolean
      read FShowTextWhilePassive write SetShowTextWhilePassive default True;
    property OnTextLineChanging: TTextLineChangingEvent
      read FOnTextLineChanging write FOnTextLineChanging;
    property Visible: Boolean read FVisible write SetVisible default True;
    property StepShift: TJvgPointClass read FStepShift write FStepShift;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvgFlyingText.pas,v $';
    Revision: '$Revision: 1.20 $';
    Date: '$Date: 2005/02/17 10:21:20 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  Math;

constructor TJvgFlyingText.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Visible := False;
  Width := 105;
  Height := 105;

  FTxtBitmap := TBitmap.Create;
  FBackgrBitmap := TBitmap.Create;
  FResBitmap := TBitmap.Create;
  FScaledTxtBitmap := TBitmap.Create;
  FPartTxtBitmap := TBitmap.Create;
  FResultFont := TFont.Create;
  FTimer := TTimer.Create(Self);
  FGradient := TJvgGradient.Create;
  FThreeDGradient := TJvg3DGradient.Create;
  FText := TStringList.Create;
  FView3D := TJvg2DAlign.Create;
  FStepShift := TJvgPointClass.Create;
  FCurTextLine := 0;

  FThreeDGradient.FromColor := clBlack;
  FThreeDGradient.ToColor := clGray;

  FGradient.Active := True;
  FGradient.FromColor := clWhite;

  FGradient.OnChanged := OnParamsChanged;
  FThreeDGradient.OnChanged := OnParamsChanged;
  FView3D.OnChanged := OnParamsChanged;

  FTimer.Enabled := False;
  FTimer.OnTimer := OnTimerProc;
  FTimer.Interval := 10;

  //...defaults
  FHorAlign := fhaCenter;
  FVertAlign := fvaCenter;
  FTransparent := False;
  FBackgrColor := clBlack;
  FInteriorOffset := 0;
  FScalePercent := 5;
  FStepScaleFactor := 1.1;

  FResultFont.Color := clWhite;
  FResultFont.Name := 'Times';
  FResultFont.Style := [fsBold];
  FResultFont.Size := 90;
  FResultFont.Color := clWhite;

  FTimerInterval := 10;
  FActive := False;
  FClearOldText := True;
  FClearOldTextWhileDrawing := True;
  FCycled := False;
  FFastDraw := True;
  FDirection := fsdRaising;
  FShowTextWhilePassive := True;
  FVisible := True;
  FStepShift.X := 0;
  FStepShift.Y := 0;
  FShift := Point(0, 0);
  FText.Add('Hello');
  FText.Add('World');

  FScaledTxtBitmap.Canvas.Brush.Color := clBlack;
  FScaledTxtBitmap.Canvas.Brush.Style := bsSolid;
  FResBitmap.Canvas.Brush.Color := clBlack;
  FResBitmap.Canvas.Brush.Style := bsSolid;
  FPartTxtBitmap.Canvas.Brush.Color := clBlack;
  FPartTxtBitmap.Canvas.Brush.Style := bsSolid;

  FNeedRebuildBitmaps := True;
  FNeedRemakeBackground := False;
  FLoaded := False;
end;

destructor TJvgFlyingText.Destroy;
begin
  FResBitmap.Free;
  FBackgrBitmap.Free;
  FTxtBitmap.Free;
  FScaledTxtBitmap.Free;
  FPartTxtBitmap.Free;
  FResultFont.Free;
  FGradient.Free;
  FThreeDGradient.Free;
  FText.Free;
  FView3D.Free;
  FStepShift.Free;
  inherited Destroy;
end;

procedure TJvgFlyingText.Paint;
var
  R: TRect;

  procedure CalcPos(var FR: TMyRect; var FP: TPoint;
    FScaledWidth, FScaledHeight: Integer; Shift: TPoint);
  begin
    case FHorAlign of
      fhaLeft:
        begin
          FR.Left := 0;
          FP.X := 0;
        end;
      fhaCenter:
        begin
          FR.Left := Max(0, (Width - FScaledWidth) div 2);
          FP.X := Max(0, -(Width - FScaledWidth) div 2);
        end;
      fhaRight:
        begin
          FR.Left := Max(0, Width - FScaledWidth);
          FP.X := Max(0, FScaledWidth - Width);
        end;
    end;
    case FVertAlign of
      fvaTop:
        begin
          FR.Top := 0;
          FP.Y := 0;
        end;
      fvaCenter:
        begin
          FR.Top := Max(0, (Height - FScaledHeight) div 2);
          FP.Y := Max(0, -(Height - FScaledHeight) div 2);
        end;
      fvaBottom:
        begin
          FR.Top := Max(0, Height - FScaledHeight);
          FP.Y := Max(0, FScaledHeight - Height);
        end;
    end;
    FR.Left := FR.Left + Shift.X;
    FR.Top := FR.Top + Shift.Y;
    FR.Width := Min(Width, FScaledWidth);
    FR.Height := Min(Height, FScaledHeight);
  end;

begin
  //FNeedRebuildBitmaps := (OldLeft<>Left)or(OldTop<>Top);
  //OldLeft := Left; OldTop := Top;
  if FNeedRebuildBitmaps then
  begin
    FLoaded := True;
    FNeedRemakeBackground := True;
    BuildBitmaps;
    FNeedRebuildBitmaps := False;
    Visible := FVisible;
  end;

  StretchBlt(FScaledTxtBitmap.Canvas.Handle, 0, 0,
    Trunc(FScaledWidth), Trunc(FScaledHeight),
    FTxtBitmap.Canvas.Handle, 0, 0,
    FTxtBitmap.Width, FTxtBitmap.Height, SRCCOPY);

  CalcPos(FR, FP, Trunc(FScaledWidth), Trunc(FScaledHeight), FShift);
  CalcPos(OldFR, OldFP, Trunc(FOldScaledWidth),
    Trunc(FOldScaledHeight), FOldShift);

  if FFastDraw then
  begin
    if FNeedRepaintBackground then
    begin
      if FClearOldText or not FActive then
        BitBlt(Canvas.Handle, 0, 0, Width, Height,
          FBackgrBitmap.Canvas.Handle, 0, 0, SRCCOPY);
    end;
    FNeedRepaintBackground := True;

    FPartTxtBitmap.Width := FR.Width;
    FPartTxtBitmap.Height := FR.Height;
    OldFR.Width := OldFR.Width + Abs(FShift.X - FOldShift.X);
    OldFR.Height := OldFR.Height + Abs(FShift.Y - FOldShift.Y);
    FResBitmap.Width := OldFR.Width;
    FResBitmap.Height := OldFR.Height;

    if FDirection = fsdRecessing then
    begin
      R := Rect(0, 0, FPartTxtBitmap.Width, FPartTxtBitmap.Height);
      FillRect(FPartTxtBitmap.Canvas.Handle, R,
        FPartTxtBitmap.Canvas.Brush.Handle);
    end;

    BitBlt(FPartTxtBitmap.Canvas.Handle, 0, 0,
      FR.Width, FR.Height,
      FScaledTxtBitmap.Canvas.Handle, FP.X, FP.Y, SRCCOPY);
    {PartBackgr}
    if FClearOldTextWhileDrawing then
      BitBlt(FResBitmap.Canvas.Handle, 0, 0, OldFR.Width, OldFR.Height,
        FBackgrBitmap.Canvas.Handle, OldFR.Left, OldFR.Top, SRCCOPY)
    else
      BitBlt(FResBitmap.Canvas.Handle, 0, 0, OldFR.Width, OldFR.Height,
        Canvas.Handle, OldFR.Left, OldFR.Top, SRCCOPY);

    if FShowTextWhilePassive or FActive then
      CreateBitmapExt(FResBitmap.Canvas.Handle, FPartTxtBitmap,
        ClientRect,
        (FR.Left - OldFR.Left), (FR.Top - OldFR.Top),
        fwoNone, fdsDefault, FTransparent, 0, clBlack);

    BitBlt(Canvas.Handle, OldFR.Left, OldFR.Top,
      FResBitmap.Width, FResBitmap.Height,
      FResBitmap.Canvas.Handle, 0, 0, SRCCOPY);
  end
  else {SLOW DRAWING}
  begin
    FPartTxtBitmap.Width := Width;
    FPartTxtBitmap.Height := Height;
    FResBitmap.Width := Width;
    FResBitmap.Height := Height;

    BitBlt(FResBitmap.Canvas.Handle, 0, 0, Width, Height,
      FBackgrBitmap.Canvas.Handle, 0, 0, SRCCOPY);
    if FDirection = fsdRecessing then
    begin
      R := Rect(0, 0, FPartTxtBitmap.Width, FPartTxtBitmap.Height);
      FillRect(FPartTxtBitmap.Canvas.Handle, R,
        FPartTxtBitmap.Canvas.Brush.Handle);
    end;
    if FShowTextWhilePassive or FActive then
    begin
      BitBlt(FPartTxtBitmap.Canvas.Handle,