unit PlugServ;

{$WARN SYMBOL_PLATFORM OFF}

interface

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

type
  TStyle = (stOneColor, stGradient, stGradientFloat);
  TCM2VisBar = class(TComObject, ICM2VisPlug, ICM2AutoUpdate, ICM2EditorSupportVis10)
  private
   fDC: HDC;
   fLeft, fTop, fWidth, fHeight: Integer;
   Rect: TRect;
   fValue: Extended;
   Canvas: TCanvas;
   BlendOver, Min, Max: Integer;
   Border, Color, endcolor, Background: TColor;
   LastErrorMsg: String;
   style: TStyle;
   Procedure InitDefaultValues;
  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_CM2VisBar: TGUID = '{5957293D-54C6-48FD-A7EF-B04ACB0FE695}';
  PlugVersion: Word = 1000;
  AutoUpdateFile = 'http://coolmon.blackstar.solar/update/plugins/visual/bar.upd';


implementation

uses ComServ, PlugHelper, Win32Dlg;

{ TCM2VisBar }

function TCM2VisBar.GetDefault(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Case Index of
  0: Begin Name := 'Min'; Value := '0'; Description := 'Minimum value'; end;
  1: Begin Name := 'Max'; Value := '100'; Description := 'Maximum value'; end;
  2: Begin Name := 'Background'; Value := 'clskyblue'; Description := 'Background color (Delphi color only)'; end;
  3: Begin Name := 'Border'; Value := 'clwhite'; Description := 'Border color (Delphi Color Only)'; end;
  4: Begin Name := 'Color'; Value := 'clblue'; Description := 'Bar color (Delphi Color Only'; end;
  5: Begin Name := 'Style'; Value := 'ONECOLOR'; Description := 'Barstyle ("ONECOLOR"/"GRADIENT"/"GRADIENTFLOAT")'; end;
 End;
 Result := S_OK;
end;

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

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

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

function TCM2VisBar.GetOptional(Index: Integer; out Name, Value,
  Description: PChar): HResult;
begin
 Case Index of
  0: Begin Name := 'Blendover'; Value := 'auto'; Description := 'How many color shade to blend over (used with gradient)'; end;
  1: Begin Name := 'EndColor'; Value := 'clred'; Description := 'Secondary Color (when using gradient'; end;
 End;
 Result := S_OK;
end;

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

function TCM2VisBar.Init(PaintDC: THandle): HResult;
begin
  InitDefaultValues;

 Result := S_OK;
 fDC := PaintDC;
 Style := stOneColor;
end;

procedure TCM2VisBar.InitDefaultValues;
begin
//    fLeft, fTop, fWidth, fHeight: Integer;
//   fValue: Extended;
//   BlendOver, Min, Max: Integer;
//   Border, Color, endcolor, Background: TColor;
 fLeft := 0; fTop := 0; fWidth := 100; fHeight := 100;
 fValue := 25;
 BlendOver := 2;
 Min := 0; Max := 100;
 Border := clBlue; Color := clFuchsia; endColor := clRed; Background := clWhite;

end;

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

function TCM2VisBar.ObjIns(ParameterName: PChar; out ValueType: Byte;
  out ValueRange: PChar): HResult;
begin
 Result := S_OK;
 ValueType := vtUnknown;
 If uppercase(parameterName) = 'BACKGROUND' then begin
  ValueType := vtColor;
 end;
 If uppercase(parameterName) = 'BORDER' then begin
  ValueType := vtColor;
 end;
 If uppercase(parameterName) = 'COLOR' then begin
  ValueType := vtColor;
 end;
 If uppercase(parameterName) = 'STYLE' then begin
  ValueType := vtFixed;
  ValueRange := 'ONECOLOR|GRADIENT|GRADIENTFLOAT';
 end;
 If uppercase(parameterName) = 'ENDCOLOR' then begin
  ValueType := vtColor;
 end;
end;

function TCM2VisBar.Redraw: HResult;
Var
 TempBlend, I, Pos,Interval: Integer;
 Multiplier: Double;
 Colors: TColorList;
begin
 SetLength(Colors, 0);
 Result := S_OK;
 Try
  Canvas := TCanvas.Create;
  Canvas.Handle := fDC;

  Canvas.Brush.Color := background;
  Canvas.Pen.Color := border;

  Canvas.Rectangle(fLeft, fTop, fLeft + fWidth, fTop + fHeight);

  Canvas.Brush.Color := color;
  Canvas.Pen.Color := color;

  Interval := Max - Min;

  Pos := round((fValue - Min) * ( fWidth / Interval ));
  Case Style of
   stOneColor: begin
                Canvas.Rectangle(fLeft + 1, fTop + 1, fLeft + pos, fTop + fHeight - 1);
               End;
   stGradient: Begin
                If blendover = -1 then Tempblend := fwidth-3
                 else TEmpBlend := blendover;
                Multiplier := ((fwidth-3) / tempblend);
                Colors := BlendUnit.BlendColors(EndColor, Color, tempblend);
                For I := 0 to tempblend-1 do begin
                 Canvas.Brush.Color := Colors[I];
                 Canvas.Pen.Color := Colors[I];
                 Canvas.Rectangle(fLeft +1+ round(I*multiplier), fTop + 1, fLeft + 2 + round(I*multiplier) + round(multiplier), fTop + fHeight - 1);
                End;
                Canvas.Brush.Color := background;
                Canvas.Pen.Color := background;
                Pos := round((fValue - Min) * ( (fWidth-2)/ Interval ));
                Canvas.Rectangle(fLeft + pos, fTop + 1, fLeft + fWidth-1, fTop + fHeight - 1);
               End;
   stGradientFloat: Begin
                     Pos := -255;
                     Multiplier := -255;
                     TempBlend := -55;
                     try
                      // Init
                      Pos := round((fValue - Min) * ( (fWidth-2)/ Interval ));
                      If blendover = -1 then Tempblend := Pos
                       else TEmpBlend := blendover;
                      If tempBlend = 0 then Multiplier := 1
                       else Multiplier := (Pos / tempblend);
                      Colors := BlendUnit.BlendColors(Endcolor, Color, tempblend);
                     except
//                      on E: Exception do begin
//                       Error('BAR DRAW INIT ERROR!' + #13#10#13#10 + 'Error: ' + E.Message + ' (Exception: ' + E.ClassName + ')' + #13#10#13#10 +
//                             'Pos = ' + IntToStr(Pos) + #13#10 +
//                             'Multiplier = ' + FloatToStr(Multiplier) + #13#10 +
//                             'TempBlend = ' + IntToStr(TempBlend));
//                      end;
                     end;
                     try
                      Colors := BlendUnit.BlendColors(Endcolor, Color, tempblend);
                      For I := 0 to tempblend-1 do begin
                       Canvas.Brush.Color := Colors[I];
                       Canvas.Pen.Color := Colors[I];
                       Canvas.Rectangle(fLeft +1+ round(I*multiplier), fTop + 1, fLeft + 2 + round(I*multiplier) + round(multiplier), fTop + fHeight - 1);
                      End;
                     except
//                      on E: Exception do begin
//                       Error('BAR DRAW ERROR' + #13#10#13#10 + 'Error: ' + E.Message);
//                      end;
                     end;
                    end;
   end;
  Canvas.Free;
 except
  on EInvalidOp do Result := S_OK;
  on E: Exception do begin
   Result := E_FAIL;
   LastErrorMsg := 'Unable to perform draw commands';
  End;
 End;

end;

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

function TCM2VisBar.SetConfigString(NewConfigString: PChar): HResult;
Var
 I: Integer;
 C,V,S: String;
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 = 'MIN' Then begin
   try // Catch converter errors
    Min := StrToInt(V);
   except
    Min := 0;
   end;
  End;
  If C = 'MAX' Then Begin
   try // Catch converter errors
    Max := StrToInt(V);
   except
    Max := 0;
   end;
  End;
  If C = 'BACKGROUND' Then begin
   Try // Catch converter errors
    Background := RGBToColor(V);
   except
    Background := clwhite;
   end;
  end;
  If C = 'BORDER' Then begin
   Try // Catch converter errors
    Border := RGBToColor(V);
   except
    Border := clblack;
   end;
  end;
  If C = 'COLOR' Then begin
   Try // Catch converter errors
    Color := RGBToColor(V);
   except
    Color := clnavy;
   end;
  end;
  If C = 'ENDCOLOR' Then begin
   Try // Catch converter errors
    Endcolor := RGBToColor(V);
   except
    EndColor := clnavy;
   end;
  end;
  If C = 'STYLE' Then begin
   If uppercase(V) = 'ONECOLOR' then Style := stOneColor;
   If uppercase(V) = 'GRADIENT' then Style := stGradient;
   If uppercase(V) = 'GRADIENTFLOAT' Then style := stGradientFloat;
  End;
  If C = 'BLENDOVER' Then begin
   If V = 'AUTO' then blendover := -1
    else
   Begin
    Try
     BlendOver := StrToInt(V);
    Except
     blendover := 10;
    End;
   End;
  End;
 End;
 Result := S_OK;
end;

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

function TCM2VisBar.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 TCM2VisBar.Setup: HResult;
begin
 result := E_NOTIMPL;
end;

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

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

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

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

initialization
  TComObjectFactory.Create(ComServer, TCM2VisBar, Class_CM2VisBar,
    'CM2VisBar', 'Coolmon 2 Visual Bar', ciMultiInstance, tmApartment);
end.
