unit PlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

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

type
  TTabbedVis = class(TComObject, ICM2EditorSupportVis20, ICM2VisPlug4)
  private
   Tabs, APIString: String;
   ParentDC: hDC;
   L, T, W, H: Integer;
   ButtonCount: Byte;
   Selected: Byte;
  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;
   // Edit Support
   Function ObjIns(ParameterName: PChar; OUT ValueType: Byte; OUT ValueRange: PChar): HResult; stdcall;
   Function OnEditor(ParameterName: PChar; FullParameterValues: PChar; OUT Value: PChar): HResult; stdcall;
   Function GetMenuCount(OUT MenuCount: Byte): HResult; stdcall;
   Function GetMenuItem(Index: Byte; OUT MenuTitle: PChar; OUT MenuHint: PChar): HResult; stdcall;
   Function OnMenu(Index: Byte; OUT ResultString: PChar): HResult; stdcall;
  end;

const
  Class_TabbedVis: TGUID = '{4DD00483-DA38-48D9-9FF3-F12492E67EC5}';
  PlugVersion = 0100;
  RCVersion = 0800;

implementation

uses ComServ, SysUtils, Dialogs;

{ TTabbedVis }

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

function TTabbedVis.GetDefault(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Case Index of
  0: Begin Name := 'Buttons'; Value := '2'; Description := 'How many buttons do you need?'; end;
  1: Begin Name := 'TabNames'; Value := 'Item 1.Form1,Item 2.Form2'; Description := 'Names to be listed on your tabs'; end;
 end;
 Result := S_OK;
end;

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

function TTabbedVis.GetInfo(Index: Integer; out InfoName,
  InfoVar: PChar): HResult;
begin
 Case Index of
  0: Begin InfoName := 'Concept Plugin'; InfoVar := ''; End;
 end;
 Result := S_OK;
end;

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

function TTabbedVis.GetLastErrorMsg(out Msg: PChar): HResult;
begin
 Msg := #0;
 Result := S_OK;
end;

function TTabbedVis.GetMenuCount(out MenuCount: Byte): HResult;
begin
 MenuCount := 0;
 Result := S_OK;
end;

function TTabbedVis.GetMenuItem(Index: Byte; out MenuTitle,
  MenuHint: PChar): HResult;
begin
 Result := S_OK;
end;

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

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

function TTabbedVis.Init(PaintDC: THandle): HResult;
begin
 ParentDC := PaintDC;
 Selected := 1;
 ButtonCount := 2;
 Tabs := 'Item 1.Form1,Item 2.Form2';
 Result := S_OK;
end;

function TTabbedVis.Name(out Name: Pchar): HResult;
begin
 Name := 'Tabbed Control';
 Result := S_OK;
end;

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

function TTabbedVis.ObjIns(ParameterName: PChar; out ValueType: Byte;
  out ValueRange: PChar): HResult;
begin
 Result := S_OK;
 ValueType := vtUnknown;
 If uppercase(ParameterName) = 'BUTTONS' then begin
  ValueType := vtRange;
  ValueRange := '2|10';
 end;
end;

function TTabbedVis.OnEditor(ParameterName, FullParameterValues: PChar;
  out Value: PChar): HResult;
begin
 Result := S_OK;
end;

function TTabbedVis.OnEvent(Sender: Pchar; EventType, ModKeys: Byte; X,
  Y: Integer; out CallBack: PChar): HResult;
Var
 LX, HX, I, DX: Integer;
 S1, S: String;
begin
 DX := W div ButtonCount;
 S := '';
 For I := 0 to ButtonCount - 1 do begin
  LX := I * DX;
  HX := LX + DX;
 { MessageDlg('I = ' + IntToStr(I) + #13#10+
             'DX = ' + IntToStr(DX) +#13+#10+
             'LX = ' + IntToStR(LX) +#13+#10+
             'HX = ' + IntToStr(HX) +#13+#10+
             'X = ' + IntToStr(X), mtWarning, [mbOK], 0);
  }
  If (X >= LX) and (X <= HX) then begin
   Selected := I;
   S := S + 'SHOW_FORM:'
  end
   else
  begin
   S := S + 'HIDE_FORM:';
  end;
  S1 := GetFilt(Tabs, I + 1, ',');
  S1 := GetFilt(S1, 2, '.');
  S := S + S1 + ';';
 end;
 APIString := S + 'REPAINT;';
// MessageDlg(APIString, mtWarning, [mbOK], 0);
 CallBack := Pchar(APIString);
 Result := S_OK;
end;

function TTabbedVis.OnMenu(Index: Byte; out ResultString: PChar): HResult;
begin
 Result := S_OK;
end;

function TTabbedVis.Redraw(out CallBack: PChar): HResult;
Var
 C: TCanvas;
 I, DX, X: Integer;
 S: String;
begin
 Result := S_OK;
 C := TCanvas.Create;
 C.Handle := ParentDC;
 C.Pen.Color := clNavy;
 C.Brush.Style := bsSolid;
 C.Brush.Color := clWhite;
 C.Rectangle(L, T, L+W, T+H);
 DX := W Div ButtonCount;
 X := 0;
 For I := 0 to ButtonCount - 1 do begin
  If Selected = I then C.Pen.Color := clFuchsia
   else C.Pen.Color := clNavy;
  C.Rectangle(X, T, X + DX, T + H);
  S := GetFilt(Tabs, I + 1, ','); //'#' + IntToStr(I);
  S := GetFilt(S, 1, '.');
  C.TextRect(Rect(X + 1, T + 1, X + DX - 2, T + H - 2), X + ((DX div 2) - (C.TextWidth(S) div 2)), T + ((H div 2) - (C.TextHeight(S) div 2)), S);
  Inc(X, DX);
 end;
 FreeAndNil(C);
end;

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

function TTabbedVis.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) = 'BUTTONS' then begin
   Try
    ButtonCount := StrToInt(V);
   except
    On EConvertError do begin
     ButtonCount := 3;
    end;
   end;
  end;
  If uppercase(N) = 'TABNAMES' then begin
   Tabs := V;
  end;
 end;
end;

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

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

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

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

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

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

initialization
  TComObjectFactory.Create(ComServer, TTabbedVis, Class_TabbedVis,
    'TabbedVis', '', ciMultiInstance, tmApartment);
end.
