unit VisPlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, CM2VisInterface, Graphics, SysUtils;

type
  TCM2APIPlug = class(TComObject, ICM2VisPlug4)
  private
   Canvas: TCanvas;
   fDC: THandle;
   LastErrorMsg: String;
   S, fString, FromCM2API: String;
   fLeft, fTop, fWidth, fHeight: Integer;
  protected
  // Declare Basics
   Function Name(OUT Name: Pchar): HResult; stdcall;
   Function Version(OUT Version: word): HResult; stdcall; // Uses MMRB Notation
   Function RequiredCoreVersion(OUT RCV: Word): HResult; stdcall; // Uses MMRB Notation - Please refer to CM2Plugtypes for details
  // Declare Error commands
   Function GetLastErrorMsg(OUT Msg: PChar): HResult; stdcall;
  // Declare Info system
   Function GetInfoCount(OUT InfoCount: Integer): HResult; stdcall;
   Function GetInfo(Index: Integer; OUT InfoName: PChar; OUT InfoVar: PChar): HResult; stdcall;
  // Declare Visual Basics
   Function SetDC(CONST NewDC: THandle): HResult; stdcall;
   Function SetDimensions(Left, Top, Width, Height : Integer): HResult; stdcall;
   Function SetConfigString(NewConfigString: PChar): HResult; stdcall;
  // Declare "Event" functions
   Function Redraw(OUT CallBack: PChar): HResult; stdcall;
   Function Update(SensorStyle: Byte; NewString: PChar; NewValue: Double; OUT CallBack: PChar): HResult; stdcall;
   Function Init(PaintDC: THandle): HResult; stdcall;
   Function Terminating: HResult; stdcall;
   Function Setup: HResult; stdcall;
   Function APICallBack(FromCM2: PChar; OUT CallBack: PChar): HResult; stdCall;
  // Declare Support types
   // Default (Required)
   Function GetDefaultCount(OUT DefaultCount: Integer): HResult; stdcall;
   Function GetDefault(Index: Integer; OUT Name: Pchar; OUT Value: PChar; OUT Description: PChar): HResult; stdcall;
   // Optional
   Function GetOptionalCount(OUT OptionalCount: Integer): HResult; stdcall;
   Function GetOptional(Index: Integer; OUT Name: Pchar; OUT Value: PChar; OUT Description: PChar): HResult; stdcall;
   // OnEvent
   Function OnEvent(Sender: Pchar; EventType: Byte; ModKeys: Byte; X, Y: Integer; OUT CallBack: PChar): HResult; stdcall;
   Function NotifyOnEvent(OUT EventList: Cardinal): HResult; stdcall;
  end;

const
  Class_CM2APIPlug: TGUID = '{6D9AEFA6-1823-4A36-B2DF-CC4F300F996A}';
  PlugVersion = 0100;
  RCVersion = 0800;

implementation

uses ComServ;

{ TCM2APIPlug }

function TCM2APIPlug.APICallBack(FromCM2: PChar;
  out CallBack: PChar): HResult;
begin
 FromCM2API := FromCM2;
 CallBack := 'REPAINT';
 Result := S_OK;
end;

function TCM2APIPlug.GetDefault(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Result := S_OK;
end;

function TCM2APIPlug.GetDefaultCount(out DefaultCount: Integer): HResult;
begin
 DefaultCount := 0;
 Result := S_OK;
end;

function TCM2APIPlug.GetInfo(Index: Integer; out InfoName,
  InfoVar: PChar): HResult;
begin
 Case Index of
  0: Begin InfoName := 'Programmed By'; InfoVar := 'Chris Aaangel'; end;
  1: Begin InfoName := 'Created'; InfoVar := 'May 22nd, 2005'; end;
  2: Begin InfoName := 'Updated'; InfoVar := 'May 22nd, 2005'; end;
  3: Begin InfoName := 'Copyright'; InfoVar := '(c) 2005 - The CoolMon Project'; end;
 end;
 result := S_OK;
end;

function TCM2APIPlug.GetInfoCount(out InfoCount: Integer): HResult;
begin
 InfoCount := 4;
 Result := S_OK;
end;

function TCM2APIPlug.GetLastErrorMsg(out Msg: PChar): HResult;
begin
 Msg := Pchar(LastErrorMsg);
 Result := S_OK;
end;

function TCM2APIPlug.GetOptional(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Result := S_OK;
end;

function TCM2APIPlug.GetOptionalCount(out OptionalCount: Integer): HResult;
begin
 OptionalCount := 0;
 Result := S_OK;
end;

function TCM2APIPlug.Init(PaintDC: THandle): HResult;
begin
 FromCM2API := 'N/A';
 fDC := PaintDC;
 Result := S_OK;
end;

function TCM2APIPlug.Name(out Name: Pchar): HResult;
begin
 Name := 'API Tester';
 Result := S_OK;
end;

function TCM2APIPlug.NotifyOnEvent(out EventList: Cardinal): HResult;
begin
 EventList := +noeMouseUpLeft;
 Result := S_OK;
end;

function TCM2APIPlug.OnEvent(Sender: Pchar; EventType, ModKeys: Byte; X,
  Y: Integer; out CallBack: PChar): HResult;
begin
 S := 'SENDBACK:X=' + IntToStr(X) + ' - Y=' + IntToStr(Y);
 CallBack := Pchar(S);

 Result := S_OK;
end;

function TCM2APIPlug.Redraw(out CallBack: PChar): HResult;
begin
 Result := S_OK;
 LastErrorMsg := '';
 Try
  Canvas := TCanvas.Create;
  Canvas.Handle := fDC;
 except
  LastErrorMsg := 'Unable to create Canvas';
  Result := E_FAIL;
  Exit;
 end;
 BeginPath(Canvas.Handle);
 Canvas.Font.Size := 10;
 Canvas.Font.Color := clwhite;
 Canvas.Brush.Color := clmoneygreen;
 Canvas.Pen.Color := clblack;
 EndPath(Canvas.Handle);
 Canvas.Rectangle(fleft, ftop, fleft + 200, ftop + 25);
 canvas.TextOut(fleft + 5, ftop + 5, 'RES=' + fString);
 BeginPath(Canvas.Handle);
 Canvas.Font.Size := 10;
 Canvas.Font.Color := clwhite;
 Canvas.Brush.Color := clskyblue;
 Canvas.Pen.Color := clblack;
 EndPath(Canvas.Handle);
 Canvas.Rectangle(fleft, ftop + 26, fleft + 200, ftop + 50);
 canvas.TextOut(fleft + 5, ftop + 30, 'API=' + FromCM2API);
 Canvas.Free;
 CallBack := '';
end;

function TCM2APIPlug.RequiredCoreVersion(out RCV: Word): HResult;
begin
 RCV := RCVersion;
 Result := S_OK;
end;

function TCM2APIPlug.SetConfigString(NewConfigString: PChar): HResult;
begin
 Result := S_OK;
end;

function TCM2APIPlug.SetDC(const NewDC: THandle): HResult;
begin
 fDc := NewDC;
 Result := S_OK;
end;

function TCM2APIPlug.SetDimensions(Left, Top, Width,
  Height: Integer): HResult;
begin
 fLeft := Left;
 fTop := Top;
 fWidth := Width;
 fHeight := Height;
 Result := S_OK;
end;

function TCM2APIPlug.Setup: HResult;
begin
 Result := E_NOTIMPL;
end;

function TCM2APIPlug.Terminating: HResult;
begin
 Result := S_OK;
end;

function TCM2APIPlug.Update(SensorStyle: Byte; NewString: PChar;
  NewValue: Double; out CallBack: PChar): HResult;
begin
 Case SensorStyle of
  0: fString := FloatToStr(NewValue);
  1: fString := NewString;
  else fString := 'Invalid SensorStyle #' + IntToStr(SensorStyle);
 End;
// fString := fString + ' [' + IntTosTr(SensorStyle) + ']';
 Result := S_OK;
end;

function TCM2APIPlug.Version(out Version: word): HResult;
begin
 Version := PlugVersion;
 Result := S_OK;
end;

initialization
  TComObjectFactory.Create(ComServer, TCM2APIPlug, Class_CM2APIPlug,
    'CM2APIPlug', '', ciMultiInstance, tmApartment);
end.
