|
görsel menu
{
------------------------------------------------------------------------- Pascal code for creating a menu-bar (Probably not the most optimied thing around, but it does the job) All code by me except the Save_Screen/Restore_Screen and HideCursor/ShowCursor procedures that I found in SWAG. This thing can off course be expanded to include shortcuts to menus and so on, use your imagination! :) Needed files: menuunit.pas - menu-system unit menusys.pas - example program ------------------------------------------------------------------------- (c) Anders Gardebring 27/1 1997 Contact me at: Email: [Bu Adresi (link) Görme Yetkiniz Yok BEDAVA'ya Üye Ol Sitemizden Faydalan....] www: [Bu Adresi (link) Görme Yetkiniz Yok BEDAVA'ya Üye Ol Sitemizden Faydalan....] ------------------------------------------------------------------------- This code is almost Public Domain. It may be freely copied, altered and included in any program of any kind as long as credit is given to the author. This program is used to create a menu like the ones you can find in MS-DOS editor, or Turbo Pascal. See menusys.pas for an example program! ------------------------------------------------------------------------- } unit menuunit; interface uses crt; const MaxHead = 10; {Max number of mainmenus} MaxSub = 20; {Max number of submenus} { End of constant declarations ---------------------------------} var Loop, Loop2 : Byte; ch : char; TmpStr : String; MenuText : Array [1..MaxHead, 1..MaxSub] of String [40]; {Text in menus} HeadPos : Array [1..MaxHead] of Byte; {X-Position of the different main-menus} MenuPos_X, {x and} MenuPos_Y : Byte; {y position for the menu} Activated_Main, {Activated Main-menu} Activated_Sub : Byte; {Activated sub-menu} C_MenuBack, C_MenuText, C_Disabled, C_HighBack, C_HighText, C_HighDisabled: Byte; {Colors for the menu system} Max_X, Max_Rows: Byte; Selected_Main, Selected_Sub: Byte; {Used to detect activated menu} Buffer : Array[1..4000] of Byte; {Used for Save_Screen and Restore_Screen} { End of variable declarations ---------------------------------} Procedure HideCursor; Procedure ShowCursor; Procedure Save_Screen; {Save Text Screen} Procedure Restore_Screen; {Restore Text Screen} Procedure Draw_Box (x1, y1, x2, y2: Byte); Procedure Draw_Shadow_Box (x1, y1, x2, y2: Byte); Procedure Start_Menu_Sys; Procedure Add_Menu (Txt: String; Head, Sub: Byte); {Add a menu} Procedure Bottom_Bar (Txt: String); Procedure Reset_Menu; Procedure Create_Menu (x, y, MenuLen: Byte); function Selected (head, sub: Byte): Boolean; Procedure Clear_Selected; implementation Procedure Clear_Selected; Begin Selected_Main := 0; Selected_Sub := 0; End; function Selected (head, sub: Byte): Boolean; {Used to determine which menu has been selected, see menusys.pas} Begin Selected := False; If (Selected_Main = head) And (Selected_Sub = sub) Then Selected := True; End; {selected} Procedure HideCursor; Assembler; Asm mov ax, 0100h mov cx, 2607h int 10h end; {HideCursor} Procedure ShowCursor; Assembler; Asm mov ax, 0100h mov cx, 0506h int 10h end; {ShowCursor} Procedure Save_Screen; {Save Text Screen} begin Move(Mem[$B800:0000],Buffer,4000); end; {Save_Screen} Procedure Restore_Screen; {Restore Text Screen} begin Move(Buffer,Mem[$B800:0000],4000); end; {Restore_Screen} Procedure Draw_Box (x1, y1, x2, y2: Byte); {Draw a box with current colors} var D_Loop, D_Loop2: Byte; Begin Window (x1, y1, x2, y2); {Fix the background of the box} ClrScr; Window (1, 1, 80, 25); {Draw Lines at the corners of the box:} For D_Loop := x1 + 1 to x2 - 1 do Begin GotoXy (D_Loop, y1); Write ('Ä'); GotoXy (D_Loop, y2); Write ('Ä'); End; For D_Loop := y1 + 1 to y2 - 1 do Begin GotoXy (x1, D_Loop); Write ('³'); GotoXy (x2, D_Loop); Write ('³'); End; GotoXy (x1, y1); Write ('Ú'); GotoXy (x2, y1); Write ('¿'); GotoXy (x1, y2); Write ('À'); GotoXy (x2, y2); Write ('Ù'); End; {Draw_Box} Procedure Draw_Shadow_Box (x1, y1, x2, y2: Byte); {Draw a box with a shadow} Begin Draw_Box (x1, y1, x2, y2); TextColor (0); For Loop := y1 + 1 to y2 do Begin GotoXy (x2 + 1, Loop); Write ('ÛÛ'); End; For Loop := x1 + 2 to x2 + 2 do Begin GotoXy (Loop, y2 + 1); Write ('Û'); End; End; {Draw_Shadow_Box} Procedure Draw_Sub_Menu (Number: Byte); {Draw a submenu} Procedure Draw_Sub_Text; {Print menu text} Begin For Loop := 1 to Max_Rows do Begin TextColor (C_MenuText); TextBackGround (C_MenuBack); If (Loop = Activated_Sub) and (Number = Activated_Main) Then Begin TextColor (C_HighText); TextBackGround (C_HighBack); GotoXy (MenuPos_X + HeadPos [Number] - 1, MenuPos_Y + Loop + 1); TmpStr := ''; For Loop2 := 1 to Max_X + 2 do TmpStr := TmpStr + ' '; Write (TmpStr); End; GotoXy (MenuPos_X + HeadPos [Number], MenuPos_Y + Loop + 1); If MenuText [Number, Loop + 1] <> '-' Then {Is current menu a separator?} Begin {No, it ain't} Write (MenuText [Number, Loop + 1]); End Else {Current menu is a separator} Begin TmpStr := ''; For Loop2 := 1 to Max_x + 2 do TmpStr := TmpStr + 'Ä'; TmpStr := 'Ã' + TmpStr + '´'; GotoXy (MenuPos_X + HeadPos [Number] - 2, MenuPos_Y + Loop + 1); Write (TmpStr); end; End; TextColor (C_MenuText); TextBackGround (C_MenuBack); End; {Draw_Sub_Text} Begin TextBackGround (C_MenuBack); {Set colors} TextColor (C_MenuText); Max_X := 0; Max_Rows := 0; {Get number of rows in this submenu:} For Loop := 1 to MaxSub do If MenuText [Number, Loop] <> '' Then Inc (Max_Rows); {Calculate the longest string in this menu:} For Loop := 1 to Max_Rows do Begin If Length (MenuText [Number, Loop]) >Max_X Then Max_X := Length (MenuText [Number, Loop]); End; {Draw a box for this submenu} Draw_Shadow_Box (MenuPos_X + HeadPos [Number] - 2, MenuPos_y + 1, MenuPos_X + HeadPos [Number] + 1 + Max_X, MenuPos_y + 1 + Max_Rows); Draw_Sub_Text; {Print text for this submenu} End; {Draw_Sub_Menu} Procedure Draw_Menu_Bar (x, y: Byte); {Draw the mainmenu} Var Pos: Byte; Begin TextBackGround (c_MenuBack); {Set colors} TextColor (c_MenuText); MenuPos_X := x; MenuPos_Y := y; GotoXy (x, y); Write (' '); pos := 2; For Loop := 1 to MaxHead do Begin If MenuText [Loop, 1] <> '' Then Begin Write (MenuText [Loop, 1], ' '); HeadPos [Loop] := Pos; Inc (Pos, Length (MenuText [Loop, 1]) + 2); End; End; End; {Draw_Menu_Bar} Procedure Create_Menu (x, y, MenuLen: Byte); {Create a new menu from specified values at position x, y} Begin Window (x, y, x+ MenuLen, y); TextBackGround (C_MenuBack); ClrScr; Window (1, 1, 80, 25); Draw_Menu_Bar (x, y); End; {Create_Menu} Procedure Reset_Menu; {Clear all menu values} Begin Activated_Main := 0; Activated_Sub := 0; MenuPos_X := 0; MenuPos_Y := 0; For Loop := 1 to MaxHead do Begin HeadPos [Loop] := 0; For Loop2 := 1 to MaxSub do MenuText [Loop, Loop2] := ''; End; End; {Reset_Menu} Procedure Add_Menu (Txt: String; Head, Sub: Byte); {Add a menu} Begin MenuText [Head, Sub] := Txt; End; {Add_Menu} Procedure Bottom_Bar (Txt: String); Begin TextBackGround (C_MenuBack); Window (1, 25, 80, 25); ClrScr; TextColor (C_MenuText); Write (' ' + Txt); Window (1, 1, 80, 25); End; {Bottom_Bar} Procedure Start_Menu_Sys; Procedure Do_Menu; Begin Draw_Sub_Menu (Activated_Main); End; {Do_Menu} Procedure Do_Menu2; Begin Save_Screen; TextBackGround (C_HighBack); TextColor (C_HighText); GotoXy (MenuPos_X + HeadPos [Activated_Main] - 1, MenuPos_Y); Write (' ' + MenuText [Activated_Main, 1] + ' '); Do_Menu End; {Do_Menu2} Begin Activated_Main := 1; {Standard menu selected at menu startup} Activated_Sub := 1; Do_Menu2; Selected_Main := 0; Selected_Sub :=0; Repeat ch := ReadKey; If ch = #13 Then Begin Selected_Main := Activated_Main; Selected_Sub := Activated_Sub + 1; End; If ch = #0 Then {Right button pressed} Begin ch := ReadKey; If ch = #77 Then Begin Restore_Screen; Inc (Activated_Main); If MenuText [Activated_Main, 1] = '' Then Dec (Activated_Main); Activated_Sub := 1; Do_Menu2; End; If ch = #75 Then {Left button pressed} Begin Restore_Screen; Dec (Activated_Main); If Activated_Main = 0 Then Activated_Main := 1; Activated_Sub := 1; Do_Menu2; End; If ch = #72 Then {Up key pressed} Begin Dec (Activated_Sub); If MenuText [Activated_Main, Activated_Sub + 1] = '-' Then Dec(Activated_Sub); If MenuText [Activated_Main, Activated_Sub] = '' Then Activated_Sub := Max_Rows - 1; Do_Menu; End; If ch = #80 Then {Down key pressed} Begin Inc (Activated_Sub); If MenuText [Activated_Main, Activated_Sub + 1] = '-' Then Inc(Activated_Sub); If MenuText [Activated_Main, Activated_Sub + 1] = '' Then Activated_Sub := 1; Do_Menu; End; End; Until (ch = #27) or (ch = #13); Restore_Screen; End; begin end. |
Paylaşım için tşkler…
|
teŞekkÜrler PaylaŞim İİÇİn
|
paylaşım için tşkrlr
|
| Bütün Zaman Ayarları WEZ +3 olarak düzenlenmiştir. Şu Anki Saat: 19:49 . |
Powered by vBulletin® Version 3.7.0
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.