unit VisPlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, ActiveX, Classes, ComObj, CM2VISInterface, Graphics, CM2EditorSupportInterface;

type
  TDropDownPanel = class(TComObject, ICM2VisPlug3, ICM2EditorSupportVis10)
  private
   LastErrMsg, callbackstr: String;
   fDC: THandle;
   fLeft, fTop, fHeight, fWidth: Integer;
   Expanded: Boolean;
   BorderColor: TColor;
   CaptionColor: TColor;
   MainAreaColor: TColor;
   CaptionFont: TFont;
   MainFont: TFont;
   CaptionHeight: Integer;
   CaptionText: String;
   MainText: 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: 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;
   // Event
   Function OnEvent(Sender: Pchar; EventType: Byte; ModKeys: Byte; X, Y: Integer; OUT CallBack: PChar): HResult; stdcall;
   Function NotifyOnEvent(OUT EventList: Cardinal): HResult; stdcall;
   // Editor support
   Function ObjIns(ParameterName: PChar; OUT ValueType: Byte; OUT ValueRange: PChar): HResult; stdcall;
  end;

const
  Class_DropDownPanel: TGUID = '{FB3F3893-50C2-4CE2-8135-54A2AF26854B}';
  RCVersion = 0620;
  PlugVersion = 0500;

implementation

uses ComServ, Filter, Sysutils, Dialogs, CM2GenInterface;

{ TDropDownPanel }

// Properties
// * Panel color
//   - Border
//   - Caption
//   - Caption text
//   - Main area color
//   - Main Text color
// * Caption Font
// * Main Font
// * Height extended/collapsed

function TDropDownPanel.GetDefault(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Result := S_OK;
 Case Index of
  0: Begin Name := 'BorderColor'; Value := 'clblue'; Description := 'Border color for the dropdown object'; end;
  1: Begin Name := 'CaptionColor'; Value := 'clnavy'; Description := 'The color for the caption panel'; end;
  2: Begin Name := 'MainColor'; Value := 'clwhite'; Description := 'The Dropdown panel color'; end;
  3: Begin Name := 'CaptionFont_Name'; Value := 'arial'; Description := 'The font name for the caption'; end;
  4: Begin Name := 'CaptionFont_Size'; Value := '10'; Description := 'The Caption font size'; end;
  5: Begin Name := 'CaptionFont_Color'; Value := 'clyellow'; Description := 'The color for caption text'; end;
  6: Begin Name := 'MainFont_Name'; Value := 'arial narrow'; Description := 'Font name for the dropdown text'; end;
  7: Begin Name := 'MainFont_Size'; Value := '18'; Description := 'Font size for the dropdown text'; end;
  8: Begin Name := 'MainFont_Color'; Value := 'clblack'; description := 'Color for the dropdown text'; end;
  9: Begin Name := 'CaptionHeight'; Value := '15'; Description := 'Height for the caption field, should be larger than CaptionFont_Size but small enough to allow height to acommodate both caption panel and dropdown block'; end;
 10: Begin Name := 'CaptionText'; Value := 'MyDropDown Panel'; Description := 'Caption Text'; end;
  else begin
   Result := E_FAIL;
   LastErrMsg := 'Index out of bounds';
  end;
 end;
end;

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

function TDropDownPanel.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 := 'September, 8th 2004'; end;
  2: Begin InfoName := 'Updated'; InfoVar := 'December, 14th 2004'; end;
  3: Begin InfoName := 'Copyright'; InfoVar := 'Copyright (c) 2004, C. Aaangel'; end;
  else begin
   LastErrMSg := 'Index out of bounds';
   Result := E_FAIL
  end;
 End;
end;

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

function TDropDownPanel.GetLastErrorMsg(out Msg: PChar): HResult;
begin
 If LAstErrMsg = '' Then LastErrMsg := 'No Error';
 Msg := PChar(LastErrMsg);
 Result := S_OK;
end;

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

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

function TDropDownPanel.Init(PaintDC: THandle): HResult;
begin
 fDC := PaintDC;
 fLeft := 0;
 fTop := 0;
 fWidth := 50;
 fHeight := 25;
 Expanded := True;

 BorderColor := clwhite;
 CaptionColor := clgray;
 MainAreaColor := clsilver;
 CaptionFont := TFont.Create;
 MainFont := TFont.Create;
 CaptionHeight := 20;
 CaptionText := 'Default Caption';
 MainText := '';

 Result := S_OK;
end;

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

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

function TDropDownPanel.ObjIns(ParameterName: PChar; out ValueType: Byte;
  out ValueRange: PChar): HResult;
begin
 Result := S_OK;
 ValueType :=vtUnknown;
 If uppercase(ParameterName) = 'BORDERCOLOR' then begin
  ValueType := vtColor;
  ValueRange := '';
 end;
 If uppercase(ParameterName) = 'CAPTIONCOLOR' then begin
  ValueType := vtColor;
  ValueRange := '';
 end;
 If uppercase(ParameterName) = 'MAINCOLOR' then begin
  ValueType := vtColor;
  ValueRange := '';
 end;
 If uppercase(ParameterName) = 'CAPTIONFONT_COLOR' then begin
  ValueType := vtColor;
  ValueRange := '';
 end;
 If uppercase(ParameterName) = 'CAPTIONFONT_SIZE' then begin
  ValueType := vtRange;
  ValueRange := '0|255';
 end;
 If uppercase(ParameterName) = 'CAPTIONFONT_NAME' then begin
  ValueType := vtFont;
  ValueRange := '';
 end;
 If uppercase(ParameterName) = 'MAINFONT_NAME' then begin
  ValueType := vtFont;
  ValueRange := '';
 end;
 If uppercase(ParameterName) = 'MAINFONT_SIZE' then begin
  ValueType := vtRange;
  ValueRange := '0|255';
 end;
 If uppercase(ParameterName) = 'MAINFONT_COLOR' then begin
  ValueType := vtColor;
  ValueRange := '';
 end;
end;

function TDropDownPanel.OnEvent(Sender: Pchar; EventType, ModKeys: Byte; X,
  Y: Integer; out CallBack: PChar): HResult;
begin
 If ((Y >= fTop) and (Y <= ftop + captionheight)) and (EventType = et_DblClick) then begin
  Expanded := Not(Expanded);
 end;
 // Make CM2 Redraw VO
 CallBackstr := 'Repaint';
 CallBack := Pchar(CallBackStr);
 Result := S_OK;
end;

function TDropDownPanel.Redraw: HResult;
Var
 C: TCanvas;
begin
// Expanded := not(Expanded);
 Result := S_OK;
 Try
  C := TCanvas.Create;
  C.Handle := fDC;
  If expanded then begin
   // Draw outline
   C.Brush.Color := mainareacolor;
   C.Pen.Color := bordercolor;
   C.Brush.Style := bsSolid;
   C.Rectangle(fleft, ftop, fleft + fwidth, ftop + fheight);
   // Draw caption
   C.Brush.Color := CaptionColor;
   C.Pen.Color := BorderColor;
   C.Brush.Style := bsSolid;
   C.Font := Captionfont;
   C.TextRect(Rect(fLeft, ftop, fleft+fwidth, ftop+captionHeight), fleft+1, ftop+1, CaptionText);
   // Draw main text
   C.Brush.Color := mainareacolor;
   C.Pen.Color := bordercolor;
   C.Brush.Style := bsSolid;
   C.Font := mainfont;
   C.TextRect(Rect(fLeft+1, ftop+captionheight+1, fleft+fwidth-2, ftop+fheight - 2), 5, captionheight + 8, Maintext);
  end
   else
  begin
 {   BorderColor: TColor;
    CaptionColor: TColor;
    MainAreaColor: TColor;
    CaptionFont: TFont;
    MainFont: TFont;
    CaptionHeight: Integer;}

   C.Brush.Color := CaptionColor;
   C.Pen.Color := BorderColor;
   C.Brush.Style := bsSolid;
   C.Font := Captionfont;
   C.TextRect(Rect(fLeft, ftop, fleft+fwidth, ftop+captionHeight), fleft+1, ftop+1, CaptionText);
  end;
  FreeAndNil(C);
 Except
  MessageDlg('Exception', mtWarning, [mbOK], 0);
  Result := E_FAIL;
 end;
end;

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

function TDropDownPanel.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 := Uppercase(GetFilt(N, 1, '='));
  If N = 'BORDERCOLOR' then begin
   Try
    BorderColor := StringToColor(V);
   except
    BorderColor := clblue;
   end;
  end;
  If N = 'CAPTIONCOLOR' then begin
   try
    CaptionColor := StringToColor(V);
   except
    CaptionColor := clNavy;
   end;
  end;
  If N = 'MAINCOLOR' then begin
   try
    MainAreaColor := StringToColor(V);
   except
    MainAreaColor := clwhite;
   end;
  end;
  If N = 'CAPTIONFONT_NAME' then begin
   CaptionFont.Name := V;
  end;
  If N = 'CAPTIONFONT_SIZE' then begin
   Try
    CaptionFont.Size := StrToInt(V);
   except
    CaptionFont.Size := 10;
   end;
  end;
  If N = 'CAPTIONFONT_COLOR' then begin
   Try
    CaptionFont.Color := StringToColor(V);
   except
    CaptionFONT.Color := clBlack;
   end;
  end;
  If N = 'MAINFONT_NAME' then begin
   MAINFont.Name := V;
  end;
  If N = 'MAINFONT_SIZE' then begin
   Try
    MainFont.Size := StrToInt(V);
   except
    MainFont.Size := 10;
   end;
  end;
  If N = 'MAINFONT_COLOR' then begin
   Try
    MainFont.Color := StringToColor(V);
   except
    MainFONT.Color := clBlack;
   end;
  end;
  If N = 'CAPTIONHEIGHT' then begin
   try
    CaptionHeight := StrToInt(V);
   except
    CaptionHeight := 12;
   end;
  end;
  If N = 'CAPTIONTEXT' then begin
   CaptionText := V;
  end;
 end;
 Result := S_OK;
end;

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

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

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

function TDropDownPanel.Terminating: HResult;
begin
 Freeandnil( CaptionFont);
 FreeAndNil(MainFont);
 Result := S_OK;
end;

function TDropDownPanel.Update(SensorStyle: Byte; NewString: PChar;
  NewValue: Double): HResult;
begin
 Case SensorStyle of
  ssNumeric: MainText := FloatToStr(NewValue);
  ssNonNumeric: MainText := NewString;
 end;
 Result := S_OK;
end;

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

initialization
  TComObjectFactory.Create(ComServer, TDropDownPanel, Class_DropDownPanel,
    'DropDownPanel', '', ciMultiInstance, tmApartment);
end.
