unit PlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, CM2PluginTypes, CM2VisPlugTypes, CM2VISInterface, extCtrls;

type
  TTCM2VIS_Ticker = class(TComObject, ICM2VisPlug4)
  private
   PDC: hDC;
   X, L, H, W, T: Integer;
   Timer: TTimer;
   Messages: TStringlist;
   Procedure OnPaint(Sender: TObject);
   procedure AddToMessages(Str: string);
  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_TCM2VIS_Ticker: TGUID = '{165E88CA-E024-4571-A209-680867FAC856}';

implementation

uses ComServ, graphics, sysutils;

{ TTCM2VIS_Ticker }

procedure TTCM2VIS_Ticker.AddToMessages(Str: string);
Var
 I: Integer;
begin
 For I := 0 to messages.count - 1 do begin
  If uppercase(str) = uppercase(messages[I]) then exit;
 end;
 Messages.Add(Str);
end;

function TTCM2VIS_Ticker.APICallBack(FromCM2: PChar;
  out CallBack: PChar): HResult;
begin
 Result := S_OK;
end;

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

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

function TTCM2VIS_Ticker.GetInfo(Index: Integer; out InfoName,
  InfoVar: PChar): HResult;
begin
 Result := S_OK;
end;

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

function TTCM2VIS_Ticker.GetLastErrorMsg(out Msg: PChar): HResult;
begin
 Msg := 'Error checking not supported';
 Result := S_OK;
end;

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

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

function TTCM2VIS_Ticker.Init(PaintDC: THandle): HResult;
begin
 X := 0;
 PDC := PaintDC;
 Messages := TStringList.Create;
 Messages.Add('Ticker Version 0.1.0.0 by Aaangel');
 Result := S_OK;
end;

function TTCM2VIS_Ticker.Name(out Name: Pchar): HResult;
begin
 Name := 'Ticker';
 Result := S_OK;
end;

function TTCM2VIS_Ticker.NotifyOnEvent(out EventList: Cardinal): HResult;
begin
 EventList := 0;
 Result := S_OK;
end;

function TTCM2VIS_Ticker.OnEvent(Sender: Pchar; EventType, ModKeys: Byte;
  X, Y: Integer; out CallBack: PChar): HResult;
begin
 CallBack := '';
 Result := S_OK;
end;

procedure TTCM2VIS_Ticker.OnPaint(Sender: TObject);
Var
 BMP: TBitmap;
 C: TCanvas;
 R: TRect;
begin
 If assigned(Timer) then begin
  Timer.Enabled := false;
 end;

 BMP := Tbitmap.Create;
 R.Left := L;
 R.Top := T;
 R.Right := L+W;
 R.Bottom := H+T;
 BMP.Width := W;
 BMP.Height := H;
 BMP.Canvas.TextRect(R, X, 0, Messages[0]);
 C := TCanvas.Create;
 C.Handle := PDC;
 C.Draw(0,0, bmp);
 Dec(X, 2);
 If X < (0- C.TextWidth(Messages[0])) then begin
  If Messages.Count > 1 then begin
   Messages.Delete(0);
  end;
  X := W;
 end;
 freeandnil(bmp);
 FreeAndnil(C);

 If assigned(Timer) then begin
  Timer.Enabled := true;
 end;
end;

function TTCM2VIS_Ticker.Redraw(out CallBack: PChar): HResult;
begin
 If not assigned(Timer) then begin
  Timer := TTimer.Create(nil);
  Timer.OnTimer := OnPaint;
  timer.Interval := 100;
  Timer.Enabled := true;
 end;
 OnPaint(Nil);
 CallBack := '';
 Result := S_OK;
end;

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

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

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

function TTCM2VIS_Ticker.SetDimensions(Left, Top, Width,
  Height: Integer): HResult;
begin
 L := Left;
 T := Top;
 W := Width;
 H := Height;
 Result := S_OK;
end;

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

function TTCM2VIS_Ticker.Terminating: HResult;
begin
 If assigned(timer) then freeandnil(timer);
 FreeAndNil(Messages);
 Result := S_OK;
end;

function TTCM2VIS_Ticker.Update(SensorStyle: Byte; NewString: PChar;
  NewValue: Double; out CallBack: PChar): HResult;
begin
 AddToMessages(NewString);
 Result := S_OK;
end;

function TTCM2VIS_Ticker.Version(out Version: word): HResult;
begin
 Version := 0100;
 Result := S_OK;
end;

initialization
  TComObjectFactory.Create(ComServer, TTCM2VIS_Ticker, Class_TCM2VIS_Ticker,
    'TCM2VIS_Ticker', '', ciMultiInstance, tmApartment);
end.
