From mboxrd@z Thu Jan 1 00:00:00 1970 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.4 X-Google-Language: ENGLISH,ASCII-7-bit X-Google-Thread: 103376,c894ce2937221e2e X-Google-Attributes: gid103376,public From: cts@kampong.aedinc.net ((null)) Subject: Re: more specific Date: 2000/08/26 Message-ID: X-Deja-AN: 662849460 References: <39a77575$0$20391@echo-01.iinet.net.au> <39A7C7A9.F9DDD421@acm.org> <39a7ed56$0$20400@echo-01.iinet.net.au> X-Trace: newsfeed.slurp.net 967327453 208.4.231.188 (Sat, 26 Aug 2000 17:04:13 CDT) Organization: Multimedia NNTP-Posting-Date: Sat, 26 Aug 2000 17:04:13 CDT Newsgroups: comp.lang.ada Date: 2000-08-26T00:00:00+00:00 List-Id: In article <39a7ed56$0$20400@echo-01.iinet.net.au>, Damon Carter wrote: >Im writing a program using ada95 compiler thats going to run in a dos >window, >and i want to change the dos window colour from black to blue.. i am >using windows 95 and have 32bit video card.. i think > >Damon, Carter You'll want to get Jerry van Dijk's NT_Console package. I'm not sure where his web page went, so I'm just tacking an old version onto this message. If you can find his home page, I'm sure he has newer version. >---cut here---< ----------------------------------------------------------------------- -- -- File: nt_console.ads -- Description: Win95/NT console support -- Rev: 0.1 -- Date: 18-jan-1998 -- Author: Jerry van Dijk -- Mail: jdijk@acm.org -- -- Copyright (c) Jerry van Dijk, 1997, 1998 -- Billie Holidaystraat 28 -- 2324 LK LEIDEN -- THE NETHERLANDS -- tel int + 31 71 531 43 65 -- -- Permission granted to use for any purpose, provided this copyright -- remains attached and unmodified. -- -- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR -- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. -- ----------------------------------------------------------------------- package NT_Console is ---------------------- -- TYPE DEFINITIONS -- ---------------------- subtype X_Pos is Natural range 0 .. 79; subtype Y_Pos is Natural range 0 .. 24; type Color_Type is (Black, Blue, Green, Cyan, Red, Magenta, Brown, Gray, Light_Blue, Light_Green, Light_Cyan, Light_Red, Light_Magenta, Yellow, White); ---------------------- -- EXTENDED PC KEYS -- ---------------------- Key_Alt_Escape : constant Character := Character'Val (16#01#); Key_Control_At : constant Character := Character'Val (16#03#); Key_Alt_Backspace : constant Character := Character'Val (16#0E#); Key_BackTab : constant Character := Character'Val (16#0F#); Key_Alt_Q : constant Character := Character'Val (16#10#); Key_Alt_W : constant Character := Character'Val (16#11#); Key_Alt_E : constant Character := Character'Val (16#12#); Key_Alt_R : constant Character := Character'Val (16#13#); Key_Alt_T : constant Character := Character'Val (16#14#); Key_Alt_Y : constant Character := Character'Val (16#15#); Key_Alt_U : constant Character := Character'Val (16#16#); Key_Alt_I : constant Character := Character'Val (16#17#); Key_Alt_O : constant Character := Character'Val (16#18#); Key_Alt_P : constant Character := Character'Val (16#19#); Key_Alt_LBracket : constant Character := Character'Val (16#1A#); Key_Alt_RBracket : constant Character := Character'Val (16#1B#); Key_Alt_Return : constant Character := Character'Val (16#1C#); Key_Alt_A : constant Character := Character'Val (16#1E#); Key_Alt_S : constant Character := Character'Val (16#1F#); Key_Alt_D : constant Character := Character'Val (16#20#); Key_Alt_F : constant Character := Character'Val (16#21#); Key_Alt_G : constant Character := Character'Val (16#22#); Key_Alt_H : constant Character := Character'Val (16#23#); Key_Alt_J : constant Character := Character'Val (16#24#); Key_Alt_K : constant Character := Character'Val (16#25#); Key_Alt_L : constant Character := Character'Val (16#26#); Key_Alt_Semicolon : constant Character := Character'Val (16#27#); Key_Alt_Quote : constant Character := Character'Val (16#28#); Key_Alt_Backquote : constant Character := Character'Val (16#29#); Key_Alt_Backslash : constant Character := Character'Val (16#2B#); Key_Alt_Z : constant Character := Character'Val (16#2C#); Key_Alt_X : constant Character := Character'Val (16#2D#); Key_Alt_C : constant Character := Character'Val (16#2E#); Key_Alt_V : constant Character := Character'Val (16#2F#); Key_Alt_B : constant Character := Character'Val (16#30#); Key_Alt_N : constant Character := Character'Val (16#31#); Key_Alt_M : constant Character := Character'Val (16#32#); Key_Alt_Comma : constant Character := Character'Val (16#33#); Key_Alt_Period : constant Character := Character'Val (16#34#); Key_Alt_Slash : constant Character := Character'Val (16#35#); Key_Alt_KPStar : constant Character := Character'Val (16#37#); Key_F1 : constant Character := Character'Val (16#3B#); Key_F2 : constant Character := Character'Val (16#3C#); Key_F3 : constant Character := Character'Val (16#3D#); Key_F4 : constant Character := Character'Val (16#3E#); Key_F5 : constant Character := Character'Val (16#3F#); Key_F6 : constant Character := Character'Val (16#40#); Key_F7 : constant Character := Character'Val (16#41#); Key_F8 : constant Character := Character'Val (16#42#); Key_F9 : constant Character := Character'Val (16#43#); Key_F10 : constant Character := Character'Val (16#44#); Key_Home : constant Character := Character'Val (16#47#); Key_Up : constant Character := Character'Val (16#48#); Key_PageUp : constant Character := Character'Val (16#49#); Key_Alt_KPMinus : constant Character := Character'Val (16#4A#); Key_Left : constant Character := Character'Val (16#4B#); Key_Center : constant Character := Character'Val (16#4C#); Key_Right : constant Character := Character'Val (16#4D#); Key_Alt_KPPlus : constant Character := Character'Val (16#4E#); Key_End : constant Character := Character'Val (16#4F#); Key_Down : constant Character := Character'Val (16#50#); Key_PageDown : constant Character := Character'Val (16#51#); Key_Insert : constant Character := Character'Val (16#52#); Key_Delete : constant Character := Character'Val (16#53#); Key_Shift_F1 : constant Character := Character'Val (16#54#); Key_Shift_F2 : constant Character := Character'Val (16#55#); Key_Shift_F3 : constant Character := Character'Val (16#56#); Key_Shift_F4 : constant Character := Character'Val (16#57#); Key_Shift_F5 : constant Character := Character'Val (16#58#); Key_Shift_F6 : constant Character := Character'Val (16#59#); Key_Shift_F7 : constant Character := Character'Val (16#5A#); Key_Shift_F8 : constant Character := Character'Val (16#5B#); Key_Shift_F9 : constant Character := Character'Val (16#5C#); Key_Shift_F10 : constant Character := Character'Val (16#5D#); Key_Control_F1 : constant Character := Character'Val (16#5E#); Key_Control_F2 : constant Character := Character'Val (16#5F#); Key_Control_F3 : constant Character := Character'Val (16#60#); Key_Control_F4 : constant Character := Character'Val (16#61#); Key_Control_F5 : constant Character := Character'Val (16#62#); Key_Control_F6 : constant Character := Character'Val (16#63#); Key_Control_F7 : constant Character := Character'Val (16#64#); Key_Control_F8 : constant Character := Character'Val (16#65#); Key_Control_F9 : constant Character := Character'Val (16#66#); Key_Control_F10 : constant Character := Character'Val (16#67#); Key_Alt_F1 : constant Character := Character'Val (16#68#); Key_Alt_F2 : constant Character := Character'Val (16#69#); Key_Alt_F3 : constant Character := Character'Val (16#6A#); Key_Alt_F4 : constant Character := Character'Val (16#6B#); Key_Alt_F5 : constant Character := Character'Val (16#6C#); Key_Alt_F6 : constant Character := Character'Val (16#6D#); Key_Alt_F7 : constant Character := Character'Val (16#6E#); Key_Alt_F8 : constant Character := Character'Val (16#6F#); Key_Alt_F9 : constant Character := Character'Val (16#70#); Key_Alt_F10 : constant Character := Character'Val (16#71#); Key_Control_Left : constant Character := Character'Val (16#73#); Key_Control_Right : constant Character := Character'Val (16#74#); Key_Control_End : constant Character := Character'Val (16#75#); Key_Control_PageDown : constant Character := Character'Val (16#76#); Key_Control_Home : constant Character := Character'Val (16#77#); Key_Alt_1 : constant Character := Character'Val (16#78#); Key_Alt_2 : constant Character := Character'Val (16#79#); Key_Alt_3 : constant Character := Character'Val (16#7A#); Key_Alt_4 : constant Character := Character'Val (16#7B#); Key_Alt_5 : constant Character := Character'Val (16#7C#); Key_Alt_6 : constant Character := Character'Val (16#7D#); Key_Alt_7 : constant Character := Character'Val (16#7E#); Key_Alt_8 : constant Character := Character'Val (16#7F#); Key_Alt_9 : constant Character := Character'Val (16#80#); Key_Alt_0 : constant Character := Character'Val (16#81#); Key_Alt_Dash : constant Character := Character'Val (16#82#); Key_Alt_Equals : constant Character := Character'Val (16#83#); Key_Control_PageUp : constant Character := Character'Val (16#84#); Key_F11 : constant Character := Character'Val (16#85#); Key_F12 : constant Character := Character'Val (16#86#); Key_Shift_F11 : constant Character := Character'Val (16#87#); Key_Shift_F12 : constant Character := Character'Val (16#88#); Key_Control_F11 : constant Character := Character'Val (16#89#); Key_Control_F12 : constant Character := Character'Val (16#8A#); Key_Alt_F11 : constant Character := Character'Val (16#8B#); Key_Alt_F12 : constant Character := Character'Val (16#8C#); Key_Control_Up : constant Character := Character'Val (16#8D#); Key_Control_KPDash : constant Character := Character'Val (16#8E#); Key_Control_Center : constant Character := Character'Val (16#8F#); Key_Control_KPPlus : constant Character := Character'Val (16#90#); Key_Control_Down : constant Character := Character'Val (16#91#); Key_Control_Insert : constant Character := Character'Val (16#92#); Key_Control_Delete : constant Character := Character'Val (16#93#); Key_Control_KPSlash : constant Character := Character'Val (16#95#); Key_Control_KPStar : constant Character := Character'Val (16#96#); Key_Alt_EHome : constant Character := Character'Val (16#97#); Key_Alt_EUp : constant Character := Character'Val (16#98#); Key_Alt_EPageUp : constant Character := Character'Val (16#99#); Key_Alt_ELeft : constant Character := Character'Val (16#9B#); Key_Alt_ERight : constant Character := Character'Val (16#9D#); Key_Alt_EEnd : constant Character := Character'Val (16#9F#); Key_Alt_EDown : constant Character := Character'Val (16#A0#); Key_Alt_EPageDown : constant Character := Character'Val (16#A1#); Key_Alt_EInsert : constant Character := Character'Val (16#A2#); Key_Alt_EDelete : constant Character := Character'Val (16#A3#); Key_Alt_KPSlash : constant Character := Character'Val (16#A4#); Key_Alt_Tab : constant Character := Character'Val (16#A5#); Key_Alt_Enter : constant Character := Character'Val (16#A6#); -------------------- -- CURSOR CONTROL -- -------------------- function Where_X return X_Pos; function Where_Y return Y_Pos; procedure Goto_XY (X : in X_Pos := X_Pos'First; Y : in Y_Pos := Y_Pos'First); ------------------- -- COLOR CONTROL -- ------------------- function Get_Foreground return Color_Type; function Get_Background return Color_Type; procedure Set_Foreground (Color : in Color_Type := Gray); procedure Set_Background (Color : in Color_Type := Black); -------------------- -- SCREEN CONTROL -- -------------------- procedure Clear_Screen (Color : in Color_Type := Black); ------------------- -- SOUND CONTROL -- ------------------- procedure Bleep; ------------------- -- INPUT CONTROL -- ------------------- function Get_Key return Character; function Key_Available return Boolean; end NT_Console; ----------------------------------------------------------------------- -- -- File: nt_console.adb -- Description: Win95/NT console support -- Rev: 0.1 -- Date: 18-jan-1998 -- Author: Jerry van Dijk -- Mail: jdijk@acm.org -- -- Copyright (c) Jerry van Dijk, 1997, 1998 -- Billie Holidaystraat 28 -- 2324 LK LEIDEN -- THE NETHERLANDS -- tel int + 31 71 531 43 65 -- -- Permission granted to use for any purpose, provided this copyright -- remains attached and unmodified. -- -- THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR -- IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED -- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. -- ----------------------------------------------------------------------- pragma C_Pass_By_Copy (128); with Interfaces; use Interfaces; package body NT_Console is pragma Linker_Options ("-luser32"); --------------------- -- WIN32 INTERFACE -- --------------------- Beep_Error : exception; Fill_Char_Error : exception; Cursor_Pos_Error : exception; Buffer_Info_Error : exception; Set_Attribute_Error : exception; Invalid_Handle_Error : exception; Fill_Attribute_Error : exception; Cursor_Position_Error : exception; subtype DWORD is Unsigned_32; subtype HANDLE is Unsigned_32; subtype WORD is Unsigned_16; subtype SHORT is Short_Integer; type LPDWORD is access all DWORD; pragma Convention (C, LPDWORD); type Nibble is mod 2 ** 4; for Nibble'Size use 4; type Attribute is record Foreground : Nibble; Background : Nibble; Reserved : Unsigned_8 := 0; end record; for Attribute use record Foreground at 0 range 0 .. 3; Background at 0 range 4 .. 7; Reserved at 1 range 0 .. 7; end record; for Attribute'Size use 16; pragma Convention (C, Attribute); type COORD is record X : SHORT; Y : SHORT; end record; pragma Convention (C, COORD); type SMALL_RECT is record Left : SHORT; Top : SHORT; Right : SHORT; Bottom : SHORT; end record; pragma Convention (C, SMALL_RECT); type CONSOLE_SCREEN_BUFFER_INFO is record Size : COORD; Cursor_Pos : COORD; Attrib : Attribute; Window : SMALL_RECT; Max_Size : COORD; end record; pragma Convention (C, CONSOLE_SCREEN_BUFFER_INFO); type PCONSOLE_SCREEN_BUFFER_INFO is access all CONSOLE_SCREEN_BUFFER_INFO; pragma Convention (C, PCONSOLE_SCREEN_BUFFER_INFO); function GetCh return Integer; pragma Import (C, GetCh, "_getch"); function KbHit return Integer; pragma Import (C, KbHit, "_kbhit"); function MessageBeep (Kind : DWORD) return DWORD; pragma Import (StdCall, MessageBeep, "MessageBeep"); function GetStdHandle (Value : DWORD) return HANDLE; pragma Import (StdCall, GetStdHandle, "GetStdHandle"); function SetConsoleCursorPosition (Buffer : HANDLE; Pos : COORD) return DWORD; pragma Import (StdCall, SetConsoleCursorPosition, "SetConsoleCursorPosition"); function SetConsoleTextAttribute (Buffer : HANDLE; Attr : Attribute) return DWORD; pragma Import (StdCall, SetConsoleTextAttribute, "SetConsoleTextAttribute"); function GetConsoleScreenBufferInfo (Buffer : HANDLE; Info : PCONSOLE_SCREEN_BUFFER_INFO) return DWORD; pragma Import (StdCall, GetConsoleScreenBufferInfo, "GetConsoleScreenBufferInfo"); function FillConsoleOutputCharacter (Console : HANDLE; Char : Character; Length : DWORD; Start : COORD; Written : LPDWORD) return DWORD; pragma Import (Stdcall, FillConsoleOutputCharacter, "FillConsoleOutputCharacterA"); function FillConsoleOutputAttribute (Console : Handle; Attr : Attribute; Length : DWORD; Start : COORD; Written : LPDWORD) return DWORD; pragma Import (Stdcall, FillConsoleOutputAttribute, "FillConsoleOutputAttribute"); WIN32_ERROR : constant DWORD := 0; INVALID_HANDLE_VALUE : constant HANDLE := -1; STD_OUTPUT_HANDLE : constant DWORD := -11; Color_Value : constant array (Color_Type) of Nibble := (0, 1, 2, 3, 4, 5, 6, 7, 9, 10, 11, 12, 13, 14, 15); Color_Type_Value : constant array (Nibble) of Color_Type := (Black, Blue, Green, Cyan, Red, Magenta, Brown, Gray, Black, Light_Blue, Light_Green, Light_Cyan, Light_Red, Light_Magenta, Yellow, White); ----------------------- -- PACKAGE VARIABLES -- ----------------------- Output_Buffer : HANDLE; Num_Bytes : aliased DWORD; Num_Bytes_Access : LPDWORD := Num_Bytes'Access; Buffer_Info_Rec : aliased CONSOLE_SCREEN_BUFFER_INFO; Buffer_Info : PCONSOLE_SCREEN_BUFFER_INFO := Buffer_Info_Rec'Access; ------------------------- -- SUPPORTING SERVICES -- ------------------------- procedure Get_Buffer_Info is begin if GetConsoleScreenBufferInfo (Output_Buffer, Buffer_Info) = WIN32_ERROR then raise Buffer_Info_Error; end if; end Get_Buffer_Info; -------------------- -- CURSOR CONTROL -- -------------------- function Where_X return X_Pos is begin Get_Buffer_Info; return X_Pos (Buffer_Info_Rec.Cursor_Pos.X); end Where_X; function Where_Y return Y_Pos is begin Get_Buffer_Info; return Y_Pos (Buffer_Info_Rec.Cursor_Pos.Y); end Where_Y; procedure Goto_XY (X : in X_Pos := X_Pos'First; Y : in Y_Pos := Y_Pos'First) is New_Pos : COORD := (SHORT (X), SHORT (Y)); begin Get_Buffer_Info; if New_Pos.X > Buffer_Info_Rec.Size.X then New_Pos.X := Buffer_Info_Rec.Size.X; end if; if New_Pos.Y > Buffer_Info_Rec.Size.Y then New_Pos.Y := Buffer_Info_Rec.Size.Y; end if; if SetConsoleCursorPosition (Output_Buffer, New_Pos) = WIN32_ERROR then raise Cursor_Pos_Error; end if; end Goto_XY; ------------------- -- COLOR CONTROL -- ------------------- function Get_Foreground return Color_Type is begin Get_Buffer_Info; return Color_Type_Value (Buffer_Info_Rec.Attrib.Foreground); end Get_Foreground; function Get_Background return Color_Type is begin Get_Buffer_Info; return Color_Type_Value (Buffer_Info_Rec.Attrib.Background); end Get_Background; procedure Set_Foreground (Color : in Color_Type := Gray) is Attr : Attribute; begin Get_Buffer_Info; Attr.Foreground := Color_Value (Color); Attr.Background := Buffer_Info_Rec.Attrib.Background; if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then raise Set_Attribute_Error; end if; end Set_Foreground; procedure Set_Background (Color : in Color_Type := Black) is Attr : Attribute; begin Get_Buffer_Info; Attr.Foreground := Buffer_Info_Rec.Attrib.Foreground; Attr.Background := Color_Value (Color); if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then raise Set_Attribute_Error; end if; end Set_Background; -------------------- -- SCREEN CONTROL -- -------------------- procedure Clear_Screen (Color : in Color_Type := Black) is Attr : Attribute; Home : COORD := (0, 0); Length : DWORD := DWORD ((X_Pos'Last + 1) * (Y_Pos'Last + 1)); begin Get_Buffer_Info; Attr.Background := Color_Value (Color); Attr.Foreground := Buffer_Info_Rec.Attrib.Foreground; if SetConsoleTextAttribute (Output_Buffer, Attr) = WIN32_ERROR then raise Set_Attribute_Error; end if; if FillConsoleOutputAttribute (Output_Buffer, Attr, Length, Home, Num_Bytes_Access) = WIN32_ERROR then raise Fill_Attribute_Error; end if; if FillConsoleOutputCharacter (Output_Buffer, ' ', Length, Home, Num_Bytes_Access) = WIN32_ERROR then raise Fill_Char_Error; end if; if SetConsoleCursorPosition (Output_Buffer, Home) = WIN32_ERROR then raise Cursor_Position_Error; end if; end Clear_Screen; ------------------- -- SOUND CONTROL -- ------------------- procedure Bleep is begin if MessageBeep (16#FFFFFFFF#) = WIN32_ERROR then raise Beep_Error; end if; end Bleep; ------------------- -- INPUT CONTROL -- ------------------- function Get_Key return Character is Temp : Integer; begin Temp := GetCh; if Temp = 16#00E0# then Temp := 0; end if; return Character'Val (Temp); end Get_Key; function Key_Available return Boolean is begin if KbHit = 0 then return False; else return True; end if; end Key_Available; begin -------------------------- -- WIN32 INITIALIZATION -- -------------------------- Output_Buffer := GetStdHandle (STD_OUTPUT_HANDLE); if Output_Buffer = INVALID_HANDLE_VALUE then raise Invalid_Handle_Error; end if; end NT_Console; -- ======================================================================= Life is short. | Craig Spannring Bike hard, ski fast. | cts@internetcds.com --------------------------------+------------------------------------