ca200srvrlib_tlb.pas

采用PC控制Ca210彩色分析仪

  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TCa200.GetDefaultInterface: ICa200;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TCa200.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TCa200Properties.Create(Self);
{$ENDIF}
end;

destructor TCa200.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TCa200.GetServerProperties: TCa200Properties;
begin
  Result := FProps;
end;
{$ENDIF}

function TCa200.Get_Cas: ICas;
begin
    Result := DefaultInterface.Cas;
end;

function TCa200.Get_SingleCa: ICa;
begin
    Result := DefaultInterface.SingleCa;
end;

procedure TCa200.SetConfiguration(CaNumberVal: Integer; const ConnecStringVal: WideString; 
                                  PortVal: Integer; BaudRateVal: Integer);
begin
  DefaultInterface.SetConfiguration(CaNumberVal, ConnecStringVal, PortVal, BaudRateVal);
end;

procedure TCa200.AutoConnect;
begin
  DefaultInterface.AutoConnect;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TCa200Properties.Create(AServer: TCa200);
begin
  inherited Create;
  FServer := AServer;
end;

function TCa200Properties.GetDefaultInterface: ICa200;
begin
  Result := FServer.DefaultInterface;
end;

function TCa200Properties.Get_Cas: ICas;
begin
    Result := DefaultInterface.Cas;
end;

function TCa200Properties.Get_SingleCa: ICa;
begin
    Result := DefaultInterface.SingleCa;
end;

{$ENDIF}

class function CoCas.Create: ICas;
begin
  Result := CreateComObject(CLASS_Cas) as ICas;
end;

class function CoCas.CreateRemote(const MachineName: string): ICas;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Cas) as ICas;
end;

procedure TCas.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{C1F0B433-1841-4330-960E-DB7403635DB3}';
    IntfIID:   '{5415C7C6-D982-46EE-BA22-FB6DC1AD5DE0}';
    EventIID:  '';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TCas.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    Fintf:= punk as ICas;
  end;
end;

procedure TCas.ConnectTo(svrIntf: ICas);
begin
  Disconnect;
  FIntf := svrIntf;
end;

procedure TCas.DisConnect;
begin
  if Fintf <> nil then
  begin
    FIntf := nil;
  end;
end;

function TCas.GetDefaultInterface: ICas;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TCas.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TCasProperties.Create(Self);
{$ENDIF}
end;

destructor TCas.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TCas.GetServerProperties: TCasProperties;
begin
  Result := FProps;
end;
{$ENDIF}

function TCas.Get_Item(IndexVal: OleVariant): ICa;
begin
    Result := DefaultInterface.Item[IndexVal];
end;

function TCas.Get_Count: Integer;
begin
    Result := DefaultInterface.Count;
end;

function TCas.Get_ItemOfNumber(CaNumberVal: Integer): ICa;
begin
    Result := DefaultInterface.ItemOfNumber[CaNumberVal];
end;

procedure TCas.SendMsr;
begin
  DefaultInterface.SendMsr;
end;

procedure TCas.ReceiveMsr;
begin
  DefaultInterface.ReceiveMsr;
end;

procedure TCas.SetCaID(CaNumberVal: Integer; const CaIDVal: WideString);
begin
  DefaultInterface.SetCaID(CaNumberVal, CaIDVal);
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
constructor TCasProperties.Create(AServer: TCas);
begin
  inherited Create;
  FServer := AServer;
end;

function TCasProperties.GetDefaultInterface: ICas;
begin
  Result := FServer.DefaultInterface;
end;

function TCasProperties.Get_Item(IndexVal: OleVariant): ICa;
begin
    Result := DefaultInterface.Item[IndexVal];
end;

function TCasProperties.Get_Count: Integer;
begin
    Result := DefaultInterface.Count;
end;

function TCasProperties.Get_ItemOfNumber(CaNumberVal: Integer): ICa;
begin
    Result := DefaultInterface.ItemOfNumber[CaNumberVal];
end;

{$ENDIF}

class function CoCa.Create: ICa;
begin
  Result := CreateComObject(CLASS_Ca) as ICa;
end;

class function CoCa.CreateRemote(const MachineName: string): ICa;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_Ca) as ICa;
end;

procedure TCa.InitServerData;
const
  CServerData: TServerData = (
    ClassID:   '{3B5F9680-00A6-469B-BADE-04C781AAFAA1}';
    IntfIID:   '{A930F0DB-F79A-467A-8479-F8369B063B8D}';
    EventIID:  '{F7663750-5900-45EB-905F-78C5D5378481}';
    LicenseKey: nil;
    Version: 500);
begin
  ServerData := @CServerData;
end;

procedure TCa.Connect;
var
  punk: IUnknown;
begin
  if FIntf = nil then
  begin
    punk := GetServer;
    ConnectEvents(punk);
    Fintf:= punk as ICa;
  end;
end;

procedure TCa.ConnectTo(svrIntf: ICa);
begin
  Disconnect;
  FIntf := svrIntf;
  ConnectEvents(FIntf);
end;

procedure TCa.DisConnect;
begin
  if Fintf <> nil then
  begin
    DisconnectEvents(FIntf);
    FIntf := nil;
  end;
end;

function TCa.GetDefaultInterface: ICa;
begin
  if FIntf = nil then
    Connect;
  Assert(FIntf <> nil, 'DefaultInterface is NULL. Component is not connected to Server. You must call ''Connect'' or ''ConnectTo'' before this operation');
  Result := FIntf;
end;

constructor TCa.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps := TCaProperties.Create(Self);
{$ENDIF}
end;

destructor TCa.Destroy;
begin
{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
  FProps.Free;
{$ENDIF}
  inherited Destroy;
end;

{$IFDEF LIVE_SERVER_AT_DESIGN_TIME}
function TCa.GetServerProperties: TCaProperties;
begin
  Result := FProps;
end;
{$ENDIF}

procedure TCa.InvokeEvent(DispID: TDispID; var Params: TVariantArray);
begin
  case DispID of
    -1: Exit;  // DISPID_UNKNOWN
    1: if Assigned(FOnExeCalZero) then
         FOnExeCalZero(Self);
  end; {case DispID}
end;

function TCa.Get_Probes: IProbes;
begin
    Result := DefaultInterface.Probes;
end;

function TCa.Get_OutputProbes: IOutputProbes;
begin
    Result := DefaultInterface.OutputProbes;
end;

function TCa.Get_Memory: IMemory;
begin
    Result := DefaultInterface.Memory;
end;

function TCa.Get_DisplayProbe: WideString;
begin
    Result := DefaultInterface.DisplayProbe;
end;

procedure TCa.Set_DisplayProbe(const DisplayProbeVal: W