dxwscrollunit.pas

Delphi Engine for games.

unit DXWScrollUnit;

interface
uses
  Windows,Classes,Graphics,Controls,Forms,ExtCtrls,SysUtils,
  DXClass, DXDraws ,DXWStatObj;

//only for Vertical Scroll yet
Type
TDXWScroll = class (TDXWObject)
 Private
    FImage        : TPictureCollectionItem;
    FBtn1Image    : TPictureCollectionItem;
    FBtn2Image    : TPictureCollectionItem;
    FThumbImage   : TPictureCollectionItem;
    FSurface      : TDirectDrawSurface;
    FBtn1         : TDXWButton;
    FBtn2         : TDXWButton;
    FThumb        : TDXWImageObject;
    ScrollingRect : TRect;

    FMax          : integer;
    FMin          : integer;
    FPosition     : integer;

    FObjectList   : TDXWObjectList;

    FOnChange     : TNotifyEvent;

    procedure SetSurface(Value: TDirectDrawSurface);

    //Procedure MoveScrollUp(Sender : TObject);
    //Procedure MoveScrollDown(Sender : TObject);

    Procedure Change;

    Procedure CorrectThumbPosition;

    procedure SetBtn1Image(const Value: TPictureCollectionItem);
    procedure SetBtn2Image(const Value: TPictureCollectionItem);
    procedure SetThumbImage(const Value: TPictureCollectionItem);
    procedure SetImage(const Value: TPictureCollectionItem);
    function  GetPosition: integer;
    procedure SetPosition(const Value: integer);

 Protected
    Procedure DoDraw;override;
    function  GetDrawImageIndex: Integer;virtual;
    procedure SetBounds;override;
    procedure SetMouseInControl(const Value: Boolean);override;

    Procedure MouseUp(Button: TMouseButton;Shift:TShiftState;X,Y:Integer);override;
    Procedure MouseDown(Button: TMouseButton;Shift:TShiftState;X,Y:Integer);override;
    Procedure MouseMove(Shift:TShiftState;X,Y:Integer);override;

 Public
    Constructor Create(AOwner : TObject);override ;
    Destructor  Destroy;override;

    property Image      : TPictureCollectionItem read FImage write SetImage;
    property Btn1Image  : TPictureCollectionItem read FBtn1Image write  SetBtn1Image;
    property Btn2Image  : TPictureCollectionItem read FBtn2Image write  SetBtn2Image;
    property ThumbImage : TPictureCollectionItem read FThumbImage write SetThumbImage;

    property Surface : TDirectDrawSurface read FSurface write SetSurface;

    property Max : integer read FMax write FMax;
    property Min : integer read FMin write FMin;
    property Position : integer read GetPosition write SetPosition;

    property OnChange : TNotifyEvent read FOnChange write FOnChange;

end;

implementation

Uses Pathes;

/////////////////////////////////////////////////////////////
Constructor TDXWScroll.Create(AOwner : TObject);
begin
 inherited;// Create(AOwner);
 MouseCaptured:=true;
 FObjectList:=TDXWObjectList.Create;

 FBtn1 :=TDXWButton.Create(Self);
 FBtn2 :=TDXWButton.Create(Self);
 FThumb:=TDXWImageObject.Create(Self);
 FThumb.MouseCaptured:=true;

 FObjectList.Add(FBtn1);
 FObjectList.Add(FBtn2);
 FObjectList.Add(FThumb);
 FMax:=100;
end;

procedure TDXWScroll.DoDraw;
Var
ImageIndex : integer;
begin;
if Not Visible then Exit;
ImageIndex := GetDrawImageIndex;
Image.Draw( FSurface, Left, Top, ImageIndex);

FObjectList.DoDraw;
end;


Destructor  TDXWScroll.Destroy;
begin
 FObjectList.Free;
 inherited Destroy;
end;

Procedure TDXWScroll.MouseUp(Button: TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
 inherited;// MouseUp(Button,Shift,X,Y);
 FObjectList.MouseUp(Button,Shift,X,Y);
end;

Procedure TDXWScroll.MouseDown(Button: TMouseButton;Shift:TShiftState;X,Y:Integer);
begin
 inherited;// MouseDown(Button,Shift,X,Y);
 FObjectList.MouseDown(Button,Shift,X,Y);
end;

Procedure TDXWScroll.MouseMove(Shift:TShiftState;X,Y:Integer);
Var
OldTop : integer;
begin
 inherited;// MouseMove(Shift,X,Y);
 FObjectList.MouseMove(Shift,X,Y);

 if ( FThumb.Down )and( ssLeft in Shift )then
  begin
   OldTop:=FThumb.Top;

   FThumb.Top:=Y-FThumb.dClickedPoint.y;
   CorrectThumbPosition;

   if FThumb.Top<>OldTop then Change;
  end;

end;

Procedure TDXWScroll.Change;
begin
 if Assigned(FOnChange) then FOnChange(Self);
end;


procedure TDXWScroll.SetSurface(Value: TDirectDrawSurface);
begin
 FSurface := Value;
 FBtn1.Surface:=Value;
 FBtn2.Surface:=Value;
 FThumb.Surface:=Value;

end;

procedure TDXWScroll.SetBtn1Image(const Value: TPictureCollectionItem);
begin
 FBtn1Image := Value;
 FBtn1.Image:=Value;

end;

procedure TDXWScroll.SetBtn2Image(const Value: TPictureCollectionItem);
begin
 FBtn2Image := Value;
 FBtn2.Image:= Value;
end;

procedure TDXWScroll.SetThumbImage(const Value: TPictureCollectionItem);
begin
 FThumbImage := Value;
 FThumb.Image:= Value;
end;

procedure TDXWScroll.SetBounds;
begin
 inherited;

 FBtn1.Left:=Left;
 FBtn1.Top:=Top;

 FBtn2.Left:=Left;
 FBtn2.Top:=Top+Height-FBtn2.Height;

 FThumb.Left:=Left;
 FThumb.Top:=Top+FBtn1.Height;

 ScrollingRect:=Bounds(Left,Top+FBtn1.Height,Width,Height-FBtn1.Height-FBtn2.Height-FThumb.Height);
end;

function TDXWScroll.GetDrawImageIndex: Integer;
begin
Result:=0;
end;

procedure TDXWScroll.SetImage(const Value: TPictureCollectionItem);
begin
  FImage := Value;
  Width:=Value.Width;
  Height:=Value.Height;
end;

procedure TDXWScroll.SetMouseInControl(const Value: Boolean);
Var
 i : integer;
begin
 inherited;

 if Not MouseInControl then
 For i:=0 to FObjectList.Count-1 do
  FObjectList.Items[i].MouseInControl:=false;

end;

procedure TDXWScroll.CorrectThumbPosition;
begin
if FThumb.Top>ScrollingRect.Bottom
 then FThumb.Top:=ScrollingRect.Bottom;

if FThumb.Top<ScrollingRect.Top
 then FThumb.Top:=ScrollingRect.Top;
end;

function TDXWScroll.GetPosition: integer;
Var
 ThumbRange : integer;
 PosRange   : integer;
 PosShift   : integer;
 ThumbShift : integer;
begin
 ThumbRange:=ScrollingRect.Bottom-ScrollingRect.Top;
 PosRange:=FMax-FMin;
 ThumbShift:=FThumb.Top-Top-FBtn1.Height;
 PosShift:=Trunc(ThumbShift*(PosRange/ThumbRange));
 Result:=FMin+PosShift;
end;

procedure TDXWScroll.SetPosition(const Value: integer);
Var
 ThumbRange : integer;
 PosRange   : integer;
 PosShift   : integer;
 ThumbShift : integer;
begin
 if Position=Value then Exit;

 ThumbRange:=ScrollingRect.Bottom-ScrollingRect.Top;
 PosRange:=FMax-FMin;
 PosShift:=Value-FMin;
 ThumbShift:=Trunc(PosShift*(ThumbRange/PosRange));
 FThumb.Top:=Top+FBtn1.Height+ThumbShift;
end;

end.