scope.pas

SPServer.rar一个基于TCP/IP监听发送代码

{$A+,B-,D-,L-,M-,O+,Q-,R-,S-,X+,Y-}
(*
  SCOPE 2.0 "The Pack"

     "It's black 'n green and scrolls, it draws a a wriggly line, 'nuff said."

  --------  --------  --------  --------  --------  --------  --------  --------
  Contents:
     TScope      - An graphic oscilloscope control like the ones used in
                   Windows NT 4.0 Taskmanager
     TIndicator  - A vertical indicator-column like the ones on that NT
                   Taskman.
     TSimplePie  - A small and simple 3D-piechart like the one shown on a
                   disk's Properties sheet.

  --------  --------  --------  --------  --------  --------  --------  --------
     Copyrights (C) 1997 ved T Skovmand Eriksen
     email: [e-mail]
     ALL RIGHTS RESERVED
  --------  --------  --------  --------  --------  --------  --------  --------

  This source is freeware and may be used as follows:

     * In development of in-house applications which will not be published.

     * In development of freeware applications PROVIDED that credit is given
       to me in the applications aboutbox or helpfile.

     * In development of shareware and commercial applications PROVIDED that
       I, Troels S Eriksen, recieve a free unlimited copy of all versions of
       said application AND that credits are given to me in the applications
       aboutbox or helpfile.

     * In printed or electronic form (fx. in a book) or in a source-library
       (fx. on CD) PROVIDED that I, Troels S Eriksen, recieve a royality-free
       unlimited copy of said book or library.

     * In any other way PROVIDED that I, Troels S Eriksen, give my explicit
       permission to the suggested use.

  By using this source you do acknowledge that the above restrictions apply to
  you and your use of this component and that you will confirm by them.

  --------  --------  --------  --------  --------  --------  --------  --------

  Revision history:
    TScope
     Rev 01 - Control created.
     Rev 02 - Gridsize & Zeroline added, grid-drawing changed to use zeroline
              as baseline.
     Rev 03 - Redraw after resizing added.
     Rev 04 - Redraw after resizing moved to "SetBounds", minor bug removed,
              (didn't show control correctly when added to project).
     Rev 05 - Memory leak problem fixed.

    TIndicator
     Rev 01 - Control created.

    TSimplePie
     Rev 01 - Control created.

  --------  --------  --------  --------  --------  --------  --------  --------

  Thanks to:
     * Bill Sparhawk, who notified me about the leaks in TScope (rev 05) and
       patiently helped me to remove them.

  --------  --------  --------  --------  --------  --------  --------  --------

  TScope Properties:
     Active           Starts/Stops scope
     Color            Backgroundcolor
     Gridcolor        Grid mask color
     Gridsize         Size of grid mask in pixels
     Height           Scopes height in pixels
     Interval         Scroll speed in 1/100's seconds
     LineColor        Scope dataline color
     Position         Dataline value (range 0-100)
     Width            Scopes width in pixels
     Basecolor        Color of baseline
     Baseline         Baseline value (range 0-100)

  TScope Methods:
     Clear            Clears the control and redraws grid

     "Yah, I know - there ain't no pacemaker property either"

  --------  --------  --------  --------  --------  --------  --------  --------

  TIndicator Properties:
     Background       The controls background color
     Foreground       The indicator color
     Height           Control height
     Width            Control widht
     Position         Indicator level (range 0-100)

  TIndicator Methods:
     n/a

  --------  --------  --------  --------  --------  --------  --------  --------

  TSimplePie Properties:
     BaseColor        The base color of the control
     Position         The used percentage (range 0-100)
     UsedColor        The color for the used percentage
     Height           Pies height in pixels
     Width            Pies width in pixels

  TSimplePie Methods:
    n/a

    "The Programmers KISS: Keep It Simple, Silly "

  --------  --------  --------  --------  --------  --------  --------  --------

  Known bugs:

    TScope
    * None - yet...

    TIndicator
    * None - yet...

    TSimplePie
    * At some specific heights/widths the pie is not filled with color.
      To get it drawn correctly, just resize the control (I know whats wrong,
      its just too much bother to fix it)

    Q: "Who suggested the cover-up?"
    A: "Actually, nobody suggested that there should NOT be a cover-up."

  --------  --------  --------  --------  --------  --------  --------  --------

*)
unit Scope;

interface

uses
  WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs,  ExtCtrls;

type
  TScope = class(TGraphicControl)

  private
    fAllowed : boolean;
    fOnUpdate  : TNotifyEvent;
    DrawBuffer : TBitmap;
    DrawTimer  : TTimer;
    fActive    : boolean;
    fBaseColor,           { Baseline color }
    fColor,               { Background color }
    fGridColor,           { Grid line color }
    fLineColor : TColor;  { Position line color }
    fBaseLine,
    fGridSize,
    fPosition,            { Value to plot }
    fInterval  : integer; { Update speed in 1/10 seconds }
    procedure SetActive(value:boolean);
    procedure SetGridSize(value:integer);
    procedure SetBaseLine(value:integer);
    procedure SetInterval(value:integer);

  protected
    Oldpos, PrevPos : integer;
    CalcBase, Counter : integer;
    procedure   UpdateScope(Sender:TObject);
    procedure   Loaded; override;
    procedure   SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

  public
    procedure   Paint; override;
    constructor Create(AnOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   Free;
    procedure   Clear;

  published
    property Baseline : integer read fBaseline write SetBaseLine;
    property Gridsize : integer read fGridSize write SetGridSize;
    property Active   : boolean read fActive write SetActive;
    property Position : Integer read fPosition write fPosition;
    property Interval : Integer read fInterval write SetInterval;
    { Color properties }
    property Color     : TColor read fColor     write fColor;
    property Gridcolor : TColor read fGridColor write fGridColor;
    property Linecolor : TColor read fLineColor write fLineColor;
    property Basecolor : TColor read fBaseColor write fBaseColor;

    property OnUpdate  : TNotifyEvent read fOnUpdate write fOnUpdate;
    { Standard properties }
    property Height;
    property Width;
    { Standard events }
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

type
  TIndicator = class(TGraphicControl)
  private
    FDrawBuffer : TBitmap;
    FShaddow,
    FForeground,
    FBackground : TColor;
    FPosition  : Integer;
    procedure SetPosition(value:integer);
    procedure SetForeground(value:TColor);
    procedure SetBackground(value:TColor);
  protected
    procedure   Paint; override;
    procedure   SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure   UpdateDrawBuffer;
  public
    constructor Create(anOwner:TComponent); override;
    destructor  Destroy; override;
    procedure   Free;
  published
    property Position  : integer read FPosition write SetPosition;
    property Background: TColor read FBackground write SetBackground;
    property Foreground: TColor read fForeground write SetForeground;
    { Standard properties }
    property Height;
    property Width;
    { Standard events }
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

type
  TSimplePie = class(TGraphicControl)
  private
    FDrawBuffer: TBitmap;
    FShaddow1,
    FShaddow2,
    FBasecolor,
    FUsedColor: TColor;

    FPosition : Integer;
    procedure SetPosition(value:integer);
    procedure SetBasecolor(value:TColor);
    procedure SetUsedcolor(value:TColor);

  protected
    procedure   Paint; override;
    procedure   UpdateDrawBuffer(h,w:integer);
    procedure   SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;

  public
    constructor Create(AnOwner:TComponent); override;
    destructor  Destroy; override;
    procedure   Free;

  published
    { Special properties }
    property Position : integer read FPosition write SetPosition;
    property Basecolor: TColor  read FBasecolor write SetBasecolor;
    property Usedcolor: TColor  read FUsedcolor write SetUsedcolor;
    { Standard events }
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  procedure Register;

implementation

{ --- TSCOPE ----------------------------------------------------------------- }

constructor TScope.Create(AnOwner:TComponent);
{ Create control and background draw buffer and timer
}
begin
  Inherited Create(AnOwner);
  fAllowed:=FALSE;
  DrawBuffer:=TBitmap.Create;
  DrawBuffer.Canvas.Brush.Color:=FColor;
  DrawBuffer.Canvas.Brush.Style:=bsSolid;
  DrawBuffer.Canvas.Pen.Width:=1;
  DrawBuffer.Canvas.Pen.Style:=psSolid;

  DrawTimer:=TTimer.Create(SELF);
  DrawTimer.Enabled:=FALSE;
  DrawTimer.OnTimer:=UpdateScope;
  DrawTimer.Interval:=500;

  Height   :=120;
  Width    :=208;

  Color    :=clBlack;
  GridColor:=clGreen;
  LineColor:=clLime;
  BaseColor:=clRed;

  BaseLine:=50;
  GridSize:=16;

  Position :=50;
  Interval :=50;
  Counter:=1;

  ControlStyle:=[csDesignInteractive,csFramed,csOpaque];
  fAllowed  :=TRUE;
end;

procedure TScope.Loaded;
{ Finished loading, now allow redraw when control is changed
}
begin
  Inherited Loaded;
  fAllowed:=TRUE;
end;

procedure TScope.Clear;
{ Redraw control, re-calculate grid etc
}
var
  a : integer;
begin
  CalcBase :=(height-round(height/100*FBaseline));
  With DrawBuffer.Canvas do begin
    Brush.Color:=FColor;
    Pen.Style  :=psClear;
    Rectangle(0,0,Width+1,height+1);
    Pen.Style:=psSolid;
    Pen.Color:=FGridColor;
    Pen.Width:=1;
    { Vertical lines }
    a:=Width;
    While a>0 do begin
      MoveTo(a-1,0);
      LineTo(a-1,Height);
      dec(a,FGridSize);
    end;
    { Horizontal lines - above Baseline }
    a:=CalcBase;
    while a<height do begin
      inc(a,FGridSize);
      MoveTo(0    ,a);
      LineTo(Width,a);
    end;
    { Horizontal lines - below Baseline }
    a:=CalcBase;
    while a>0 do begin
      Dec(a,FGridSize);
      MoveTo(0    ,a);
      LineTo(Width,a);
    end;
    { Baseline }
    Pen.Color:=FBaseColor;
    MoveTo(0,CalcBase);
    LineTo(Width,CalcBase);

    { Start new position-line on baseline... }
    OldPos   :=CalcBase;
    PrevPos  :=CalcBase;
    {
    // Draws a line from 0,baseline to width, new pos
    Pen.Color:=FLineColor;
    MoveTo(0,height);
    LineTo(Width,height-round(height/100*position));
    }
    counter:=1;
  end;
end;

procedure TScope.Free;
{ Free control and all internal objects
}
begin
  DrawTimer .Free;
  DrawBuffer.Free;
  Inherited Free;
end;

destructor TScope.Destroy;
begin
  if DrawTimer<>NIL then
    DrawTimer.Destroy;
  if DrawBuffer<>NIL then