unit VisPlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, CM2VisInterface, graphics, SysUtils,
   CM2EditorSupportInterface, Filter, CM2AutoUpdateInterface;

type
  TCM2VIS_BinaryClock = class(TComObject, ICM2VisPlug, ICM2EditorSupportVis10, ICM2AutoUpdate)
  private
   fDC: THandle;
   LastErrMsg: String;
   BColor, LOnColor, LOffColor: TColor;
   fLeft, fTop, fWidth, fHeight: Integer;
  protected
   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: HResult; stdcall;
   Function Update(SensorStyle: Byte; NewString: PChar; NewValue: Double): 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;
  // SUPPORT INTERFACE
   Function ObjIns(ParameterName: PChar; OUT ValueType: Byte; OUT ValueRange: PChar): HResult; stdcall;
  // AUTO UPDATE
   Function UpdateFileURL(OUT URL: Pchar): HResult; stdcall;
 End;

const
  Class_CM2VIS_BinaryClock: TGUID = '{8A0A361C-8984-46F5-91D7-E14821259280}';
  PlugVersion = 0101;
  RCVersion = 0800;
  LastUpdate = 'Oct. 18th 2005';
  UPDFile = 'http://www.coolmon.org/update/binclock.upd';

implementation

uses ComServ;

{ TCM2VIS_BinaryClock }

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

function TCM2VIS_BinaryClock.GetDefault(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Case Index of
  0: Begin Name := 'BackgroundColor'; Value := 'clBlack'; Description := 'The background color'; end;
  1: Begin Name := 'LedOnColor'; Value := 'clRed'; Description := 'The Color of active leds'; end;
  2: Begin Name := 'LedOffColor'; Value := 'clMaroon'; Description := 'The Color of inactive leds'; end;
 end;
 Result := S_OK;
end;

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

function TCM2VIS_BinaryClock.GetInfo(Index: Integer; out InfoName,
  InfoVar: PChar): HResult;
begin
 Result := S_OK;
 Case Index of
  0: Begin InfoName := 'Programmed By'; InfoVar := 'C. Aaangel'; end;
 1: Begin InfoName := 'Created'; InfoVar := 'Oct. 17th 2005'; end;
  2: Begin InfoName := 'Updated'; InfoVar := LastUpdate; end;
  else result := E_FAIL;
 end;
end;

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

function TCM2VIS_BinaryClock.GetLastErrorMsg(out Msg: PChar): HResult;
begin
 If LastErrMsg = '' then Msg := 'No error message reported'
  else Msg := Pchar(LastErrMsg);
 Result := S_OK;
end;

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

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

function TCM2VIS_BinaryClock.Init(PaintDC: THandle): HResult;
begin
 fDC := PaintDC;
 BColor := clBlack;
 LOnColor := clRed;
 LOffColor := clMaroon;
 Result := S_OK;
end;

function TCM2VIS_BinaryClock.Name(out Name: Pchar): HResult;
begin
 Name := 'Binary Clock';
 Result := S_OK;
end;

function TCM2VIS_BinaryClock.ObjIns(ParameterName: PChar;
  out ValueType: Byte; out ValueRange: PChar): HResult;
begin
 If uppercase(ParameterName) = 'BACKGROUNDCOLOR' then begin
  ValueType := vtColor;
  ValueRange := '';
 end;
 If uppercase(ParameterName) = 'LEDONCOLOR' then begin
  ValueType := vtColor;
  ValueRange := '';
 end;
 If uppercase(ParameterName) = 'LEDOFFCOLOR' then begin
  ValueType := vtColor;
  ValueRange := '';
 end;
 Result := S_OK;
end;

function TCM2VIS_BinaryClock.Redraw: HResult;
Var
 Canvas: TCanvas;
 H, M, S, Msec: Word;
begin
 Canvas := TCanvas.Create;
 Canvas.Handle := fDC;
 // Draw background
 Canvas.Pen.Color := BColor;
 Canvas.Brush.Color := BColor;
 Canvas.Brush.Style := bsSolid;
 Canvas.Rectangle(fleft, ftop, fleft + fWidth, fTop + fHeight);
 Canvas.Pen.Color := LOffColor;
 Canvas.Brush.Color := LOffColor;
 Canvas.Ellipse(0+fleft, 0+ftop, 10+fleft, 10+ftop);
 Canvas.Ellipse(15+fleft, 0+ftop, 15+10+fleft, 10+ftop);
 Canvas.Ellipse(30+fleft, 0+ftop, 30+10+fleft, 10+ftop);
 Canvas.Ellipse(45+fleft, 0+ftop, 45+10+fleft, 10+ftop);
 Canvas.Ellipse(60+fleft, 0+ftop, 60+10+fleft, 10+ftop);
 Canvas.Ellipse(0+fleft, 12+ftop, 10+fleft, 12+10+ftop);
 Canvas.Ellipse(12+fleft, 12+ftop, 10+12+fleft, 12+10+ftop);
 Canvas.Ellipse(24+fleft, 12+ftop, 10+24+fleft, 12+10+ftop);
 Canvas.Ellipse(36+fleft, 12+ftop, 10+36+fleft, 12+10+ftop);
 Canvas.Ellipse(48+fleft, 12+ftop, 10+48+fleft, 12+10+ftop);
 Canvas.Ellipse(60+fleft, 12+ftop, 10+60+fleft, 12+10+ftop);
 Canvas.Pen.Color := LOnColor;
 Canvas.Brush.Color := LOnColor;
 DecodeTime(Now, H, M, S, MSec);
 If H > 15 then begin
  Canvas.Ellipse(0+fleft, 0+ftop, 10+fleft, 10+ftop);
  Dec(H, 16);
 end;
 If H > 7 then begin
  Canvas.Ellipse(15+fleft, 0+ftop, 15+10+fleft, 10+ftop);
  Dec(H, 8);
 end;
 If H > 3 then begin
  Canvas.Ellipse(30+fleft, 0+ftop, 30+10+fleft, 10+ftop);
  Dec(H, 4);
 end;
 If H > 1 then begin
  Canvas.Ellipse(45+fleft, 0+ftop, 45+10+fleft, 10+ftop);
  Dec(H, 2);
 end;
 If H = 1 then begin
  Canvas.Ellipse(60+fleft, 0+ftop, 60+10+fleft, 10+ftop);
 end;
 If M > 31 then begin
  Canvas.Ellipse(0+fleft, 12+ftop, 10+fleft, 12+10+ftop);
  Dec(M, 32);
 end;
 If M > 15 then begin
  Canvas.Ellipse(12+fleft, 12+ftop, 10+12+fleft, 12+10+ftop);
  Dec(M, 16);
 end;
 If M > 7 then begin
  Canvas.Ellipse(24+fleft, 12+ftop, 10+24+fleft, 12+10+ftop);
  Dec(M, 8);
 end;
 If M > 3 then begin
  Canvas.Ellipse(36+fleft, 12+ftop, 10+36+fleft, 12+10+ftop);
  Dec(M, 4);
 end;
 If M > 1 then begin
  Canvas.Ellipse(48+fleft, 12+ftop, 10+48+fleft, 12+10+ftop);
  Dec(M, 2);
 end;
 If M = 1 then begin
  Canvas.Ellipse(60+fleft, 12+ftop, 10+60+fleft, 12+10+ftop);
 end;
 FreeAndNil(Canvas);
 Result := S_OK;
end;

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

function TCM2VIS_BinaryClock.SetConfigString(
  NewConfigString: PChar): HResult;
Var
 I: Integer;
 N, V: String;
begin
 For I := 1 to countfilt(NewConfigString, '|') do begin
  N := GetFilt(NewConfigString, I, '|');
  V := GetFilt(N, 2, '=');
  N := GetFilt(N, 1, '=');
  If uppercase(N) = 'BACKGROUNDCOLOR' then begin
   BColor := StringToColor(V);
  end;
  If uppercase(N) = 'LEDONCOLOR' then begin
   LOnColor := StringToColor(V);
  end;
  If Uppercase(N) = 'LEDOFFCOLOR' Then begin
   LOffColor := StringToColor(V);
  end;
 end;
 Result := S_OK;
end;

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

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

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

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

function TCM2VIS_BinaryClock.Update(SensorStyle: Byte; NewString: PChar;
  NewValue: Double): HResult;
begin
 Result := S_OK;
end;

function TCM2VIS_BinaryClock.UpdateFileURL(out URL: Pchar): HResult;
begin
 URL := UPDFile;
 result := S_OK;
end;

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

initialization
  TComObjectFactory.Create(ComServer, TCM2VIS_BinaryClock, Class_CM2VIS_BinaryClock,
    'CM2VIS_BinaryClock', '', ciMultiInstance, tmApartment);
end.
