unit PlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

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

type
  TVisImage = class(TComObject, ICM2VisPlug, ICM2AutoUpdate, ICM2EditorSupportVis10)
  private
   fLeft, fWidth, fheight, ftop: Integer;
   fDc: HDC;
   FName: String;
   S: String;
   LastErrorMsg: Pchar;
  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;
  // 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;
   // 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_VisImage: TGUID = '{77FEF083-655F-4711-9BA3-9DEC9249F5F5}';
  AutoUpdateFile = 'http://www.coolmon.org/update/image.upd';

implementation

uses ComServ;

{ TVisImage }

function TVisImage.GetDefault(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Case Index of
  0: begin Name := 'Filename'; value := 'MyImage.Jpg'; Description := 'Full path to the (JPEG or BMP) image file you want to use'; end;
 end;
 result := S_OK;
end;

function TVisImage.GetDefaultCount(out DefaultCount: Integer): HResult;
begin
 result := S_OK;
 DefaultCount := 1;
end;

function TVisImage.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 := 'May 19th 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 TVisImage.GetInfoCount(out InfoCount: Integer): HResult;
begin
 Result := S_OK;
 InfoCount := 3;
end;

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

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

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

function TVisImage.Init(PaintDC: THandle): HResult;
begin
 fLeft := 1;
 fTop := 1;
 fWidth := 200;
 fHeight := 100;
 fDc := PaintDC;
 Result := S_OK;
end;

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

function TVisImage.ObjIns(ParameterName: PChar; out ValueType: Byte;
  out ValueRange: PChar): HResult;
begin
 Result := S_OK;
 If uppercase(Parametername) = 'FILENAME' then begin
  ValueType := vtFile;
  S := 'BMP|JPG|JPEG';
  ValueRange := PChar(S);
 end;
end;

function TVisImage.Redraw: HResult;
Var
 Canvas: TCanvas;
 Picture: TPicture;
// R: TRect;
// Tgraphic
begin
// Showmessage('Filename = ' + FNAme);
 Result := S_OK;
 If Not fileexists(FName) then exit;
 Try

  Canvas := TCanvas.Create;
  Canvas.Handle := fDC;
  Picture := TPicture.Create;
  Picture.LoadFromFile(FName);

  Canvas.Draw(fleft, ftop, Picture.Graphic);
{  R.Left := fLEft;
  R.Top := fTop;
  R.Right := fLeft + fWidth;
  R.Bottom := fTop + fHeight;
  Canvas.StretchDraw(R, Picture.Graphic);}
  Canvas.Free;
  Picture.Free;

 Except
  Result := E_FAIL;
  LastErrorMsg := 'unable to perform draw commands';
 End;
end;

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

function TVisImage.SetConfigString(NewConfigString: PChar): HResult;
Var
 I: Integer;
 N, V: String;
begin
 Result := S_OK;
 For I := 1 to countFilt(NewConfigString, '|') do begin
  N := GetFilt(NewConfigString, I, '|');
  V := GetFilt(N, 2, '=');
  N := GetFilt(N, 1, '=');
  If Uppercase(N) = 'FILENAME' Then FName := V;
 End;
end;

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

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

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

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

function TVisImage.Update(SensorStyle: Byte; NewString: PChar; NewValue: Double): HResult;
begin
 If Fileexists(NewString) then Fname := NewString; 
 Result := S_OK;
end;

function TVisImage.UpdateFileURL(out URL: Pchar): HResult;
begin
 URL := PChar(AutoUpdateFile);
 Result := S_OK;
end;

function TVisImage.Version(out Version: word): HResult;
begin
 Version := 0600;
 Result := S_OK;
end;

initialization
  TComObjectFactory.Create(ComServer, TVisImage, Class_VisImage,
    'VisImage', 'Image Plugin For Coolmon2', ciMultiInstance, tmApartment);
end.
