(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTImageScroller;

interface

uses
  SysUtils,Windows, Messages, Classes, Graphics, Controls,
  AHMEnhancedClass,AHMControls;

type
  TAHMImageScroller = class(TAHMGraphicControl)
  private
    FColor:TColor;
    f3d : TAHMFont3D;
    FParentColor:Boolean;
    FTextWindowLeft:integer;
    FTextWindowTop:integer;
    FTextToCenter:Boolean;
    FText:string;
    FBitmap:TBitmap;
    FTextBitmap:TBitmap;
    FTimer:TAHMEnhancedTimer32;
    FXPos,FYPos:Integer;
    FAHMAboutStr : TAHMAboutEnhancedStr;
    FMemoryWidth,FMemoryHeight:Integer;
    FScrollDirection:TAHMKind;
    FScrollInterval:Integer;
    FScrollStep : Byte;
    FScrolling : Boolean;
    FScrollInverse:Boolean;
    FMemoryBmp:TBitmap;
    FAlreadyIniMemoryBmp:Boolean;
    FAlreadyIniTextMemoryBmp:Boolean;
    FAutoSize:Boolean;
    FParentCenter:Boolean;
    procedure SetBitmap(Value:TBitmap);
    procedure MoveImage(Sender:TObject);
    procedure SetScrollDirection(Value:TAHMKind);
    procedure SetScrollInterval(Value:Integer);
    procedure SetAutoSize(Value:Boolean);
    procedure SetParentCenter(Value:Boolean);
    procedure SetText(Value:string);
    procedure IniMemoryBmp;
    procedure IniTextMemoryBmp;
    procedure SetTextBitmap;
    function  GetColor:TColor;
    procedure SetColor(Value:TColor);
    procedure CMFontChanged(var Message:TMessage); message CM_FONTCHANGED;
    procedure SetParentColor(Value:Boolean);
    procedure SetTextWindowLeft(Value:Integer);
    procedure SetTextWindowTop(Value:Integer);
    procedure SetTextToCenter(Value:Boolean);
    procedure SetScrolling(value : boolean);
    procedure Set3D(value : TAHMFont3D);
  protected
    procedure Paint;override;
  public
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure Loaded;override;
  published
    property About : TAHMAboutEnhancedStr read FAHMAboutStr write FAHMAboutStr stored False;
    property Width default 100;
    property Height default 100;
    property Align;
    property ParentColor read FParentColor write SetParentColor default True;
    property Color read GetColor write SetColor default clbtnface;
    property Font;
    Property Scrolling : Boolean read fscrolling write SetScrolling default False;
    property Text:string read FText write SetText;
    property Bitmap:TBitmap read FBitmap write SetBitmap;
    property AutoSize:Boolean read FAutoSize write SetAutoSize default False;
    property ScrollDirection:TAHMKind read FScrollDirection write SetScrollDirection
               default kHorizontal;
    property ScrollInterval : Integer read FScrollInterval write SetScrollInterval
               default 50;
    property ScrollStep:Byte read FScrollStep write FScrollStep default 1;
    property ScrollInverse:Boolean read FScrollInverse write FScrollInverse default False;
    property Font3D  : TAHMFont3D read f3d write set3d stored true;
    property Visible;
    property ShowHint;
    property ParentShowHint;
    property ParentCenter:Boolean read FParentCenter write SetParentCenter default False;
    property TextWindowLeft:integer read FTextWindowLeft write SetTextWindowLeft default 10;
    property TextWindowTop:integer read FTextWindowTop write SetTextWindowTop default 10;
    property TextToCenter:Boolean read FTextToCenter write SetTextToCenter default True;
    property PopupMenu;
    property Tag;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;
implementation


constructor TAHMImagescroller.Create(AOwner:TComponent);
begin
   inherited Create(AOwner);
   f3d:=TAHMFont3D.create(Self);
   ControlStyle := ControlStyle + [csFramed, csOpaque];
   FBitmap:=TBitmap.Create;
   FTextBitmap:=TBitmap.Create;
   fscrolling:=false;
   FTimer:=TAHMEnhancedTimer32.Create;
   FScrollInterval:=50;
   FTimer.Interval:=FScrollInterval;
   FTimer.Enabled:=Fscrolling;
   FTimer.OnTimer:=MoveImage;
   Width:=100;
   Height:=100;
   FXPos:=0;
   FYPos:=0;
   FScrollDirection:=kHorizontal;
   FScrollStep:=1;
   FScrollInverse:=False;
   FMemoryBmp:=TBitmap.Create;
   FAlreadyIniMemoryBmp:=False;
   FAlreadyIniTextMemoryBmp:=False;
   FAutoSize:=False;
   FParentCenter:=False;
   FColor:=clbtnface;
   FParentColor:=True;
   FTextWindowLeft:=10;
   FTextWindowTop:=10;
   FTextToCenter:=True;
end;


destructor TAHMImagescroller.Destroy;
begin
  F3d.free;
  ftimer.free;
  FBitmap.Free;
  FTextBitmap.Free;
  FMemoryBmp.Free;
  inherited Destroy;
end;


procedure TAHMImagescroller.Loaded;
begin
  inherited Loaded;
  if (FTextToCenter) and (Text<>'') then SetTextToCenter(True);
  if Text<>'' then SetTextBitmap;
  if not FBitmap.Empty then IniMemoryBmp;
end;

procedure TAHMImagescroller.SetBitmap(Value:TBitmap);
begin
  FBitmap.Assign(Value);
  IniMemoryBmp;
  Repaint;
end;

procedure TAHMImagescroller.SetTextBitmap;
var frect,rs : Trect;
begin
  rs:=rect(0,0,width,height);
  FTextBitmap.Width:=Width;
  FTextBitmap.Height:=Height;
  FTextBitmap.Canvas.Brush.Color:=Color;
  frect:=Rect(0,0,FTextBitmap.Width,FTextBitmap.Height);
  FTextBitmap.Canvas.FillRect(frect);
  f3d.write(Font,FTextBitmap.Canvas.handle,
            frect,FText,DT_CENTER or DT_VCENTER or DT_SINGLELINE,enabled);
  IniTextMemoryBmp;
end;

procedure TAHMImagescroller.SetText(Value:string);
begin
  FText:=Value;
  if (FTextToCenter) then SetTextToCenter(True);
  SetTextBitmap;
  Invalidate;
end;

procedure TAHMImagescroller.SetColor(Value:TColor);
begin
  if (Value<>FColor) then
  begin
    FColor:=Value;
    ParentColor:=False;
    SetTextBitmap;
    Invalidate
  end
end;

procedure TAHMImagescroller.Set3d(Value:TAHMFont3D);
begin
  F3d:=Value;
  SetTextBitmap;
  Invalidate;
end;

function TAHMImagescroller.GetColor:TColor;
begin
  if ParentColor then
  begin
    if FColor<>Parent.Brush.Color then FColor:=Parent.Brush.Color;
    Result:=Parent.Brush.Color
  end else Result:=FColor;
end;

procedure TAHMImagescroller.SetParentColor(Value:Boolean);
begin
  if (Value<>FParentColor) then
  begin
    FParentColor:=Value;
    if FParentColor then Color:=Parent.Brush.Color;
  end
end;

procedure TAHMImagescroller.CMFontChanged(var Message:TMessage);
begin
  inherited;
  if (Text<>'') then
  begin
    if (FTextToCenter) then SetTextToCenter(True);
    SetTextBitmap;
    Invalidate
  end
end;

procedure TAHMImagescroller.IniTextMemoryBmp;
begin
   if (FTextBitmap.Empty or (Text=''))then exit;
   FAlreadyIniTextMemoryBmp:=True;
   FAlreadyIniMemoryBmp:=False;
   FMemoryBmp.Canvas.brush.style:=bsclear;
   if AutoSize and (Align=alNone) then
      SetBounds(Left,Top,FTextBitmap.Width,FTextBitmap.Height);
   FMemoryBmp.Width:=FTextBitmap.Width;
   FMemoryBmp.Height:=FTextBitmap.Height;
   FMemoryBmp.Canvas.Draw(0,0,FTextBitmap);
   FMemoryWidth:=FTextBitmap.Width;
   FMemoryHeight:=FTextBitmap.Height;
end;

procedure TAHMImagescroller.IniMemoryBmp;
var
   OldPos,I:Integer;
   HorizontalCount:Integer;
begin
   if FBitmap.Empty then exit;
   FAlreadyIniMemoryBmp:=True;
   FAlreadyIniTextMemoryBmp:=False;
   if AutoSize and (Align=alNone) then
      SetBounds(Left,Top,FBitmap.Width,FBitmap.Height);
   FMemoryBmp.Width:=FBitmap.Width;
   FMemoryBmp.Height:=FBitmap.Height;
   FMemoryBmp.Canvas.brush.style:=bsclear;
   FMemoryBmp.Canvas.Draw(0,0,FBitmap);
   HorizontalCount:=1;
   while (FMemoryBmp.Width<Width) do
      begin
         OldPos:=FMemoryBmp.Width;
         Inc(HorizontalCount);
         FMemoryBmp.Width:=FMemoryBmp.Width+FBitmap.Width;
         FMemoryBmp.Canvas.Draw(OldPos,0,FBitmap);
      end;
   while (FMemoryBmp.Height<Height) do
      begin
         OldPos:=FMemoryBmp.Height;
         FMemoryBmp.Height:=FMemoryBmp.Height+FBitmap.Height;
         for I:=1 to HorizontalCount do
            FMemoryBmp.Canvas.Draw(FBitmap.Width*(I-1),OldPos,FBitmap);
      end;
   FMemoryWidth:=FMemoryBmp.Width;
   FMemoryHeight:=FMemoryBmp.Height;
end;

procedure TAHMImagescroller.Paint;
var
   PaintBmp:TBitmap;
   DestRect,SourceRect:TRect;
begin
   if (FBitmap.Empty and (Text='')) then exit;
   if (((not FAlreadyIniTextMemoryBmp) and FBitmap.Empty) or (csDesigning in ComponentState)) then
   if (Text<>'') then
   begin
     if (FTextToCenter) then SetTextToCenter(True);
     SetTextBitmap
   end;
   if ((not FAlreadyIniMemoryBmp) or (csDesigning in ComponentState)) then
   if not FBitmap.Empty then IniMemoryBmp;
   PaintBmp:=TBitmap.Create;
   PaintBmp.Width:=Width;
   PaintBmp.Height:=Height;
   Paintbmp.canvas.brush.style:=bsclear;
   PaintBmp.Canvas.CopyMode:=cmSrcCopy;
   if (ScrollDirection=kHorizontal) then
   begin
     if (FMemoryBmp.Width-FXPos)>=PaintBmp.Width then
     begin
       PaintBmp.Canvas.copyrect(Rect(0,0,Width,Height),FMemoryBmp.canvas,
                Rect(FXPos,FYPos,FXPos+Width,FYPos+Height));
     end
     else
     begin
       PaintBmp.Canvas.copyrect(Rect(0,0,FMemoryBmp.Width-FXPos,Height),FMemoryBmp.canvas,
             Rect(FXPos,0,FMemoryBmp.Width,Height));
       PaintBmp.Canvas.copyrect(Rect(FMemoryBmp.Width-FXPos,0,Width,Height),FMemoryBmp.canvas,
             Rect(0,FYPos,Width-(FMemoryBmp.Width-FXPos),FYPos+Height));
     end;
   end
   else      { for ScrollDirection=sdVertical }
   begin
     if (FMemoryBmp.Height-FYPos)>=PaintBmp.Height then
     begin
       PaintBmp.Canvas.copyrect(Rect(0,0,Width,Height),FMemoryBmp.canvas,
           Rect(FXPos,FYPos,FXPos+Width,FYPos+Height));
     end
     else
     begin
       PaintBmp.Canvas.Copyrect(Rect(0,0,Width,FMemoryBmp.Height-FYPos),FMemoryBmp.canvas,
           Rect(0,FYPos,Width,FMemoryBmp.Height));
       PaintBmp.Canvas.Copyrect(Rect(0,FMemoryBmp.Height-FYPos,Width,Height),FMemoryBmp.canvas,
           Rect(0,0,Width,Height-(FMemoryBmp.Height-FYPos)));
     end;
   end;
   SourceRect:=Rect(0,0,Width,Height);
   DestRect:=Rect(0,0,Width,Height);
   Canvas.brush.style:=bsclear;
   Canvas.CopyMode:=cmsrccopy;
   Canvas.copyrect(destRect,Paintbmp.canvas,sourceRect);
   PaintBmp.Free;
end;

procedure TAHMImagescroller.SetAutoSize(Value:Boolean);
begin
   if (Value<>FAutoSize) then
      begin
         FAutoSize:=Value;
         IniMemoryBmp;
         Invalidate;
      end
end;

procedure TAHMImagescroller.MoveImage(Sender:TObject);
begin
  if (Bitmap.Empty and (Text='')) then exit;
  if (ScrollDirection=kHorizontal) then
  begin
    if (FScrollInverse) then
    begin
      FXPos:=FXPos-ScrollStep;
      while FXPos<0 do FXPos:=FXPos+FMemoryWidth
    end else
    begin
      FXPos:=FXPos+ScrollStep;
      while FXPos>FMemoryWidth do FXPos:=FXPos-FMemoryWidth
    end
  end else
  begin
    if (FScrollInverse) then
    begin
      FYPos:=FYPos-ScrollStep;
      while FYPos<0 do FYPos:=FYPos+FMemoryHeight
    end else
    begin
      FYPos:=FYPos+ScrollStep;
      while FYPos>FMemoryHeight do FYPos:=FYPos-FMemoryHeight
    end
  end;
  Repaint;
end;

procedure TAHMImagescroller.SetScrollDirection(Value:TAHMKind);
begin
  if (Value<>FScrollDirection) then
  begin
    FScrollDirection:=Value;
    FXPos:=0;
    FYPos:=0;
    Repaint;
  end;
end;

procedure TAHMImagescroller.SetScrollInterval(Value:Integer);
begin
  if (Value<>ScrollInterval) then
  begin
    FScrollInterval:=Value;
    FTimer.Interval:=FScrollInterval;
  end;
end;

procedure TAHMImagescroller.SetScrolling(Value:Boolean);
begin
  if (Value<>FScrolling) then
  begin
    FScrolling:=Value;
    FTimer.Enabled:=Value;
  end
end;

procedure TAHMImagescroller.SetParentCenter(Value:Boolean);
begin
  if (Value<>FParentCenter) then
  begin
    FParentCenter:=Value;
    if (FParentCenter) then
    begin
      if Width<=Parent.ClientWidth then
         Left:=(Parent.ClientWidth-Width) div 2;
      if Height<=Parent.ClientHeight then
         Top:=(Parent.ClientHeight-Height) div 2;
    end;
  end;
end;

procedure TAHMImagescroller.SetTextWindowLeft(Value:integer);
begin
  if (Value<>FTextWindowLeft) and (Value>=0) then
  begin
    FTextWindowLeft:=Value;
    FTextToCenter:=False;
    SetTextBitmap;
    Invalidate
  end;
end;

procedure TAHMImagescroller.SetTextWindowTop(Value:integer);
begin
  if (Value<>FTextWindowTop) and (Value>=0) then
  begin
    FTextWindowTop:=Value;
    FTextToCenter:=False;
    SetTextBitmap;
    Invalidate
  end;
end;

procedure TAHMImagescroller.SetTextToCenter(Value:Boolean);
var
   MsgWidth,MsgHeight:Integer;
begin
  FTextToCenter:=Value;
  if (Text<>'') then
  begin
    Canvas.Font.Assign(Font);
    {for calculation of TextWidth & TextHeight}
     MsgWidth:=Canvas.TextWidth(Text);
     MsgHeight:=Canvas.TextHeight(Text);
     if MsgWidth<=Width then FTextWindowLeft:=(Width-MsgWidth) div 2;
     if MsgHeight<=Height then FTextWindowTop:=(Height-MsgHeight) div 2;
  end;
end;

end.
