{------------------------------------------------------------------------------}
{  Borland Delphi Visual Component Library                                     }
{                                                                              }
{  SoftScrollingText.pas - EnemyleftSoftScrollingText                          }                    
{                                                                              }
{  Mit dieser Komponente kannst du z.B. im Info-Teil deines Programms          }
{  Informationen Preis geben. Das interessante daran, du kannst den Text wie   }
{  ein Filmabspann laufen lassen. ssText1.scroll := true !                     }
{  Dein Text kann ein und oder Ausgeblendet werden, benutze dazu die           }
{  Farbverläufe.                                                               }
{                                                                              }
{                                                                              }
{  OpenSource:                                                                 }
{                                                                              }
{  Diese Komponente kann beliebig und frei eingesetzt werden.                  }
{  Sie unterliegt keiner rechtlichen Bestimmung.                               }
{  Auch kannst du die Komponente beliebig anpassen oder weiter entwickeln.     }
{                                                                              }
{  Unter ReleaseNotes kannst du deinen Namen hinschreiben und erklären         }
{  was du gemacht hast. ES WERDEN KEINE NAMEN GELÖSCHT. Es wäre nett, wenn     }
{  du nach deinen Änderungen die Komponente wieder öffentlich zur Verfügung    }
{  stellst und die relevanten Personen darüber informierst.                    }                                                        
{                                                                              }
{------------------------------------------------------------------------------}
///////////////////////////////////////////////////////////////////////////////
// SOFTSCROLLINGTEXT (OS) 2009, Enemyleft [email]enemyleft@gmail.com[/email]
///////////////////////////////////////////////////////////////////////////////
// ReleaseNotes:
//
// > v1.0.0 27.05.09 - Enemyleft > Fertiges **RELEASE 1.0**
//
// RELEASE 1.0 Features By Enemyleft
// ---------------------------------
// . SoftScrollingText
// . blend- in/-out properties
// . horizontal gradient
// . vertical gradient
// . many color propertys
//
///////////////////////////////////////////////////////////////////////////////

unit SSText;

interface

uses
  SysUtils, Classes, Controls, ExtCtrls, Windows, Dialogs, Messages, GraphUtil,
  Graphics, Math, GR32, GR32_Image;

type
  gradient = (grNone, grToptoBottom, grLefttoRight);
  BlendMode = (bmNone, bmIn, bmOut);

  TSSText = class(TCustomControl)
  private
    { Private-Deklarationen }

    tx: Integer;
    ty: Integer;
    ScrollTimer: TTimer;
    TextWidth: Integer;

    FTextPosFromLeft: Integer;
    FTextBeginHight: Integer;

    FColor1: TColor;
    FColor2: TColor;
    FPanelColorTop1: TColor;
    FPanelColorTop2: TColor;
    FPanelColorBottom1: TColor;
    FPanelColorBottom2: TColor;
    FPanelColorRight1: TColor;
    FPanelColorRight2: TColor;
    FPanelColorLeft1: TColor;
    FPanelColorLeft2: TColor;
    FGradient: gradient;
    FShowPanelTop: Boolean;
    FShowPanelLeft: Boolean;
    FShowPanelRight: Boolean;
    FShowPanelBottom: Boolean;

    FCaption: TCaption;
    FBorder: Boolean;
    FBorderColor: TColor;

    FLines: TStrings;
    FScroll: Boolean;
    FSpeedx: Integer;
    FSpeedy: Integer;
    FSpReversex: Boolean;
    FSpReversey: Boolean;

    pb: TPaintBox32;
    bmp32: TBitmap32;

    procedure SetTextPosFromLeft(Value: Integer);
    procedure SetTextBeginHight(Value: Integer);
    procedure SetColor1(Value: TColor);
    procedure SetColor2(Value: TColor);
    procedure SetPanelColorTop1(Value: TColor);
    procedure SetPanelColorTop2(Value: TColor);
    procedure SetPanelColorBottom1(Value: TColor);
    procedure SetPanelColorBottom2(Value: TColor);
    procedure SetPanelColorRight1(Value: TColor);
    procedure SetPanelColorRight2(Value: TColor);
    procedure SetPanelColorLeft1(Value: TColor);
    procedure SetPanelColorLeft2(Value: TColor);
    procedure SetGradient(Value: gradient);
    procedure SetShowPanelTop(Value: Boolean);
    procedure SetShowPanelLeft(Value: Boolean);
    procedure SetShowPanelRight(Value: Boolean);
    procedure SetShowPanelBottom(Value: Boolean);
    procedure SetCaption(Value: TCaption);
    procedure SetBorder(Value: Boolean);
    procedure SetBorderColor(Value: TColor);
    procedure SetLines(Value: TStrings);
    procedure SetSpeedx(Value: Integer);
    procedure SetSpeedy(Value: Integer);
    procedure SetSpReversex(Value: Boolean);
    procedure SetSpReversey(Value: Boolean);
    procedure SetScroll(Value: Boolean);
    procedure TimerAction(Sender: TObject);
    procedure PaintText;

  protected
    { Protected-Deklarationen }

    procedure SetTextWidth;
    procedure DrawGradientV(bmp32: TBitMap32; Color1, Color2: TColor; Rect: TRect; Alpha: Integer; Blend: blendmode);
    procedure DrawGradientH(bmp32: TBitMap32; Color1, Color2: TColor; Rect: TRect; Alpha: Integer; Blend: blendmode);
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure Paint; override;

  public
    { Public-Deklarationen }

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    
  published
    { Published-Deklarationen }
    property TextPosL: Integer read FTextPosFromLeft write SetTextPosFromLeft;
    property TextPosT: Integer read FTextBeginHight write SetTextBeginHight;
    property Color1: TColor read FColor1 write SetColor1;
    property Color2: TColor read FColor2 write SetColor2;
    property PanelColorTop1: TColor read FPanelColorTop1 write SetPanelColorTop1;
    property PanelColorTop2: TColor read FPanelColorTop2 write SetPanelColorTop2;
    property PanelColorBottom1: TColor read FPanelColorBottom1 write SetPanelColorBottom1;
    property PanelColorBottom2: TColor read FPanelColorBottom2 write SetPanelColorBottom2;
    property PanelColorRight1: TColor read FPanelColorRight1 write SetPanelColorRight1;
    property PanelColorRight2: TColor read FPanelColorRight2 write SetPanelColorRight2;
    property PanelColorLeft1: TColor read FPanelColorLeft1 write SetPanelColorLeft1;
    property PanelColorLeft2: TColor read FPanelColorLeft2 write SetPanelColorLeft2;
    property Gradient: gradient read FGradient write SetGradient;
    property ShowPanelTop: Boolean read FShowPanelTop write SetShowPanelTop;
    property ShowPanelLeft: Boolean read FShowPanelLeft write SetShowPanelLeft;
    property ShowPanelRight: Boolean read FShowPanelRight write SetShowPanelRight;
    property ShowPanelBottom: Boolean read FShowPanelBottom write SetShowPanelBottom;
    property Caption: TCaption read FCaption write SetCaption;
    property Lines: TStrings read FLines write SetLines;
    property Speedx: Integer read FSpeedx write SetSpeedx;
    property Speedy: Integer read FSpeedy write SetSpeedy;
    property SpReversex: Boolean read FSpReversex write SetSpReversex;
    property SpReversey: Boolean read FSpReversey write SetSpReversey;
    property Scroll: Boolean read FScroll write SetScroll;
    property ShowBorder: Boolean read FBorder write SetBorder;
    property BorderColor: TColor read FBorderColor write SetBorderColor;

    property Font;
    property Anchors;
    property Action;
    property Align;
    property BiDiMode;
    property DragCursor;
    property DragKind;
    property DragMode;
    property ParentBiDiMode;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;

    property OnClick;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('enemyleft', [TSSText]);
end;

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

 DoubleBuffered := true; // Ohne DoubleBuffer würde das ganz schön flackern!
 Width := 200;
 Height := 100;

 FColor1 := clBtnFace;
 FColor2 := clBtnFace;
 FPanelColorTop1 := clBtnFace;
 FPanelColorTop2 := clBtnFace;
 FPanelColorBottom1 := clBtnFace;
 FPanelColorBottom2 := clBtnFace;
 FPanelColorRight1 := clBtnFace;
 FPanelColorRight2 := clBtnFace;
 FPanelColorLeft1 := clBtnFace;
 FPanelColorLeft2 := clBtnFace;
 FGradient := grNone;
 FShowPanelTop := True;
 FShowPanelLeft := False;
 FShowPanelRight := False;
 FShowPanelBottom := True;
 FBorder := False;
 FBorderColor := clWindowText;

 FLines := TStringList.Create;
 FLines.Add('#enemyleft');
 TextWidth := 100;

 FTextPosFromLeft := 10;
 FTextBeginHight := 20;
 tx := FTextBeginHight;
 ty := FTextPosFromLeft;
 FScroll := False;
 FSpeedx := 1;
 FSpeedy := 0;
 FSpReversex := False;
 FSpReversey := False;

 ScrollTimer := TTimer.Create(Self);
 ScrollTimer.Interval := 100;
 ScrollTimer.OnTimer := TimerAction;
 ScrollTimer.Enabled := FScroll;

 pb := TPaintBox32.Create(Self);
 pb.Parent := Self;
 pb.Width := Width;
 pb.Height := Height;

 bmp32 := TBitmap32.Create;
 bmp32.Width := pb.Width;
 bmp32.Height := pb.Height;
end;

destructor TSSText.Destroy;
begin
 inherited Destroy;
end;

procedure TSSText.DrawGradientV(bmp32: TBitMap32; Color1, Color2: TColor; Rect: TRect; Alpha: Integer; Blend: blendmode);
var
 i, R, G, B: Integer;
 blender: Integer;
 col32: TColor32;
begin

 blender := 255 div (Rect.Right - Rect.Left);

 Color1 := ColorToRGB(Color1);
 Color2 := ColorToRGB(Color2);

 for i := 0 to (Rect.Right - Rect.Left) - 1 do
 begin

  R := GetRValue(Color1) - (((GetRValue(Color1) - GetRValue(Color2)) * I) DIV (Rect.Right - Rect.Left));
  G := GetGValue(Color1) - (((GetGValue(Color1) - GetGValue(Color2)) * I) DIV (Rect.Right - Rect.Left));
  B := GetBValue(Color1) - (((GetBValue(Color1) - GetBValue(Color2)) * I) DIV (Rect.Right - Rect.Left));

  col32 := Color32(R,G,B,Alpha);
  bmp32.LineAs(Rect.Left + I, Rect.Top, Rect.Left + I, Rect.Bottom, col32);

  if Blend = bmIn then
  begin
    Alpha := Alpha - blender;
    if Alpha < 0 then
      Alpha := 0;
  end
  else if Blend = bmOut then
  begin
    Alpha := Alpha + blender;
    if Alpha > 255 then
      Alpha := 255;
  end;
 end;
end;

procedure TSSText.DrawGradientH(bmp32: TBitMap32; Color1, Color2: TColor; Rect: TRect; Alpha: Integer; Blend: blendmode);
var
 i, R, G, B: Integer;
 blender: Integer;
 col32: TColor32;
begin

 blender := 255 div (Rect.Bottom - Rect.Top);

 Color1 := ColorToRGB(Color1);
 Color2 := ColorToRGB(Color2);

 for i := 0 to (Rect.Bottom - Rect.Top) - 1 do
 begin

  R := GetRValue(Color1) - (((GetRValue(Color1) - GetRValue(Color2)) * I) DIV (Rect.Bottom - Rect.Top));
  G := GetGValue(Color1) - (((GetGValue(Color1) - GetGValue(Color2)) * I) DIV (Rect.Bottom - Rect.Top));
  B := GetBValue(Color1) - (((GetBValue(Color1) - GetBValue(Color2)) * I) DIV (Rect.Bottom - Rect.Top));

  col32 := Color32(R,G,B,Alpha);
  bmp32.LineAs(Rect.Left, Rect.Top + I, Rect.Right, Rect.Top + I, col32);

  if Blend = bmIn then
  begin
    Alpha := Alpha - blender;
    if Alpha < 0 then
      Alpha := 0;
  end
  else if Blend = bmOut then
  begin
    Alpha := Alpha + blender;
    if Alpha > 255 then
      Alpha := 255;
  end;
 end;
end;

procedure TSSText.TimerAction(Sender: TObject);
begin
  // move text up / down
  if not FSpReverseX then
  begin
    if tx <= 0 - Canvas.TextHeight(FLines.Strings[0]) * FLines.Count then
      tx := Height;
    tx := tx - FSpeedx
  end
  else
  begin
    if tx >= Height then
      tx := 0 - Canvas.TextHeight(FLines.Strings[0]) * FLines.Count;
    tx := tx + FSpeedx
  end;
  // move text left / right
  if not FSpReverseY then
  begin
    if ty >= Width then
      ty := 0 - TextWidth;
    ty := ty + FSpeedy
  end
  else
  begin
    if ty <= 0 - TextWidth then
      ty := Width;
    ty := ty - FSpeedy
  end;
  // repaint
  Repaint;
end;

procedure TSSText.PaintText;
var
  I: Integer;
begin
  if FLines.Count > 0 then
  begin
    bmp32.Canvas.Font.Assign(Font);
    bmp32.Canvas.Brush.Style := bsClear;
    for I := 0 to FLines.Count -1 do
      bmp32.Canvas.TextOut(ty, tx + bmp32.Canvas.TextHeight(FLines.Strings[0]) * I, FLines.Strings[I]);
  end;
end;

procedure TSSText.Paint;
var
  Rect1,Rect2,Rect3,Rect4,Rect5: TRect;
begin

  pb.width := Width;
  pb.Height := Height;

  bmp32.Width := pb.Width;
  bmp32.Height := pb.Height;

  // übergabeparameter Rect bereitstellen,
  // wenn Verlauf ausgewählt
  if Gradient <> grNone then
  begin
   Rect1.Left := 0;
   Rect1.Top := 0;
   Rect1.Right := Width;
   Rect1.Bottom := height;
   // Verlauf herstellen
   if (FGradient = grTopToBottom) then
     DrawGradientH(bmp32, FColor1, FColor2, Rect1, 255, bmNone)
   else if (FGradient = grLeftToRight) then
     DrawGradientV(bmp32, FColor1, FColor2, Rect1, 255, bmNone)
  end
  else
  begin
   bmp32.Canvas.Pen.Color := FColor1;
   bmp32.Canvas.Brush.Style := bsSolid;
   bmp32.Canvas.Brush.Color := FColor1;
   bmp32.Canvas.Rectangle(0,0,Width,Height);
  end;

  {panel gradient for blending: TOP}
  with Rect2 do
  begin
    Left := 0;
    Top := 0;
    Right := Width;
    Bottom := 51;
  end;
  {panel gradient for blending: BOTTOM}
  with Rect3 do
  begin
    Left := 0;
    Top := Height-51;
    Right := Width;
    Bottom := Height;
  end;
  {panel gradient: LEFT}
  with Rect4 do
  begin
    Left := 0;
    Top := 0;
    Right := 51;
    Bottom := Height;
  end;
  {panel gradient: RIGHT}
  with Rect5 do
  begin
    Left := Width-51;
    Top := 0;
    Right := Width;
    Bottom := Height;
  end;

  PaintText;

  {TOP blending}
  if FShowPanelTop then
    DrawGradientH(bmp32, FPanelColorTop1, FPanelColorTop2, Rect2, 255, bmIn);
  {BOTTOM blending}
  if FShowPanelBottom then
    DrawGradientH(bmp32, FPanelColorBottom1, FPanelColorBottom2, Rect3, 0, bmOut);
  {LEFT panel}
  if FShowPanelLeft then
    DrawGradientV(bmp32, FPanelColorLeft1, FPanelColorLeft2, Rect4, 255, bmIn);
  {RIGHT panel}
  if FShowPanelRight then
    DrawGradientV(bmp32, FPanelColorRight1, FPanelColorRight2, Rect5, 0, bmOut);

  // Rand Zeichnen
  if (FBorder) then
  begin
   bmp32.Canvas.Pen.Color := ColorToRGB(FBorderColor);
   bmp32.Canvas.Brush.Style := bsClear;
   bmp32.Canvas.Rectangle(0,0,Width,Height);
  end;

  pb.Buffer.Assign(bmp32);

end;

procedure TSSText.SetTextWidth;
var
  I: Integer;
begin
  for I := 0 to Lines.Count - 1 do
    if TextWidth < Canvas.TextWidth(FLines.Strings[I]) then
      TextWidth := Canvas.TextWidth(FLines.Strings[I]);
end;

procedure TSSText.SetColor1(Value: TColor);
begin
 if (FColor1 <> Value) then
 begin
  FColor1 := Value;
  RePaint;
 end;
end;

procedure TSSText.SetPanelColorTop1(Value: TColor);
begin
 if (FPanelColorTop1 <> Value) then
 begin
  FPanelColorTop1 := Value;
  RePaint;
 end;
end;

procedure TSSText.SetPanelColorTop2(Value: TColor);
begin
 if (FPanelColorTop2 <> Value) then
 begin
  FPanelColorTop2 := Value;
  RePaint;
 end;
end;

procedure TSSText.SetPanelColorBottom1(Value: TColor);
begin
 if (FPanelColorBottom1 <> Value) then
 begin
  FPanelColorBottom1:= Value;
  RePaint;
 end;
end;

procedure TSSText.SetPanelColorBottom2(Value: TColor);
begin
 if (FPanelColorBottom2 <> Value) then
 begin
  FPanelColorBottom2:= Value;
  RePaint;
 end;
end;
procedure TSSText.SetColor2(Value: TColor);
begin
 if (FColor2 <> Value) then
 begin
  FColor2 := Value;
  RePaint;
 end;
end;

procedure TSSText.SetGradient(Value: gradient);
begin
 if (FGradient <> Value) then
 begin
  FGradient := Value;
  RePaint;
 end;
end;

procedure TSSText.CMTextChanged(var Message: TMessage);
begin
 FCaption := Name;
end;

procedure TSSText.SetCaption(Value: TCaption);
begin
 if (FCaption <> Value) then
 begin
  FCaption := Value;
  RePaint;
 end;
end;

procedure TSSText.SetBorder(Value: Boolean);
begin
 if (FBorder <> Value) then
 begin
  FBorder := Value;
  RePaint;
 end;
end;

procedure TSSText.SetBorderColor(Value: TColor);
begin
 if (FBorderColor <> Value) then
 begin
  FBorderColor := Value;
  RePaint;
 end;
end;

procedure TSSText.SetLines(Value: TStrings);
begin
  if (FLines <> Value) then
  begin
    FLines.Assign(Value);
    SetTextWidth;
    RePaint;
  end;
end;

procedure TSSText.SetSpeedx(Value: Integer);
begin
  if (FSpeedx <> Value) then
    FSpeedx := Value;
end;

procedure TSSText.SetSpeedy(Value: Integer);
begin
  if (FSpeedy <> Value) then
    FSpeedy := Value;
end;

procedure TSSText.SetScroll(Value: Boolean);
begin
  if (FScroll <> Value) then
  begin
    FScroll := Value;
    ScrollTimer.Enabled := FScroll;
  end;
end;

procedure TSSText.SetPanelColorRight1(Value: TColor);
begin
  if (FPanelColorRight1 <> Value) then
  begin
    FPanelColorRight1 := Value;
    Repaint;
  end;
end;

procedure TSSText.SetPanelColorRight2(Value: TColor);
begin
  if (FPanelColorRight2 <> Value) then
  begin
    FPanelColorRight2 := Value;
    Repaint;
  end;
end;

procedure TSSText.SetPanelColorLeft1(Value: TColor);
begin
  if (FPanelColorLeft1 <> Value) then
  begin
    FPanelColorLeft1 := Value;
    Repaint;
  end;
end;

procedure TSSText.SetPanelColorLeft2(Value: TColor);
begin
  if (FPanelColorLeft2 <> Value) then
  begin
    FPanelColorLeft2 := Value;
    Repaint;
  end;
end;

procedure TSSText.SetShowPanelTop(Value: Boolean);
begin
  if (FShowPanelTop <> Value) then
  begin
    FShowPanelTop := Value;
    Repaint;
  end;
end;

procedure TSSText.SetShowPanelLeft(Value: Boolean);
begin
  if (FShowPanelLeft <> Value) then
  begin
    FShowPanelLeft := Value;
    Repaint;
  end;
end;

procedure TSSText.SetShowPanelRight(Value: Boolean);
begin
  if (FShowPanelRight <> Value) then
  begin
    FShowPanelRight := Value;
    Repaint;
  end;
end;

procedure TSSText.SetShowPanelBottom(Value: Boolean);
begin
  if (FShowPanelBottom <> Value) then
  begin
    FShowPanelBottom := Value;
    Repaint;
  end;
end;

procedure TSSText.SetTextPosFromLeft(Value: Integer);
begin
  if (FTextPosFromLeft <> Value) then
  begin
    FTextPosFromLeft := Value;
    Repaint;
  end;
end;

procedure TSSText.SetTextBeginHight(Value: Integer);
begin
  if (FTextBeginHight <> Value) then
  begin
    FTextBeginHight := Value;
    tx := FTextBeginHight;
    Repaint;
  end;
end;

procedure TSSText.SetSpReversex(Value: Boolean);
begin
  if (FSpReverseX <> Value) then
    FSpReverseX := Value;
end;

procedure TSSText.SetSpReversey(Value: Boolean);
begin
  if (FSpReverseY <> Value) then
    FSpReverseY := Value;
end;

end.