Quick.Console.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766
  1. { ***************************************************************************
  2. Copyright (c) 2016-2018 Kike Pérez
  3. Unit : Quick.Console
  4. Description : Console output with colors and optional file log
  5. Author : Kike Pérez
  6. Version : 1.8
  7. Created : 10/05/2017
  8. Modified : 09/03/2018
  9. This file is part of QuickLib: https://github.com/exilon/QuickLib
  10. ***************************************************************************
  11. Licensed under the Apache License, Version 2.0 (the "License");
  12. you may not use this file except in compliance with the License.
  13. You may obtain a copy of the License at
  14. http://www.apache.org/licenses/LICENSE-2.0
  15. Unless required by applicable law or agreed to in writing, software
  16. distributed under the License is distributed on an "AS IS" BASIS,
  17. WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  18. See the License for the specific language governing permissions and
  19. limitations under the License.
  20. *************************************************************************** }
  21. unit Quick.Console;
  22. {$IFDEF CONDITIONALEXPRESSIONS}
  23. {$ifndef VER140}
  24. {$ifndef LINUX}
  25. {$define WITHUXTHEME}
  26. {$endif}
  27. {$endif}
  28. {$IF CompilerVersion >= 17.0}
  29. {$DEFINE INLINES}
  30. {$ENDIF}
  31. {$IF RTLVersion >= 14.0}
  32. {$DEFINE HASERROUTPUT}
  33. {$ENDIF}
  34. {$ENDIF}
  35. interface
  36. uses
  37. Classes,
  38. Windows,
  39. Winapi.Messages,
  40. System.SysUtils,
  41. Quick.Commons,
  42. Quick.Log;
  43. type
  44. //text colors
  45. TConsoleColor = (
  46. ccBlack = 0,
  47. ccBlue = 1,
  48. ccGreen = 2,
  49. ccCyan = 3,
  50. ccRed = 4,
  51. ccMagenta = 5,
  52. ccBrown = 6,
  53. ccLightGray = 7,
  54. ccDarkGray = 8,
  55. ccLightBlue = 9,
  56. ccLightGreen = 10,
  57. ccLightCyan = 11,
  58. ccLightRed = 12,
  59. ccLightMagenta = 13,
  60. ccYellow = 14,
  61. ccWhite = 15);
  62. TConsoleProperties = record
  63. LogVerbose : TLogVerbose;
  64. Log : TQuickLog;
  65. end;
  66. TOutputProc<T> = reference to procedure(const aLine : T);
  67. TExecuteProc = reference to procedure;
  68. TConsoleMenuOption = record
  69. private
  70. fCaption : string;
  71. fKey : Word;
  72. fOnKeyPressed : TExecuteProc;
  73. public
  74. property Caption : string read fCaption write fCaption;
  75. property Key : Word read fKey write fKey;
  76. property OnKeyPressed : TExecuteProc read fOnKeyPressed write fOnKeyPressed;
  77. procedure DoKeyPressed;
  78. end;
  79. TConsoleMenu = class
  80. private
  81. fConsoleMenu : array of TConsoleMenuOption;
  82. fMenuColor : TConsoleColor;
  83. fIsActive : Boolean;
  84. procedure WriteMenu;
  85. public
  86. constructor Create;
  87. property MenuColor : TConsoleColor read fMenuColor write fMenuColor;
  88. property IsActive : Boolean read fIsActive;
  89. procedure AddMenu(const cMenuCaption : string; const cMenuKey : Word; MenuAction : TExecuteProc); overload;
  90. procedure AddMenu(MenuOption : TConsoleMenuOption); overload;
  91. procedure Refresh(aClearScreen : Boolean = False);
  92. procedure WaitForKeys;
  93. end;
  94. procedure cout(const cMsg : Integer; cEventType : TLogEventType); overload;
  95. procedure cout(const cMsg : Double; cEventType : TLogEventType); overload;
  96. procedure cout(const cMsg : string; cEventType : TLogEventType); overload;
  97. procedure cout(const cMsg : string; cColor : TConsoleColor); overload;
  98. procedure coutXY(x,y : Integer; const cMsg : string; cEventType : TLogEventType); overload;
  99. procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor); overload;
  100. procedure coutXY(x,y : Integer; const cMsg : string; params : array of const; cEventType : TLogEventType); overload;
  101. procedure coutXY(x,y : Integer; const cMsg : string; params : array of const; cColor : TConsoleColor); overload;
  102. procedure coutTL(const cMsg : string; cEventType : TLogEventType); overload;
  103. procedure coutTL(const cMsg : string; cColor : TConsoleColor); overload;
  104. procedure coutBL(const cMsg : string; cEventType : TLogEventType); overload;
  105. procedure coutBL(const cMsg : string; cColor : TConsoleColor); overload;
  106. procedure coutFmt(const cMsg : string; params : array of const; cEventType : TLogEventType);
  107. procedure TextColor(Color: TConsoleColor); overload;
  108. procedure TextColor(Color: Byte); overload;
  109. procedure TextBackground(Color: TConsoleColor); overload;
  110. procedure TextBackground(Color: Byte); overload;
  111. procedure ResetColors;
  112. procedure ConsoleResize(Width, Height : Integer);
  113. procedure ClearScreen;
  114. procedure ClearLine; overload;
  115. procedure ClearLine(Y : Integer); overload;
  116. procedure ShowCursor;
  117. procedure HideCursor;
  118. function GetCursorX: Integer; {$IFDEF INLINES}inline;{$ENDIF}
  119. function GetCursorY: Integer; {$IFDEF INLINES}inline;{$ENDIF}
  120. function GetCursorMaxBottom : Integer;
  121. procedure SetCursorPos(NewCoord : TCoord);
  122. procedure ProcessMessages;
  123. procedure ConsoleWaitForEnterKey;
  124. procedure RunConsoleCommand(const aCommand, aParameters : String; CallBack : TOutputProc<PAnsiChar> = nil; OutputLines : TStrings = nil);
  125. procedure InitConsole;
  126. var
  127. Console : TConsoleProperties;
  128. CSConsole : TRTLCriticalSection;
  129. LastMode : Word;
  130. DefConsoleColor : Byte;
  131. TextAttr : Byte;
  132. hStdOut: THandle;
  133. hStdErr: THandle;
  134. ConsoleRect: TSmallRect;
  135. ScreenBufInfo : TConsoleScreenBufferInfo;
  136. CursorInfo : TConsoleCursorInfo;
  137. implementation
  138. procedure cout(const cMsg : Integer; cEventType : TLogEventType);
  139. var
  140. FmtSets : TFormatSettings;
  141. begin
  142. try
  143. FmtSets := TFormatSettings.Create;
  144. FmtSets.ThousandSeparator := '.';
  145. FmtSets.DecimalSeparator := ',';
  146. cout(FormatFloat('0,',cMsg,FmtSets),cEventType);
  147. except
  148. cout(cMsg.ToString,cEventType);
  149. end;
  150. end;
  151. procedure cout(const cMsg : Double; cEventType : TLogEventType);
  152. var
  153. FmtSets : TFormatSettings;
  154. begin
  155. try
  156. FmtSets := TFormatSettings.Create;
  157. FmtSets.ThousandSeparator := '.';
  158. FmtSets.DecimalSeparator := ',';
  159. cout(FormatFloat('.0###,',cMsg,FmtSets),cEventType);
  160. except
  161. cout(cMsg.ToString,cEventType);
  162. end;
  163. end;
  164. procedure cout(const cMsg : string; cEventType : TLogEventType);
  165. begin
  166. if cEventType in Console.LogVerbose then
  167. begin
  168. EnterCriticalSection(CSConsole);
  169. try
  170. if hStdOut <> 0 then
  171. begin
  172. case cEventType of
  173. etError : TextColor(ccLightRed);
  174. etInfo : TextColor(ccWhite);
  175. etSuccess : TextColor(ccLightGreen);
  176. etWarning : TextColor(ccYellow);
  177. etDebug : TextColor(ccLightCyan);
  178. etTrace : TextColor(ccLightMagenta);
  179. else TextColor(ccWhite);
  180. end;
  181. Writeln(cMsg);
  182. TextColor(LastMode);
  183. end;
  184. finally
  185. LeaveCriticalSection(CSConsole);
  186. end;
  187. if Assigned(Console.Log) then Console.Log.Add(cMsg,cEventType);
  188. end;
  189. end;
  190. procedure cout(const cMsg : string; cColor : TConsoleColor);
  191. begin
  192. EnterCriticalSection(CSConsole);
  193. try
  194. if hStdOut <> 0 then
  195. begin
  196. TextColor(cColor);
  197. Writeln(cMsg);
  198. TextColor(LastMode);
  199. end;
  200. finally
  201. LeaveCriticalSection(CSConsole);
  202. end;
  203. end;
  204. function GetCursorX: Integer; {$IFDEF INLINES}inline;{$ENDIF}
  205. var
  206. BufferInfo: TConsoleScreenBufferInfo;
  207. begin
  208. GetConsoleSCreenBufferInfo(hStdOut, BufferInfo);
  209. Result := BufferInfo.dwCursorPosition.X;
  210. end;
  211. function GetCursorY: Integer; {$IFDEF INLINES}inline;{$ENDIF}
  212. var
  213. BufferInfo: TConsoleScreenBufferInfo;
  214. begin
  215. GetConsoleSCreenBufferInfo(hStdOut, BufferInfo);
  216. Result := BufferInfo.dwCursorPosition.Y;
  217. end;
  218. function GetCursorMaxBottom : Integer;
  219. var
  220. BufferInfo: TConsoleScreenBufferInfo;
  221. begin
  222. GetConsoleSCreenBufferInfo(hStdOut, BufferInfo);
  223. Result := BufferInfo.srWindow.Bottom;
  224. end;
  225. procedure SetCursorPos(NewCoord : TCoord);
  226. begin
  227. SetConsoleCursorPosition(hStdOut, NewCoord);
  228. end;
  229. procedure coutXY(x,y : Integer; const cMsg : string; cEventType : TLogEventType);
  230. var
  231. NewCoord : TCoord;
  232. LastCoord : TCoord;
  233. begin
  234. if hStdOut = 0 then Exit;
  235. LastCoord.X := GetCursorX;
  236. LastCoord.Y := GetCursorY;
  237. NewCoord.X := x;
  238. NewCoord.Y := y;
  239. ClearLine(Y);
  240. SetCursorPos(NewCoord);
  241. try
  242. cout(cMsg,cEventType);
  243. finally
  244. SetCursorPos(LastCoord);
  245. end;
  246. end;
  247. procedure coutXY(x,y : Integer; const cMsg : string; cColor : TConsoleColor); overload;
  248. var
  249. NewCoord : TCoord;
  250. LastCoord : TCoord;
  251. begin
  252. if hStdOut = 0 then Exit;
  253. LastCoord.X := GetCursorX;
  254. LastCoord.Y := GetCursorY;
  255. NewCoord.X := x;
  256. NewCoord.Y := y;
  257. ClearLine(Y);
  258. SetCursorPos(NewCoord);
  259. try
  260. cout(cMsg,cColor);
  261. finally
  262. SetCursorPos(LastCoord);
  263. end;
  264. end;
  265. procedure coutXY(x,y : Integer; const cMsg : string; params : array of const; cEventType : TLogEventType);
  266. begin
  267. coutXY(x,y,Format(cMsg,params),cEventType);
  268. end;
  269. procedure coutXY(x,y : Integer; const cMsg : string; params : array of const; cColor : TConsoleColor);
  270. begin
  271. coutXY(x,y,Format(cMsg,params),cColor);
  272. end;
  273. procedure coutTL(const cMsg : string; cEventType : TLogEventType);
  274. begin
  275. coutXY(0,0,cMsg,cEventType);
  276. end;
  277. procedure coutTL(const cMsg : string; cColor : TConsoleColor);
  278. begin
  279. coutXY(0,0,cMsg,cColor);
  280. end;
  281. procedure coutBL(const cMsg : string; cEventType : TLogEventType);
  282. begin
  283. coutXY(0,GetCursorMaxBottom - 1,cMsg,cEventType);
  284. end;
  285. procedure coutBL(const cMsg : string; cColor : TConsoleColor);
  286. begin
  287. coutXY(0,GetCursorMaxBottom - 1,cMsg,cColor);
  288. end;
  289. procedure coutFmt(const cMsg : string; params : array of const; cEventType : TLogEventType);
  290. begin
  291. cout(Format(cMsg,params),cEventType);
  292. end;
  293. procedure TextColor(Color: TConsoleColor);
  294. begin
  295. TextColor(Integer(Color));
  296. end;
  297. procedure TextColor(Color: Byte);
  298. begin
  299. if hStdOut = 0 then Exit;
  300. LastMode := TextAttr;
  301. TextAttr := (TextAttr and $F0) or (Color and $0F);
  302. if TextAttr <> LastMode then SetConsoleTextAttribute(hStdOut, TextAttr);
  303. end;
  304. procedure TextBackground(Color: TConsoleColor);
  305. begin
  306. TextBackground(Integer(Color));
  307. end;
  308. procedure TextBackground(Color: Byte);
  309. begin
  310. if hStdOut = 0 then Exit;
  311. LastMode := TextAttr;
  312. TextAttr := (TextAttr and $0F) or ((Color shl 4) and $F0);
  313. if TextAttr <> LastMode then SetConsoleTextAttribute(hStdOut, TextAttr);
  314. end;
  315. procedure ResetColors;
  316. begin
  317. SetConsoleTextAttribute(hStdOut, DefConsoleColor);
  318. TextAttr := DefConsoleColor;
  319. end;
  320. procedure ConsoleResize(Width, Height : Integer);
  321. var
  322. Rect: TSmallRect;
  323. Coord: TCoord;
  324. begin
  325. Rect.Left := 1;
  326. Rect.Top := 1;
  327. Rect.Right := Width;
  328. Rect.Bottom := Height;
  329. Coord.X := Rect.Right + 1 - Rect.Left;
  330. Coord.y := Rect.Bottom + 1 - Rect.Top;
  331. SetConsoleScreenBufferSize(GetStdHandle(STD_OUTPUT_HANDLE), Coord);
  332. SetConsoleWindowInfo(GetStdHandle(STD_OUTPUT_HANDLE), True, Rect);
  333. end;
  334. procedure ClearScreen;
  335. var
  336. stdout: THandle;
  337. bufinfo: TConsoleScreenBufferInfo;
  338. ConsoleSize: DWORD;
  339. NumWritten: DWORD;
  340. Origin: TCoord;
  341. begin
  342. stdout := GetStdHandle(STD_OUTPUT_HANDLE);
  343. if stdout<>INVALID_HANDLE_VALUE then
  344. begin
  345. GetConsoleScreenBufferInfo(stdout,bufinfo);
  346. ConsoleSize := bufinfo.dwSize.X * bufinfo.dwSize.Y;
  347. Origin.X := 0;
  348. Origin.Y := 0;
  349. FillConsoleOutputCharacter(stdout,' ',ConsoleSize,Origin,NumWritten);
  350. FillConsoleOutputAttribute(stdout,bufinfo.wAttributes,ConsoleSize,Origin,NumWritten);
  351. SetConsoleCursorPosition(stdout, Origin);
  352. end;
  353. end;
  354. procedure ClearLine;
  355. begin
  356. ClearLine(GetCursorY);
  357. end;
  358. procedure ClearLine(Y : Integer);
  359. var
  360. dwWriteCoord: TCoord;
  361. dwCount, dwSize: DWord;
  362. begin
  363. if hStdOut = 0 then Exit;
  364. dwWriteCoord.X := 0;
  365. dwWriteCoord.Y := Y;
  366. dwSize := ConsoleRect.Right + 1;
  367. FillConsoleOutputAttribute(hStdOut, TextAttr, dwSize, dwWriteCoord, dwCount);
  368. FillConsoleOutputCharacter(hStdOut, ' ', dwSize, dwWriteCoord, dwCount);
  369. end;
  370. procedure ShowCursor;
  371. begin
  372. GetConsoleCursorInfo(hStdOut,CursorInfo);
  373. CursorInfo.bVisible := True;
  374. SetConsoleCursorInfo(hStdOut,CursorInfo);
  375. end;
  376. procedure HideCursor;
  377. begin
  378. GetConsoleCursorInfo(hStdOut,CursorInfo);
  379. CursorInfo.bVisible := False;
  380. SetConsoleCursorInfo(hStdOut,CursorInfo);
  381. end;
  382. function ConsoleKeyPressed(ExpectedKey: Word): Boolean;
  383. var
  384. lpNumberOfEvents: DWORD;
  385. lpBuffer: TInputRecord;
  386. lpNumberOfEventsRead : DWORD;
  387. nStdHandle: THandle;
  388. begin
  389. Result := False;
  390. nStdHandle := GetStdHandle(STD_INPUT_HANDLE);
  391. lpNumberOfEvents := 0;
  392. GetNumberOfConsoleInputEvents(nStdHandle, lpNumberOfEvents);
  393. if lpNumberOfEvents <> 0 then
  394. begin
  395. PeekConsoleInput(nStdHandle, lpBuffer, 1, lpNumberOfEventsRead);
  396. if lpNumberOfEventsRead <> 0 then
  397. begin
  398. if lpBuffer.EventType = KEY_EVENT then
  399. begin
  400. if lpBuffer.Event.KeyEvent.bKeyDown and ((ExpectedKey = 0) or (lpBuffer.Event.KeyEvent.wVirtualKeyCode = ExpectedKey)) then Result := true
  401. else FlushConsoleInputBuffer(nStdHandle);
  402. end
  403. else FlushConsoleInputBuffer(nStdHandle);
  404. end;
  405. end;
  406. end;
  407. function GetConsoleKeyPressed : Word;
  408. var
  409. lpNumberOfEvents: DWORD;
  410. lpBuffer: TInputRecord;
  411. lpNumberOfEventsRead : DWORD;
  412. nStdHandle: THandle;
  413. begin
  414. Result := 0;
  415. nStdHandle := GetStdHandle(STD_INPUT_HANDLE);
  416. lpNumberOfEvents := 0;
  417. GetNumberOfConsoleInputEvents(nStdHandle, lpNumberOfEvents);
  418. if lpNumberOfEvents <> 0 then
  419. begin
  420. PeekConsoleInput(nStdHandle, lpBuffer, 1, lpNumberOfEventsRead);
  421. if lpNumberOfEventsRead <> 0 then
  422. begin
  423. if lpBuffer.EventType = KEY_EVENT then
  424. begin
  425. Result := lpBuffer.Event.KeyEvent.wVirtualKeyCode;
  426. FlushConsoleInputBuffer(nStdHandle);
  427. end
  428. else FlushConsoleInputBuffer(nStdHandle);
  429. end;
  430. end;
  431. end;
  432. procedure ProcessMessages;
  433. var
  434. Msg: TMsg;
  435. begin
  436. while integer(PeekMessage(Msg, 0, 0, 0, PM_REMOVE)) <> 0 do begin
  437. TranslateMessage(Msg);
  438. DispatchMessage(Msg);
  439. end;
  440. end;
  441. procedure ConsoleWaitForEnterKey;
  442. var
  443. msg: TMsg;
  444. begin
  445. while not ConsoleKeyPressed(VK_RETURN) do
  446. begin
  447. {$ifndef LVCL}
  448. if GetCurrentThreadID=MainThreadID then CheckSynchronize{$ifdef WITHUXTHEME}(1000){$endif} else
  449. {$endif}
  450. WaitMessage;
  451. while PeekMessage(msg,0,0,0,PM_REMOVE) do
  452. begin
  453. if Msg.Message = WM_QUIT then Exit
  454. else
  455. begin
  456. TranslateMessage(Msg);
  457. DispatchMessage(Msg);
  458. end;
  459. end;
  460. end;
  461. end;
  462. procedure RunConsoleCommand(const aCommand, aParameters : String; CallBack : TOutputProc<PAnsiChar> = nil; OutputLines : TStrings = nil);
  463. const
  464. CReadBuffer = 2400;
  465. var
  466. saSecurity: Windows.TSecurityAttributes;
  467. hRead: THandle;
  468. hWrite: THandle;
  469. suiStartup: TStartupInfo;
  470. piProcess: TProcessInformation;
  471. pBuffer: array [0..CReadBuffer] of AnsiChar;
  472. dBuffer: array [0..CReadBuffer] of AnsiChar;
  473. dRead: DWORD;
  474. dRunning: DWORD;
  475. dAvailable: DWORD;
  476. begin
  477. saSecurity.nLength := SizeOf(Windows.TSecurityAttributes);
  478. saSecurity.bInheritHandle := true;
  479. saSecurity.lpSecurityDescriptor := nil;
  480. if CreatePipe(hRead,hWrite,@saSecurity, 0) then
  481. begin
  482. try
  483. FillChar(suiStartup, SizeOf(TStartupInfo), #0);
  484. suiStartup.cb := SizeOf(TStartupInfo);
  485. suiStartup.hStdInput := hRead;
  486. suiStartup.hStdOutput := hWrite;
  487. suiStartup.hStdError := hWrite;
  488. suiStartup.dwFlags := STARTF_USESTDHANDLES or STARTF_USESHOWWINDOW;
  489. suiStartup.wShowWindow := SW_HIDE;
  490. if CreateProcess(nil,PChar(Format('%s %s',[aCommand,aParameters])),
  491. @saSecurity,
  492. @saSecurity,
  493. True,
  494. NORMAL_PRIORITY_CLASS,
  495. nil,
  496. nil,
  497. suiStartup,
  498. piProcess) then
  499. begin
  500. try
  501. repeat
  502. dRunning := WaitForSingleObject(piProcess.hProcess,100);
  503. PeekNamedPipe(hRead,nil,0,nil,@dAvailable,nil);
  504. if (dAvailable > 0) then
  505. begin
  506. repeat
  507. dRead := 0;
  508. ReadFile(hRead,pBuffer[0],CReadBuffer,dRead,nil);
  509. pBuffer[dRead] := #0;
  510. OemToCharA(pBuffer,dBuffer);
  511. if Assigned(CallBack) then CallBack(dBuffer);
  512. if Assigned(OutputLines) then OutputLines.Add(dBuffer);
  513. until (dRead < CReadBuffer);
  514. end;
  515. //Application.ProcessMessages;
  516. until (dRunning <> WAIT_TIMEOUT);
  517. finally
  518. CloseHandle(piProcess.hProcess);
  519. CloseHandle(piProcess.hThread);
  520. end;
  521. end;
  522. finally
  523. CloseHandle(hRead);
  524. CloseHandle(hWrite);
  525. end;
  526. end
  527. else raise Exception.Create('Can''t create pipe!');
  528. end;
  529. procedure InitConsole;
  530. var
  531. BufferInfo: TConsoleScreenBufferInfo;
  532. begin
  533. Console.LogVerbose := LOG_ALL;
  534. Rewrite(Output);
  535. hStdOut := TTextRec(Output).Handle;
  536. {$IFDEF HASERROUTPUT}
  537. Rewrite(ErrOutput);
  538. hStdErr := TTextRec(ErrOutput).Handle;
  539. {$ELSE}
  540. hStdErr := GetStdHandle(STD_ERROR_HANDLE);
  541. {$ENDIF}
  542. if not GetConsoleScreenBufferInfo(hStdOut, BufferInfo) then
  543. begin
  544. SetInOutRes(GetLastError);
  545. Exit;
  546. end;
  547. ConsoleRect.Left := 0;
  548. ConsoleRect.Top := 0;
  549. ConsoleRect.Right := BufferInfo.dwSize.X - 1;
  550. ConsoleRect.Bottom := BufferInfo.dwSize.Y - 1;
  551. TextAttr := BufferInfo.wAttributes and $FF;
  552. DefConsoleColor := TextAttr;
  553. LastMode := 3; //CO80;
  554. end;
  555. { TConsoleMenu }
  556. procedure TConsoleMenu.AddMenu(const cMenuCaption: string; const cMenuKey: Word; MenuAction: TExecuteProc);
  557. var
  558. conmenu : TConsoleMenuOption;
  559. begin
  560. conmenu.Caption := cMenuCaption;
  561. conmenu.Key := cMenuKey;
  562. conmenu.OnKeyPressed := MenuAction;
  563. fConsoleMenu := fConsoleMenu + [conmenu];
  564. end;
  565. procedure TConsoleMenu.AddMenu(MenuOption: TConsoleMenuOption);
  566. begin
  567. fConsoleMenu := fConsoleMenu + [MenuOption];
  568. end;
  569. constructor TConsoleMenu.Create;
  570. begin
  571. fMenuColor := ccLightCyan;
  572. fIsActive := False;
  573. end;
  574. procedure TConsoleMenu.Refresh(aClearScreen: Boolean);
  575. begin
  576. if aClearScreen then ClearScreen;
  577. WriteMenu;
  578. end;
  579. procedure TConsoleMenu.WaitForKeys;
  580. var
  581. msg: TMsg;
  582. conmenu : TConsoleMenuOption;
  583. keypressed : Word;
  584. begin
  585. fIsActive := True;
  586. HideCursor;
  587. WriteMenu;
  588. while True do
  589. begin
  590. //check key pressed
  591. keypressed := GetConsoleKeyPressed;
  592. for conmenu in fConsoleMenu do
  593. begin
  594. if keypressed = conmenu.Key then
  595. begin
  596. ClearScreen;
  597. WriteMenu;
  598. conmenu.DoKeyPressed;
  599. end;
  600. end;
  601. if keypressed = VK_ESCAPE then
  602. begin
  603. coutXY(50,12,'Exiting...',etInfo);
  604. Exit;
  605. end;
  606. {$ifndef LVCL}
  607. if GetCurrentThreadID=MainThreadID then CheckSynchronize{$ifdef WITHUXTHEME}(1000){$endif} else
  608. {$endif}
  609. WaitMessage;
  610. while PeekMessage(msg,0,0,0,PM_REMOVE) do
  611. begin
  612. if Msg.Message = WM_QUIT then Exit
  613. else
  614. begin
  615. TranslateMessage(Msg);
  616. DispatchMessage(Msg);
  617. end;
  618. end;
  619. end;
  620. ShowCursor;
  621. fIsActive := False;
  622. end;
  623. function GetCharFromVirtualKey(Key: Word): string;
  624. var
  625. keyboardState: TKeyboardState;
  626. asciiResult: Integer;
  627. begin
  628. GetKeyboardState(keyboardState) ;
  629. SetLength(Result, 2) ;
  630. asciiResult := ToAscii(key, MapVirtualKey(key, 0), keyboardState, @Result[1], 0) ;
  631. case asciiResult of
  632. 0: Result := '';
  633. 1: SetLength(Result, 1) ;
  634. 2:;
  635. else
  636. Result := '';
  637. end;
  638. end;
  639. procedure TConsoleMenu.WriteMenu;
  640. var
  641. conmenu : TConsoleMenuOption;
  642. ckey : string;
  643. coord : TCoord;
  644. oldcoord : TCoord;
  645. begin
  646. oldcoord.X := GetCursorX;
  647. oldcoord.Y := GetCursorY;
  648. coord.X := 0;
  649. coord.Y := 0;
  650. SetCursorPos(coord);
  651. TextColor(fMenuColor);
  652. ClearLine(0);
  653. for conmenu in fConsoleMenu do
  654. begin
  655. case conmenu.Key of
  656. VK_F1 : ckey := 'F1';
  657. VK_F2 : ckey := 'F2';
  658. VK_F3 : ckey := 'F3';
  659. VK_F4 : ckey := 'F4';
  660. VK_F5 : ckey := 'F5';
  661. VK_F6 : ckey := 'F6';
  662. VK_F7 : ckey := 'F7';
  663. VK_F8 : ckey := 'F8';
  664. VK_F9 : ckey := 'F9';
  665. VK_F10 : ckey := 'F10';
  666. VK_F11 : ckey := 'F11';
  667. VK_F12 : ckey := 'F12';
  668. else ckey := GetCharFromVirtualKey(conmenu.Key);
  669. end;
  670. TextColor(ccWhite);
  671. Write(Format('[%s]',[ckey]));
  672. TextColor(Self.MenuColor);
  673. Write(Format(' %s ',[conmenu.Caption]));
  674. end;
  675. TextColor(ccWhite);
  676. Write('[ESC]');
  677. TextColor(Self.MenuColor);
  678. Write(' Exit');
  679. TextColor(LastMode);
  680. SetCursorPos(oldcoord);
  681. end;
  682. { TConsoleMenuOption }
  683. procedure TConsoleMenuOption.DoKeyPressed;
  684. begin
  685. if Assigned(fOnKeyPressed) then fOnKeyPressed;
  686. end;
  687. initialization
  688. InitializeCriticalSection(CSConsole);
  689. //init stdout if not a service
  690. if GetStdHandle(STD_OUTPUT_HANDLE) <> 0 then InitConsole;
  691. finalization
  692. DeleteCriticalSection(CSConsole);
  693. end.