igaugepointer.pas

iocopm3.04源码,一套很好的工控开发工具

{*******************************************************}
{                                                       }
{       TiGaugePointer                                  }
{                                                       }
{       Copyright (c) 1997,2003 Iocomp Software         }
{                                                       }
{*******************************************************}
{$I iInclude.inc}

{$ifdef iVCL}unit  iGaugePointer;{$endif}
{$ifdef iCLX}unit QiGaugePointer;{$endif}

interface

uses
  {$I iIncludeUses.inc}
  {$IFDEF iVCL} iTypes, iGPFunctions; {$ENDIF}
  {$IFDEF iCLX}QiTypes, QiGPFunctions;{$ENDIF}

type
  TiGaugePointer = class;
  
  TiGaugePointerManager = class(TObject)
  private
    FList     : TStringList;
    FOnInsert : TNotifyEvent;
    FOnRemove : TNotifyEvent;
    FOnChange : TNotifyEvent;
  protected
    function  GetCount: Integer;
    function  GetItem  (Index: Integer): TiGaugePointer;

    procedure NotificationInsert(Sender : TObject);
    procedure NotificationRemove(Sender : TObject);

    procedure DoChange;
  public
    constructor Create(AOnChange, AOnInsert, AOnRemove : TNotifyEvent); virtual;
    destructor  Destroy; override;

    function  DoWriteToStream : Boolean;
    procedure WriteToStream (Writer: TWriter);
    procedure ReadFromStream(Reader: TReader);

    procedure Clear;
    procedure Delete(Index: Integer);
    function  CreateObject : TiGaugePointer;
    function  Add: Integer;

    property  Items[Index: Integer]: TiGaugePointer read GetItem;
    property  Count                : Integer        read GetCount;
  end;

  TiGaugePointer = class(TPersistent)
  private
    FSize          : Integer;
    FStyle         : Integer;
    FMargin        : Integer;
    FColor         : TColor;
    FOwner         : TiGaugePointerManager;
    FPosition      : Double;
    FVisible       : Boolean;
    FMouseDown     : Boolean;
    {$IFDEF iVCL}
    FRegion        : HRGN;
    {$ENDIF}
    FOnChange      : TNotifyEvent;
    FDrawScaleSide : Boolean;
  protected
    procedure SetSize    (const Value: Integer);
    procedure SetColor   (const Value: TColor);
    procedure SetMargin  (const Value: Integer);
    procedure SetStyle   (const Value: Integer);
    procedure SetPosition(const Value: Double);
    procedure SetVisible (const Value: Boolean);
    {$IFDEF iVCL}
    procedure SetRegion  (Value: HRGN);
    {$ENDIF}

    procedure DoChange;
  public
    constructor Create(AOwner: TiGaugePointerManager);
    destructor  Destroy; override;
    property    OnChange: TNotifyEvent read FOnChange write FOnChange;
    {$IFDEF iVCL}
    property Region        : HRGN    read FRegion        write SetRegion;
    {$ENDIF}
    property MouseDown     : Boolean read FMouseDown     write FMouseDown;
  published
    property Size          : Integer read FSize          write SetSize;
    property Margin        : Integer read FMargin        write SetMargin;
    property Color         : TColor  read FColor         write SetColor;
    property Style         : Integer read FStyle         write SetStyle;
    property Position      : Double  read FPosition      write SetPosition;
    property Visible       : Boolean read FVisible       write SetVisible;
    property DrawScaleSide : Boolean read FDrawScaleSide write FDrawScaleSide;
  end;

implementation

type
  TWriterAccess     = class(TWriter    ) end;
  TReaderAccess     = class(TReader    ) end;
  TPersistentAccess = class(TPersistent) end;
//****************************************************************************************************************************************************
constructor TiGaugePointer.Create(AOwner: TiGaugePointerManager);
begin
  FSize    := 10;
  FStyle   := 3;
  FVisible := True;

  FOwner    := AOwner;
  if Assigned(FOwner) then FOwner.NotificationInsert(Self);
end;
//****************************************************************************************************************************************************
destructor TiGaugePointer.Destroy;
begin
  {$IFDEF iVCL}
  if FRegion <> 0 then DeleteObject(FRegion);
  FRegion := 0;
 {$ENDIF}
  if Assigned(FOwner) then FOwner.NotificationRemove(Self);
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointer.DoChange;
begin
  if Assigned(FOwner) then FOwner.DoChange;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointer.SetPosition(const Value: Double);
begin
  if FPosition <> Value then
    begin
      FPosition := Value;
      DoChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointer.SetColor(const Value: TColor);
begin
  if FColor <> Value then
    begin
      FColor := Value;
      DoChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointer.SetMargin(const Value: Integer);
begin
  if FMargin <> Value then
    begin
      FMargin := Value;
      DoChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointer.SetSize(const Value: Integer);
begin
  if FSize <> Value then
    begin
      FSize := Value;
      DoChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointer.SetVisible(const Value: Boolean);
begin
  if FVisible <> Value then
    begin
      FVisible := Value;
      DoChange;
    end;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointer.SetStyle(const Value: Integer);
begin
  if FStyle <> Value then
    begin
      FStyle := Value;
      DoChange;
    end;
end;
//****************************************************************************************************************************************************
{$IFDEF iVCL}
procedure TiGaugePointer.SetRegion  (Value: HRGN);
begin
  if FRegion <> 0 then DeleteObject(FRegion);
  FRegion := Value;
end;
{$ENDIF}
//****************************************************************************************************************************************************
{ TiGaugePointerManager }
//****************************************************************************************************************************************************
constructor TiGaugePointerManager.Create(AOnChange, AOnInsert, AOnRemove : TNotifyEvent);
begin
  if not Assigned(AOnChange)  then raise Exception.Create('OnChange event handler can not be null');
  if not Assigned(AOnInsert)  then raise Exception.Create('OnInsert event handler can not be null');
  if not Assigned(AOnRemove)  then raise Exception.Create('OnRemove event handler can not be null');

  FOnChange := AOnChange;
  FOnInsert := AOnInsert;
  FOnRemove := AOnRemove;

  FList := TStringList.Create;

  FOnInsert(Self);
end;
//****************************************************************************************************************************************************
destructor TiGaugePointerManager.Destroy;
begin
  Clear;
  FList.Free;

  if Assigned(FOnRemove) then FOnRemove(Self);
  inherited;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointerManager.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;
//****************************************************************************************************************************************************
function TiGaugePointerManager.GetCount: Integer;
begin
  Result := FList.Count;
end;
//****************************************************************************************************************************************************
function TiGaugePointerManager.Add: Integer;
begin
  Result := FList.IndexOfObject(CreateObject);
end;
//****************************************************************************************************************************************************
procedure TiGaugePointerManager.Clear;
begin
  while FList.Count <> 0 do
    FList.Objects[0].Free;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointerManager.Delete(Index: Integer);
begin
  FList.Objects[Index].Free;
end;
//****************************************************************************************************************************************************
function TiGaugePointerManager.CreateObject: TiGaugePointer;
begin
  Result := TiGaugePointer.Create(Self);
end;
//****************************************************************************************************************************************************
function TiGaugePointerManager.GetItem(Index: Integer): TiGaugePointer;
begin
  Result := FList.Objects[Index] as TiGaugePointer;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointerManager.NotificationInsert(Sender: TObject);
begin
  if Sender is TiGaugePointer then if FList.IndexOfObject(Sender) = -1 then
    FList.AddObject('', Sender);

  FOnInsert(Sender);
  FOnChange(Sender);
end;
//****************************************************************************************************************************************************
procedure TiGaugePointerManager.NotificationRemove(Sender: TObject);
var
  x : Integer;
begin
  FOnRemove(Sender);
  FOnChange(Sender);

  for x := 0 to Count-1 do
    if (FList.Objects[x] = Sender) then
      begin
        FList.Delete(x);
        Break;
      end;
end;
//****************************************************************************************************************************************************
function TiGaugePointerManager.DoWriteToStream: Boolean;
begin
  Result := FList.Count <> 0;
end;
//****************************************************************************************************************************************************
procedure TiGaugePointerManager.ReadFromStream(Reader: TReader);
var
  Item : TiGaugePointer;
begin
  Clear;
  if not Reader.EndOfList then Clear;
  if TReaderAccess(Reader).ReadValue <> vaCollection then exit;
  while not Reader.EndOfList do
  begin
    Item := CreateObject;
    Reader.ReadListBegin;
    while not Reader.EndOfList do TReaderAccess(Reader).ReadProperty(Item);
    Reader.ReadListEnd;
  end;
  Reader.ReadListEnd; 
end;
//****************************************************************************************************************************************************
procedure TiGaugePointerManager.WriteToStream(Writer: TWriter);
var
  x : Integer;
begin
  TWriterAccess(Writer).WriteValue(vaCollection);
  for x := 0 to Count - 1 do
  begin
    Writer.WriteListBegin;
    WriterWriteProperties(Writer, GetItem(x));
    Writer.WriteListEnd;
  end;
  Writer.WriteListEnd;
end;
//****************************************************************************************************************************************************
end.