MGSCALE

Top  Previous  Next

unit MgScale;

 

interface

 

{$IFDEF WIN32}

uses Windows, Messages, Classes, Graphics, Forms, Controls, ExtCtrls;

{$ELSE}

uses WinTypes, Messages, Classes, Graphics, Forms, Controls, ExtCtrls;

{$ENDIF}

 

type

TMgScale = class(TCustomControl)

private

  FMG : integer;

  FMinMG : integer;

  FMaxMG : integer;

  FScaleIncrement : integer;

  FScaleVisible : boolean;

  FBaseColor : TColor;

  FStarColor : TColor;

  FScaleFont : TFont;

  procedure SetMinMG(Value:integer);

  procedure SetMaxMG(Value:integer);

  procedure SetScaleIncrement(Value:integer);

  procedure SetScaleVisible(Value:boolean);

  procedure SetBaseColor(Value:TColor);

  procedure SetStarColor(Value:TColor);

  procedure SetScaleFont(Value:TFont);

protected

  Procedure Paint; override;

  procedure MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer); override;

  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;

public

  constructor Create(AOwner:TComponent);override;

  destructor Destroy;override;

published

  Property MG : integer read FMG;

  Property MinMG : integer read FMinMG write SetMinMG ;

  Property MaxMG : integer read FMaxMG write SetMaxMG ;

  Property ScaleIncrement : integer read FScaleIncrement write SetScaleIncrement ;

  Property ScaleVisible : boolean read FScaleVisible write SetScaleVisible ;

  Property BaseColor : TColor read FBaseColor write SetBaseColor ;

  Property StarColor : TColor read FStarColor write SetStarColor ;

  Property ScaleFont : TFont read FScaleFont write SetScaleFont ;

end;

 

procedure Register;

 

 

implementation

 

{$IFDEF WIN32}

uses SysUtils, Consts, StdCtrls;

{$ELSE}

uses SysUtils, WinProcs, Consts, StdCtrls;

{$ENDIF}

 

procedure Register;

begin

   RegisterComponents('Sky',[TMgScale]);

end;

 

constructor TMgScale.Create(AOwner:TComponent);

begin

   inherited Create(AOwner);

   FBaseColor := clBlack;

   FStarColor := clYellow;

   FMinMG     := 0;

   FMaxMG     := 80;

   FScaleIncrement := 10;

   FScaleVisible   := True;

   Width := 100;

   Height:= 40;

   FScaleFont := TFont.Create;

   with FScaleFont do begin

        Name := 'Times New Roman';

        Size := 8;

        Color:=clWhite;

   end;

end;

 

destructor TMgScale.Destroy;

begin

   ScaleFont.free;

   inherited Destroy;

end;

 

 

procedure TMgScale.SetMinMG(Value:integer);

begin

If FMinMG<>Value then begin

  FMinMG:=Value;

  Invalidate;

end;

end;

 

 

procedure TMgScale.SetMaxMG(Value:integer);

begin

If FMaxMG<>Value then begin

  FMaxMG:=Value;

  Invalidate;

end;

end;

 

 

procedure TMgScale.SetScaleIncrement(Value:integer);

begin

If FScaleIncrement<>Value then begin

  FScaleIncrement:=Value;

  Invalidate;

end;

end;

 

 

procedure TMgScale.SetScaleVisible(Value:boolean);

begin

If FScaleVisible<>Value then begin

  FScaleVisible:=Value;

  Invalidate;

end;

end;

 

 

procedure TMgScale.SetBaseColor(Value:TColor);

begin

If FBaseColor<>Value then begin

  FBaseColor:=Value;

  Invalidate;

end;

end;

 

 

procedure TMgScale.SetStarColor(Value:TColor);

begin

If FStarColor<>Value then begin

  FStarColor:=Value;

  Canvas.Pen.Color:=StarColor;

  Invalidate;

end;

end;

 

 

procedure TMgScale.SetScaleFont(Value:TFont);

begin

If FScaleFont<>Value then begin

  FScaleFont:=Value;

  Canvas.Font.Assign(FScaleFont);

  Invalidate;

end;

end;

 

Procedure TMgScale.Paint;

var i,n,r: integer;

  dx,dy,aktMG: integer;

begin

 With Canvas do begin

    brush.style:=bsSolid;

    Brush.color:=BaseColor;

    Pen.Color:=BaseColor;

    Pen.Mode:=pmCopy;

    Rectangle(0,0,Width,Height);

    Brush.Color := StarColor;

    n := (MaxMG - MinMG) div ScaleIncrement;

    dx := Width div n;

    If ScaleVisible then dy := Height div 3

       else dy := Height div 2;

    For i:=0 to n-1 do begin

        aktMG := (MinMg+i*ScaleIncrement);

        r := 10 - (aktMG div 10);

        Ellipse((i+1)*dx-r,dy-r,(i+1)*dx+r,dy+r);

        Brush.Color := BaseColor;

        TextOut(dx,Height-Font.size-4,Format('%2.1f',[aktMG/107]));

    end;

 end;

end;

 

procedure TMgScale.MouseDown(Button: TMouseButton; Shift: TShiftState;

    X, Y: Integer);

begin

inherited MouseDown(Button, Shift, X, Y);

end;

 

procedure TMgScale.MouseMove(Shift: TShiftState; X, Y: Integer);

begin

inherited MouseMove(Shift,x,y);

end;

 

end.