How to use OleVariant parameters to TWebBrowser Print dialog? - delphi

I'm trying to implement custom headers and footers when printing from a TWebBrowser, as per the information in this Microsoft knowledge base question (KB267240). The knowledgebase article is quite helpful and even includes a lengthy code example, however, the code example is in C++ not Delphi, so I've had to attempt to convert the necessary data structure into Delphi code myself. I'm not terribly confident I've correctly converted the part of the code I need.
Here's probably the most important part of that article, where it explains what is supposed to go in my paramater vaIn in my code below:
When you use an OLECMDID enumeration of the OLECMDID_PRINT element
together with the ExecWB method, you can specify extended printing
information by passing in the SAFEARRAY structure through the VARIANT
argument pvaIn. This SAFEARRAY data type takes a maximum of five
items:
1) A string (BSTR) that contains a custom header.
2) A string (BSTR) that contains a custom footer.
3) ...
When I run the code I've written, it successfully removes the original header and footer, but does not replace it with my new header and footer strings, so I'm wondering if my code is incorrect in some way (or several ways), or if I simply shouldn't expect it to work since I'm using IE 9 and not a version in the 4-6 range that was current at the time the knowledgebase article was written.
var
vaIn, vaOut: OleVariant;
begin
vaIn := VarArrayCreate([0,1], varOleStr);
vaIn[0] := VarAsType('new header', VarOleStr); //header
vaIn[1] := VarAsType('new footer', VarOleStr); //footer
// Show print-preview dialog
WebBrowser1.ControlInterface.ExecWB(OLECMDID_PRINTPREVIEW,
OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut);
end;

This prints with custom header/footer. Custom headers don't for OLECMDID_PRINTPREVIEW, but they do work for OLECMDID_PRINT. The key is to use VT_ARRAY or VT_BYREF as the TVariantArg has to be passed by reference.
Code credit: TEmbeddedWB at https://github.com/7even11/Delphi-EmbeddedWB
procedure PrintWithHeaderFooter(ControlInterface: IWebBrowser2; Header, Footer: PWideChar; Options: OLECMDEXECOPT);
var
saBound: TSafeArrayBound;
psaHeadFoot: PSafeArray;
vaIn, vaOut: TVariantArg;
vHeadStr, vFootStr: TVariantArg;
rgIndex: LongInt;
begin
try
saBound.lLbound := 0;
saBound.cElements := 2;
psaHeadFoot := SafeArrayCreate(VT_VARIANT, 1, saBound);
vHeadStr.vt := VT_BSTR;
vHeadStr.bstrVal := SysAllocString(Header);
vFootStr.vt := VT_BSTR;
vFootStr.bstrVal := SysAllocString(Footer);
rgIndex := 0;
OleCheck(SafeArrayPutElement(psaHeadFoot, rgIndex, vHeadStr));
rgIndex := 1;
OleCheck(SafeArrayPutElement(psaHeadFoot, rgIndex, vFootStr));
vaIn.vt := VT_ARRAY or VT_BYREF;
vaIn.parray := psaHeadFoot;
ControlInterFace.ExecWB(OLECMDID_PRINT, Options,
OleVariant(vaIn), OleVariant(vaOut));
if vHeadStr.bstrVal <> nil then
SysFreeString(vHeadStr.bstrVal);
if vFootStr.bstrVal <> nil then
SysFreeString(vFootStr.bstrVal);
except
end;
end;
procedure Print(ControlInterface: IWebBrowser2; bHideSetup: Boolean = False; bCustomHeaderFooter: Boolean = False; Header: string = ''; Footer: string = '');
var
vaIn, vaOut: OleVariant;
begin
if DocumentLoaded(ControlInterface.Document) then
begin
if bCustomHeaderFooter then
begin
if bHideSetup then
PrintWithHeaderFooter(ControlInterface, TaskAllocWideString(Header), TaskAllocWideString(Footer), OLECMDEXECOPT_DONTPROMPTUSER)
else
PrintWithHeaderFooter(ControlInterface, TaskAllocWideString(Header), TaskAllocWideString(Footer), OLECMDEXECOPT_PROMPTUSER);
end
else
if bHideSetup then
ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER, vaIn, vaOut)
else
ControlInterface.ExecWB(OLECMDID_PRINT, OLECMDEXECOPT_PROMPTUSER, vaIn, vaOut)
end;
end;

Related

Extract plain text from .RTF file in a Delphi console application? [duplicate]

I need to use a TRichEdit at runtime to perform the rtf to text conversion as discussed here. I succeded in doing this but I had to set a dummy form as parent if not I cannot populate the TRichedit.Lines. (Error: parent is missing).
I paste my funciton below, can anyone suggest a way to avoid to define a parent? Can you also comment on this and tell me if you find a more performant idea?
Note: I need a string, not TStrings as output, this is why it has been designed like this.
function RtfToText(const RTF: string;ReplaceLineFeedWithSpace: Boolean): string;
var
RTFConverter: TRichEdit;
MyStringStream: TStringStream;
i: integer;
CustomLineFeed: string;
begin
if ReplaceLineFeedWithSpace then
CustomLineFeed := ' '
else
CustomLineFeed := #13;
try
RTFConverter := TRichEdit.Create(nil);
try
MyStringStream := TStringStream.Create(RTF);
RTFConverter.parent := Form4; // this is the part I don't like
RTFConverter.Lines.LoadFromStream(MyStringStream);
RTFConverter.PlainText := True;
for i := 0 to RTFConverter.Lines.Count - 1 do
begin
if i < RTFConverter.Lines.Count - 1 then
Result := Result + RTFConverter.Lines[i] + CustomLineFeed
else
Result := Result + RTFConverter.Lines[i];
end;
finally
MyStringStream.Free;
end;
finally
RTFConverter.Free;
end;
end;
UPDATE:
After the answer I updated the function and write it here for reference:
function RtfToText(const RTF: string;ReplaceLineFeedWithSpace: Boolean): string;
var
RTFConverter: TRichEdit;
MyStringStream: TStringStream;
begin
RTFConverter := TRichEdit.CreateParented(HWND_MESSAGE);
try
MyStringStream := TStringStream.Create(RTF);
try
RTFConverter.Lines.LoadFromStream(MyStringStream);
RTFConverter.PlainText := True;
RTFConverter.Lines.StrictDelimiter := True;
if ReplaceLineFeedWithSpace then
RTFConverter.Lines.Delimiter := ' '
else
RTFConverter.Lines.Delimiter := #13;
Result := RTFConverter.Lines.DelimitedText;
finally
MyStringStream.Free;
end;
finally
RTFConverter.Free;
end;
end;
TRichEdit control is an wrapper around the RichEdit control in Windows. Windows's controls are... well.. Windows, and they need an Window Handle to work. Delphi needs to call CreateWindow or CreateWindowEx to create the Handle, and both routines need an valid parent Window Handle to work. Delphi tries to use the handle of the control's parent (and it makes sense!). Happily one can use an alternative constructor (the CreateParanted(HWND) constructor) and the nice people at Microsoft made up the HWND_MESSAGE to be used as parent for windows that don't actually need a "window" (messaging-only).
This code works as expected:
procedure TForm2.Button2Click(Sender: TObject);
var R:TRichEdit;
L:TStringList;
begin
R := TRichEdit.CreateParented(HWND_MESSAGE);
try
R.PlainText := False;
R.Lines.LoadFromFile('C:\Temp\text.rtf');
R.PlainText := True;
Memo1.Lines.Text := R.Lines.Text;
finally
R.Free;
end;
end;
This is part of the way the VCL works, and you're not going to get it to work differently without some heavy workarounds. But you don't need to define a dummy form to be the parent; just use your current form and set visible := false; on the TRichEdit.
If you really want to improve performance, though, you could throw out that loop you're using to build a result string. It has to reallocate and copy memory a lot. Use the Text property of TrichEdit.Lines to get a CRLF between each line, and DelimitedText to get somethimg else, such as spaces. They use an internal buffer that's only allocated once, which will speed up the concatenation quite a bit if you're working with a lot of text.
I use DrawRichText to draw RTF without a RichEdit control. (IIRC this is called Windowless Rich Edit Controls.) Maybe you can use this also for converting - however I have never tried this.
This has been the most helpfull for me to get started with TRichEdit, but not with the conversion. This however works as expected and you don't need to set the Line Delimiter:
// RTF to Plain:
procedure TForm3.Button1Click(Sender: TObject);
var
l:TStringList;
s:WideString;
RE:TRichEdit;
ss:TStringStream;
begin
ss := TStringStream.Create;
s := Memo1.Text; // Input String
RE := TRichEdit.CreateParented(HWND_MESSAGE);
l := TStringList.Create;
l.Add(s);
ss.Position := 0;
l.SaveToStream(ss);
ss.Position := 0;
RE.Lines.LoadFromStream(ss);
Memo2.Text := RE.Text; // Output String
end;
// Plain to RTF:
procedure TForm3.Button2Click(Sender: TObject);
var
RE:TRichEdit;
ss:TStringStream;
begin
RE := TRichEdit.CreateParented(HWND_MESSAGE);
RE.Text := Memo2.Text; // Input String
ss := TStringStream.Create;
ss.Position := 0;
RE.Lines.SaveToStream(ss);
ss.Position := 0;
Memo1.Text := ss.ReadString(ss.Size); // Output String
end;
I'm using the TStringList "l" in the conversion to plain because somehow the TStringStream puts every single character in a new line.
Edit: Made the code a bit nicer and removed unused variables.

Copy formated text from a cell in a Table in Word document to TRichEdit

I use OLE Automation to work with Word document.
I can get the content of the cell using
Table.Cell(rowIndex, colIndex).Range.FormattedText
it returns OleVariant.
I'm not sure if I'm using right property and have no idea how to paste this text in TRichEdit without losing formating (e.g. superscripted text)
I set up a mock up form with just a richedit and a button on it. The code below may not the best way to achive this, but it works with Word 2007 on Win XP.
uses Word_TLB;
procedure TForm1.Button1Click(Sender: TObject);
var
wordApp : _Application;
doc : WordDocument;
table : Word_TLB.Table;
filename : OleVariant;
aRange : Range;
aWdUnits : OleVariant;
count : OleVariant;
begin
//need to back up 2 characters from range object to exclude table border.
//Remove 1 character only if using selection
count := -2;
aWdUnits := wdCharacter;
filename := '"H:\Documents and Settings\HH\My Documents\testing.docx"';
RichEdit1.Clear;
try
wordApp := CoWordApplication.Create;
wordApp.visible := False;
doc := wordApp.documents.open( filename, emptyparam,emptyparam,emptyparam,
emptyparam,emptyparam,emptyparam,emptyparam,
emptyparam,emptyparam,emptyparam,emptyparam,
emptyparam,emptyparam,emptyparam,emptyparam );
table := doc.tables.item(1);
aRange := table.cell(3,1).Range;
aRange.MoveEnd(aWdUnits, count); //This is needed so border is not included
aRange.Copy;
RichEdit1.PasteFromClipboard;
RichEdit1.Lines.Add('');
finally
wordApp.quit(EmptyParam, EmptyParam, EmptyParam);
end;
end;
And, this is the result:
.
The only thing is the multiline text appeared as a single line in the richedit.
I gave up solving this problem with OLE Automation.
TRichView gives desired functionality, but it's not free...

How can I loop through a delimited string and assign the contents of the string to local delphi variables?

I have written a Delphi function that loads data from a .dat file into a string list. It then decodes the string list and assigns to a string variable. The contents of the string use the '#' symbol as a separator.
How can I then take the contents of this string and then assign its contents to local variables?
// Function loads data from a dat file and assigns to a String List.
function TfrmMain.LoadFromFile;
var
index, Count : integer;
profileFile, DecodedString : string;
begin
// Open a file and assign to a local variable.
OpenDialog1.Execute;
profileFile := OpenDialog1.FileName;
if profileFile = '' then
exit;
profileList := TStringList.Create;
profileList.LoadFromFile(profileFile);
for index := 0 to profileList.Count - 1 do
begin
Line := '';
Line := profileList[Index];
end;
end;
After its been decoded the var "Line" contains something that looks like this:
example:
Line '23#80#10#2#1#...255#'.
Not all of the values between the separators are the same length and the value of "Line" will vary each time the function LoadFromFile is called (e.g. sometimes a value may have only one number the next two or three etc so I cannot rely on the Copy function for strings or arrays).
I'm trying to figure out a way of looping through the contents of "Line", assigning it to a local variable called "buffer" and then if it encounters a '#' it then assigns the value of buffer to a local variable, re-initialises buffer to ''; and then moves onto the next value in "Line" repeating the process for the next parameter ignoring the '#' each time.
I think I have been scratching around with this problem for too long now and I cannot seem to make any progress and need a break from it. If anyone would care to have a look, I would welcome any suggestions on how this might be achieved.
Many Thanks
KD
You need a second TStringList:
lineLst := TStringList.Create;
try
lineLst.Delimiter := '#';
lineLst.DelimitedText := Line;
...
finally
lineLst.Free;
end;
Depending on your Delphi version you can set lineLst.StrictDelimiter := true in case the line contains spaces.
You can do something like this:
program Project1;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils, StrUtils;
var
S : string;
D : string;
begin
S := '23#80#10#2#1#...255#';
for D in SplitString(S,'#') do //SplitString is in the StrUtils unit
writeln(D);
readln;
end.
You did not tag your Delphi version, so i don't know if it applies or not.
That IS version-specific. Please do!
In order of my personal preference:
1: Download Jedi CodeLib - http://jcl.sf.net. Then use TJclStringList. It has very nice split method. After that you would only have to iterate through.
function Split(const AText, ASeparator: string; AClearBeforeAdd: Boolean = True): IJclStringList;
uses JclStringLists;
...
var s: string; js: IJclStringList.
begin
...
js := TJclStringList.Create().Split(input, '#', True);
for s in js do begin
.....
end;
...
end;
2: Delphi now has somewhat less featured StringSplit routine. http://docwiki.embarcadero.com/Libraries/en/System.StrUtils.SplitString
It has a misfeature that array of string type may be not assignment-compatible to itself. Hello, 1949 Pascal rules...
uses StrUtils;
...
var s: string;
a_s: TStringDynArray;
(* aka array-of-string aka TArray<string>. But you have to remember this term exactly*)
begin
...
a_s := SplitString(input, '#');
for s in a_s do begin
.....
end;
...
end;
3: Use TStringList. The main problem with it is that it was designed that spaces or new lines are built-in separators. In newer Delphi that can be suppressed. Overall the code should be tailored to your exact Delphi version. You can easily Google for something like "Using TStringlist for splitting string" and get a load of examples (like #Uwe's one).
But you may forget to suppress here or there. And you may be on old Delphi,, where that can not be done. And you may mis-apply example for different Delphi version. And... it is just boring :-) Though you can make your own function to generate such pre-tuned stringlists for you and carefully check Delphi version in it :-) But then You would have to carefully free that object after use.
I use a function I've written called Fetch. I think I stole the idea from the Indy library some time ago:
function Fetch(var VString: string; ASeperator: string = ','): string;
var LPos: integer;
begin
LPos := AnsiPos(ASeperator, VString);
if LPos > 0 then
begin
result := Trim(Copy(VString, 1, LPos - 1));
VString := Copy(VString, LPos + 1, MAXINT);
end
else
begin
result := VString;
VString := '';
end;
end;
Then I'd call it like this:
var
value: string;
line: string;
profileFile: string;
profileList: TStringList;
index: integer;
begin
if OpenDialog1.Execute then
begin
profileFile := OpenDialog1.FileName;
if (profileFile = '') or not FileExists(profileFile) then
exit;
profileList := TStringList.Create;
try
profileList.LoadFromFile(profileFile);
for index := 0 to profileList.Count - 1 do
begin
line := profileList[index];
Fetch(line, ''''); //discard "Line '"
value := Fetch(line, '#')
while (value <> '') and (value[1] <> '''') do //bail when we get to the quote at the end
begin
ProcessTheNumber(value); //do whatever you need to do with the number
value := Fetch(line, '#');
end;
end;
finally
profileList.Free;
end;
end;
end;
Note: this was typed into the browser, so I haven't checked it works.

delphi hashmap?

i have java-code filling a hashmap from a textfile.
HashMap<String, String[]> data = new HashMap<String, String[]>();
i use this to make key-value-pairs. the values are an array of string. i have to iterate over every possible combo of the key-value-pairs (so also have to iterate over the String[]-array). This works with java but now i have to port this to delphi. is it possible to do so? and how?
thanks!
In Delphi 2009 and higher, you can use TDictionary<string, TStringlist> using Generics.Collections.
In older versions, you can use TStringlist where every item in the TStringlist has an associated object value of type TStrings.
The Docwiki has a page to get started with TDictionary
If you have an older version of Delphi (Delphi 6 and up), you could also use a dynamic array of record, then our TDynArray or TDynArrayHashed wrappers to create a dictionary with one field of the dynamic array records. See this unit.
The TDynArrayHashed wrapper was developed to be fast.
Here is some sample code (from supplied unitary tests):
var ACities: TDynArrayHashed;
Cities: TCityDynArray;
CitiesCount: integer;
City: TCity;
added: boolean;
N: string;
i,j: integer;
const CITIES_MAX=200000;
begin
// valide generic-like features
// see http://docwiki.embarcadero.com/CodeExamples/en/Generics_Collections_TDictionary_(Delphi)
ACities.Init(TypeInfo(TCityDynArray),Cities,nil,nil,nil,#CitiesCount);
(...)
Check(ACities.FindHashed(City)>=0);
for i := 1 to 2000 do begin
City.Name := IntToStr(i);
City.Latitude := i*3.14;
City.Longitude := i*6.13;
Check(ACities.FindHashedAndUpdate(City,true)=i+2,'multiple ReHash');
Check(ACities.FindHashed(City)=i+2);
end;
ACities.Capacity := CITIES_MAX+3; // make it as fast as possible
for i := 2001 to CITIES_MAX do begin
City.Name := IntToStr(i);
City.Latitude := i*3.14;
City.Longitude := i*6.13;
Check(ACities.FindHashedAndUpdate(City,true)=i+2,'use Capacity: no ReHash');
Check(ACities.FindHashed(City.Name)=i+2);
end;
for i := 1 to CITIES_MAX do begin
N := IntToStr(i);
j := ACities.FindHashed(N);
Check(j=i+2,'hashing with string not City.Name');
Check(Cities[j].Name=N);
CheckSame(Cities[j].Latitude,i*3.14);
CheckSame(Cities[j].Longitude,i*6.13);
end;
end;
So for your problem:
type
TMyMap = record
Key: string;
Value: array of string;
end;
TMyMapDynArray = array of TMyMap;
var
Map: TMyMap;
Maps: TMyMapDynArray;
MapW: TDynArrayHashed;
key: string;
i: integer;
begin
MapW.Init(TypeInfo(TMyMapDynArray),Maps);
Map.Key := 'Some key';
SetLength(Map.Value,2);
Map.Value[0] := 'One';
Map.Value[1] := 'Two';
MapW.FindHashedAndUpdate(Map,true); // ,true for adding the Map content
key := 'Some key';
i := MapW.FindHashed(key);
// now i=0 and Maps[i].Key=key
for i := 0 to MapW.Count-1 do // or for i := 0 to high(Maps) do
with Maps[i] do
// now you're enumerating all key/value pairs
end;
Since Delphi 6, the set of predefined container classes includes TBucketList and TObjectBucketList. These two lists are associative, which means they have a key and an actual entry. The key is used to identify the items and search for them. To add an item, you call the Add method with two parameters: the key and the data. When you use the Find method, you pass the key and retrieve the data. The same effect is achieved by using the Data array property, passing the key as parameter.

How to cut out a part from a stream in Delphi7

I have an incoming soap message wich form is TStream (Delphi7), server that send this soap is in development mode and adds a html header to the message for debugging purposes. Now i need to cut out the html header part from it before i can pass it to soap converter. It starts from the beginning with 'pre' tag and ends with '/pre' tag. Im thinking it should be fairly easy to but i havent done it before in Delphi7, so can someone help me?
Another solution, more in line with Lars' suggestion and somehow more worked out.
It's faster, especially when the size of the Stream is above 100, and even more so on really big ones. It avoids copying to an intermediate string.
FilterBeginStream is simpler and follows the "specs" in removing everything up until the end of the header.
FilterMiddleStream does the same as DepreStream, leaving what's before and after the header.
Warning: this code is for Delphi up to D2007, not D2009.
// returns position of a string token (its 1st char) into a Stream. 0 if not found
function StreamPos(Token: string; AStream: TStream): Int64;
var
TokenLength: Integer;
StringToMatch: string;
begin
Result := 0;
TokenLength := Length(Token);
if TokenLength > 0 then
begin
SetLength(StringToMatch, TokenLength);
while AStream.Read(StringToMatch[1], 1) > 0 do
begin
if (StringToMatch[1] = Token[1]) and
((TokenLength = 1) or
((AStream.Read(StringToMatch[2], Length(Token)-1) = Length(Token)-1) and
(Token = StringToMatch))) then
begin
Result := AStream.Seek(0, soCurrent) - (Length(Token) - 1); // i.e. AStream.Position - (Length(Token) - 1);
Break;
end;
end;
end;
end;
// Returns portion of a stream after the end of a tag delimited header. Works for 1st header.
// Everything preceding the header is removed too. Returns same stream if no valid header detected.
// Result is True if valid header found and stream has been filtered.
function FilterBeginStream(const AStartTag, AEndTag: string; const AStreamIn, AStreamOut: TStream): Boolean;
begin
AStreamIn.Seek(0, soBeginning); // i.e. AStreamIn.Position := 0;
Result := (StreamPos(AStartTag, TStream(AStreamIn)) > 0) and (StreamPos(AEndTag, AStreamIn) > 0);
if Result then
AStreamOut.CopyFrom(AStreamIn, AStreamIn.Size - AStreamIn.Position)
else
AStreamOut.CopyFrom(AStreamIn, 0);
end;
// Returns a stream after removal of a tag delimited portion. Works for 1st encountered tag.
// Returns same stream if no valid tag detected.
// Result is True if valid tag found and stream has been filtered.
function FilterMiddleStream(const AStartTag, AEndTag: string; const AStreamIn, AStreamOut: TStream): Boolean;
var
StartPos, EndPos: Int64;
begin
Result := False;
AStreamIn.Seek(0, soBeginning); // i.e. AStreamIn.Position := 0;
StartPos := StreamPos(AStartTag, TStream(AStreamIn));
if StartPos > 0 then
begin
EndPos := StreamPos(AEndTag, AStreamIn);
Result := EndPos > 0;
end;
if Result then
begin
if StartPos > 1 then
begin
AStreamIn.Seek(0, soBeginning); // i.e. AStreamIn.Position := 0;
AStreamOut.CopyFrom(AStreamIn, StartPos - 1);
AStreamIn.Seek(EndPos - StartPos + Length(AEndTag), soCurrent);
end;
AStreamOut.CopyFrom(AStreamIn, AStreamIn.Size - AStreamIn.Position);
end
else
AStreamOut.CopyFrom(AStreamIn, 0);
end;
I think the following code would do what you want, assuming you only have one <pre> block in your document.
function DepreStream(Stm : tStream):tStream;
var
sTemp : String;
oStrStm : tStringStream;
i : integer;
begin
oStrStm := tStringStream.create('');
try
Stm.Seek(0,soFromBeginning);
oStrStm.copyfrom(Stm,Stm.Size);
sTemp := oStrStm.DataString;
if (Pos('<pre>',sTemp) > 0) and (Pos('</pre>',sTemp) > 0) then
begin
delete(sTemp,Pos('<pre>',sTemp),(Pos('</pre>',sTemp)-Pos('<pre>',sTemp))+6);
oStrStm.free;
oStrStm := tStringStream.Create(sTemp);
end;
Result := tMemoryStream.create;
oStrStm.Seek(0,soFromBeginning);
Result.CopyFrom(oStrStm,oStrStm.Size);
Result.Seek(0,soFromBeginning);
finally
oStrStm.free;
end;
end;
Another option I believe would be to use an xml transform to remove the unwanted tags, but I don't do much in the way of transforms so if anyone else wants that torch...
EDIT: Corrected code so that it works. Teaches me for coding directly into SO rather than into the IDE first.
Make a new TStream (use TMemoryStream) and move any stuff you want to keep over from one stream to the other with TStream.CopyFrom or the TStream.ReadBuffer/WriteBuffer methods.
An XPath expression of "//pre[1][1]" will haul out the first node of the first <pre> tag in the XML message: from your description, that should contain the SOAP message you want.
It's been many years since I last used it, but I think Dieter Koehler's OpenXML library supports XPath.

Resources