ivclcomponent.pas

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

end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.CNKeyUp(var Message: TWMKeyUp);
begin
  UserGenerated := True;
  try
    try
      inherited;
      iKeyUp(Message.CharCode, []);
    except
      on exception do;
    end;
  finally
    UserGenerated := False;
  end;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.WMLButtonUp    (var Message: TWMLButtonUp    );begin try inherited;except on exception do; end;end;
procedure TiVCLComponent.WMMButtonUp    (var Message: TWMMButtonUp    );begin try inherited;except on exception do; end;end;
procedure TiVCLComponent.WMRButtonUp    (var Message: TWMRButtonUp    );begin try inherited;except on exception do; end;end;
procedure TiVCLComponent.WMLButtonDblClk(var Message: TWMLButtonDblClk);begin try inherited;except on exception do; end;end;
procedure TiVCLComponent.WMMButtonDblClk(var Message: TWMMButtonDblClk);begin try inherited;except on exception do; end;end;
procedure TiVCLComponent.WMRButtonDblClk(var Message: TWMRButtonDblClk);begin try inherited;except on exception do; end;end;
procedure TiVCLComponent.WMLButtonDown  (var Message: TWMLButtonDown  );begin try inherited;except on exception do; end;end;
procedure TiVCLComponent.WMMButtonDown  (var Message: TWMMButtonDown  );begin try inherited;except on exception do; end;end;
procedure TiVCLComponent.WMRButtonDown  (var Message: TWMRButtonDown  );begin try inherited;except on exception do; end;end;
//****************************************************************************************************************************************************
function TiVCLComponent.PaletteChanged(Foreground: Boolean): Boolean;
begin
  Result := inherited PaletteChanged(Foreground);
  BackGroundChange;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.SaveImageToMetaFile(FileName: String);
var
  MetaFile       : TMetaFile;
  MetaFileCanvas : TMetaFileCanvas;
begin
  MetaFile := TMetaFile.Create;
  try
    MetaFile.Width    := Width;
    MetaFile.Height   := Height;
    MetaFile.Enhanced := True;

    MetaFileCanvas := TMetafileCanvas.CreateWithComment(MetaFile, 0, 'Iocomp', '');
    try
      iPaintTo(MetaFileCanvas);
    finally
      MetaFileCanvas.Free;
    end;
    MetaFile.SaveToFile(FileName);
  finally
    MetaFile.Free;
  end;                             
end;
//****************************************************************************************************************************************************
function TiVCLComponent.OPCAddItem: Integer;
begin
  Result := FOPCItemManager.Add;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCDeleteItem(Index: Integer);
begin
  FOPCItemManager.Delete(Index);
end;
//****************************************************************************************************************************************************
function TiVCLComponent.OPCItemCount: Integer;
begin
  Result := FOPCItemManager.Count;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCRemoveAllItems;
begin
  FOPCItemManager.Clear;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCItemActivate(Index: Integer);
begin
  FOPCItemManager.Items[Index].Activate;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCItemDeactivate(Index: Integer);
begin
  FOPCItemManager.Items[Index].Deactivate;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCItemUpdateResume(Index: Integer);
begin
  FOPCItemManager.Items[Index].UpdateResume;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCItemUpdateSuspend(Index: Integer);
begin
  FOPCItemManager.Items[Index].UpdateSuspend;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCItemLoaded(Index: Integer);
begin
  FOPCItemManager.Items[Index].Loaded;
end;
//****************************************************************************************************************************************************
function TiVCLComponent.GetOPCItem(Index: Integer): TiOPCItem;
begin
  Result := FOPCItemManager.Items[Index];
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.SetOPCItemData        (Index: Integer; Value: OleVariant);begin FOPCItemManager.Items[Index].Data        := Value;end;
procedure TiVCLComponent.SetOPCItemComputerName(Index: Integer; Value: String    );begin FOPCItemManager.Items[Index].ComputerName:= Value;end;
procedure TiVCLComponent.SetOPCItemServerName  (Index: Integer; Value: String    );begin FOPCItemManager.Items[Index].ServerName  := Value;end;
procedure TiVCLComponent.SetOPCItemItemName    (Index: Integer; Value: String    );begin FOPCItemManager.Items[Index].ItemName    := Value;end;
procedure TiVCLComponent.SetOPCItemPropertyName(Index: Integer; Value: String    );begin FOPCItemManager.Items[Index].PropertyName:= Value;end;
procedure TiVCLComponent.SetOPCItemAutoConnect (Index: Integer; Value: Boolean   );begin FOPCItemManager.Items[Index].AutoConnect := Value;end;
procedure TiVCLComponent.SetOPCItemUpdateRate  (Index: Integer; Value: Integer   );begin FOPCItemManager.Items[Index].UpdateRate  := Value;end;
//****************************************************************************************************************************************************
function TiVCLComponent.GetOPCItemComputerName(Index: Integer): String;    begin Result := FOPCItemManager.Items[Index].ComputerName;end;
function TiVCLComponent.GetOPCItemServerName  (Index: Integer): String;    begin Result := FOPCItemManager.Items[Index].ServerName;  end;
function TiVCLComponent.GetOPCItemItemName    (Index: Integer): String;    begin Result := FOPCItemManager.Items[Index].ItemName;    end;
function TiVCLComponent.GetOPCItemPropertyName(Index: Integer): String;    begin Result := FOPCItemManager.Items[Index].PropertyName;end;
function TiVCLComponent.GetOPCItemAutoConnect (Index: Integer): Boolean;   begin Result := FOPCItemManager.Items[Index].AutoConnect; end;
function TiVCLComponent.GetOPCItemUpdateRate  (Index: Integer): Integer;   begin Result := FOPCItemManager.Items[Index].UpdateRate;  end;
function TiVCLComponent.GetOPCItemData        (Index: Integer): OleVariant;begin Result := FOPCItemManager.Items[Index].Data;        end;
function TiVCLComponent.GetOPCItemQuality     (Index: Integer): Word;      begin Result := FOPCItemManager.Items[Index].Quality;     end;
function TiVCLComponent.GetOPCItemTimeStamp   (Index: Integer): TDateTime; begin Result := FOPCItemManager.Items[Index].TimeStamp;   end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCSetProperty(Instance: TPersistent; Path: String; PropertyName: String; PropertyValue: OleVariant);
var
  i         : Integer;
  Count     : Integer;                            
  PropName  : String;
  PropInfo  : PPropInfo;
  PropList  : PPropList;
  TypeData  : PTypeData;
  SubClass  : TObject;
  AValue    : String;
  Found     : Boolean;
begin
  Count := GetTypeData(Instance.ClassInfo)^.PropCount;
  if Count > 0 then
  begin
    GetMem(PropList, Count * SizeOf(Pointer));
    try
      GetPropInfos(Instance.ClassInfo, PropList);
      for i := 0 to Count - 1 do
      begin
        PropInfo := PropList^[i];
        if PropInfo <> nil then
          begin
            if Assigned(PropInfo^.SetProc) then
              begin
                if Trim(Path) <> '' then PropName  := Path + '.' + PropInfo.Name
                  else PropName  := PropInfo.Name;

                Found := True;
                if PropInfo^.PropType^.Kind <> tkClass then Found := UpperCase(PropertyName) = UpperCase(PropName);

                if not Found then Continue;

                case PropInfo^.PropType^.Kind of
                  tkEnumeration            : begin
                                               AValue := PropertyValue;
                                               if Uppercase(AValue) = UpperCase('True')  then AValue := '1';
                                               if Uppercase(AValue) = UpperCase('False') then AValue := '0';

                                               TypeData := GetTypeData(PropInfo^.PropType^);
                                               if (TypeData.MinValue = 0) and (TypeData.MaxValue = 1) then
                                                 begin
                                                   if AValue <> '0' then AValue := '1';
                                                 end;
                                               SetOrdProp  (Instance, GetPropInfo(PTypeInfo(Instance.ClassInfo), PropInfo.Name), StrToInt(AValue));
                                             end;
                  tkInteger, tkSet, tkChar : begin
                                               AValue := PropertyValue;
                                               SetOrdProp  (Instance, GetPropInfo(PTypeInfo(Instance.ClassInfo), PropInfo.Name), StrToInt(AValue));
                                             end;
                  tkFloat                  : begin
                                               AValue := PropertyValue;
                                               SetFloatProp(Instance, GetPropInfo(PTypeInfo(Instance.ClassInfo), PropInfo.Name), StrToFloat(AValue));
                                             end;
                  tkString, tkLString, tkWString : begin
                                                     AValue := PropertyValue;
                                                     //SetLength
                                                     SetStrProp  (Instance, GetPropInfo(PTypeInfo(Instance.ClassInfo), PropInfo.Name), AValue);
                                                   end;
                  tkClass                        : begin
                                                     SubClass := GetObjectProperty(Instance, PropInfo.Name);
                                                     if SubClass is TPersistent then
                                                       OPCSetProperty(SubClass as TPersistent, PropName, PropertyName, PropertyValue);
                                                   end;
                end;
              end;
          end
        else Break;
      end;
    finally
      FreeMem(PropList, Count * SizeOf(Pointer));
    end;
  end;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.OPCNewData(Sender: TObject);
var
  OPCItem  : TiOPCItem;
  Index    : Integer;
  TempData : OleVariant;
begin
  OPCItem := Sender as TiOPCItem;

  if OPCItem.PropertyName = '' then Exit;

  TempData := OPCItem.Data;
  Index := FOPCItemManager.FindIndex(OPCItem);

  if Assigned(FOnBeforeNewOPCdata) then FOnBeforeNewOPCData(Index, TempData);
  FOPCIncomingActive := True;
  try
    if OPCItem.QualityGood then                     
      begin
        if not OPCNewDataSpecial(OPCItem) then
          OPCSetProperty(Self, '', OPCItem.PropertyName, TempData);
      end;

    if Assigned(FOnNewOPCData) then FOnNewOPCData(Index);
  finally
    FOPCIncomingActive := False;
  end;
end;
//****************************************************************************************************************************************************
function TiVCLComponent.OPCOutputData(PropertyName: String; Value: OleVariant): Boolean;
var
  OPCItem : TiOPCItem;
  x       : Integer;
begin
  Result := False;
  if FOPCIncomingActive then
    begin
      FOPCIncomingActive := False;
      Exit;
    end;

  for x := 0 to FOPCItemManager.Count-1 do
    begin
      OPCItem := FOPCItemManager.Items[x] as TiOPCItem;
      if not OPCItem.Active then Continue;
      if UpperCase(OPCItem.PropertyName) = UpperCase(PropertyName) then
        begin
          OPCItem.Data := Value;
          Result := True;
          Exit;
        end;
    end;
end;
//****************************************************************************************************************************************************
function TiVCLComponent.OPCNewDataSpecial(iOPCItem: TiOPCItem): Boolean;
begin
  Result := False;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.UpdateOPCSpecialList;
begin

end;
//****************************************************************************************************************************************************
function TiVCLComponent.GetTimerRunning: Boolean;
begin
  Result := FTimerID <> 0;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.TimerStart(InitialDelay, Interval: Integer);
begin
  if FTimerID = 0 then
    begin
      FTimerInterval := Interval;
      if InitialDelay <> 0 then
        begin
          FTimerID           := SetTimer(FWindowHandle, 1, InitialDelay, nil);
          FTimerFirstMessage := True;
        end
      else if Interval <> 0 then
        begin
          FTimerID           := SetTimer(FWindowHandle, 1, FTimerInterval, nil);
          FTimerFirstMessage := False;
        end;
    end;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.TimerStop;
begin
  if FTimerID <> 0 then
    begin
      KillTimer(FWindowHandle, FTimerID);
      FTimerID := 0;
    end;
end;
//****************************************************************************************************************************************************
procedure TiVCLComponent.TimerProc(var Message: TMessage);
begin
  if (Message.Msg = WM_TIMER) and (Message.WParam = 1) then
    begin
      if FTimerFirstMessage then
        begin
          FTimerFirstMessage := False;
          SetTimer(FWindowHandle, FTimerID, FTimerInterval, nil);
        end;
      if Assigned(FOnInternalTimer) then FOnInternalTimer(Self);
    end
  else if Message.Msg = WM_ENDSESSION then
    begin
      Message.Result := 0;
      Message.WParam := 1;