ActiveX Code

The source code shown below comes from two files. The first is the form file shown as text(DueDateCalcForm.dfm). The second is the complete from the main form(DueDateCalcForm.pas) including the code written in automatically by Delphi. For your convenience, the code added by me has been set to bold.
If you have any questions or comments about the code, contact me at .

DueDateCalcForm.dfm

 object DueDateCalcX: TDueDateCalcX
   Left = 248
   Top = 128
   Width = 345
   Height = 304
   Caption = 'DueDateCalcX'
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindowText
   Font.Height = -11
   Font.Name = 'MS Sans Serif'
   Font.Style = []
   OnCreate = FormCreate
   PixelsPerInch = 96
   TextHeight = 13
   object Label2: TLabel
     Left = 10
     Top = 20
     Width = 220
     Height = 13
     Caption = 'Please Select the First Date of your last period:'
   end
   object pnlCalendar: TPanel
     Left = 65
     Top = 75
     Width = 216
     Height = 176
     TabOrder = 0
     Visible = False
     object lblCalendar: TLabel
       Left = 5
       Top = 20
       Width = 206
       Height = 13
       Alignment = taCenter
       AutoSize = False
       Caption = 'January 12, 1997'
     end
     object Label1: TLabel
       Left = 5
       Top = 5
       Width = 206
       Height = 13
       Alignment = taCenter
       AutoSize = False
       Caption = 'Your Due Date is:'
       Font.Charset = DEFAULT_CHARSET
       Font.Color = clWindowText
       Font.Height = -11
       Font.Name = 'MS Sans Serif'
       Font.Style = [fsBold]
       ParentFont = False
     end
     object calDueDate: TCalendar
       Left = 5
       Top = 35
       Width = 206
       Height = 136
       Color = clInfoBk
       Enabled = False
       StartOfWeek = 0
       TabOrder = 0
       UseCurrentDate = False
       OnChange = calDueDateChange
     end
   end
   object cboMonth: TComboBox
     Left = 10
     Top = 40
     Width = 91
     Height = 21
     ItemHeight = 13
     Items.Strings = (
       'January'
       'February'
       'March'
       'April'
       'May'
       'June'
       'July'
       'August'
       'September'
       'October'
       'November'
       'December')
     TabOrder = 1
     OnChange = cboMonthChange
   end
   object cboDay: TComboBox
     Left = 105
     Top = 40
     Width = 41
     Height = 21
     ItemHeight = 13
     TabOrder = 2
   end
   object cboYear: TComboBox
     Left = 150
     Top = 40
     Width = 61
     Height = 21
     ItemHeight = 13
     TabOrder = 3
     OnChange = cboMonthChange
   end
   object Button1: TButton
     Left = 220
     Top = 40
     Width = 106
     Height = 21
     Caption = 'Calculate Due Date'
     TabOrder = 4
     OnClick = CalcDueDate
   end
 end

DueDateCalcForm.pas

 unit DueDateCalcForm;
 { * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 Created by christopher litsinger
 8/20/97
  * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * }
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ActiveX, AxCtrls, DueDateCalcProj_TLB, StdCtrls, Grids, Calendar,
   ExtCtrls;
 
 type
   TDueDateCalcX = class(TActiveForm, IDueDateCalcX)
     pnlCalendar: TPanel;
     calDueDate: TCalendar;
     lblCalendar: TLabel;
     cboMonth: TComboBox;
     cboDay: TComboBox;
     cboYear: TComboBox;
     Button1: TButton;
     Label1: TLabel;
     Label2: TLabel;
     procedure FormCreate(Sender: TObject);
     procedure CalcDueDate(Sender: TObject);
     procedure cboMonthChange(Sender: TObject);
     procedure calDueDateChange(Sender: TObject);
   private
     { Private declarations }
     FEvents: IDueDateCalcXEvents;
     procedure ActivateEvent(Sender: TObject);
     procedure ClickEvent(Sender: TObject);
     procedure CreateEvent(Sender: TObject);
     procedure DblClickEvent(Sender: TObject);
     procedure DeactivateEvent(Sender: TObject);
     procedure DestroyEvent(Sender: TObject);
     procedure KeyPressEvent(Sender: TObject; var Key: Char);
     procedure PaintEvent(Sender: TObject);
     procedure SetDays;
   protected
     { Protected declarations }
     procedure EventSinkChanged(const EventSink: IUnknown); override;
     procedure Initialize; override;
     function Get_Active: WordBool; safecall;
     function Get_AutoScroll: WordBool; safecall;
     function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
     function Get_Caption: WideString; safecall;
     function Get_Color: TColor; safecall;
     function Get_Cursor: Smallint; safecall;
     function Get_DropTarget: WordBool; safecall;
     function Get_Enabled: WordBool; safecall;
     function Get_Font: Font; safecall;
     function Get_HelpFile: WideString; safecall;
     function Get_KeyPreview: WordBool; safecall;
     function Get_PixelsPerInch: Integer; safecall;
     function Get_PrintScale: TxPrintScale; safecall;
     function Get_Scaled: WordBool; safecall;
     function Get_Visible: WordBool; safecall;
     function Get_WindowState: TxWindowState; safecall;
     procedure AboutBox; safecall;
     procedure Set_AutoScroll(Value: WordBool); safecall;
     procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
     procedure Set_Caption(const Value: WideString); safecall;
     procedure Set_Color(Value: TColor); safecall;
     procedure Set_Cursor(Value: Smallint); safecall;
     procedure Set_DropTarget(Value: WordBool); safecall;
     procedure Set_Enabled(Value: WordBool); safecall;
     procedure Set_Font(const Value: Font); safecall;
     procedure Set_HelpFile(const Value: WideString); safecall;
     procedure Set_KeyPreview(Value: WordBool); safecall;
     procedure Set_PixelsPerInch(Value: Integer); safecall;
     procedure Set_PrintScale(Value: TxPrintScale); safecall;
     procedure Set_Scaled(Value: WordBool); safecall;
     procedure Set_Visible(Value: WordBool); safecall;
     procedure Set_WindowState(Value: TxWindowState); safecall;
   public
     { Public declarations }
   end;
 
 implementation
 
 uses ComServ, About1;
 
 {$R *.DFM}
 
  function IsNumeric(TestString: String): Boolean;
 var
    HoldResult: Boolean;
 begin
   HoldResult := True;
   try
     StrToFloat(TestString);
   except
     on EConvertError do
       begin
       HoldResult := False;
       end;  // on EConvertError
   end; // except
   Result := HoldResult;
 end;  // function IsNumeric
 
 function getMonthDays(day: TDateTime): Word;
 var
   Year, Date, Month: Word;
   numDays: word;
 begin
   DecodeDate(day, Year, Month, Date);
   Case Month Of
     1: numDays:=31;
     2:
        begin
        numDays:=28;
        if (((Year mod 4 = 0) AND (Year mod 100 <> 0)) OR (Year mod 400 = 0)) then
          begin
          numDays := 29;
          end; //if
        end; //case 2
     3: numDays:=31;
     4: numDays:=30;
     5: numDays:=31;
     6: numDays:=30;
     7: numDays:=31;
     8: numDays:=31;
     9: numDays:=30;
     10: numDays:=31;
     11: numDays:=30;
     12: numDays:=31;
   else
     numDays:=30;
   end;//case Month
   // do the classic leap year calculation
   result:= numDays;
 end;//function getMonthDays(day: TDateTime): Word;
 
 
 function getMonthName(Month: Integer): String;
 begin
   case Month of
     1: Result:= 'January';
     2: Result:= 'February';
     3: Result:= 'March';
     4: Result:= 'April';
     5: Result:= 'May';
     6: Result:= 'June';
     7: Result:= 'July';
     8: Result:= 'August';
     9: Result:= 'September';
     10: Result:= 'October';
     11: Result:= 'November';
     12: Result:= 'December';
   end;//case Month of
 end;  //function getMonthName(Month: Integer): String
 
 { TDueDateCalcX }
 
 procedure TDueDateCalcX.SetDays;
 var
   holder, ii: Integer;
   dayStr: String;
   numDays: word;
 begin
   holder:=32;
   If IsNumeric(cboDay.Text) then
     begin
     holder:=StrToInt(cboDay.Text);
     end;//if IsNumeric(cboDay.Text)
   cboDay.clear;
   dayStr :=IntToStr(cboMonth.ItemIndex + 1)+'/1/'+cboYear.text;
   numDays := getMonthDays(StrToDate(dayStr));
   for ii := 1 to numDays do
     begin
     cboDay.Items.add(IntToStr(ii));
     end;  //for ii := 1 to numDays do
   if holder <= numDays then
     begin
     cboDay.ItemIndex:=holder-1;
     end  //if holder > numDays
   else
     begin
     cboDay.ItemIndex := numDays-1;
     end; //if holder > numDays..else
 
 end;  //procedure SetCal(Day, Month, Year: Integer)
  
 procedure TDueDateCalcX.EventSinkChanged(const EventSink: IUnknown);
 begin
   FEvents := EventSink as IDueDateCalcXEvents;
 end;
 
 procedure TDueDateCalcX.Initialize;
 begin
   OnActivate := ActivateEvent;
   OnClick := ClickEvent;
   OnCreate := CreateEvent;
   OnDblClick := DblClickEvent;
   OnDeactivate := DeactivateEvent;
   OnDestroy := DestroyEvent;
   OnKeyPress := KeyPressEvent;
   OnPaint := PaintEvent;
 end;
 
 function TDueDateCalcX.Get_Active: WordBool;
 begin
   Result := Active;
 end;
 
 function TDueDateCalcX.Get_AutoScroll: WordBool;
 begin
   Result := AutoScroll;
 end;
 
 function TDueDateCalcX.Get_AxBorderStyle: TxActiveFormBorderStyle;
 begin
   Result := Ord(AxBorderStyle);
 end;
 
 function TDueDateCalcX.Get_Caption: WideString;
 begin
   Result := WideString(Caption);
 end;
 
 function TDueDateCalcX.Get_Color: TColor;
 begin
   Result := Color;
 end;
 
 function TDueDateCalcX.Get_Cursor: Smallint;
 begin
   Result := Smallint(Cursor);
 end;
 
 function TDueDateCalcX.Get_DropTarget: WordBool;
 begin
   Result := DropTarget;
 end;
 
 function TDueDateCalcX.Get_Enabled: WordBool;
 begin
   Result := Enabled;
 end;
 
 function TDueDateCalcX.Get_Font: Font;
 begin
   GetOleFont(Font, Result);
 end;
 
 function TDueDateCalcX.Get_HelpFile: WideString;
 begin
   Result := WideString(HelpFile);
 end;
 
 function TDueDateCalcX.Get_KeyPreview: WordBool;
 begin
   Result := KeyPreview;
 end;
 
 function TDueDateCalcX.Get_PixelsPerInch: Integer;
 begin
   Result := PixelsPerInch;
 end;
 
 function TDueDateCalcX.Get_PrintScale: TxPrintScale;
 begin
   Result := Ord(PrintScale);
 end;
 
 function TDueDateCalcX.Get_Scaled: WordBool;
 begin
   Result := Scaled;
 end;
 
 function TDueDateCalcX.Get_Visible: WordBool;
 begin
   Result := Visible;
 end;
 
 function TDueDateCalcX.Get_WindowState: TxWindowState;
 begin
   Result := Ord(WindowState);
 end;
 
 procedure TDueDateCalcX.AboutBox;
 begin
   ShowDueDateCalcXAbout;
 end;
 
 procedure TDueDateCalcX.Set_AutoScroll(Value: WordBool);
 begin
   AutoScroll := Value;
 end;
 
 procedure TDueDateCalcX.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
 begin
   AxBorderStyle := TActiveFormBorderStyle(Value);
 end;
 
 procedure TDueDateCalcX.Set_Caption(const Value: WideString);
 begin
   Caption := TCaption(Value);
 end;
 
 procedure TDueDateCalcX.Set_Color(Value: TColor);
 begin
   Color := Value;
 end;
 
 procedure TDueDateCalcX.Set_Cursor(Value: Smallint);
 begin
   Cursor := TCursor(Value);
 end;
 
 procedure TDueDateCalcX.Set_DropTarget(Value: WordBool);
 begin
   DropTarget := Value;
 end;
 
 procedure TDueDateCalcX.Set_Enabled(Value: WordBool);
 begin
   Enabled := Value;
 end;
 
 procedure TDueDateCalcX.Set_Font(const Value: Font);
 begin
   SetOleFont(Font, Value);
 end;
 
 procedure TDueDateCalcX.Set_HelpFile(const Value: WideString);
 begin
   HelpFile := String(Value);
 end;
 
 procedure TDueDateCalcX.Set_KeyPreview(Value: WordBool);
 begin
   KeyPreview := Value;
 end;
 
 procedure TDueDateCalcX.Set_PixelsPerInch(Value: Integer);
 begin
   PixelsPerInch := Value;
 end;
 
 procedure TDueDateCalcX.Set_PrintScale(Value: TxPrintScale);
 begin
   PrintScale := TPrintScale(Value);
 end;
 
 procedure TDueDateCalcX.Set_Scaled(Value: WordBool);
 begin
   Scaled := Value;
 end;
 
 procedure TDueDateCalcX.Set_Visible(Value: WordBool);
 begin
   Visible := Value;
 end;
 
 procedure TDueDateCalcX.Set_WindowState(Value: TxWindowState);
 begin
   WindowState := TWindowState(Value);
 end;
 
 procedure TDueDateCalcX.ActivateEvent(Sender: TObject);
 begin
   if FEvents <> nil then FEvents.OnActivate;
 end;
 
 procedure TDueDateCalcX.ClickEvent(Sender: TObject);
 begin
   if FEvents <> nil then FEvents.OnClick;
 end;
 
 procedure TDueDateCalcX.CreateEvent(Sender: TObject);
 begin
   if FEvents <> nil then FEvents.OnCreate;
 end;
 
 procedure TDueDateCalcX.DblClickEvent(Sender: TObject);
 begin
   if FEvents <> nil then FEvents.OnDblClick;
 end;
 
 procedure TDueDateCalcX.DeactivateEvent(Sender: TObject);
 begin
   if FEvents <> nil then FEvents.OnDeactivate;
 end;
 
 procedure TDueDateCalcX.DestroyEvent(Sender: TObject);
 begin
   if FEvents <> nil then FEvents.OnDestroy;
 end;
 
 procedure TDueDateCalcX.KeyPressEvent(Sender: TObject; var Key: Char);
 var
   TempKey: Smallint;
 begin
   TempKey := Smallint(Key);
   if FEvents <> nil then FEvents.OnKeyPress(TempKey);
   Key := Char(TempKey);
 end;
 
  procedure TDueDateCalcX.PaintEvent(Sender: TObject);
 begin
   if FEvents <> nil then FEvents.OnPaint;
 end;
 
 procedure TDueDateCalcX.FormCreate(Sender: TObject);
 var
   today: TDateTime;
   Year, Date, Month: Word;
 begin
   today:=Now;
   DecodeDate(today, Year, Month, Date);
   cboYear.Items.add(IntToStr(Year-1));
   cboYear.Items.add(IntToStr(Year));
   cboYear.Items.add(IntToStr(Year+1));
   cboYear.Items.add(IntToStr(Year+2));
   cboYear.Items.add(IntToStr(Year+3));
   cboMonth.itemIndex := Month-1;
   cboYear.itemIndex := 1;
   SetDays;
   cboDay.itemIndex := Date-1;
   end; //procedure TDueDateCalcX.FormCreate(Sender: TObject)
 
 procedure TDueDateCalcX.CalcDueDate(Sender: TObject);
 var
   DueDate: TDate;
   intMonth: Integer;
 begin
 //for some reason cboMonth.item index will return -1
 //had to do this weird stuff to get around this
   intMonth:=cboMonth.Items.IndexOf(cboMonth.text);
   DueDate := StrToDate(IntToStr(IntMonth+1) + '/'+cboDay.text+'/'+cboYear.text);
   DueDate := DueDate+280;
   calDueDate.calendarDate:=DueDate;
   pnlCalendar.visible:=true;
 end; //procedure TDueDateCalcX.CalcDueDate(Sender: TObject)
 
 procedure TDueDateCalcX.cboMonthChange(Sender: TObject);
 begin
   SetDays;
 end; //procedure TDueDateCalcX.cboMonthChange(Sender: TObject)
 
 procedure TDueDateCalcX.calDueDateChange(Sender: TObject);
 var
   HoldStr: String;
 begin
   HoldStr := getMonthName(calDueDate.Month)+' '+IntToStr(calDueDate.Day) + ', ' +IntToStr(calDueDate.Year);
   lblCalendar.Caption := HoldStr;
 end; //procedure TDueDateCalcX.calDueDateChange(Sender: TObject)
  
 
 initialization
   TActiveFormFactory.Create(
     ComServer,
     TActiveFormControl,
     TDueDateCalcX,
     Class_DueDateCalcX,
     1,
     '',
     OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL);
 end.

return to geekstuff