STSCROLL

Top  Previous  Next

unit Stscroll;

 

interface

 

uses

SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,

Forms, Dialogs, StdCtrls, stmap16w, Almtype;

 

type

TStScrollBar = class(TScrollBar)

private

  FStellaMap    : TStMapW;

  procedure SeTStMapW(Value:TStMapW);

protected

   Fpos : integer;

   procedure Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);override;

   procedure Notification(AComponent: TComponent;

    Operation: TOperation); override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  property StellaMapSource: TStMapW read FStellaMap write SeTStMapW;

end;

 

Var

StScrollBar : TStScrollBar;

stm: TStMapW;

 

implementation

 

constructor TStScrollBar.Create(AOwner:TComponent);

begin

   stm:=nil;

   FStellaMap:=nil;

   Position := (Max - Min) div 2;

   Fpos := Position;

   inherited Create(AOwner);

end;

 

destructor TStScrollBar.Destroy;

begin

   inherited Destroy;

end;

 

procedure TStScrollBar.SeTStMapW(Value:TStMapW);

begin

   FStellaMap:=Value;

   stm := FStellaMap;

   Position := (Max - Min) div 2;

   Fpos := Position;

end;

 

procedure TStScrollBar.Scroll(ScrollCode: TScrollCode; var ScrollPos: Integer);

var el: real;

begin

If Stm<>nil then begin

   el:=100/stm.nagyitas;

Case Kind of

sbHorizontal :

   Case ScrollCode of

   scLineDown :  stm.eltolas(elLeft);

   scPageDown :  stm.eltolas(elLeft);

   scLineUp   :  stm.eltolas(elRight);

   scPageUp   :  stm.eltolas(elRight);

   scTrack    :  stm.origox:=stm.origox + el*(ScrollPos-FPos);

   end;

sbVertical :

   Case ScrollCode of

   scLineDown :  stm.eltolas(elDown);

   scPageDown :  stm.eltolas(elDown);

   scLineUp   :  stm.eltolas(elUp);

   scPageUp   :  stm.eltolas(elUp);

   scTrack    :  stm.origoy:=stm.origoy - el*(ScrollPos-FPos);

   end;

end;

end;

FPos := ScrollPos;

inherited Scroll(ScrollCode, ScrollPos);

end;

 

procedure TStScrollBar.Notification(AComponent: TComponent;

Operation: TOperation);

begin

inherited Notification(AComponent, Operation);

if (Operation = opRemove) and (AComponent = StellaMapSource)

then StellaMapSource := nil;

end;

 

end.