Uses Win2K2,CoolKey,Graph,ccontr,Core; TYPE EStatus = (ST_WAITING,ST_RUNNING,ST_FINISHED); const AStatus : array [EStatus] of string[15] = ('Waiting','Running', 'Finished'); var TextOut : Text; RunNum : Integer; gCol : Integer; Parent : hWNd; Stat : EStatus; OCButtons : Array [1..2] of hWnd; Edits : array [1..9] of hWnd; Traces : array [0..5] of boolean; Checks : array [0..5] of hWnd; Plot : hWnd; Model : ^CModel; Buffer : PBuffer; Device : PDevice; Srcs1, Srcs2,Srcs3 : PSource; BegVal, LastVal : Real; Steps,CurStep : integer; BufferSize : integer; S1,S2,S3 : Real; Delta, DovInt : real; Function GetFloat(aH:hWND):real; var st : string; ret : real; i : integer; begin GetWindowText(AH,@st,255); Val(st,ret,i); GetFloat := ret; end; Procedure GetParams; var st : string[50]; i : integer; v : real; begin BegVal := GetFloat(Edits[3]); LastVal := GetFloat(Edits[4]); DovInt := GetFloat(Edits[2]); Steps := Round(GetFloat(Edits[5])); BufferSize := Round(GetFloat(Edits[6])); S1 := Getfloat(Edits[7]); S2 := Getfloat(Edits[8]); S3 := Getfloat(Edits[9]); GetWindowText(Edits[1],@st,50); if st[ord(st[0])] = '%' then begin Val(copy(st,1,ord(st[0])-1),v,i); Delta := v/100.0; end else Val(st,Delta,i); end; Procedure InitModel; begin Delta := 0.1; DovInt := 1.64; BegVal := 1.0; LastVal := 4.0; Steps := 20; BufferSize := 5; S1 := 2.0; S2 := 1.0; S3 := 5.0; New(Buffer, Init(BufferSize)); New(Device, Init(BegVal)); New(Model, Init(3,Device,Buffer,Delta,DovInt)); New(Srcs1,Init(0,S1)); Model^.AddNewSource(Srcs1); New(Srcs2,Init(1,S2)); Model^.AddNewSource(Srcs2); New(Srcs3,Init(2,S3)); Model^.AddNewSource(Srcs3); end; Procedure StartModel; var XY : TRPoint; nm : string; i : UINT8; begin Buffer^.SetBufferSize(BufferSize); Device^.Lambda := BegVal; Model^.Delta := Delta; Model^.DovInt := DovInt; Srcs1^.Lambda := S1; Srcs2^.Lambda := S2; Srcs3^.Lambda := S3; { for i := 0 to 5 do Traces[i] := boolean(SendMessage(Checks[i],CB_GETCHECK,0,0));} XY.X:=0; XY.Y:=Steps; SendMessage(Plot,XP_DELALLPOINTS,0,0); SendMessage(Plot,XP_DELALLPOINTS,1,0); SendMessage(Plot,XP_DELALLPOINTS,2,0); SendMessage(Plot,XP_DELALLPOINTS,3,0); SendMessage(Plot,XP_DELALLPOINTS,4,0); SendMessage(Plot,XP_DELALLPOINTS,5,0); SendMessage(Plot,XP_SETXRANGE,0,UINT32(@XY)); SendMessage(Plot,XP_SETXRANGE,1,UINT32(@XY)); SendMessage(Plot,XP_SETXRANGE,2,UINT32(@XY)); SendMessage(Plot,XP_SETXRANGE,3,UINT32(@XY)); SendMessage(Plot,XP_SETXRANGE,4,UINT32(@XY)); SendMessage(Plot,XP_SETXRANGE,5,UINT32(@XY)); str(RunNum,nm); Inc(RunNum); nm := 'result.'+nm; Assign(TextOut,nm); Rewrite(TextOut); Model^.Start; CurStep := 0; end; Function WindowProc(ahWnd:HWND;aMsg,wParam,lParam:UINT32):UINT32;far; var ps : LPPAINTSTRUCT; XY,Max : TRPoint; i : UINT8; rt : RECT; begin case aMsg of WM_CREATE: begin OCButtons[1] := CreateWindow('OK','BUTTON',WS_CHILD, 66,350,50,30,ahWnd,NULL); PostMessage(OCButtons[1],CB_SETID,1,0); OCButtons[2] := CreateWindow('Cancel','BUTTON',WS_CHILD, 152,350,60,30,ahWnd,NULL); PostMessage(OCButtons[2],CB_SETID,2,0); CreateWindow('Veroyatn','LABEL',WS_CHILD, 10,10,140,15,ahWnd,NULL); Edits[1]:=CreateWindow('10%','EDIT',WS_CHILD, 150,10,140,15,ahWnd,NULL); CreateWindow('Dov. Int','LABEL',WS_CHILD, 10,30,140,15,ahWnd,NULL); Edits[2]:=CreateWindow('1.64','EDIT',WS_CHILD, 150,30,140,15,ahWnd,NULL); CreateWindow('Beg. Lam ist','LABEL',WS_CHILD, 10,50,140,15,ahWnd,NULL); Edits[3]:=CreateWindow('1.0','EDIT',WS_CHILD, 150,50,140,15,ahWnd,NULL); CreateWindow('End Lam ist','LABEL',WS_CHILD, 10,70,140,15,ahWnd,NULL); Edits[4]:=CreateWindow('4.0','EDIT',WS_CHILD, 150,70,140,15,ahWnd,NULL); CreateWindow('Steps','LABEL',WS_CHILD, 10,90,140,15,ahWnd,NULL); Edits[5]:=CreateWindow('20','EDIT',WS_CHILD, 150,90,140,15,ahWnd,NULL); CreateWindow('Buf size','LABEL',WS_CHILD, 10,110,140,15,ahWnd,NULL); Edits[6]:=CreateWindow('5','EDIT',WS_CHILD, 150,110,140,15,ahWnd,NULL); CreateWindow('Lambda 1','LABEL',WS_CHILD, 10,130,140,15,ahWnd,NULL); Edits[7]:=CreateWindow('2.0','EDIT',WS_CHILD, 150,130,140,15,ahWnd,NULL); CreateWindow('Lambda 2','LABEL',WS_CHILD, 10,150,140,15,ahWnd,NULL); Edits[8]:=CreateWindow('1.0','EDIT',WS_CHILD, 150,150,140,15,ahWnd,NULL); CreateWindow('Lambda 3','LABEL',WS_CHILD, 10,170,140,15,ahWnd,NULL); Edits[9]:=CreateWindow('5.0','EDIT',WS_CHILD, 150,170,140,15,ahWnd,NULL); Plot := CreateWindow('Test plot','XYPLOT',WS_CHILD,310,10,300,300,ahWnd,NULL); SendMessage(Plot,XP_SETPLOTCOUNT,6,0); SendMessage(Plot,XP_SETCOLOR,0,Red); SendMessage(Plot,XP_SETCOLOR,1,Green); SendMessage(Plot,XP_SETCOLOR,2,Blue); SendMessage(Plot,XP_SETCOLOR,3,Magenta); SendMessage(Plot,XP_SETCOLOR,4,Yellow); SendMessage(Plot,XP_SETCOLOR,5,White); XY.X:=0; XY.Y:=100; SendMessage(Plot,XP_SETYRANGE,0,UINT32(@XY)); SendMessage(Plot,XP_SETYRANGE,1,UINT32(@XY)); SendMessage(Plot,XP_SETYRANGE,2,UINT32(@XY)); Checks[0] := CreateWindow('Ist1 Potk (Red)','CHECKBOX',WS_CHILD, 10,200,200,15,ahWnd,NULL); SendMessage(Checks[0],CB_SETCHECK,0,0); Checks[1] := CreateWindow('Ist2 Potk (Green)','CHECKBOX',WS_CHILD, 10,220,200,15,ahWnd,NULL); SendMessage(Checks[1],CB_SETCHECK,1,0); Checks[2] := CreateWindow('Ist3 Potk (Blue)','CHECKBOX',WS_CHILD, 10,240,200,15,ahWnd,NULL); SendMessage(Checks[2],CB_SETCHECK,0,0); Checks[3] := CreateWindow('Ist1 MatO (Magenta)','CHECKBOX',WS_CHILD, 10,260,200,15,ahWnd,NULL); SendMessage(Checks[3],CB_SETCHECK,0,0); Checks[4] := CreateWindow('Ist2 MatO (Yellow)','CHECKBOX',WS_CHILD, 10,280,200,15,ahWnd,NULL); SendMessage(Checks[4],CB_SETCHECK,1,0); Checks[5] := CreateWindow('Ist3 MatO (White)','CHECKBOX',WS_CHILD, 10,300,200,15,ahWnd,NULL); SendMessage(Checks[5],CB_SETCHECK,0,0); Randomize; Stat := ST_WAITING; for i := 0 to 5 do SendMessage(Checks[i],CB_SETID,i+100,0); { fillchar(Traces,sizeof(Traces),0);} InitModel; RunNum := 0; PostMessage(ahWnd,WM_PAINT,0,0); AddOnFrameMessage(ahWnd); end; WM_COMMAND: begin case wParam of 1: if (lParam = 0) and (Stat <> ST_RUNNING) then begin {OK button pressed} GetParams; StartModel; Stat := ST_RUNNING; PostMessage(ahWnd,WM_PAINT,0,0); end; 2: if lParam = 0 then begin if Stat = ST_RUNNING then begin Close(TextOut); Stat := ST_WAITING; PostMessage(ahWnd,WM_PAINT,0,0); end else PostMessage(ahWnd,WM_DESTROY,0,0); end; end; if (wParam >= 100) and (wParam <=105) and (lParam = 1) then begin SendMessage(Plot,WM_SETVISIBLE,i-100,SendMessage(Checks[i-100],CB_GETCHECK,0,0)); end; end; WM_ONFRAME: begin if Stat = ST_RUNNING then begin if Not Model^.Step then begin XY.X := CurStep; if Traces[0] then begin XY.Y := 100*Srcs1^.RefusedReq/Srcs1^.TotalReq; SendMessage(Plot,XP_ADDPOINT,0,UINT32(@XY)); end; if Traces[1] then begin XY.Y := 100*Srcs2^.RefusedReq/Srcs2^.TotalReq; SendMessage(Plot,XP_ADDPOINT,1,UINT32(@XY)); end; if Traces[2] then begin XY.Y := 100*Srcs3^.RefusedReq/Srcs3^.TotalReq; SendMessage(Plot,XP_ADDPOINT,2,UINT32(@XY)); end; if (Srcs1^.DoneReq <> 0) AND Traces[3] then begin XY.Y := Srcs1^.MatWait/Srcs1^.DoneReq; SendMessage(Plot,XP_ADDPOINT,3,UINT32(@XY)); end; if (Srcs2^.DoneReq <> 0) AND Traces[4] then begin XY.Y := Srcs2^.MatWait/Srcs2^.DoneReq; SendMessage(Plot,XP_ADDPOINT,4,UINT32(@XY)); end; if (Srcs3^.DoneReq <> 0) AND Traces[5] then begin XY.Y := Srcs3^.MatWait/Srcs3^.DoneReq; SendMessage(Plot,XP_ADDPOINT,5,UINT32(@XY)); end; Max.X := 0; Max.Y := 0; for i := 3 to 5 do if Traces[i] then begin SendMessage(Plot,XP_GETYRANGE,i,UINT32(@XY)); if XY.Y > Max.Y then Max.Y := XY.Y; end; for i := 3 to 5 do if Traces[i] then SendMessage(Plot,XP_SETYRANGE,i,UINT32(@Max)); PostMessage(Plot,WM_PAINT,0,0); Model^.PrintValues(TextOut); inc(CurStep); Device^.Lambda := BegVal + (LAstVal-BegVal)/Steps*Curstep; if CurStep = Steps+1 then begin Stat := ST_FINISHED; Close(TextOut); PostMessage(ahWnd,WM_PAINT,0,0); end else Model^.Start; end end; end; WM_DESTROY: begin if Stat <> ST_WAITING then begin Dispose(Model,Done); Dispose(Buffer,Done); Dispose(Device,Done); end; DelOnFrameMessage(ahWnd); PostQuitMessage(ahwnd); end; WM_KEYDOWN: if wParam = ord(SC_ESCAPE) then PostMessage(ahWnd,WM_DESTROY,0,0); WM_PAINT: begin ps := BeginPaint(ahWNd); wSetColor(ps,GlobalPalette.WindowFontColor); wSetBgColor(ps,GlobalPalette.ThreeDColor1); wSetStyle(ps,SolidFill); wSetFontJustify(ps,CenterText,BottomText); GetClientRect(ahWnd,@rt); wBar(ps,0,rt.b.y - 20, rt.b.x,rt.b.y); wTextOut(ps,rt.b.x shr 1, rt.b.y-1, @AStatus[Stat]); EndPaint(ps); end; end; end; var bA : longint; begin ba := MemAvail; if InitWin2K2 = ERR_OK then if RegisterClass('MSMO',WindowProc) = ERR_OK then begin InitCommonControls; Parent:=CreateWindow('Configuration','MSMO', WS_TITLE OR WS_SIZEABLE OR WS_MINMAX, 10,10,620,420, NULL,NULL); MainRunLoop; end; DoneWin2K2; WriteLn(ba-MemAvail); end.