home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-04-28 | 31.6 KB | 1,209 lines |
- {$M 10000,7000,90000}
- Program ScrDemo;
-
- {
- Before trying to compile and run this program, read and follow Part II of
- Turbo ScrEdit Tutor (stored in the file ScrEdit.Tut.)
- }
-
- USES Crt,Dos,ScrMouse,ScrEdit;
-
- {
- Remember to use Turbo ScrEdit to compile the screens in ScrDemo.Scr before you
- try to compile and run this program. See Turbo ScrEdit Tutor for instructions.
- }
- {$I ScrDemo.001}
- {$I ScrDemo.002}
- {$I ScrDemo.003}
- {$I ScrDemo.004}
- {$I ScrDemo.005}
-
- Var
- Result,
- Tr,Tc,Br,Bc : Integer;
- Option : Integer;
- Screen_Mode : Integer;
- Cursor_Position : Integer;
- Name,
- Address_a,
- Address_b: String[34];
- City:String[20];
- State:String[2];
- ZipCode:String[10];
- Phone:String[15];
- SSN :String[12];
- Gross :Real;
-
-
-
- {*****************************
-
- MENU OPTION 1 (Example data entry screen)
-
- Section 2 of Turbo ScrEdit Tutor Describes this portion of code
-
- *****************************}
-
-
- Procedure RecordDemo_Init;
- Var R :Integer;
- Begin
- {
- Initialize_Dupe_Fields_buf;
- }
- Name := '';
- Address_a:= '';
- Address_b:= '';
- City := '';
- State := '';
- ZipCode := '';
- Phone := '';
- Ssn := '';
- Gross := 0.0;
- S_Point := 1;
- S_EnterAsTab := False;
- S_LoadScreen('Dupe_Fields');
- S_ClearScreen(1);
- End;
-
-
-
- Function MakeMsg(Mode,Bg,Fg:integer):S_Str80;
- Var ColorWork : String[3];
- WorkStr : String[85];
- Begin
- Case mode Of
- 1 : workstr := 'Change colors of ERROR messages from VALIDATE procedures Bg(';
- 2 : workstr := 'Change Colors of HELP messages accessed by auto help or "?" Bg(';
- 3 : workstr := 'Specify the color attributes for you customer messages Bg (';
- End;
- Str(Bg:1,ColorWork);
- WorkStr := WorkStr + ColorWork + ') Fg(';
- Str(Fg:2,ColorWork);
- MakeMsg := WorkStr + ColorWork + ')';
- End;
-
-
-
- Procedure EnterRecords;
- Var R : Boolean;
- Begin
- If S_EnterAsTab Then
- Dupe_Fields_buf.Key := ' F10 '
- Else
- Dupe_Fields_buf.Key := 'Enter';
-
- S_ReadScreen;
-
-
- If (S_Ctrl) And (UpCase(S_Ch) = 'A') Then
- Begin
- Case S_Cursor Of
- S_Off
- : S_Cursor := S_Bold;
- S_Bold
- : S_Cursor := S_Normal;
- S_Normal
- : S_Cursor := S_InverseNormal;
- S_InverseNormal
- : S_Cursor := S_InverseBold;
- Else
- S_Cursor := S_Off;
- End;
- End;
-
- While ((S_Home)Or(S_End)Or(S_Up)Or(S_Down)Or(S_PgUp)Or(S_PgDn)) Do
- Begin
- If (S_Home)Or(S_End) Then S_ErrorMsg:=MakeMsg(1,S_ErrorBg,S_ErrorFg);
- If (S_Up) Or(S_Down) Then S_AutoHelpMsg:=MakeMsg(2,S_HelpBg,S_HelpFg);
- If (S_PgUp)Or(S_PgDn) Then S_UserMsg:=MakeMsg(3,S_UserBg,S_UserFg);
-
- S_ReadKey;
-
- If (S_Home)Or(S_End) Then
- Begin
- If (S_Home) Then Inc(S_ErrorBg);
- If (S_End) Then Inc(S_ErrorFg);
- If (S_ErrorBg > 7) Then S_ErrorBg := 0;
- If (S_ErrorFg > 15) Then S_ErrorFg := 0;
- End;
-
- If (S_Up)Or(S_Down) Then
- Begin
- If (S_Up) Then Inc(S_HelpBg);
- If (S_Down) Then Inc(S_HelpFg);
- If (S_HelpBg > 7) Then S_HelpBg := 0;
- If (S_HelpFg > 15) Then S_HelpFg := 0;
- End;
-
- If (S_PgUp)Or(S_PgDn) Then
- Begin
- If (S_PgUp) Then Inc(S_UserBg);
- If (S_PgDn) Then Inc(S_UserFg);
- If (S_UserBg > 7) Then S_UserBg := 0;
- If (S_UserFg > 15) Then S_UserFg := 0;
- End;
- End;
-
-
- If S_F1 Then
- Begin
- If Not S_IsDupe(S_PrevFld) Then
- Begin
- If S_PrevFld in [12,15,18,21,24,27,30,33,36] Then
- Begin
- R:=S_SetDupe(S_PrevFld-1);
- R:=S_SetDupe(S_PrevFld+1);
- R:=S_SetDupe(S_PrevFld);
- End;
- If S_IsDupe(S_PrevFld) Then
- Case S_PrevFld of
- 12 : Begin
- Dupe_Fields_buf.a := '[';
- Dupe_Fields_buf.r := ']';
- End;
- 15 : Begin
- Dupe_Fields_buf.b := '[';
- Dupe_Fields_buf.s := ']';
- End;
- 18 : Begin
- Dupe_Fields_buf.c := '[';
- Dupe_Fields_buf.t := ']';
- End;
- 21 : Begin
- Dupe_Fields_buf.d := '[';
- Dupe_Fields_buf.u := ']';
- End;
- 24 : Begin
- Dupe_Fields_buf.e := '[';
- Dupe_Fields_buf.v := ']';
- End;
- 27 : Begin
- Dupe_Fields_buf.f := '[';
- Dupe_Fields_buf.w := ']';
- End;
- 30 : Begin
- Dupe_Fields_buf.g := '[';
- Dupe_Fields_buf.x := ']';
- End;
- 33 : Begin
- Dupe_Fields_buf.h := '[';
- Dupe_Fields_buf.y := ']';
- End;
- 36 : Begin
- Dupe_Fields_buf.i := '[';
- Dupe_Fields_buf.z := ']';
- End;
- End;
- End
- Else
- Begin
- If S_IsDupe(S_PrevFld)Then
- Begin
- If S_PrevFld in [12,15,18,21,24,27,30,33,36] Then
- Begin
- S_ReSetDupe(S_PrevFld-1);
- S_ReSetDupe(S_PrevFld+1);
- S_ReSetDupe(S_PrevFld);
- End;
- If Not S_IsDupe(S_PrevFld) Then
- Case S_PrevFld Of
- 12 : Begin Dupe_Fields_buf.a:='';Dupe_Fields_buf.r:='';End;
- 15 : Begin Dupe_Fields_buf.b:='';Dupe_Fields_buf.s:='';End;
- 18 : Begin Dupe_Fields_buf.c:='';Dupe_Fields_buf.t:='';End;
- 21 : Begin Dupe_Fields_buf.d:='';Dupe_Fields_buf.u:='';End;
- 24 : Begin Dupe_Fields_buf.e:='';Dupe_Fields_buf.v:='';End;
- 27 : Begin Dupe_Fields_buf.f:='';Dupe_Fields_buf.w:='';End;
- 30 : Begin Dupe_Fields_buf.g:='';Dupe_Fields_buf.x:='';End;
- 33 : Begin Dupe_Fields_buf.h:='';Dupe_Fields_buf.y:='';End;
- 36 : Begin Dupe_Fields_buf.i:='';Dupe_Fields_buf.z:='';End;
- End;
- End;
- End;
- S_Point := S_PrevFld;
- End;
-
- If S_F2 Then
- Begin
- S_ClearDupes;
- FillChar(Dupe_Fields_buf.a,2,0);
- FillChar(Dupe_Fields_buf.b,2,0);
- FillChar(Dupe_Fields_buf.c,2,0);
- FillChar(Dupe_Fields_buf.d,2,0);
- FillChar(Dupe_Fields_buf.e,2,0);
- FillChar(Dupe_Fields_buf.f,2,0);
- FillChar(Dupe_Fields_buf.g,2,0);
- FillChar(Dupe_Fields_buf.h,2,0);
- FillChar(Dupe_Fields_buf.i,2,0);
- FillChar(Dupe_Fields_buf.r,2,0);
- FillChar(Dupe_Fields_buf.s,2,0);
- FillChar(Dupe_Fields_buf.t,2,0);
- FillChar(Dupe_Fields_buf.u,2,0);
- FillChar(Dupe_Fields_buf.v,2,0);
- FillChar(Dupe_Fields_buf.w,2,0);
- FillChar(Dupe_Fields_buf.x,2,0);
- FillChar(Dupe_Fields_buf.y,2,0);
- FillChar(Dupe_Fields_buf.z,2,0);
- End;
-
- If S_F3 Then
- Begin
- If S_HelpSound Then
- Begin
- S_HelpSound := False;
- S_ErrorSound:= False;
- S_UserSound := False;
- End
- Else
- Begin
- S_HelpSound :=True;
- S_ErrorSound:=True;
- S_UserSound :=True;
- End;
- End;
-
- If S_F4 Then
- If S_AutoHelp Then S_AutoHelp := False Else S_AutoHelp := True;
-
- If S_F5 Then
- If S_AutoValidate Then
- S_AutoValidate := False
- Else
- S_AutoValidate := True;
-
- If S_F6 Then
- If Dupe_Fields_buf.Name1 > '' Then
- Begin
- Dupe_Fields_buf.Name2 := Dupe_Fields_buf.Name1;
- Dupe_Fields_buf.Address2_a := Dupe_Fields_buf.Address1_a;
- Dupe_Fields_buf.Address2_b := Dupe_Fields_buf.Address1_b;
- Dupe_Fields_buf.City2 := Dupe_Fields_buf.City1;
- Dupe_Fields_buf.S2 := Dupe_Fields_buf.S1;
- Dupe_Fields_buf.Zip2 := Dupe_Fields_buf.Zip1;
- Dupe_Fields_buf.Phone2 := Dupe_Fields_buf.Phone1;
- Dupe_Fields_buf.Ssn2 := Dupe_Fields_buf.Ssn1;
- Dupe_Fields_buf.Gross2 := Dupe_Fields_buf.Gross1;
- FillChar(Dupe_Fields_buf.Name1,35,0);
- FillChar(Dupe_Fields_buf.Address1_a,35,0);
- FillChar(Dupe_Fields_buf.Address1_b,35,0);
- FillChar(Dupe_Fields_buf.City1,21,0);
- FillChar(Dupe_Fields_buf.S1,3,0);
- FillChar(Dupe_Fields_buf.Zip1,10,0);
- FillChar(Dupe_Fields_buf.Phone1,15,0);
- FillChar(Dupe_Fields_buf.Ssn1,12,0);
- Dupe_Fields_buf.Gross1 := 0.0;
- S_Point := 8;
- End
- Else
- S_UserMsg := ' No record entered to Edit.. ';
-
- If S_F9 Then
- If S_EnterAsTab Then
- S_EnterAsTab := False
- Else
- S_EnterAsTab := True;
-
- If (S_EnterAsTab)And(S_F10) Then
- Begin
- S_ScreenValid := True;
- S_ValidateScreen;
- if Not S_ScreenValid Then S_ResetKeyFlags;
- End;
-
- if (((Not S_EnterAsTab)And(S_Enter))Or((S_EnterAsTab)And(S_F10))) Then
- Begin
- Name :=Dupe_Fields_buf.Name2;
- Address_a:=Dupe_Fields_buf.Address2_a;
- Address_b:=Dupe_Fields_buf.Address2_b;
- City :=Dupe_Fields_buf.City2;
- State :=Dupe_Fields_buf.S2;
- ZipCode :=Dupe_Fields_buf.Zip2;
- Phone :=Dupe_Fields_buf.Phone2;
- Ssn :=Dupe_Fields_buf.Ssn2;
- Gross :=Dupe_Fields_buf.Gross2;
- S_ClearScreen(1);
- Dupe_Fields_buf.Name1 :=Name;
- Dupe_Fields_buf.Address1_a:=Address_a;
- Dupe_Fields_buf.Address1_b:=Address_b;
- Dupe_Fields_buf.City1 :=City;
- Dupe_Fields_buf.S1 :=State;
- Dupe_Fields_buf.Zip1 :=ZipCode;
- Dupe_Fields_buf.Phone1 :=Phone;
- Dupe_Fields_buf.Ssn1 :=Ssn;
- Dupe_Fields_buf.Gross1 :=Gross;
- S_Point := 8;
- End;
- End;
-
-
-
-
- Procedure RecordDemo;
- Var R : Integer;
- Begin
- RecordDemo_Init;
- Repeat
- EnterRecords;
- Until S_Esc;
- S_EnterAsTab := False;
- S_AutoHelp := False;
- S_ErrorSound := True;
- S_HelpSound := True;
- S_UserSound := True;
- R := S_SetDisplayOff(1);
- S_ClearDupes;
- FillChar(Dupe_Fields_buf.a,2,0);
- FillChar(Dupe_Fields_buf.b,2,0);
- FillChar(Dupe_Fields_buf.c,2,0);
- FillChar(Dupe_Fields_buf.d,2,0);
- FillChar(Dupe_Fields_buf.e,2,0);
- FillChar(Dupe_Fields_buf.f,2,0);
- FillChar(Dupe_Fields_buf.g,2,0);
- FillChar(Dupe_Fields_buf.h,2,0);
- FillChar(Dupe_Fields_buf.i,2,0);
- FillChar(Dupe_Fields_buf.r,2,0);
- FillChar(Dupe_Fields_buf.s,2,0);
- FillChar(Dupe_Fields_buf.t,2,0);
- FillChar(Dupe_Fields_buf.u,2,0);
- FillChar(Dupe_Fields_buf.v,2,0);
- FillChar(Dupe_Fields_buf.w,2,0);
- FillChar(Dupe_Fields_buf.x,2,0);
- FillChar(Dupe_Fields_buf.y,2,0);
- FillChar(Dupe_Fields_buf.z,2,0);
- End;
-
-
-
-
-
-
-
-
-
-
-
-
-
- {*****************************
-
- MENU OPTION 2 (Demo of Mouse functions)
-
- Section 3 of Turbo ScrEdit Tutor Describes this portion of code
-
- *****************************}
-
- Procedure Set_Button_Labels;
- Begin
- If S_MsLeftPressed Then
- Mouse_Demo_buf.Lb := '*Pressed*'
- Else
- If S_MsLeftReleased Then
- Mouse_Demo_buf.Lb := '*Released*'
- else
- Mouse_Demo_buf.Lb := '';
-
- If S_MsMiddlePressed Then
- Mouse_Demo_buf.Mb:='*Pressed*'
- Else
- If S_MsMiddleReleased Then
- Mouse_Demo_buf.Mb :='*Released*'
- Else
- Mouse_Demo_buf.Mb := '';
-
- If S_MsRightPressed Then
- Mouse_Demo_buf.Rb := '*Pressed*'
- Else
- If S_MsRightReleased Then
- Mouse_Demo_buf.Rb := '*Released*'
- Else
- Mouse_Demo_buf.Rb := '';
- End;
-
-
-
-
- Procedure Set_Event_Mask;
- Var R:Integer;
- Begin
- If Not S_MsLeftPressed Then Exit;
-
- If (S_MsRow=2)And((S_MsCol>2)And(S_MsCol<19))Then
- Begin
- If Mouse_Demo_buf.EM[1]='1' Then
- Begin
- Mouse_Demo_buf.EM[1]:='0';
- R := S_ChangeFieldColor(1,2,0,7);
- End
- Else
- Begin
- Mouse_Demo_buf.EM[1]:='1';
- R := S_ChangeFieldColor(1,2,7,0);
- End;
- End;
-
-
- If (S_MsRow=2)And((S_MsCol>20)And(S_MsCol<40)) Then
- S_ErrorMsg := 'The Left Mouse Button must remain enabled for this demo..';
-
- If (S_MsRow=3)And((S_MsCol>20)And(S_MsCol<40)) Then
- Begin
- If Mouse_Demo_buf.EM[3]='1' Then
- Begin
- Mouse_Demo_buf.EM[3]:='0';
- R := S_ChangeFieldColor(6,2,0,7);
- End
- Else
- Begin
- Mouse_Demo_buf.EM[3]:='1';
- R := S_ChangeFieldColor(6,2,7,0);
- End;
- End;
-
-
- If (S_MsRow=2)And((S_MsCol>59)And(S_MsCol<80)) Then
- Begin
- if Mouse_Demo_buf.EM[4]='1' Then
- Begin
- Mouse_Demo_buf.EM[4]:='0';
- R := S_ChangeFieldColor(4,2,0,7);
- End
- Else
- Begin
- Mouse_Demo_buf.EM[4]:='1';
- R := S_ChangeFieldColor(4,2,7,0);
- End;
- End;
-
- If (S_MsRow=3)And((S_MsCol>59)And(S_MsCol<80)) Then
- Begin
- If Mouse_Demo_buf.EM[5]='1' Then
- Begin
- Mouse_Demo_buf.EM[5]:='0';
- R := S_ChangeFieldColor(8,2,0,7);
- End
- Else
- Begin
- Mouse_Demo_buf.EM[5]:='1';
- R := S_ChangeFieldColor(8,2,7,0);
- End;
- End;
-
-
-
- If (S_MsRow=2)And((S_MsCol>40)And(S_MsCol<59)) Then
- Begin
- If Mouse_Demo_buf.EM[6]='1' Then
- Begin
- Mouse_Demo_buf.EM[6]:='0';
- R := S_ChangeFieldColor(3,2,0,7);
- End
- Else
- Begin
- Mouse_Demo_buf.EM[6]:='1';
- R := S_ChangeFieldColor(3,2,7,0);
- End;
- End;
-
-
- If (S_MsRow=3)And((S_MsCol>40)And(S_MsCol<59)) Then
- Begin
- If Mouse_Demo_buf.EM[7]='1' Then
- Begin
- Mouse_Demo_buf.EM[7]:='0';
- R := S_ChangeFieldColor(7,2,0,7);
- End
- Else
- Begin
- Mouse_Demo_buf.EM[7]:='1';
- R := S_ChangeFieldColor(7,2,7,0);
- End;
- End;
- End;
-
-
- Procedure Change_Mode;
- Var R:Integer;
- Begin
- If Not S_MsLeftPressed Then Exit;
-
- If (S_MsRow=7)And((S_MsCol>1)And(S_MsCol<5)) Then
- Begin
- Tr:=6;
- Tc:=30;
- Br:=17;
- Bc:=52;
- S_SetMouseRange(Tc,Tr,Bc,Br);
- S_MsRow := 11;
- S_MsCol := 41;
- S_MoveMouse;
- End;
-
- If (S_MsRow=9)And((S_MsCol>1)And(S_MsCol<5)) Then
- Begin
- Tr:=6;
- Tc:=57;
- Br:=17;
- Bc:=79;
- S_SetMouseRange(Tc,Tr,Bc,Br);
- S_MsRow := 11;
- S_MsCol := 68;
- S_MoveMouse;
- End;
-
- If (S_MsRow=5)And((S_MsCol>1)And(S_MsCol<5)) Then
- Begin
- R := S_ChangeFieldColor(5,2,2,0);
- Mouse_Demo_buf.End_Set_Up := '** FINISHED **';
- Tr:=2;
- Tc:=2;
- Br:=3;
- Bc:=79;
- S_SetMouseRange(Tc,Tr,Bc,Br);
- S_MsRow := 3;
- S_MsCol := 8;
- S_MoveMouse;
- End;
- End;
-
-
-
- Procedure MouseDemo;
- Var R:Integer;
- Begin
- S_ActivateMouse;
-
- S_SetMouseEvent(Mouse_Demo_buf.EM);
- Tr:=5;
- Tc:=1;
- Br:=18;
- Bc:=28;
- S_SetMouseRange(Tc,Tr,Bc,Br);
- S_MsRow := 5;
- S_MsCol := 1;
- S_ShowMouse;
-
- Repeat
- Mouse_Demo_buf.Cr:=S_MsRow;
- Mouse_Demo_buf.Cc:=S_MsCol;
- Mouse_Demo_buf.Ur:=Tr;
- Mouse_Demo_buf.Uc:=Tc;
- Mouse_Demo_buf.Lr:=Br;
- Mouse_Demo_buf.Lc:=Bc;
-
- S_ResetMouseFlags;
-
- S_ReadKey;
-
- If (S_MouseEvent) Then S_AnalizeMouse;
-
- Set_Button_Labels;
-
- If (((S_MsLeftPressed)And(S_MsRow=11)And((S_MsCol>35)And(S_MsCol<48)))Or
- ((S_MsLeftPressed)And(S_MsRow=11)And((S_MsCol>62)And(S_MsCol<75)))Or
- ((S_MsLeftPressed)And(S_MsRow=3) And((S_MsCol>2) And(S_MsCol<17)))) Then
- Begin
- Tr:=5;
- Tc:=1;
- Br:=18;
- Bc:=28;
- S_SetMouseRange(Tc,Tr,Bc,Br);
- If (S_MsRow=3) Then
- Begin
- R := S_ChangeFieldColor(5,2,0,2);
- Mouse_Demo_buf.End_Set_Up:='';
- S_SetMouseEvent(Mouse_Demo_buf.EM);
- S_MsRow := 5;
- S_MsCol := 3;
- S_MoveMouse;
- End
- Else
- If (S_MsCol > 62) Then
- Begin
- S_MsRow:=9;
- S_MsCol:=3;
- S_MoveMouse;
- End
- Else
- Begin
- S_MsRow:=7;
- S_MsCol:=3;
- S_MoveMouse;
- End;
- End
- Else
- Begin
- Case S_MsRow Of
- 2,3 : Set_Event_Mask;
- 5,7,9: Change_Mode;
- End;
- End;
-
- Until (S_MsLeftPressed)And(S_MsRow=11)And((S_MsCol>1)And(S_MsCol<5));
- S_ResetMouseFlags;
- S_HideMouse;
- S_DisableMouse;
- End;
-
-
-
-
-
-
-
-
-
-
- {*****************************
-
- MENU OPTION 3 (Customizing Screen Colors)
-
- Section 4 of Turbo ScrEdit Tutor Describes this portion of code
-
- *****************************}
-
- Procedure ChangeColors;
- Var R,X,Y:Integer;
- Begin
- Color_Demo_buf.F1:=2.0;
- Color_Demo_buf.A :=0.0;
- Color_Demo_buf.F2:=0.0;
- Color_Demo_buf.B :=5.0;
- Color_Demo_buf.F3:=15.0;
- Color_Demo_buf.C :=0.0;
- Color_Demo_buf.F4:=14.0;
- Color_Demo_buf.D :=0.0;
- Color_Demo_buf.F5:=3.0;
- Color_Demo_buf.E :=0;
- Color_Demo_buf.F6:=2.0;
- Color_Demo_buf.F :=0.0;
- Color_Demo_buf.F7:=2.0;
- Color_Demo_buf.G :=0.0;
- Color_Demo_buf.F8:=15.0;
- Color_Demo_buf.H :=0.0;
- Color_Demo_buf.F9:=2.0;
- Color_Demo_buf.I :=0.0;
- S_PrevFld := 1;
- While Not S_Esc Do
- Begin
-
- S_Point := S_PrevFld;
- S_ReadScreen;
-
- { Text }
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.A),Trunc(Color_Demo_buf.F1), 1,24, 1,80);
-
- { double line around logo }
- R := S_ChangeScreenColor(
- 2,Trunc(Color_Demo_buf.D),Trunc(Color_Demo_buf.F4), 1,11, 1,80);
-
- { Logo }
- R := S_ChangeScreenColor(
- 2,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 2, 9,10,69);
-
- { Fill in logo letters }
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 2, 8,11,11);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 2, 8,18,18);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 5, 8,22,22);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 5, 8,27,27);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 5, 8,31,31);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 7, 8,35,35);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 5, 6,36,36);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 2, 8,40,40);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 3, 3,47,47);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 8, 8,47,47);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 5, 8,51,51);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 2, 8,56,56);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 6, 8,60,60);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 2, 8,64,64);
-
- { other logo text }
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 6, 6, 3, 7);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 2, 2,21,24);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 5, 5,67,78);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 6, 6,69,76);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 7, 7,70,74);
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.B),Trunc(Color_Demo_buf.F2), 8, 9,67,79);
-
- { Copyright Notice }
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.C),Trunc(Color_Demo_buf.F3),10,10,27,57);
-
- { Version Number }
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.E),Trunc(Color_Demo_buf.F5), 3, 3,71,75);
-
- { text in configure box }
- R := S_ChangeScreenColor(
- 0,Trunc(Color_Demo_buf.G),Trunc(Color_Demo_buf.F7),13,23,18,64);
-
- { single line box }
- R := S_ChangeScreenColor(
- 1,Trunc(Color_Demo_buf.F),Trunc(Color_Demo_buf.F6),13,24,17,65);
-
- X := 1;
- While (X < 19) Do
- Begin
- R := S_ChangeFieldColor(
- X,1,Trunc(Color_Demo_buf.H),Trunc(Color_Demo_buf.F8));
- R := S_ChangeFieldColor(
- X,2,Trunc(Color_Demo_buf.I),Trunc(Color_Demo_buf.F9));
- Inc(X);
- End;
-
- S_RefreshScreen;
- End;
- End;
-
-
-
-
-
-
-
-
-
-
-
-
- {*****************************
-
- MENU OPTION 9 (Mixed ScrEdit)
-
- Section 4 of Turbo ScrEdit Tutor Describes this portion of code
-
- *****************************}
-
-
- Procedure Back_To_Turbo_Pascal_Land;
- Var
- Response : String[10];
- Begin
- ClrScr;
- Repeat
- ClrScr;
- WriteLn('This is regular pascal code now.');
- WriteLn('');
- WriteLn('You can do anything now that you want to, use any ');
- WriteLn('programming statement that you wish to. When you');
- WriteLn('are ready to resume with Turbo ScrEdit just return');
- WriteLn('and the screen will be reloaded and you will resume');
- WriteLn('at the point where you left the screen.');
- WriteLn;
- Write('Type "RETURN" in upper case to end this example...');
- ReadLn(Response);
- Until (Response = 'RETURN')
- End;
-
-
-
-
-
-
-
-
- {*****************************
-
- START OF MAIN MENU SCREEN PROCEDURES
-
- Section 1 of Turbo ScrEdit Tutor Describes this portion of code
-
- *****************************}
-
- Procedure Process_Screen;
- Begin
-
- {*** changes ****}
-
- If Screen_Mode = 1 Then
- Begin
- Val(Demo_Screen_Buf.OP,Cursor_Position,Result);
- Case Cursor_Position of
- 1 : S_Point := 5;
- 2 : S_Point := 8;
- 3 : S_Point := 12;
- 4 : S_Point := 14;
- 5 : S_Point := 16;
- else
- S_Point := S_FirstField;
- End; {Case of}
- End;
-
- If Screen_Mode = 2 then
- Begin
- S_Point := S_Point + 1;
- Val(Demo_Screen_Buf.OP,Cursor_Position,Result);
- Case Cursor_Position of
- 0 : S_Point := 4;
- 1 : If (S_Point > 7) Or
- (S_Point < 5) Then
- S_Point := 5;
- 2 : Begin
- If (S_Point > 11) Or
- (S_Point < 8) Then
- S_Point := 8;
- End;
- 3 : If (S_Point > 13) Or
- (S_Point < 12) Then
- S_Point := 12;
- 4 : Begin
- If (S_Point > 15) Or
- (S_Point < 14) Then
- S_Point := 14;
- End;
- 5 : S_Point := 16;
- End; {Case of}
- End;
-
- S_UserMsg := ' <F1>=clear screen <ESC>=exit ';
-
- Case Screen_Mode of
- 2 : S_ReadField;
- 1 : S_ReadScreen;
- End; {Case of}
-
- If S_Fkey Then
- Begin
- If (Not S_Shift) And
- (Not S_Ctrl) And
- (Not S_Alt) Then
- Begin
- If S_F1 Then
- Begin
- S_ClearScreen(1);
- S_Point := 4;
- End;
- End;
- End;
- {*** changes ***}
- End;
-
-
-
-
-
-
-
-
-
-
- Procedure ScrDemo_Init;
- Begin
-
- S_OpenScreenFile('ScrDemo.SCR');
-
- Initialize_Demo_Menu_buf;
- Initialize_Demo_Screen_Buf;
- Initialize_Mouse_Demo_Buf;
- Initialize_Dupe_Fields_Buf;
- S_LoadScreen('Demo_Menu');
-
- TextBackGround(Black);
- TextColor(Green);
-
- S_ErrorSound := True;
- S_ErrorFreq := 300;
- S_ErrorDur := 100;
- S_HelpSound := True;
- S_HelpFreq := 400;
- S_HelpDur := 100;
- S_UserSound := True;
- S_UserFreq := 200;
- S_UserDur := 100;
-
- Screen_Mode := 0;
- S_Cursor := S_Normal;
- S_Sound := False;
- S_ShowStatus := True;
- End;
-
-
-
-
-
-
-
-
- Procedure Read_Menu_Screen;
- Var
- X,Y,Z : Integer;
- Begin
- Option := 1;
- S_LoadScreen('Demo_Menu');
-
- Repeat
-
- Demo_Menu_Buf.O1 := 'Example Data Entry Screen';
- Demo_Menu_Buf.O2 := 'Demo of Mouse functions';
- Demo_Menu_Buf.O3 := 'Customizing screen colors';
- Demo_Menu_Buf.O4 := 'Using S_ReadScreen';
- Demo_Menu_Buf.O5 := 'Using S_ReadField';
- Demo_Menu_Buf.O6 := 'Using S_ReadKey';
- Demo_Menu_Buf.O7 := 'Using S_NextKey';
- Demo_Menu_Buf.O8 := '"Pop Up" windows demo';
- Demo_Menu_Buf.O13:= 'Mixed ScrEdit';
-
- If Option < 1 Then Option := 9;
- If Option > 9 Then Option := 1;
-
- With Demo_Menu_Buf Do
- Begin
- P1 := '';
- P2 := '';
- P3 := '';
- P4 := '';
- P5 := '';
- P6 := '';
- P7 := '';
- P8 := '';
- P13:= '';
- Case Option of
- 1 : Begin
- M1 := 'This option is a pratical example of a';
- M2 := 'data entry screen that demonstrates how';
- M3 := 'to use EDIT MASKS, DUPE FIELDS, AUTO';
- M4 := 'HELP, AUTO VALIDATE, SOUND On/Off,';
- M5 := 'CLEAR SCREEN, CLEAR DUPES, and CHANGING';
- M6 := 'MESSAGE LINE COLORS.';
- P1 := '==>';
- End;
- 2 : Begin
- M1 := 'Using the MOUSE interface. This option ';
- M2 := 'shows how to set up and use all the';
- M3 := 'features of the MOUSE and MOUSE DRIVER.';
- M4 := 'How to monitor for mouse buttons being';
- M5 := 'pressed or mouse movement. How to ';
- M6 := 'define mouse windows, and much more..';
- P2 := '==>';
- End;
- 3 : Begin
- M1 := 'This option demonstrates how to change';
- M2 := 'the color assignments for screens, and';
- M3 := 'screen fields "on the fly". With these';
- M4 := 'procedures you can write installation ';
- M5 := 'routines that will make your programs ';
- M6 := 'customizable to the users taste. ';
- P3 := '==>';
- End;
- 4 : Begin
- M1 := 'This option demonstrates using more ';
- M2 := 'complex field validation statements to';
- M3 := 'control data entry into a screen. It ';
- M4 := 'demonstrates the use of nearly all the';
- M5 := 'field validation statements and using ';
- M6 := 'them with S_READSCREEN.';
- P4 := '==>';
- End;
- 5 : Begin
- M1 := 'This option is just like option 4 ';
- M2 := 'except it uses S_READFIELD to process ';
- M3 := 'each field on the screen individually.';
- M4 := 'You will see that it works quite diff-';
- M5 := 'erently than the previous example that';
- M6 := 'uses S_READSCREEN.';
- P5 := '==>';
- End;
- 6 : Begin
- M1 := 'This option demonstrates how a program';
- M2 := 'can communicate with the user using the';
- M3 := 'message line to display a message that';
- M4 := 'the user must respond to by pressing a';
- M5 := 'key. The key pressed is not echoed to ';
- M6 := 'the screen. See S_READKEY for more info';
- P6 := '==>';
- End;
- 7 : Begin
- M1 := 'This option demonstrates how S_NEXTKEY';
- M2 := 'works. It is similar to S_READKEY ';
- M3 := 'except no screen field values will be ';
- M4 := 'displayed and no messages can be disp- ';
- M5 := 'layed. Only the next key pressed is ';
- M6 := 'returned to your program. ';
- P7 := '==>';
- End;
- 8 : Begin
- M1 := 'Demonstrates iHn Systems`s "POP UP" ';
- M2 := 'windows package that is included with';
- M3 := 'the registered version of Turbo ScrEdit';
- M4 := '';
- M5 := '';
- M6 := '';
- P8 := '==>';
- End;
- 9 : Begin
- M1 := 'This option demonstarates how you can ';
- M2 := 'exit a procedure using a Turbo ScrEdit';
- M3 := 'screen to use your language`s standard';
- M4 := 'I/O statements such as CLRSCR, WRITELN,';
- M5 := 'READLN, ect. To resume using Turbo ';
- M6 := 'ScrEdit, use S_REFRESHSCREEN and go on.';
- P13 := '==>';
- End;
- End;{Case of};
- End;
- Repeat
- S_ReadKey;
- If (S_Up) Or
- (S_Down) Or
- (S_Enter)Then
- {
- (S_Esc) Then
- }
- Begin
- If S_Down Then
- Option := Option + 1;
-
- If S_Up Then
- Option := Option - 1;
-
- If S_Enter Then
- Begin
- If Option = 1 Then
- Begin
- RecordDemo;
- S_LoadScreen('Demo_Menu');
- End;
- If Option = 2 Then
- Begin
- If S_MouseInstalled Then
- Begin
- S_LoadScreen('Mouse_Demo');
- S_ClearScreen(1);
- MouseDemo;
- S_LoadScreen('Demo_Menu');
- End
- Else
- S_ErrorMsg := 'Mouse Driver is not loaded into memory';
- End;
- If Option = 3 Then
- Begin
- Initialize_Color_Demo_Buf;
- S_LoadScreen('Color_Demo');
- ChangeColors;
- S_LoadScreen('Demo_Menu');
-
- End;
- If Option = 4 Then
- Begin
- Screen_Mode := 1;
- S_LoadScreen('Demo_Screen');
- S_ClearScreen(1);
-
- While Not S_ESC Do Process_Screen;
-
- S_LoadScreen('Demo_Menu');
- End;
-
- If Option = 5 Then
- Begin
- Screen_Mode := 2;
- S_LoadScreen('Demo_Screen');
- S_ClearScreen(1);
-
- While Not S_ESC Do Process_Screen;
-
- S_LoadScreen('Demo_Menu');
- S_ResetkeyFlags;
- End;
- If Option = 6 Then
- Begin
- S_UserMsg := 'Demo of S_READKEY - Press "C" key to continue';
-
- Repeat
- S_ReadKey;
- S_UserMsg := 'OOPS!! wrong key - Press "C" key to continue';
- Until UpCase(S_Ch) = 'C';
-
- S_UserMsg := ' "C" has been pressed - You may continue';
- End;
-
- If Option = 7 Then
- Begin
- For X := 1 to 6 Do
- Begin
- Gotoxy(39,14+X);
- Write(' ');
- End;
- gotoxy(39,17);
- Write(' << OKAY PRESS SHIFT C TO CONTINUE >>');
- Repeat
- S_NextKey;
- Until (S_Shift) and (UpCase(S_Ch)='C');
- End;
-
- If Option = 8 Then
- Begin
- S_SetCursor(S_Normal);
- If S_BW Then
- Exec('demowind.exe','/BW')
- Else
- Exec('demowind.exe','');
- S_SetCursor(S_OFF);
- If DosError > 0 Then
- Begin
- If DosError = 8 then
- s_UserMsg := 'Not enough memory to run windows demo'
- Else
- If DosError > 0 Then
- S_UserMsg := 'DemoWind.EXE is not in current directory';
- End
- Else
- S_UserMsg := ' End of Windows Demo ';
-
- End;
-
- If Option = 9 Then
- Begin
- Back_To_Turbo_Pascal_Land;
- S_RefreshScreen;
- End;
-
- S_ResetKeyFlags;
- End;
- End
- Else
- S_UserMsg := ' Only UP and DOWN arrows and ENTER and ESC are valid';
-
- Until (S_Esc)Or(S_UP)Or(S_Down);
-
- Until (S_Esc);
- End;
-
-
-
-
- {*****************************
-
- MAIN MENU SCREEN
-
- Section 1 of Turbo ScrEdit Tutor Describes this portion of code
-
- *****************************}
-
- Begin
- ScrDemo_Init;
- Read_Menu_Screen;
- S_CloseScreenFile;
- gotoxy(1,25);
- End.