iclasses.pas

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

  YMin   :=  1E301;
end;
//*************************************************************************************************************************************
procedure TiMinMaxPoint.AddData(Value: Double; Null: Boolean; X: Integer);
begin
  Empty := False;

  if not Null then
    begin
      if IsNull then
        begin
         IsNull  := False;
         YFirst  := Value;
         PixelsX := X;
        end;

      if Value > YMax then YMax := Value;
      if Value < YMin then YMin := Value;
      YLast := Value;
    end
end;
//*************************************************************************************************************************************
procedure TiMinMaxPoint.AssignDown(Source: TPersistent);
begin
  if not(Source is TiMinMaxPoint) then raise Exception.Create('Assign class must be TiMinMaxPoint');

  Empty   := (Source as TiMinMaxPoint).Empty;
  IsNull  := (Source as TiMinMaxPoint).IsNull;
  PixelsX := (Source as TiMinMaxPoint).PixelsX;
  YMax    := (Source as TiMinMaxPoint).YMax;
  YMin    := (Source as TiMinMaxPoint).YMin;
  YFirst  := (Source as TiMinMaxPoint).YFirst;
  YLast   := (Source as TiMinMaxPoint).YLast;
end;
//*************************************************************************************************************************************
procedure TiMinMaxPoint.Clear;
begin
  Empty  := True;
  IsNull := True;
  YMax   := -1E301;
  YMin   :=  1E301;
end;
//*************************************************************************************************************************************
{ TiPlotMinMaxPoint }
//*************************************************************************************************************************************
constructor TiPlotMinMaxPoint.Create;
begin
  Clear;
end;
//*************************************************************************************************************************************
procedure TiPlotMinMaxPoint.Clear;
begin
  Empty  := True;
  YMax   := -1E301;
  YMin   :=  1E301;
end;
//*************************************************************************************************************************************
procedure TiPlotMinMaxPoint.AddData(const NewXValue, NewYValue: Double; const NewXPixels: Integer);
begin
  if Empty then
    begin
      Empty   := False;
      XPixels := NewXPixels;
      XValue  := NewXValue;
      YFirst  := NewYValue;
    end;

  if NewYValue > YMax then YMax := NewYValue;
  if NewYValue < YMin then YMin := NewYValue;
  YLast := NewYValue;
end;
//*************************************************************************************************************************************
procedure TiPlotMinMaxPoint.AssignDown(const Source: TiPlotMinMaxPoint);
begin
  Empty   := Source.Empty;
  XPixels := Source.XPixels;
  XValue  := Source.XValue;
  YMax    := Source.YMax;
  YMin    := Source.YMin;
  YFirst  := Source.YFirst;
  YLast   := Source.YLast;
end;
//*************************************************************************************************************************************
{ TiGotoURL }
//*************************************************************************************************************************************
{$ifndef iCLX}
function TiGotoURL.RegKey(Key: HKey; SubKey: String; var Data: String): LongInt;
var
  TempKey : HKey;
  TData   : array[0..259] of Char;
  DSize   : Integer;
begin
  Result := regopenkeyex(Key, PChar(subkey), 0, KEY_QUERY_VALUE, TempKey);
  if result = ERROR_SUCCESS then
  begin
    DSize := Sizeof(TData);
    regqueryvalue(TempKey, nil, TData, DSize);
    Data := StrPas(TData);
    RegCloseKey(TempKey);
  end;
end;
{$endif}
//*************************************************************************************************************************************
procedure TiGotoURL.Connect(URLString: String; ShowCommand: TiURLShowCommand);
{$ifdef iVCL}
var
  Show         : Integer;
  Key          : String;
  P            : Integer;
  WindowHandle : THandle;
{$endif}
begin
  {$ifdef iVCL}
  case ShowCommand of
    ssHide              : Show := sw_Hide;
    ssMaximize          : Show := sw_Maximize;
    ssMinimize          : Show := sw_Minimize;
    ssRestore           : Show := sw_Restore;
    ssShow              : Show := sw_Show;
    ssShowDefault       : Show := sw_ShowDefault;
    ssShowMaximized     : Show := sw_ShowMaximized;
    ssShowMinimized     : Show := sw_ShowMinimized;
    ssShowMinNoActivate : Show := sw_ShowMinNoActive;
    ssShowNA            : Show := sw_ShowNA;
    ssShowNoActivate    : Show := sw_ShowNoActivate;
    else                  Show := sw_ShowNormal;
  end;

  WindowHandle := FindWindow('IEFrame', nil);
  if WindowHandle <> 0 then
    begin
      ShowWindow(WindowHandle, SW_RESTORE);
      BringWindowToTop(WindowHandle);

      exit;
    end;
    
  if RegKey(HKEY_CLASSES_ROOT, '.htm', Key) = ERROR_SUCCESS then
  begin
    Key := Key + '\shell\open\command';
    if RegKey(HKEY_CLASSES_ROOT, Key, Key) = ERROR_SUCCESS then
    begin
      P := Pos('"%1"', Key);
      if P = 0 then
        P := Pos('%1', Key);
      if P <> 0 then
       SetLength(Key, P-1);
      Key := Key + ' ' + URLString;
      if winexec(PChar(Key), show) < 32 then
        raise exception.create('Couldn''t launch default browser');
    end;
  end;
  {$endif}
end;
//*************************************************************************************************************************************
{ TiLimitDataList }
//*************************************************************************************************************************************
destructor TiLimitDataList.Destroy;
begin
  FreeMem(FList);
  inherited;
end;
//*************************************************************************************************************************************
function TiLimitDataList.Add(Value1, Value2, Value3: Double): Integer;
var
  Item : TiLimitData;
begin
  Item.Value1 := Value1;
  Item.Value2 := Value2;
  Item.Value3 := Value3;

  Result := FCount;
  if Result = FCapacity then Grow;
  FList^[Result] := Item;
  Inc(FCount);
end;
//*************************************************************************************************************************************
procedure TiLimitDataList.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 64 then
    Delta := FCapacity div 4
  else
    if FCapacity > 8 then
      Delta := 16
    else
      Delta := 4;
  SetCapacity(FCapacity + Delta);
end;
//*************************************************************************************************************************************
procedure TiLimitDataList.SetCapacity(NewCapacity: Integer);
begin
  if (NewCapacity > MaxListSize) then Exception.Create('Exceed Maximum List Size');
  if NewCapacity <> FCapacity then
  begin
    ReallocMem(FList, NewCapacity * SizeOf(TiLimitData));
    FCapacity := NewCapacity;
    if FCapacity < FCount then FCount := FCapacity;
  end;
end;
//*************************************************************************************************************************************
procedure TiLimitDataList.Clear;
begin
  FCount := 0;
  SetCapacity(0);
end;
//*************************************************************************************************************************************
function TiLimitDataList.GetItem(Index: Integer): TiLimitData;
begin
  if (Index < 0) or (Index >= FCount) then raise Exception.Create('Index out of Bounds');
  Result := FList^[Index];
end;
//*************************************************************************************************************************************
function TiLimitDataList.GetItem1(Index: Integer): Double;
begin
  Result := GetItem(Index).Value1;
end;
//*************************************************************************************************************************************
function TiLimitDataList.GetItem2(Index: Integer): Double;
begin
  Result := GetItem(Index).Value2;
end;
//*************************************************************************************************************************************
function TiLimitDataList.GetItem3(Index: Integer): Double;
begin
  Result := GetItem(Index).Value3;
end;
//*************************************************************************************************************************************
procedure TiLimitDataList.SetItem(Index: Integer; const Value: TiLimitData);
begin
  if (Index < 0) or (Index >= FCount) then raise Exception.Create('Index out of Bounds');
  FList^[Index] := Value;
end;
//*************************************************************************************************************************************
procedure TiLimitDataList.SetItem1(Index: Integer; const Value: Double);
var
  iLimitData : TiLimitData;
begin
  iLimitData   := GetItem(Index);
  iLimitData.Value1 := Value;
  SetItem(Index, iLimitData);
end;
//*************************************************************************************************************************************
procedure TiLimitDataList.SetItem2(Index: Integer; const Value: Double);
var
  iLimitData : TiLimitData;
begin
  iLimitData   := GetItem(Index);
  iLimitData.Value2 := Value;
  SetItem(Index, iLimitData);
end;
//*************************************************************************************************************************************
procedure TiLimitDataList.SetItem3(Index: Integer; const Value: Double);
var
  iLimitData : TiLimitData;
begin
  iLimitData   := GetItem(Index);
  iLimitData.Value3 := Value;
  SetItem(Index, iLimitData);
end;
//*************************************************************************************************************************************
procedure TDigitalSequenceData.Clear;
begin
  StartSet      := False;
  StopSet       := False;
  TransitionSet := False;
end;
//*************************************************************************************************************************************
{ TiDrawObject }
//*************************************************************************************************************************************
destructor TiDrawObject.Destroy;
begin
  FPointArray := nil;
  inherited;
end;
//*************************************************************************************************************************************
procedure TiDrawObject.ClearPolyPoints;
begin
  FCount := 0;
  SetLength(FPointArray, FCount);
end;
//*************************************************************************************************************************************
procedure TiDrawObject.AddPolyPoint(Point: TPointDouble);
begin
  inc(FCount);
  SetLength(FPointArray, FCount);

  FPointArray[FCount-1].x := Point.x;
  FPointArray[FCount-1].y := Point.y;
end;
//*************************************************************************************************************************************
function TiDrawObject.GetPolyPoint(Index: Integer): TPointDouble;
begin
  if (Index < 0) or (Index >= FCount) then raise Exception.Create('Index out of Bounds');

  Result.x := FPointArray[Index].x;
  Result.y := FPointArray[Index].y;
end;
//*************************************************************************************************************************************
procedure TiDrawObject.SetPolyPoint(Index: Integer; const Value: TPointDouble);
begin
  if (Index < 0) or (Index >= FCount) then raise Exception.Create('Index out of Bounds');

  FPointArray[Index].x := Value.x;
  FPointArray[Index].y := Value.y;
end;
//*************************************************************************************************************************************
function TiDrawObject.GetPolyPointCount: Integer;
begin
  Result := FCount;
end;
//*************************************************************************************************************************************
end.