Using Windows Print Spooler API's, we can print out XPS files.
The problem is that the print spooler ignores the default printer settings.
(We've given up on trying to apply printer settings. Default printer settings will just have to suffice.)
For example... the printouts always come out in colour and on one paper per page, regardless of what the settings are set to in the control panel: black & white/colour, duplex/not duplex, multiple pages per sheet/single page per sheet.
Other applications such as MS Word and Adobe respect the default printer settings.
We're using Delphi XE2 and Windows 7 64-bit.
This test code is self contained, so you can just paste it in to test it...
Populate a combo box with printer names using:
uses
Printers
ComboBox1.Items.Assign(Printer.Printers);
Printing procedure:
uses
Winapi.WinSpool
procedure PrintXPS(PrinterName, FileNameXPS: string; ParentFormHandle: THandle = 0);
// Printer handle
procedure Printer_Open(out Printer: THandle; Defaults: PPrinterDefaultsW = nil);
begin
if not OpenPrinterW(PWideChar(PrinterName), Printer, Defaults) then
RaiseLastOSError;
end;
procedure Printer_Close(Printer: THandle);
begin
if not ClosePrinter(Printer) then
RaiseLastOSError;
end;
// Print jobs
function JobCreate(Printer: THandle; FileName: string): Cardinal;
var
lBufferSize: Cardinal;
lAddJobInfo: PAddJobInfo1W;
begin
// Create job
AddJobW(Printer, 1, nil, 0, lBufferSize);
GetMem(lAddJobInfo, lBufferSize);
try
if not AddJobW(Printer, 1, lAddJobInfo, lBufferSize, lBufferSize) then
RaiseLastOSError;
Result := lAddJobInfo.JobId;
// Copy the file into place
CopyFile(PWideChar(FileName), lAddJobInfo.Path, True);
finally
FreeMem(lAddJobInfo, lBufferSize);
end;
end;
procedure JobStart(Printer: THandle; JobID: Cardinal);
begin
if not ScheduleJob(Printer, JobID) then
RaiseLastOSError;
end;
var
PrinterA: THandle;
JobID: Cardinal;
begin
if not FileExists(FileNameXPS) then
raise Exception.Create('File not found: ' + FileNameXPS);
Printer_Open(PrinterA, nil);
try
JobID := JobCreate(PrinterA, FileNameXPS);
JobStart(PrinterA, JobID);
finally
Printer_Close(PrinterA);
end;
end;
Much as I know you can not change the appearance of a .xps file.
XPS stands for XML Paper Specification, it is virtually an "electronic paper", the document on screen and in print is exactly the way it was intended by the author. Anyone who has ever experienced, how the page layout of an Office document on a shared computer because of a different default printer has shifted, appreciate it.
EDIT
Test
1.) Default black and white printer settings. Open the. xps file Print.
With IE == colored output.
With XPS Viewer EP == colored output.
Default printer settings == ignored.
2.) Dialog: Printer-settings manually to print black and white set.
IE == black and white output.
XPS Viewer EP == black and white output.
Related
An old app using Delphi 7, but should be similar code in older Delphi versions up to perhaps 2010. I need to change the background color of a TListView header so I can offer a dark theme. I can change the colors of everything else. I found the thread below which apparently works for changing the font color on a column header, but I need to adjust the background color of the entire header as well.
Delphi: ListView (vsReport) single column header caption with custom font color?
Can someone please help as I am lost. Windows message notifications are beyond my comprehension.
Many thanks.
I'm fairly proud of myself and somehow found bits and pieces of code that all went together to make it all work. Something like this...
procedure TTntListView.WMNotify(var AMessage: TWMNotify);
const
DT_ALIGN: array[TAlignment] of integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
NMCustomDraw: TNMCustomDraw;
i: Integer;
r: TRect;
begin
if (AMessage.NMHdr.hwndFrom = FHeaderHandle) and
(AMessage.NMHdr.code = NM_CUSTOMDRAW) then
begin
NMCustomDraw := PNMCustomDraw(TMessage(AMessage).LParam)^;
case NMCustomDraw.dwDrawStage of
CDDS_PREPAINT: AMessage.Result := CDRF_NOTIFYITEMDRAW;
CDDS_ITEMPREPAINT: begin
i := NMCustomDraw.dwItemSpec;
r := NMCustomDraw.rc;
FillRect(NMCustomDraw.hdc, r, Sender.Canvas.Brush.Handle);
SetBkColor(NMCustomDraw.hdc, ColorToRGB(Sender.Canvas.Brush.Color));
SetTextColor(NMCustomDraw.hdc, ColorToRGB(Sender.Canvas.Font.Color));
DrawEdge(NMCustomDraw.hdc,r,EDGE_SUNKEN,BF_LEFT);
Inc(r.Left,2);
Dec(r.Right,2);
if Sender.Column[i].Alignment = taLeftJustify then Inc(r.Left,3)
else Dec(r.Right,3);
DrawTextW(NMCustomDraw.hdc,
pWideChar(Sender.Column[i].Caption),
length(Sender.Column[i].Caption),
r,
DT_SINGLELINE or DT_ALIGN[Sender.Column[i].Alignment] or
DT_VCENTER or DT_END_ELLIPSIS);
Message.Result := CDRF_SKIPDEFAULT;
end;
else AMessage.Result := CDRF_DODEFAULT;
end;
end
else inherited;
end;
Using Delphi 7. I have a simple routine successfully loading .bmp, .emf, .wmf, .ico and .jpg files (code given below). My problem is that every .ico (Icon) file always reports TImage.TPicture.Width and TImage.TPicture.Height as "32". All icons are 32-bit with a single page inside. It doesn't matter what the actual size is (I have tried 16x16, 32x32, 64x64 and 128x128).
If I manually set TImage.Width and TImage.Width to what I know the icon size is, the image displays nicely. All the other file types report the size correctly.
Why is there a problem with .ico files and how do I correct or workaround the problem.
procedure TfrmImageLoader.btnBrowseClick(Sender: TObject);
var
openPictureDlg: TOpenPictureDialog;
jpgImage: TJPEGImage;
testWidth, testHeight: Integer;
begin
// Browse for the image file
openPictureDlg := TOpenPictureDialog.Create(Self);
if (openPictureDlg.Execute) then
begin
// Check if file exists
if (FileExists(openPictureDlg.FileName)) then
begin
// Load the image into out image component
imgLoaded.Visible := False;
if (IsJPEG(openPictureDlg.FileName)) then
begin
jpgImage := TJPEGImage.Create();
jpgImage.LoadFromFile(openPictureDlg.FileName);
imgLoaded.Picture.Assign(jpgImage);
jpgImage.Free();
end
else
begin
imgLoaded.Picture.LoadFromFile(openPictureDlg.FileName);
end;
// Test width...here's the problem. Icons always report "32".
testWidth := m_imgLoaded.Picture.Width;
testHeight := m_imgLoaded.Picture.Height;
m_imgLoaded.Visible := True;
end
else
begin
// File does not exist
MessageDlg('File does not exist', mtWarning, [mbOK], 0);
end;
end;
// Clean up
openPictureDlg.Free();
end;
Update 1
As a test, I loaded the file as a TIcon, but the results are the same.
ico: TIcon;
// ...
ico := TIcon.Create();
ico.LoadFromFile(openPictureDlg.FileName);
testWidth := ico.Width; // Still 32, regardless of the actual size
testHeight := ico.Height;
ico.Free();
Update 2
See the accepted answer. There are basically two ways to get the correct size (a) load the icon, assign to a TBitmap, and read the bitmap size or (b) read the icon header, bytes 7 & 8 are the width/height. The latter is ~20 times faster in my tests and the code is given below:
procedure GetTrueIconSize2(const cszIcon: String; var trueW: Integer; var trueH: Integer);
var
fs: TFileStream;
firstBytes: AnsiString;
begin
// The size of image/vnd.microsoft.icon MIME files (Windows icon) is in the header
// at bytes 7 & 8. A value of "0" means "256" (the largest icon size supported).
fs := TFileStream.Create(cszIcon, fmOpenRead);
try
SetLength(firstBytes, 8);
fs.Read(firstBytes[1], 8);
trueW := Integer(firstBytes[7]);
if (trueW = 0) then
trueW := 256;
trueH := Integer(firstBytes[8]);
if (trueH = 0) then
trueH := 256;
finally
fs.Free();
end;
end;
A workaround would be to parse ICO files yourself, which is rather trivial: https://en.wikipedia.org/wiki/ICO_(file_format) - that way you easily know the dimensions for each entry. In the most simple case (only one picture) the first 6 bytes of the file must be #0#0#1#0#1#0 and byte 7 and 8 are width and height.
I have a program that uses SetCursorPos to position the cursor. The program operates as it is supposed to when running on real hardware but, when running in a VM (VMware workstation 10.0.7) it doesn't work. The cursor does not move. I tried using SendInput instead (the syscall it makes is different, because of that, I thought it might work), the result is the same as with SetCursorPos, it works on real hardware, does not work when running in a VM.
The question is: does anyone know if either SetCursorPos or SendInput can be made to work in a VM and if yes, how ? Any other way to position the cursor at a specific place that works in a VM would be welcome as well.
Thank you for your help.
For anyone who cares to try, here is some of the code I've tried.
{$APPTYPE CONSOLE}
program ConsoleSetCursorPos;
uses
Windows
;
function GetConsoleWindow : HWND; stdcall; external kernel32;
procedure DoIt;
var
ConsoleWindow : HWND;
ClientRect : TRECT;
CursorPosRetVal : BOOL;
LastError : dword;
Desktop : HDESK;
begin
// the code below is not normally necessary - for testing only
Desktop := OpenInputDesktop(0, false, WINSTA_WRITEATTRIBUTES);
LastError := GetLastError;
writeln;
writeln('From OpenInputDesktop');
writeln('Last error (decimal) : ', LastError);
if Desktop = 0 then
begin
writeln('Program terminated due to OpenInputDesktop failure');
halt(255);
end;
if not SetThreadDesktop(Desktop) then
begin
writeln('Program terminated due to SetThreadDesktop failure');
halt(255);
end;
writeln;
// end of normally unnecessary code
SetLastError(0);
ConsoleWindow := GetConsoleWindow;
GetClientRect(ConsoleWindow, ClientRect);
ClientToScreen(ConsoleWindow, ClientRect.TopLeft);
CursorPosRetVal := SetCursorPos(ClientRect.Left, ClientRect.Top);
LastError := GetLastError;
if not CursorPosRetVal
then writeln('SetCursorPos returned false (failed)')
else writeln('SetCursorPos returned true (succeeded)');
writeln('Last error (decimal) : ', LastError);
if Desktop <> 0 then CloseDesktop(Desktop);
end;
begin
DoIt;
end.
As the remarks on SetCursorPos doc:
The cursor is a shared resource. A window should move the cursor only
when the cursor is in the window's client area.
The calling process must have WINSTA_WRITEATTRIBUTES access to the
window station.
The input desktop must be the current desktop when you call
SetCursorPos. Call OpenInputDesktop to determine whether the current
desktop is the input desktop. If it is not, call SetThreadDesktop with
the HDESK returned by OpenInputDesktop to switch to that desktop.
Or you can take the same try to un-installed the mouse driver from the VM as this answer.
I'm in my first try with WinAPI and I am trying to send some text from a Delphi program (well Lazarus) to Notepad++.
I already found a good example to use simple Notepad, that goes like this :
Procedure TForm1.Button1Click(Sender: TObject);
var Var1, Var2 : HWND;
Begin
Var1 := FindWindow('notepad', nil);
Var2 := FindWindowEx(Var1, FindWindow('Edit', nil), nil, nil);
Clipboard.AsText:='This is some sample text.';
SendMessage(Var2, WM_PASTE, 0, 0);
End;
So this works fine for Notepad.
Now I would like to adapt it to use with any other program.
Taking Notepad++ for example, how do I find it's equivalent to 'Edit' used there in the FindWindowEx() ? Or let's say the correct cell and workbook to paste in LibreOffice Calc?
Any samples or clues?
Thanks.
Is there any way to block the Keyboard input completely ? This should also block key combos like WIN+E.
I found this Code, is there anyway to change it to block only keyboard input (Mouse needs to work)
procedure TForm1.Button1Click(Sender: TObject) ;
function FuncAvail(dllName, funcName: string; var p: pointer): boolean;
var
lib: THandle;
begin
result := false;
p := nil;
if LoadLibrary(PChar(dllName)) = 0 then exit;
lib := GetModuleHandle(PChar(dllName)) ;
if lib <> 0 then
begin
p := GetProcAddress(lib, PChar(funcName)) ;
if p <> nil then Result := true;
end;
end;
var
BlockInput : function(Block: BOOL): BOOL; stdcall;
begin
if FuncAvail('USER32.DLL', 'BlockInput', #BlockInput) then
begin
ShowMessage('Your Mouse and Keyboard will be blocked for 5 seconds!') ;
BlockInput(true) ;
Sleep(5000) ;
BlockInput(false) ;
end;
end;
end.
Would this code also work with WIN keys etc ?
Thanks!
You're thinking way too hard.
The appropriate way to set up a kiosk that can be controlled by the mouse and not the keyboard is to not have a keyboard attached. (This also makes it impossible for an unscrupulous kiosk-user to steal your keyboard.)
This also means that, if you need to perform administrative tasks, you can attach a keyboard (or remote in) and everything will work fine.
If for some reason removing the keyboard is not a feasible option, there is an unsupported way of doing this in software: remove the UpperFilters value from
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Class\{4D36E96B-E325-11CE-BFC1-08002BE10318}
This disables input from all normal keyboard devices, but the Remote Desktop virtual keyboard will still work, so you may want to ensure that Remote Desktop is configured and working first.
For your reference, should you want to reverse the process, UpperFilters is normally a REG_MULTI_SZ containing a single string "kbdclass" (without the quote marks).