Click here to Skip to main content
15,908,115 members
Home / Discussions / Visual Basic
   

Visual Basic

 
QuestionProblem with Binding a database to a datagridview Pin
crain198118-Dec-10 12:13
crain198118-Dec-10 12:13 
AnswerRe: Problem with Binding a database to a datagridview Pin
crain198118-Dec-10 13:04
crain198118-Dec-10 13:04 
AnswerRe: Problem with Binding a database to a datagridview Pin
crain198119-Dec-10 11:25
crain198119-Dec-10 11:25 
QuestionMSChart on Win 7 64 bits ? Pin
gbessis18-Dec-10 6:43
professionalgbessis18-Dec-10 6:43 
AnswerRe: MSChart on Win 7 64 bits ? Pin
Dave Kreskowiak18-Dec-10 15:34
mveDave Kreskowiak18-Dec-10 15:34 
QuestionWhat is the equivalent code in vb? [modified] Pin
Milad.Biroonvand17-Dec-10 21:57
Milad.Biroonvand17-Dec-10 21:57 
AnswerRe: What is the equivalent code in vb? Pin
Eddy Vluggen18-Dec-10 0:15
professionalEddy Vluggen18-Dec-10 0:15 
GeneralRe: What is the equivalent code in vb? Pin
Milad.Biroonvand18-Dec-10 1:43
Milad.Biroonvand18-Dec-10 1:43 
Hi How are you?
Thank you for the answer.
If the code is complete?


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

**
*******************************************************
* 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.
GeneralRe: What is the equivalent code in vb? Pin
Eddy Vluggen18-Dec-10 11:44
professionalEddy Vluggen18-Dec-10 11:44 
GeneralRe: What is the equivalent code in vb? Pin
Milad.Biroonvand18-Dec-10 2:14
Milad.Biroonvand18-Dec-10 2:14 
QuestionNeed help loading a background image from the registry Pin
Garrett Crawford17-Dec-10 18:18
Garrett Crawford17-Dec-10 18:18 
AnswerRe: Need help loading a background image from the registry Pin
Richard MacCutchan17-Dec-10 23:46
mveRichard MacCutchan17-Dec-10 23:46 
AnswerRe: Need help loading a background image from the registry Pin
Dave Kreskowiak18-Dec-10 3:02
mveDave Kreskowiak18-Dec-10 3:02 
GeneralRe: Need help loading a background image from the registry Pin
Garrett Crawford18-Dec-10 9:39
Garrett Crawford18-Dec-10 9:39 
GeneralRe: Need help loading a background image from the registry Pin
Dave Kreskowiak18-Dec-10 15:32
mveDave Kreskowiak18-Dec-10 15:32 
GeneralRe: Need help loading a background image from the registry Pin
Garrett Crawford18-Dec-10 19:16
Garrett Crawford18-Dec-10 19:16 
GeneralRe: Need help loading a background image from the registry Pin
Dave Kreskowiak19-Dec-10 4:21
mveDave Kreskowiak19-Dec-10 4:21 
GeneralRe: Need help loading a background image from the registry Pin
Garrett Crawford19-Dec-10 5:52
Garrett Crawford19-Dec-10 5:52 
QuestionSourceSafe and VB.Net Pin
#realJSOP15-Dec-10 8:48
professional#realJSOP15-Dec-10 8:48 
AnswerRe: SourceSafe and VB.Net Pin
fjdiewornncalwe15-Dec-10 8:53
professionalfjdiewornncalwe15-Dec-10 8:53 
AnswerRe: SourceSafe and VB.Net Pin
Prerak Patel16-Dec-10 0:24
professionalPrerak Patel16-Dec-10 0:24 
AnswerRe: SourceSafe and VB.Net Pin
Gary Wheeler16-Dec-10 0:55
Gary Wheeler16-Dec-10 0:55 
AnswerRe: SourceSafe and VB.Net Pin
Member 459898616-Dec-10 5:33
Member 459898616-Dec-10 5:33 
AnswerRe: SourceSafe and VB.Net Pin
Steve Naidamast16-Dec-10 7:23
professionalSteve Naidamast16-Dec-10 7:23 
GeneralRe: SourceSafe and VB.Net Pin
Member 376360816-Dec-10 10:37
Member 376360816-Dec-10 10:37 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.