iclasses.pas

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

    procedure iMouseDown(Button: TMouseButton; Shift: TShiftState; X, Y, ScreenX, ScreenY: Integer); virtual;
    procedure iMouseMove(                      Shift: TShiftState; X, Y, ScreenX, ScreenY: Integer); virtual;
    procedure iMouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y, ScreenX, ScreenY: Integer); virtual;

    procedure Draw(const Canvas : TCanvas); virtual; 

    property DrawRect     : TRect        read GetDrawRect   write SetDrawRect;
    property Left         : Integer      read FLeft         write FLeft;
    property Top          : Integer      read FTop          write FTop;
    property Right        : Integer      read FRight        write FRight;
    property Bottom       : Integer      read FBottom       write FBottom;
    property MouseDown    : Boolean      read FMouseDown    write SetMouseDown;
    property Width        : Integer      read GetWidth;
    property Height       : Integer      read GetHeight;
    property Visible      : Boolean      read FVisible      write SetVisible;
    property Enabled      : Boolean      read FEnabled      write SetEnabled;
    property GroupIndex   : Integer      read FGroupIndex   write FGroupIndex;

    property Caption      : String       read FCaption write SetCaption;
    property Font         : TFont        read FFont write SetFont;

    property OnInvalidate : TNotifyEvent read FOnInvalidate write FOnInvalidate;
    property OnClick      : TNotifyEvent read FOnClick      write FOnClick;
  end;

  TiGotoURL = class(TObject)
  private
    {$ifndef iCLX}function RegKey(Key: HKey; SubKey: String; var Data: String) : LongInt;{$endif}
  public
    procedure Connect(URLString: String; ShowCommand: TiURLShowCommand);
  end;

type
  TiLimitData = record
    Value1 : Double;
    Value2 : Double;
    Value3 : Double;
  end;
type
  PiLimitDataArray = ^TiLimitDataArray;
  TiLimitDataArray = array[0..(Maxint div 32) - 1] of TiLimitData;

  TiLimitDataList = class(TObject)
  private
    FList     : PiLimitDataArray;
    FCount    : Integer;
    FCapacity : Integer;

    function  GetItem           (Index: Integer): TiLimitData;
    function  GetItem1          (Index: Integer): Double;
    function  GetItem2          (Index: Integer): Double;
    function  GetItem3          (Index: Integer): Double;

    procedure SetItem           (Index: Integer; const Value: TiLimitData);
    procedure SetItem1          (Index: Integer; const Value: Double);
    procedure SetItem2          (Index: Integer; const Value: Double);
    procedure SetItem3          (Index: Integer; const Value: Double);
  protected
    procedure Grow;
  public
    destructor Destroy; override;
    function  Add(Value1, Value2, Value3: Double): Integer;
    procedure SetCapacity(NewCapacity: Integer);
    procedure Clear;

    property Count                : Integer read FCount;
    property Item1[Index: Integer]: Double  read GetItem1 write SetItem1;
    property Item2[Index: Integer]: Double  read GetItem2 write SetItem2;
    property Item3[Index: Integer]: Double  read GetItem3 write SetItem3;
  end;

  implementation
//****************************************************************************************************************************************************
procedure TiMemoryStream.WriteString(Value: String);
var
  OutString : ShortString;
begin
  if Length(Value) > 255 then raise Exception.Create('String Exceeds 255 Characters');
  OutString := Value;
  Write(OutString[1],Length(OutString));
end;
//****************************************************************************************************************************************************
procedure TiMemoryStream.WriteCRLF;
begin
  WriteString(#13+#10);
end;
//****************************************************************************************************************************************************
procedure TiMemoryStream.WriteStringCRLF(Value: String);
begin
  WriteString(Value);
  WriteCRLF;
end;
//****************************************************************************************************************************************************
function TiMemoryStream.ReadChar: Char;
begin
  Read(Result, 1);
  if Position = Size then raise Exception.Create('EOF');
end;
//****************************************************************************************************************************************************
{TiXMLFileStream}
//****************************************************************************************************************************************************
procedure TiXMLMemoryStream.StartElement(Name: String);
begin
  WriteStringCRLF('<' + Name + '>');
end;
//****************************************************************************************************************************************************
procedure TiXMLMemoryStream.EndElement(Name: String);
begin
  WriteStringCRLF('</' + Name + '>');
end;
//****************************************************************************************************************************************************
procedure TiXMLMemoryStream.WriteElement(Name, Value: String);
begin
  WriteStringCRLF('<' + Name + '>' + Value + '</' + Name + '>');
end;
//****************************************************************************************************************************************************
function TiXMLMemoryStream.GetNameElementStart : String;
var
  NextChar     : Char;
  EndOfElement : Boolean;
  EndOfName    : Boolean;
begin
  Result       := '';
  EndOfElement := False;
  EndOfName    := False;

  while ReadChar <> '<' do;
  while not EndOfElement do
    begin
      NextChar := ReadChar;
      if NextChar = '/' then
        begin
          while ReadChar <> '<' do;
          Continue;
        end;

      if NextChar = '>' then
        begin
          EndOfElement := True;
          EndOfName    := True;
        end;
      if NextChar = ' ' then EndOfName := True;

      if not EndOfName then Result := Result + NextChar;
    end;
end;
//****************************************************************************************************************************************************
procedure TiXMLMemoryStream.GotoElementStart(Value : String);
begin
  while GetNameElementStart <> Value do;
end;
//****************************************************************************************************************************************************
function TiXMLMemoryStream.GetElementValue : String;
var
  NextChar     : Char;
  EndOfElement : Boolean;
begin
  Result := '';
  EndOfElement := False;
  while not EndOfElement do
    begin
      NextChar := ReadChar;
      if NextChar = '<' then EndOfElement := True;
      if not EndOfElement then Result := Result + NextChar;
    end;
  Seek(-1, soFromCurrent);
end;
//****************************************************************************************************************************************************
function TiXMLMemoryStream.GetNameElementStop: String;
var
  NextChar     : Char;
  EndOfElement : Boolean;
  EndOfName    : Boolean;
begin
  Result       := '';
  EndOfElement := False;
  EndOfName    := False;

  if ReadChar <> '<' then raise Exception.Create('XML Parsing Error - "<" not Found');
  if ReadChar <> '/' then raise Exception.Create('XML Parsing Error - "/" not Found');
  while not EndOfElement do
    begin
      NextChar := ReadChar;
      if NextChar = '>' then
        begin
          EndOfElement := True;
          EndOfName    := True;
        end;
      if NextChar = ' ' then EndOfName := True;

      if not EndOfName then Result := Result + NextChar;
    end;
end;
//****************************************************************************************************************************************************
function TiXMLMemoryStream.GetElement(Name: String): String;
begin
  while GetNameElementStart <> Name do;
  Result := GetElementValue;
  while GetNameElementStop <> Name do;
end;
//****************************************************************************************************************************************************
function TiXMLMemoryStream.GetNextPiece: String;
var
  NextChar : Char;
begin
  Result := '';

  repeat
    NextChar := ReadChar;
  until (NextChar <> #10) and (NextChar <> #13);
  
  if NextChar = '<' then
    begin
      while True do
        begin
          NextChar := ReadChar;
          if NextChar = '>' then Break
          else Result := Result + NextChar;
        end;
    end
  else
    begin
      while True do
        begin
          NextChar := ReadChar;
          if NextChar = '<' then
            begin
              Seek(-1, soFromCurrent);
              Break;
            end
          else Result := Result + NextChar;
        end;
    end;
end;
//****************************************************************************************************************************************************
function TiXMLMemoryStream.PeekNextPiece: String;
var
  OldPosition : Integer;
begin
  OldPosition := Position;
  Result := GetNextPiece;
  Position := OldPosition;
end;
//****************************************************************************************************************************************************
{ TiStripChartChannelObject }
//*************************************************************************************************************************************
constructor TiStripChartChannelObject.Create;
begin
  Visible           := True;
  VisibleInLegend   := True;
  HighestIndex      := -1;
  FTrackLimitColors := True;
end;
//*************************************************************************************************************************************
procedure TiStripChartChannelObject.SetColor(const Value: TColor);
begin
  if FColor <> Value then
    begin
      FColor := Value;
      if FTrackLimitColors then
        begin
          ControlLimitUpperColor := FColor;
          ControlLimitLowerColor := FColor;
          WarningLimitUpperColor := FColor;
          WarningLimitLowerColor := FColor;
        end;
    end;
end;
//*************************************************************************************************************************************
procedure TiStripChartChannelObject.SetControlLimitUpperColor(const Value: TColor);
begin
  if FControlLimitUpperColor <> Value then
    begin
      FControlLimitUpperColor := Value;
      FTrackLimitColors := False;
    end;
end;
//*************************************************************************************************************************************
procedure TiStripChartChannelObject.SetControlLimitLowerColor(const Value: TColor);
begin
  if FControlLimitLowerColor <> Value then
    begin
      FControlLimitLowerColor := Value;
      FTrackLimitColors := False;
    end;
end;
//*************************************************************************************************************************************
procedure TiStripChartChannelObject.SetWarningLimitUpperColor(const Value: TColor);
begin
  if FWarningLimitUpperColor <> Value then
    begin
      FWarningLimitUpperColor := Value;
      FTrackLimitColors := False;
    end;
end;
//*************************************************************************************************************************************
procedure TiStripChartChannelObject.SetWarningLimitLowerColor(const Value: TColor);
begin
  if FWarningLimitLowerColor <> Value then
    begin
      FWarningLimitLowerColor := Value;
      FTrackLimitColors := False;
    end;
end;
//*************************************************************************************************************************************
//*************************************************************************************************************************************
{ TiStripChartContinuousDataChannelObject }
//*************************************************************************************************************************************
//*************************************************************************************************************************************
constructor TiStripChartContinuousDataChannelObject.Create;
begin
  inherited;
  FDataList := TiDataNullList.Create;
end;
//*************************************************************************************************************************************