unit PlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, CM2VISInterface, Graphics,
  SysUtils, Filter, CM2AutoUpdateInterface, CM2EditorSupportInterface;

type
  TCM2VisText = class(TComObject, ICM2VisPlug, ICM2AutoUpdate, ICM2EditorSupportVis10)
  private
   fDC: HDC;
   fLeft, fTop, fWidth, fHeight: Integer;
   Rect: TRect;
   fString: String;
   Canvas: TCanvas;
   FontName: String;
   FontColor: TColor;
   FontSize: Integer;
   FontStyle: TFontStyles;
   Background: TColor;
   LastErrorMsg: PChar;
   S: String;
  public
  // 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: 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;
   // 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;
   // Auto Update
   Function UpdateFileURL(OUT URL: Pchar): HResult; stdcall;
   // Editor Support
   Function ObjIns(ParameterName: PChar; OUT ValueType: Byte; OUT ValueRange: PChar): HResult; stdcall;
  end;

const
  Class_CM2VisText: TGUID = '{71607841-0C87-4F65-9C88-CFEAFADDFF16}';
  AutoUpdateFile = 'http://www.coolmon.org/update/text.upd';

implementation

uses ComServ;

{ TCM2VisText }

function TCM2VisText.GetDefault(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Result := S_OK;
 // Font, size, color, background
 Case Index of
  // <name>,<size>,<bold on/off (1/0)><italic on/off (1/0)><Underline on/off (1/0)><Strikeout On/Off (1/0)>
  0: Begin Name := 'Font'; Value := 'Arial,8,0000'; Description := 'Font settings'; end;
  1: Begin Name := 'Color'; Value := 'clwindowtext'; Description := 'Font color'; end;
  2: Begin Name := 'Background'; Value := 'clbtnface'; Description := 'Background color - Should be the color of the parent form'; End;
  else
   begin
    LastErrorMsg := 'Index of out of bounds';
    Result := E_FAIL;
   End;
 end
end;

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

function TCM2VisText.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 := 'Updated'; InfoVar := 'June 30th 2004';
     End;
  2: Begin
      InfoName := 'Copyright'; InfoVar := '(c) 2003 - 2004, by Christian Aaangel';
     End;
  else begin
        Result := E_FAIL;
        LastErrorMsg := 'Index out of bounds';
       End;
 End;
end;

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

function TCM2VisText.GetLastErrorMsg(OUT Msg: PChar): HResult;
begin
 If LastErrorMsg = '' then LastErrorMsg := ('No error');
 Msg := LastErrorMsg;
 Result := S_OK;
end;

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

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

function TCM2VisText.Init(PaintDC: THandle): HResult;
begin
 Result := S_OK;
 FontColor := clWhite;
 Background := clBlack;
 Try
  fDC := PaintDC;
 Except
  LastErrorMsg := 'Unable to set internal DC';
  Result := E_FAIL;
 End;
end;

function TCM2VisText.Name(out Name: Pchar): HResult;
begin
 Name := PChar('Text');
 Result := S_OK;
end;

function TCM2VisText.ObjIns(ParameterName: PChar; out ValueType: Byte;
  out ValueRange: PChar): HResult;
begin
 ValueType := vtUnknown;
 If Uppercase(ParameterName) = 'FONT' then begin
  ValueType := 6;
 end;
 If Uppercase(ParameterName) = 'COLOR' then begin
  ValueType := vtColor;
 end;
 If Uppercase(ParameterName) = 'BACKGROUND' then begin
  ValueType := vtColor;
 end;
 Result := S_OK;
end;

function TCM2VisText.Redraw: HResult;
begin
 Result := S_OK;
 LastErrorMsg := '';
 Try
  Canvas := TCanvas.Create;
  Canvas.Handle := fDC;
 except
  LastErrorMsg := 'Unable to create Canvas';
  Result := E_FAIL;
  Exit;
 end;
 Try
  BeginPath(Canvas.Handle);
  Canvas.Font.Name := FontName;
  Canvas.Font.Size := FontSize;
  Canvas.Font.Color := FontColor;
  Canvas.Font.Style := FontStyle;
  Canvas.Brush.Color := Background;
  Canvas.Pen.Color := FontColor;
  EndPath(Canvas.Handle);
 except
  try
   Canvas.Free;
  except
  end;
  LastErrorMsg := 'Unable to set canvas properties';
  result := E_FAIL;
  exit;
 end;
 try
  //Canvas.TextOut(fLeft, fTop, fString);
  Canvas.TextRect(Rect, fLeft+2, fTop+2, fString);
 except
  try
   Canvas.Free;
  except
  end;
  LastErrorMsg := 'Unable to draw text';
  result := E_FAIL;
  exit;
 End;
 try
  Canvas.Free;
 except
  LastErrorMsg := 'Unable free canvas';
  result := E_FAIL;
  exit;
 End;
end;

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

function TCM2VisText.SetConfigString(NewConfigString: PChar): HResult;
Var
 I: Integer;
 FName, FSize, FStyle, C,V: String;
 Bold, Italic, Underline, StrikeOut: Boolean;
 FS: TFontStyles;
begin
 S := NewConfigString;
 For I := 0 to CountFilt(NewConfigString, '|') do begin
  S := uppercase(GetFilt(NewConfigString, I, '|'));
  C := GetFilt(S, 1, '=');
  V := GetFilT(S, 2, '=');
  If C = 'FONT' Then Begin
   If CountFilt(V, ',') = 3 then begin
    FName := GetFilt(V, 1, ',');
    FSize := GetFilt(V, 2, ',');
    FStyle := GetFilt(V, 3, ',');
    If length(FStyle) <> 4 then FStyle := '0000';
   end;
   try
    FontName := FName;
   except
    FontName := 'Arial';
   End;
   try
    FontSize := StrToInt(FSize);
   except
    FontSize := 10;
   end;
   If FStyle[1] = '1' then Bold := true
    else Bold := false;
   If FStyle[2] = '1' then Italic := true
    else Italic := false;
   If FStyle[3] = '1' then Underline := true
    else Underline := False;
   If FStyle[4] = '1' then StrikeOut := true
    else Strikeout := False;
   Fs := [];
   If Bold then FS := FS + [fsBold];
   If Italic then FS := FS + [fsItalic];
   If Underline Then FS := FS + [fsUnderline];
   If StrikeOut then FS := FS + [fsStrikeOut];
   FontStyle := FS;
  End;
  If C = 'COLOR' Then Begin
   Try // Catch converter errors
    FontColor := StringToColor(V);
   except
    FontColor := clBlack;
   end;
  End;
  If C = 'BACKGROUND' Then begin
   Try // Catch converter errors
    Background := StringToColor(V);
   except
    Background := clwhite;
   end;
  end;
 End;
 Result := S_OK;
end;

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

function TCM2VisText.SetDimensions(Left, Top, Width,
  Height: Integer): HResult;
begin
 fLeft := Left;
 fTop := Top;
 fWidth := Width;
 fHeight := Height;
 Rect.Left := Left;
 Rect.Top := Top;
 Rect.Right := Left + Width;
 Rect.Bottom := Top + Height;
 Result := S_OK;
end;

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

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

function TCM2VisText.Update(SensorStyle: Byte; NewString: PChar; NewValue: Double): 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 TCM2VisText.UpdateFileURL(out URL: Pchar): HResult;
begin
 URL := PChar(AutoUpdateFile);
 Result := S_OK;
end;

function TCM2VisText.Version(out Version: word): HResult;
begin
 Version := 0700;
 Result := S_OK;
end;

initialization
  TComObjectFactory.Create(ComServer, TCM2VisText, Class_CM2VisText,
    'CM2VisText', 'CoolMon 2 Visual Text Plugin', ciMultiInstance, tmApartment);
end.
