How I can clear the console screen in a delphi console application (delphi xe6 or higher) I have searched the internet and the help file but cannot seem to find it?
I am trying to find out if there is a function already provided in the delphi units to provide this functionality.
There is no such function provided by the Delphi runtime library. You will need to write your own function using the operating system services. This article on MSDN explains how to do it: https://support.microsoft.com/en-us/kb/99261
Translate that like so:
procedure ClearScreen;
var
stdout: THandle;
csbi: TConsoleScreenBufferInfo;
ConsoleSize: DWORD;
NumWritten: DWORD;
Origin: TCoord;
begin
stdout := GetStdHandle(STD_OUTPUT_HANDLE);
Win32Check(stdout<>INVALID_HANDLE_VALUE);
Win32Check(GetConsoleScreenBufferInfo(stdout, csbi));
ConsoleSize := csbi.dwSize.X * csbi.dwSize.Y;
Origin.X := 0;
Origin.Y := 0;
Win32Check(FillConsoleOutputCharacter(stdout, ' ', ConsoleSize, Origin,
NumWritten));
Win32Check(FillConsoleOutputAttribute(stdout, csbi.wAttributes, ConsoleSize, Origin,
NumWritten));
Win32Check(SetConsoleCursorPosition(stdout, Origin));
end;
Related
I currently use both Delphi XE6 and Delphi Seattle:
I am busy putting together a little app on Firemonkey that needs to play sound files (mp3, wav etc.). Adjusting the master volume is straight forward, but it seems that adjusting the left-to-right balance of a sound file playing is not.
This is the code that I have for achieving this feat, except, it will not be supported in FMX, as it calls mostly Windows API functions. Can anyone help with the API functions to call on the FMX platform instead? At this point I am hoping to support at least Android devices. If there is additional/alternative code (or compiler directive settings with alternative code) to cover for iOS devices as well, that would be greatly appreciated.
Thank you very much in advance!
Here is what I have so far...
function GetWaveVolume(var LVol: DWORD; var RVol: DWORD): Boolean;
var
WaveOutCaps: TWAVEOUTCAPS;
Volume: DWORD;
begin
Result := False;
if WaveOutGetDevCaps(WAVE_MAPPER, #WaveOutCaps, SizeOf(WaveOutCaps)) = MMSYSERR_NOERROR then
if WaveOutCaps.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
begin
Result := WaveOutGetVolume(WAVE_MAPPER, #Volume) = MMSYSERR_NOERROR;
LVol := LoWord(Volume);
RVol := HiWord(Volume);
end;
end;
function SetWaveVolume(const AVolume: DWORD): Boolean;
var
WaveOutCaps: TWAVEOUTCAPS;
begin
Result := False;
if WaveOutGetDevCaps(WAVE_MAPPER, #WaveOutCaps, SizeOf(WaveOutCaps)) = MMSYSERR_NOERROR then
if WaveOutCaps.dwSupport and WAVECAPS_VOLUME = WAVECAPS_VOLUME then
Result := WaveOutSetVolume(WAVE_MAPPER, AVolume) = MMSYSERR_NOERROR;
end;
My application is build in delphi and it runs perfect on other platforms except Windows 7 64bit machine. Each and everytime try to close the application is giving me this error
'Unable to write to application file.ini'
here is my code for closing
procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
frmMain.close;
end;
This error is usually caused by trying to write to your app's own folder under Program Files, which is not allowed for a non-Administrator under Vista and higher (and XP, if you're not running as an Administrator or Power User).
Here's some code for getting the proper folder for your .INI file:
uses
Windows,
ShlObj; // For SHGetSpecialFolderPath
function GetFolderLocation(Handle: HWnd; Folder: Integer): string;
begin
Result := '';
SetLength(Result, MAX_PATH);
if not SHGetSpecialFolderPath(Handle, PChar(Result), Folder, False) then
RaiseLastOSError;
end;
I use these in my application to retrieve the non-roaming profile folder, and use a sub-folder created beneath that for my app's data. It's set up during the creation of a TDataModule:
procedure TAppData.Create(Sender.TObject);
begin
// DataPath is a property of the datamodule, declared as a string
// CSIDL_LOCAL_APPDATA is the local non-roaming profile folder.
// CSIDL_APPDATA is for the local roaming profile folder, and is more typically used
DataPath := GetFolderLocation(Application.Handle, CSIDL_LOCAL_APPDATA);
DataPath := IncludeTrailingPathDelimiter(DataPath) + 'MyApp\';
end;
See MSDN's documentation page on the meaning of the various CSIDL_ or FOLDERID_ values. The FOLDERID_ values are similar, but are available only on Vista and above and used with SHGetKnownFolderIDList.
For those of you not willing to disregard MS's warnings about SHGetSpecialFolderPath not being supported, here's an alternate version of GetFolderLocation using SHGetFolderPath, which is preferred:
uses
ShlObj, SHFolder, ActiveX, Windows;
function GetFolderLocation(Handle: HWnd; Folder: Integer): string;
begin
Result := '';
SetLength(Result, MAX_PATH);
if not Succeeded(SHGetFolderPath(Handle, Folder, 0, 0, PChar(Result))) then
RaiseLastOSError();
end;
And finally, for those working with only Vista and higher, here's an example using SHGetKnownFolderPath - note this isn't available in pre-XE versions of Delphi (AFAIK-may be in 2009 or 2010), and you'll need to use KNOWNFOLDERID values instead of CSIDL_, like FOLDERID_LocalAppData:
uses
ShlObj, ActiveX, KnownFolders;
// Tested on XE2, VCL forms application, Win32 target, on Win7 64-bit Pro
function GetFolderLocation(const Folder: TGuid): string;
var
Buf: PWideChar;
begin
Result := '';
if Succeeded(SHGetKnownFolderPath(Folder, 0, 0, Buf)) then
begin
Result := Buf;
CoTaskMemFree(Buf);
end
else
RaiseLastOSError();
end;
You should not write ini files to the program directory. Although it worked in the past, it has never been a good practice.
You should be using %APPDATA% for user specific application data.
You might want to read Best practices storing application data
DLL registration with regsvr32.exe freezes when unit HtmlHelpViewer is used in DLL sources in Delphi XE or Delphi XE2 Update 3. Just add the unit to interface uses list. The main project (that uses DLL) freezes on exit too.
How to fix the issue?
Thanks for the help!
STEPS TO REPRODUCE THE ISSUE AND ISSUE IN SUGGESTED FIX:
1). Please create the following DLL:
library Test;
uses
ComServ,
HtmlHelpFixer,
HtmlHelpViewer;
exports
DllGetClassObject,
DllCanUnloadNow,
DllRegisterServer,
DllUnregisterServer;
begin
end.
2). Also create the following BPL linked to this DLL (by -LUTestBpl dcc32 parameter for example):
package TestBpl;
requires
Vcl;
end.
3). Then just execute: regsvr32.exe /s Test.dll. OS Windows 7 32-bit.
Update
According to the latest comments on the QC report submitted by Altaveron, this problem will be resolved in the next Delphi update, update 4. And indeed, Altaveron now confirms that update 4 does resolve the issue.
This is a known problem with the MS HTML help control, hhctrl.ocx. The best description of it that I am aware of is at the HelpWare FAR HTML FAQ. There are many QC reports describing the issue: 48983, 67463, 78998, 89616.
According to the latest QC report, this is fixed in XE2 but you report otherwise and I'd be inclined to believe you. Especially as a comparison of the source for the HtmlHelpViewer unit from XE and XE2 reveals no changes that appear related to this issue.
It's quite hard to work around the issue since the code that needs to be modified is buried deep inside the HtmlHelpViewer unit. I've had to resort to patching the HtmlHelp API call. Like this:
unit HtmlHelpFixer;
interface
implementation
uses
Windows;
function HtmlHelp(hWndCaller: HWND; pszFile: PWideChar; uCommand: UINT; dwData: DWORD): HWND;
begin
if uCommand=HH_CLOSE_ALL then begin
//don't call HtmlHelpW because it can result in a hang due to a bug in hhctrl.ocx
Result := 0;
end else begin
Result := HtmlHelpW(hWndCaller, pszFile, uCommand, dwData);
end;
end;
procedure PatchCode(Address: Pointer; const NewCode; Size: Integer);
var
OldProtect: DWORD;
begin
if VirtualProtect(Address, Size, PAGE_EXECUTE_READWRITE, OldProtect) then begin
Move(NewCode, Address^, Size);
FlushInstructionCache(GetCurrentProcess, Address, Size);
VirtualProtect(Address, Size, OldProtect, #OldProtect);
end;
end;
type
PInstruction = ^TInstruction;
TInstruction = packed record
Opcode: Byte;
Offset: Integer;
end;
procedure RedirectProcedure(OldAddress, NewAddress: Pointer);
var
NewCode: TInstruction;
begin
NewCode.Opcode := $E9;//jump relative
NewCode.Offset := NativeInt(NewAddress)-NativeInt(OldAddress)-SizeOf(NewCode);
PatchCode(OldAddress, NewCode, SizeOf(NewCode));
end;
procedure RedirectHtmlHelp;
var
HtmlHelp: function(hWndCaller: HWND; pszFile: PWideChar; uCommand: UINT; dwData: DWORD_PTR): HWND;
begin
HtmlHelp := Windows.HtmlHelp;
RedirectProcedure(#HtmlHelp, #HtmlHelpFixer.HtmlHelp);
end;
initialization
RedirectHtmlHelp;
end.
Include this unit early in your .dpr uses list, before any unit that does anything with HTML help.
The version of the code that I use does a little more and takes steps to ensure that any open help windows are closed when the DLL unloads. This no longer happens because we have stopped sending HH_CLOSE_ALL.
You will want to make sure that any help windows are shut down then keep track of the window handles returned by HtmlHelp calls, which you can now intercept. Then at shutdown send a WM_CLOSE message to those windows which replaces the missing HH_CLOSE_ALL call to HtmlHelp.
However, I believe that the code above should get you over your immediate hurdle with regsvr32 which won't be showing help windows.
Feel free to do some experimentation! At the very least, the code above gives you entry points with which you can modify the behaviour of the HtmlHelpViewer unit.
Embarcadero have fixed this issue on Delphi XE2 Update 4. But now context help doesn't work on IDE while you're using BPL with HtmlHelpViewer unit on uses clause.
What I'm trying to do is to create an ability to view (not to edit) the HTML pages included into project. The Welcome Page already has embedded web browser, so it appears to be a good candidate for that.
Curios why? Here is a question with background info.
Here is a solution I've made specifically for you...
Download the source from here, extract and load the package in Delphi (I made it in Delphi XE, but it'll load in any version! You will need to change the Unit Output path in Project Options on pre-XE versions, though)... install the package.
In the Help menu, find Create Browser and click it. This will then create and display a tab which navigates to my blog (for the purpose of example).
You can easily modify this to suit your needs! The Help Menu Item code is located in EditWizard.MenuItem.pas, and can be disregarded! Just note that it's making a call when clicked to (BorlandIDEServices as IOTAEditorViewServices).ShowEditorView(CreateTab('http://www.simonjstuart.com'));, which is what actually creates a browser tab instance!
All the code for the Browser Tab (including its Frame layout) is contained in EditorWizard.Frame.pas, which makes it really easy to modify to suit your needs!
The unit EditorWizard.Wizard.pas contains the small amount of code needed to register the custom browser tab into the IDE.
Some tweaking will of course be required on your part, but this should certainly serve as a very acceptable base for what you're trying to do.
Enjoy :)
In case you're willing to use a hack like this:
type
TOpenNewURLModule = procedure(const URL: string; EditorForm: TCustomForm);
procedure OpenURL(const URL: string);
var
EditWindow: INTAEditWindow;
Lib: HMODULE;
OpenNewURLModule: TOpenNewURLModule;
begin
EditWindow := (BorlandIDEServices as INTAEditorServices).TopEditWindow;
if not Assigned(EditWindow) or not Assigned(EditWindow.Form) then
Exit;
Lib := GetModuleHandle('startpageide150.bpl');
if Lib = 0 then
Exit;
OpenNewURLModule := GetProcAddress(Lib, '#Urlmodule#OpenNewURLModule$qqrx20System#UnicodeStringp22Editorform#TEditWindow');
if #OpenNewURLModule <> nil then
OpenNewURLModule(URL, EditWindow.Form);
end;
Cons:
it's a hack (startpageidexx.bpl is not exposed through the API or documented)
it's hard-coded for Delphi XE (you need a different file name for other versions, the method signature might be different, too - e.g. in older AnsiString versions)
it does nothing if there is no edit window (there has to be at least one open module)
it always opens a new browser view
EDIT: It seems to be possible to reuse an existing open Welcome page, as well as make this hack compatible with older versions of Delphi. The following shows two alternatives, Delphi XE and Delphi 2007 (both seem to be working):
type
IURLModule = interface(IOTAModuleData)
['{9D215B02-6073-45DC-B007-1A2DBCE2D693}']
function GetURL: string;
procedure SetURL(const URL: string);
property URL: string read GetURL write SetURL;
end;
TOpenNewURLModule = procedure(const URL: string; EditorForm: TCustomForm);
function FindURLModule: IURLModule;
var
I: Integer;
begin
Result := nil;
with BorlandIDEServices as IOTAModuleServices do
for I := 0 to ModuleCount - 1 do
if Supports(Modules[I], IURLModule, Result) then
Break;
end;
procedure OpenURL(const URL: string; ReuseExistingView: Boolean = True);
{$IFDEF VER220} // Delphi XE
const
SStartPageIDE = 'startpageide150.bpl';
SOpenNewURLModule = '#Urlmodule#OpenNewURLModule$qqrx20System#UnicodeStringp22Editorform#TEditWindow';
{$ENDIF}
{$IFDEF VER185} // Delphi 2007
const
SStartPageIDE = 'startpageide100.bpl';
SOpenNewURLModule = '#Urlmodule#OpenNewURLModule$qqrx17System#AnsiStringp22Editorform#TEditWindow';
{$ENDIF}
var
Module: IURLModule;
EditWindow: INTAEditWindow;
Lib: HMODULE;
OpenNewURLModule: TOpenNewURLModule;
begin
EditWindow := nil;
Module := nil;
if ReuseExistingView then
Module := FindURLModule;
if Assigned(Module) then
begin
Module.URL := URL;
(Module as IOTAModule).Show;
end
else
begin
{$IFDEF VER220}
EditWindow := (BorlandIDEServices as INTAEditorServices).TopEditWindow;
{$ENDIF}
{$IFDEF VER185}
if Assigned((BorlandIDEServices as IOTAEditorServices).TopView) then
EditWindow := (BorlandIDEServices as IOTAEditorServices).TopView.GetEditWindow;
{$ENDIF}
if not Assigned(EditWindow) or not Assigned(EditWindow.Form) then
Exit;
Lib := GetModuleHandle(SStartPageIDE);
if Lib = 0 then
Exit;
OpenNewURLModule := GetProcAddress(Lib, SOpenNewURLModule);
if #OpenNewURLModule <> nil then
OpenNewURLModule(URL, EditWindow.Form);
end;
end;
Remaining cons:
it's still a hack
it's still hard-coded, for Delphi XE (Unicode) and Delphi 2007 (ANSI)
it still does nothing if there is no edit window
Perhaps you can use this as a start if you need compatibility for other versions.
You are better off displaying your own TForm with a TWebBrowser component on it that you can load HTML into.
I'm successfully using Delph 7 and the ActiveX control of Adobe Reader version 7 to extract the page number from an open PDF document housed in the ActiveX component (TAcroPDF). I am interested in upgrading to the latest Adobe reader but something changed in Adobe Reader 8 (and 9) that prevented me from upgrading (I have not tested Adobe 10/X). With Adobe 7, I use the Windows SDK function EnumChildWindows to gather the child windows of my form containing the TAcroPDF component and find a control with the name AVPageNumView, then FindWindowEx to get its handle. Then I call SendMessage to get the text of that control which has the page number information. With Adobe 8 and 9, window/control AVPageNumView is no longer there it seems. Thus I am stuck in Adobe 7 and still looking for a way to get the page number, preferably Adobe 9 or 10/X. The goal would be to not have to do a complete rewrite with another technology, but I am open to that if its the only solution.
Thanks,
Michael
You're using a wndclass name (AVPageNumView). Obviously, the class name has changed in the new version. You can use something like WinDowse to investigate the windows in the newer version of Reader to find out the new class names. Update your code to first check for the old wndclass; if it's not found, try and find the new one.
function EnumWindowProc(pHwnd: THandle; Edit: Integer): LongBool; stdcall;
function GetWindowTxt(gwtHwnd: THandle): string;
var dWTextBuf: PChar;
TextLen: Integer;
begin
TextLen := SendMessage(gwtHwnd, WM_GetTextLength, 0, 0);;
dWTextBuf := StrAlloc(TextLen + 1);
SendMessage(gwtHwnd, WM_GetText, TextLen + 1, Integer(dWTextBuf));
Result := dWTextBuf;
StrDispose(dWTextBuf);
end;
function GetClassNameTxt(gcnHwnd: THandle): string;
var dWClassBuf: PChar;
begin
dWClassBuf := StrAlloc(1024);
GetClassName(gcnHwnd, dWClassBuf, 1024);
Result := dWClassBuf;
StrDispose(dWClassBuf);
end;
begin
Result := LongBool(True);
if (GetClassNameTxt(pHwnd) = 'AVL_AVView') and (GetWindowTxt(pHwnd) = 'AVPageView') then
begin
TEdit(Edit).Text := GetWindowTxt(FindWindowEx(pHwnd, 0, 'RICHEDIT50W', nil));
Result := LongBool(False);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
EnumChildWindows(AcroPDF1.Handle, #EnumWindowProc, LongInt(Edit1));
end;