Visual Basic

Dim nWidth As Integer = Me.PointToScreen(pRight.Location).X - Me.PointToScreen(pMid.Location).X

For n As Integer = 1 To nAantalSpelers
  For m As Integer = 1 To nAantalSpelers
    P(n, m) = New TextBox
    With P(n, m)
      .Height = nAfstand
      .Name = Format(n, "0000") & "_" & Format(m, "0000")
      .CharacterCasing = CharacterCasing.Upper
      .MaxLength = 1
      .Visible = True
      .Tag = Convert.ToString(n) & "_" & m.ToString("000")
    End With
    Me.pPunten.Controls.Add(P(n, m))
    AddHandler P(n, m).MouseDown, AddressOf Punten_MouseDown
    AddHandler P(n, m).LostFocus, AddressOf Punten_LostFocus
    AddHandler P(n, m).GotFocus, AddressOf Punten_GotFocus
    AddHandler P(n, m).TextChanged, AddressOf Punten_Change
    AddHandler P(n, m).KeyPress, AddressOf Punten_KeyPress
    AddHandler P(n, m).KeyDown, AddressOf Punten_KeyDown
  Next
Next

Private Sub gridload()
     Me.File_DataGridView.DataSource = Me.data
     retrievedata("SELECT * FROM table;")

 End Sub
 Private Sub retrievedata(ByVal command As String)
     'This will bind the data to the DataGridView'
     Try
         Dim connection As String = "Data Source = test.db3"
         adapter = New SQLite.SQLiteDataAdapter(command, connection)
         Dim builder As New SQLite.SQLiteCommandBuilder(adapter)
         Dim table As New DataTable
         table.Locale = System.Globalization.CultureInfo.InvariantCulture
         adapter.Fill(table)
         data.DataSource = table
         File_DataGridView.AutoResizeColumns()
     Catch ex As Exception
         MessageBox.Show("There is a problem with retrieving the data for the data grid")
         MessageBox.Show(ex.Message.ToString)
     End Try
 End Sub

{
***** Process scheduling - FCFS, HRRN, SPN simulator ********
**
** Tested on Microsoft Windows XP SP2
**
** Written with Borland Delphi 7 Enterprise edition
**
*******************************************************

**
*******************************************************
* Greets:
**
** To my dear mother, father & anybody who supports me
**
*******************************************************   }

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, XPMan, ComCtrls;

(****************************************************************************)
Type
 TProcess=Record
    Name:String;
    ArrivalTime:Integer;
    ServiceTime:Integer;
    FinishTime:Integer;
    TimeLeft:Integer;
    Tq:Integer;         {Turnaround time: total time in system, waiting + execution}
    TqDivTs:Real;        {Tq/Ts: Is the normalized turnaround time.
                                 This value indicates the
                                 relative delay experienced by a process.}
end;
(****************************************************************************)
Type TOrigin=Packed Record   
    X: Longint;
    Y: Longint;
end;
 (****************************************************************************)
Type
  TForm1 = class(TForm)
    XPManifest1: TXPManifest;
    SaveDialog1: TSaveDialog;
    SaveDialog2: TSaveDialog;
    MemoService: TMemo;
    Memo1: TMemo;
    MemoArrival: TMemo;
    MemoProcess: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Image1: TImage;
    BtnStart: TBitBtn;
    btnSavePicture: TBitBtn;
    btnSaveLog: TBitBtn;
    ComboScheduling: TComboBox;
    Label5: TLabel;
    StatusBar1: TStatusBar;
    procedure ComboSchedulingSelect(Sender: TObject);
    procedure MemoArrivalKeyPress(Sender: TObject; var Key: Char);
    procedure MemoServiceKeyPress(Sender: TObject; var Key: Char);
    procedure BtnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnSavePictureClick(Sender: TObject);
    procedure btnSaveLogClick(Sender: TObject);
(****************************************************************************)
  private
    Procedure SortQueue;
    Procedure CheckErrors;
    Procedure ClearCanvas;
    Procedure FilterNumericKeys(var Memo:TMemo;var Key:Char); // don't let to enter non-numeric keys
    procedure TrimMemo(var Memo:TMemo); // earse all blank lines
    Function  CountsAreEqual:Boolean;  //number of lines in MEMOs are equal
    Function  DualProcess:Boolean;    //  2 process with the same name ?
    Procedure InitQ;                 // initialize Arrays
    Procedure FCFS;
    Procedure SPN;
    Procedure DrawAxle;
    Procedure DeleteElementFromReadyQ(Loc:Integer);
    Procedure HRRN;
  Public
    Max:Integer;     // holds numbers of lines in memoProcess
    Origin:TOrigin;
    ReadyQ:Array of TProcess; {Dynamic Array of TQueue}
  end;

var Form1: TForm1;
implementation
{$R *.dfm}
(***********************************************************************)
Procedure Tform1.FilterNumericKeys(var Memo:TMemo;var Key:Char);
begin
    If Not( Key In ['0'..'9',#8,#13] ) Then  Key:=#0;
end;
(*******************[ Accepts Numeric Keys]**************************)

procedure TForm1.MemoArrivalKeyPress(Sender: TObject; var Key: Char);
begin
   Self.FilterNumericKeys(MemoArrival,key);
end;
(*******************[ Accepts Numeric Keys]**************************)

procedure TForm1.MemoServiceKeyPress(Sender: TObject; var Key: Char);
begin
   Self.FilterNumericKeys(MemoService,key);
end;
(***********************************************************************)

Procedure TForm1.btnSavePictureClick(Sender: TObject);
begin
  If SaveDialog1.Execute then
    Image1.Picture.SaveToFile(SaveDialog1.FileName);
end;
(***********************************************************************)

procedure TForm1.btnSaveLogClick(Sender: TObject);
begin
 If SaveDialog2.Execute Then
     Memo1.Lines.SaveToFile(SaveDialog2.FileName);
end;
(*******************[ Earse all blank lines ]********************************)

procedure Tform1.TrimMemo(var Memo:TMemo);
var
   Index:Integer;
begin
  With Memo do
   begin
    For Index:=0 To (Lines.Count-1) do
      begin
         Trim(Lines.Strings[Index]);
         If (Lines.Strings[Index])='' Then Lines.Delete(Index);
      end;
  end;
end;
(***************** [2 Processes with the same name?]***************************)

function TForm1.DualProcess:Boolean;
var
  I,J:Integer;
  k:Byte;  {0..255}
begin
 K:=0;
 With MemoProcess.Lines do
  begin
    For I:=0 To  (Count)-1 do
      For J:=(I+1) To (Count) do If (Strings[J])=(Strings[I]) Then Inc(K,1);

        If (K > 0) Then
          begin
             Application.MessageBox('2 processes with the same name !','',mb_iconError);
             Abort;
          end;
  end;  //with

 Result:=True;

end;
(******************[Count of lines are equal ?]******************************)
Function Tform1.CountsAreEqual:Boolean;
var
  i,ProcessCount:Integer;
begin
  Result:=True; // init

  With Self do
   begin
     For i:=0 To MemoService.Lines.Count-1 Do
      if Trim(MemoService.Lines.Strings[i])='0' Then
       begin
         ShowMessage('Serive time can not be zero');
         Result:=False;
         Exit;
       end;
   end;

  With Self do
   begin
      ProcessCount:=MemoProcess.Lines.Count;
      If Not((MemoService.Lines.Count= ProcessCount )And(MemoArrival.Lines.Count=ProcessCount)) Then
        begin
           Application.MessageBox('Lines count are''nt equal','',mb_iconerror);
           Result:=False; // Tell caller we got an error
        end
      Else
        Self.Max:=ProcessCount;
   end;
end;
(***********************[Algorithm is Selected]******************************)

procedure TForm1.ComboSchedulingSelect(Sender: TObject);
begin
  BtnStart.Enabled:=True;  // let's run
end;
(*************************************************************************)

procedure TForm1.CheckErrors;
begin
   Self.TrimMemo(MemoProcess);
   Self.TrimMemo(MemoArrival);
   Self.TrimMemo(MemoService);
   If (Not(Self.CountsAreEqual)) Then Abort;
   Self.DualProcess;
end;
(********************[In fact, our simulation satarts from here]**************)

procedure TForm1.FormCreate(Sender: TObject);
begin
   Origin.X:=16 ;
   Origin.Y:=16;
   DrawAxle;  // Draw Vertical and Horizantal lines as axle
end;
(****************************************************************************)
procedure TForm1.BtnStartClick(Sender: TObject);
begin
  Self.CheckErrors;
  Self.DrawAxle;
  Self.InitQ;
  btnSavePicture.Enabled:=True;
  btnSaveLog.Enabled:=True;

  With Image1.Canvas do
   begin
    Case ComboScheduling.ItemIndex of
      0: begin Self.FCFS; TextOut(Image1.Width-35,Image1.Height-15,'FCFS'); end;
      1: begin Self.SPN; TextOut(Image1.Width-35,Image1.Height-15,'SPN'); end;
      2: begin Self.HRRN; TextOut(Image1.Width-35,Image1.Height-15,'HRRN'); end;
    End;
   end;
end;
(***************************************************************************)

Procedure TForm1.ClearCanvas;
begin
  With Image1.Canvas do
    begin                  {Clears Canvas content with a white rectangle}
      Brush.Color:=clWhite;
      Brush.Style:=bsSolid;
      Pen.Width:=1;
      Pen.Color:=clWhite;
      Rectangle(0,0,Image1.Width,Image1.Height); // clear canvas
    end;
end;
(****************************************************************************)

Procedure Tform1.DrawAxle;
begin
  With Image1.Canvas do
   begin
     Self.ClearCanvas;
     Font:=Self.Font;
     TextOut(Image1.Width-25,1,'Time' );
     TextOut(1,Image1.Height-15,'Process');
     Pen.Width:=2;
     Pen.Color:=clBlue;
     MoveTo(Origin.X,Origin.Y);  //Origin is (16,16)
     LineTo(Image1.Width-10,Origin.Y);       //Vertical axle
     MoveTo(Origin.X,Origin.Y);  //Origin is (16,16)
     LineTo(Origin.X,Image1.Height-20);       //Horizantal axle
     RePaint;
   end;
end;
(*****************************[ Initiliza Q ]*********************************)
Procedure Tform1.InitQ;
var
   Next:Integer;
begin
  Try
    SetLength(ReadyQ,0);    // Empty last saved data
    SetLength(ReadyQ,Max);

    For Next:=0 To (Max-1) do {Queue is FiFo }
      begin
         ReadyQ[Next].Name:=Trim(MemoProcess.Lines.Strings[Next]);
         ReadyQ[Next].ArrivalTime:=StrToInt(Trim(MemoArrival.Lines.Strings[Next]));
         ReadyQ[Next].ServiceTime:=StrToInt(Trim(MemoService.Lines.Strings[Next]));
      end;
  Except
    ShowMessage('Initialize error');
  end;
end;
(*****************************************************************************)
Procedure TForm1.SortQueue;
var
  I,J:Integer;
  T:TProcess;  {Temporary}
begin
 For I:=Low(ReadyQ) To High(ReadyQ)-1 do
  For J:=(I+1) To High(ReadyQ) do
    If (ReadyQ[i].ArrivalTime >= ReadyQ[j].ArrivalTime)  Then
      begin
        T:=ReadyQ[i];
        ReadyQ[i]:=ReadyQ[j];
        ReadyQ[j]:=T;
     end;
end;
(*****************************************************************************)

procedure TForm1.DeleteElementFromReadyQ(Loc:Integer);
begin
  with ReadyQ[Loc] do
   begin
      Name:='';
      ArrivalTime:=-1;
      ServiceTime:=-1;
   end;
end;

(***************************[Fist Come First Served]**************************)
Procedure Tform1.FCFS;
var
   Sum,X,U,V,Y,I:Integer;
   TqTs:Real;
   M:String;
begin

  Memo1.Lines.Add('  ');
  Memo1.Lines.Add('FCFS:');
  M:='Process    Arrival    Service    Finished    Tq      Tq/Ts';
  Memo1.Lines.Add(M);
  M:='';
  Memo1.Lines.Add('-----------------------------------------------------------------');

  X:=(Origin.X)+2;
  Y:=(Origin.Y)+2;
  U:=35;
  Self.SortQueue;
  X:= X+ (ReadyQ[0].ArrivalTime * 20);
  With Image1.Canvas do
    begin
      TextOut(X,1,IntToStr(ReadyQ[0].ArrivalTime));
      For I:=Low(ReadyQ) To High(ReadyQ) do
       begin
         Pen.Width:=1;  Pen.Color:= $00FF3620 ;   Brush.Color:=$00FF9D93;  Brush.Style:=bsSolid;
         V:=X+(ReadyQ[I].ServiceTime*20);
         Rectangle(X,Y,V,U);
         Brush.Color:=clWhite;Brush.Style:=bsClear;
         TextOut(1,Y,ReadyQ[I].Name);
         TextOut(V,1,IntToStr(V div 20));
         ReadyQ[i].FinishTime:=V div 20;
         ReadyQ[i].Tq:=(ReadyQ[I].FinishTime)-(ReadyQ[I].ArrivalTime);
         ReadyQ[i].TqDivTs:= (ReadyQ[i].Tq / ReadyQ[i].ServiceTime);
         ReadyQ[i].TimeLeft:=0;
         IF (V div 20) >= (ReadyQ[I+1].ArrivalTime) Then  X:=V
         Else
           begin
             X:=18 + (ReadyQ[I+1].ArrivalTime * 20);
             TextOut(X,1,IntToStr(X div 20));
           end;
         Y:=U+2;
         U:=U+17;
         M:=M+'    '+ReadyQ[i].Name + '              ' +
         Format('%d',[ReadyQ[i].ArrivalTime]) + '            ' +
         Format('%d',[ReadyQ[i].ServiceTime])+ '             ' +
         Format('%3d',[ReadyQ[i].FinishTime])+ '         '+
         Format('%2d',[ReadyQ[i].Tq]) + '        ' +
         Format('%1.1f',[ReadyQ[i].TqDivTs] );
         Memo1.Lines.Add(M);
         M:='';
         DeleteElementFromReadyQ(I);
        end;
    end;
   Sum:=0;
   For I:=Low(ReadyQ) To High(ReadyQ) Do Sum := Sum + ReadyQ[I].TQ ;
   Memo1.Lines.Add('Average(Tq)=  ' + Format('%1.2f',[sum/Max]) );
   TqTs:=0;
   For I:=Low(ReadyQ) To High(ReadyQ) Do TqTs := TqTs + ReadyQ[I].TqDivTs;
   Memo1.Lines.Add('Average(Tq/Ts)=  ' + Format('%1.2f',[TqTs/Max]));
end;

(****************************[Shortest Process Next]**************************)

Procedure Tform1.SPN;
var
   Job,Sum,X,Y,U,V,min,J,I,K:Integer;
   P:TProcess;
   M:String;
   TqTs:Real;
begin

 Memo1.Lines.Add('  '); Memo1.Lines.Add('SPN:');
 M:='Process    Arrival    Service    Finished    Tq      Tq/Ts';
 Memo1.Lines.Add(M);  M:=''; Memo1.Lines.Add('-----------------------------------------------------------------');
 X:=Origin.X + 2;
 Y:=Origin.Y + 2;
 U:=35;
 Self.SortQueue;
 I:=Low(ReadyQ);
 P:= ReadyQ[I];
 X := X + ( P.ArrivalTime * 20 );
 Job:=Max;
 Image1.Canvas.Textout(X,1,IntToStr(P.ArrivalTime));

 With Image1.Canvas do
  While Job > 0 do
   begin
     Pen.Width:=1; Pen.Color:=clGreen; Brush.Color:=clLime; Brush.Style:=bsSolid;
     V:=X+(P.ServiceTime*20);
     Rectangle(X,Y,V,U);
     Brush.Color:=clWhite;Brush.Style:=bsClear;
     TextOut(1,Y,P.Name);
     TextOut(V,1,IntToStr(V div 20));
     ReadyQ[I].TimeLeft:=0;
     ReadyQ[I].FinishTime:= (V div 20);
     ReadyQ[I].Tq:= (ReadyQ[I].FinishTime)-(ReadyQ[I].ArrivalTime);
     ReadyQ[I].TqDivTs:= (ReadyQ[I].Tq / ReadyQ[I].ServiceTime);
     Y:=U+2;
     Inc(U,17);
     M:=M+'    '+ReadyQ[I].Name + '              ' + Format('%2d',[ReadyQ[I].ArrivalTime]) + '            ' +
     Format('%d',[ReadyQ[I].ServiceTime])+ '             ' +    Format('%3d',[ReadyQ[I].FinishTime])+ '         '+
     Format('%2d',[ReadyQ[I].Tq]) + '        ' + Format('%1.1f',[ReadyQ[I].TqDivTs] );
     Memo1.Lines.Add(M);
     M:='';
     DeleteElementFromReadyQ(I);
     Dec(Job,1);
     K:=(-1);
     Min:=(9000);
     For J:=Low(ReadyQ) To High(ReadyQ) do
      begin
       If (ReadyQ[J].ArrivalTime <= (V div 20))And(ReadyQ[J].ServiceTime <> -1) Then
         If (ReadyQ[J].ServiceTime <= Min)Then
           begin
             Min:=ReadyQ[J].ServiceTime;
             K:=J;
           end;
      end;
     If (K <> -1) Then // If we found anything...
       begin
        I:=K;
        P:=ReadyQ[I];
      end
     Else     // We didn't find anything
      begin
        For J:=Low(ReadyQ) To High(ReadyQ) do // find 1st undeleted process...
          If (ReadyQ[J].ServiceTime <> -1 ) Then
           begin
             I:=J;
             P:=ReadyQ[I];
             Break;
           end;
      end;
     If (V div 20) >= (P.ArrivalTime) Then  X:=V // the same origin
     Else
       begin                                    // make gap ( blank space )
         X:= (Origin.X+2)+(P.ArrivalTime*20);
         TextOut(X,1,IntToStr(X div 20));
       end;
   end;
   Sum:=0;
   For I:=Low(ReadyQ) To High(ReadyQ) Do   Sum:=Sum+(ReadyQ[I].Tq);
   Memo1.Lines.Add('Average(Tq)=  ' + Format('%1.2f',[Sum/Max]) );
   TqTs:=0;
   For I:=Low(ReadyQ) To High(ReadyQ) Do TqTs:=TqTs+(ReadyQ[I].TqDivTs);
   Memo1.Lines.Add('Average(Tq/Ts)=  ' + Format('%1.2f',[TqTs/Max]));
end;

(*****************************[ HRRN ]*****************************)

Procedure TForm1.HRRN;
var
   Job,Sum,X,Y,U,V,J,I,K : Integer;
   P : TProcess;
   M : String;
   TqTs,Rate,Maximum : Real;
begin

 Memo1.Lines.Add('  '); Memo1.Lines.Add('HRRN:');
 M:='Process    Arrival    Service    Finished    Tq      Tq/Ts';
 Memo1.Lines.Add(M);  M:=''; Memo1.Lines.Add('-----------------------------------------------------------------');

 X:=Origin.X + 2;
 Y:=Origin.Y + 2;
 U:=35;
 Self.SortQueue;
 I:=Low(ReadyQ);
 P:= ReadyQ[I];
 X := X + ( P.ArrivalTime * 20 );
 Job:=Max;
 Image1.Canvas.Textout(X,1,IntToStr(P.ArrivalTime));

 With Image1.Canvas do
  While Job > 0 do
   begin
     Pen.Width:=1; Pen.Color:=$005098A5; Brush.Color:=$00A4CBD2; Brush.Style:=bsSolid;
     V:=X+(P.ServiceTime*20);
     Rectangle(X,Y,V,U);
     Brush.Color:=clWhite;Brush.Style:=bsClear;
     TextOut(1,Y,P.Name);
     P.FinishTime:=(V div 20) ;
     TextOut(V,1,IntToStr(P.FinishTime));
     ReadyQ[I].TimeLeft:=0;
     ReadyQ[I].FinishTime:= (P.FinishTime);
     ReadyQ[I].Tq:= (ReadyQ[I].FinishTime)-(ReadyQ[I].ArrivalTime);
     ReadyQ[I].TqDivTs:= (ReadyQ[I].Tq / ReadyQ[I].ServiceTime);
     Y:=U+2;
     Inc(U,17);
     M:=M+'    '+ReadyQ[I].Name + '              ' + Format('%2d',[ReadyQ[I].ArrivalTime]) + '            ' +
     Format('%d',[ReadyQ[I].ServiceTime])+ '             ' +    Format('%3d',[ReadyQ[I].FinishTime])+ '         '+
     Format('%2d',[ReadyQ[I].Tq]) + '        ' + Format('%1.1f',[ReadyQ[I].TqDivTs] );
     Memo1.Lines.Add(M);
     M:='';
     DeleteElementFromReadyQ(I);
     Dec(Job,1);
     K:=-1;
     Maximum:=0;

     For J:=Low(ReadyQ) To High(ReadyQ) do
      begin
       If (ReadyQ[J].ArrivalTime <= (P.FinishTime)) And (ReadyQ[J].ServiceTime <> -1) Then
        begin
          Rate:=( (P.FinishTime - ReadyQ[j].ArrivalTime) + (ReadyQ[j].ServiceTime))  / (ReadyQ[j].ServiceTime);  // Max((w+s)/s)
          If Rate>Maximum Then
           begin
             Maximum:=Rate;
             K:=J;
           end;
        end;
      end;
     If (K <> -1) Then // If we found something...
       begin
        I:=K;
        P:=ReadyQ[I];
      end
     Else     // We didn't find
      begin
        For J:=Low(ReadyQ) To High(ReadyQ) do // find 1st undeleted process...
          If (ReadyQ[J].ServiceTime <> -1 ) Then
           begin
             I:=J;
             P:=ReadyQ[I];
             Break;
           end;
      end;

     If (V div 20) >= (P.ArrivalTime) Then  X:=V  // the same origin
     Else
       begin                                     // make gap ( blank space )
         X:= (Origin.X+2)+(P.ArrivalTime*20);
         TextOut(X,1,IntToStr(X div 20));
       end;
   end;
   Sum:=0;
   For I:=Low(ReadyQ) To High(ReadyQ) Do   Sum:=Sum+(ReadyQ[I].Tq);
   Memo1.Lines.Add('Average(Tq)=  ' + Format('%1.2f',[Sum/Max]) );
   TqTs:=0;
   For I:=Low(ReadyQ) To High(ReadyQ) Do TqTs:=TqTs+(ReadyQ[I].TqDivTs);
   Memo1.Lines.Add('Average(Tq/Ts)=  ' + Format('%1.2f',[TqTs/Max]));
end;
(***************************************************************************)

end.