I am inserting a ContentControl into a MS Word document using Delphi 10.4
The content control is inserted, into a bookmark on the template, using the following snippet:
procedure TBF.SetPI;
var
R: WordRange;
bookmark: OleVariant;
s: string;
begin
s:= 'insert text here';
bookmark := 'textValue';
R := MF.WordDoc.Bookmarks.Item(bookmark).Range;
R.Text := s;
R.HighlightColorIndex := wdYellow;
MF.WordDoc.ContentControls.Add(wdContentControlRichText,R);
end;
This successfully creates the ContentControl, however the control is persistant oonce the text has been edited.
Word has an option to mark ContentControls as "temporary" and the VBA for that is
Selection.ParentContentControl.Temporary = True
Delphi exposes the same as R.ParentContentControl.Temporary which requires a WordBool value.
Try as I might I cannot get Delphi to accept a True value and pass it to Word.
The problem is that you are trying to assign Delphi Boolean value to WordBool.
Delphi Boolean value is 8 bit (1 byte in size). But WordBool is actually 16 bit (2 byte in size).
For more info on this check System.WordBool;
The solution was that I was trying to access the wrong instance of .ContentControl.Temporary which was compounded by my also setting the Range.Text value.
The following is a working version of the above example.
procedure TBF.SetPI;
var
R: WordRange;
bookmark: OleVariant;
s: string;
cc: ContentControl;
begin
s := 'insert text here';
bookmark := 'textValue';
R := MF.WordDoc.Bookmarks.Item(bookmark).Range;
R.Text := '';
cc := MF.WordDoc.ContentControls.Add(wdContentControlRichText, R);
cc.SetPlaceholderText(nil, nil, s);
cc.Range.HighlightColorIndex := wdYellow;
cc.Temporary := true;
end;
Related
I have a small Delphi 10.3.3 app that has some text editing functions, using a TMemo where the user type the text.
I'm trying to include some formatting options, something as this site provides :
http://qaz.wtf/u/convert.cgi?text=How%20do%20it%20on%20Delphi
When i copy the 'circled' text from the site above and paste on my memo, it works, appears 'circled'. But i want to give my user the ability to apply the formatting inside my app.
For instance, i want to have a speedbutton to apply the 'circle' formatting to the current TMemo selected text : the user selects a text , click on this speedbutton and then the selected text gets the 'circled' formatting.
This is rather easy. If you look at the Unicode chart for the enclosed alphanumerics, you realise that the following mapping is valid:
function EncircleChr(AChr: Char): Char;
begin
case AChr of
'0':
Result := Chr($24EA);
'1'..'9':
Result := Chr($2460 + Ord(AChr) - Ord('1'));
'a'..'z':
Result := Chr($24D0 + Ord(AChr) - Ord('a'));
'A'..'Z':
Result := Chr($24B6 + Ord(AChr) - Ord('A'));
else
Result := AChr;
end;
end;
Hence, with
function Encircle(const S: string): string;
var
i: Integer;
begin
SetLength(Result, S.Length);
for i := 1 to S.Length do
Result[i] := EncircleChr(S[i]);
end;
and
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.SelText := Encircle(Memo1.SelText);
end;
you get the desired behaviour:
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.
I have some files in a directory. I try get these files with FindFirst and FindNext but I can't get same order on Windows 7.
C:\Test
SampleFile.0.png
SampleFile.1.png
SampleFile.2.png
SampleFile.3.png
SampleFile.4.png
SampleFile.5.png
SampleFile.6.png
SampleFile.7.png
SampleFile.8.png
SampleFile.9.png
SampleFile.10.png
SampleFile.11.png
SampleFile.12.png
SampleFile.13.png
SampleFile.14.png
SampleFile.15.png
SampleFile.16.png
SampleFile.17.png
SampleFile.18.png
SampleFile.19.png
SampleFile.20.png
SampleFile.21.png
SampleFile.22.png
When I try using my code I've got
SampleFile.0.png
SampleFile.1.png
SampleFile.10.png
SampleFile.11.png
SampleFile.12.png
SampleFile.13.png
SampleFile.14.png
SampleFile.15.png
SampleFile.16.png
SampleFile.17.png
SampleFile.18.png
SampleFile.19.png
SampleFile.2.png
SampleFile.20.png
SampleFile.21.png
.
.
.
How can I get file list on correct rank order?
Procedure Test;
var
sr : TSearchRec;
i : integer;
ListFiles : TStringList;
begin
ListFiles := TStringList.Create;
i := FindFirst('c:\test\*.png', faDirectory, sr);
while i = 0 do begin
ListFiles.Add(ExtractFileName(sr.FindData.cFileName));
i := FindNext(sr);
end;
FindClose(sr);
end;
Note : Result is still wrong, if I can use ListFiles.Sorted = True
I think I've a solution, created a function.
function SortFilesByName(List: TStringList; Index1, Index2: Integer): integer;
var
FileName1, FileName2: String;
i, FileNumber1, FileNumber2: Integer;
begin
FileName1 := ChangeFileExt(ExtractFileName(List[Index1]), '');
FileName2 := ChangeFileExt(ExtractFileName(List[Index2]), '');
i := POS('.', FileName1)+1;
FileNumber1 := StrToInt(Copy(FileName1, i, MaxInt));
i := POS('.', FileName2)+1;
FileNumber2 := StrToInt(Copy(FileName2, i, MaxInt));
Result := (FileNumber1 - FileNumber2);
end;
I've added another line
ListFiles.CustomSort(SortFilesByName); //(ListFiles,1,2):integer);
before
FindClose(sr);
As jachguate said, the sorting is done by Explorer.exe, not the filesystem. FindFirst/FindNext does not guarantee any specific sorting, including plain ASCII based, so you shouldn't rely on it. You don't, however, need to re-implement the numeric sort in Delphi. Windows exposes the one it uses as StrCmpLogicalW, which is in shlwapi.dll. The import looks like this:
function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall;
external 'shlwapi.dll'
It is possible to disable that behavior in Windows. If you want to follow the order that Windows uses, you need to call SHRestricted with the REST_NOSTRCMPLOGICAL value. If it returns true you should use AnsiCompareStr instead.
const
// Use default CompareString instead of StrCmpLogical
REST_NOSTRCMPLOGICAL = $4000007E;
function SHRestricted(rest: DWORD): LongBool; stdcall; external 'shell32.dll';
So your final sort function should be something like this:
function CompareFilenames(const AFilename1, AFilename2: string): Integer;
begin
if SHRestricted(REST_NOSTRCMPLOGICAL) then
Result := AnsiCompareStr(AFilename1, AFilename2)
else
Result := StrCmpLogicalW(PWideChar(AFilename1), PWideChar(AFilename2));
end;
You can cache the result of the SHRestricted call, but if you do you need to watch for the WM_SETTINGSCHANGE broadcast message and re-read it when you get one.
The different orders you see in the windows explorer is implemented in explorer.exe and not in the file system.
The Numerical sort order is a new feature in windows 7, so if you sort by name and you have a bunch of files with a prefix followed by numbers, the explorer "identifies" that pattern and doesn't present a list sorted by name in the traditional way, but sorted by prefix and then by number (as if the string were a Integer number).
If you want to do the same in Delphi, you can do it by adding all the file names returned by FindFirst/FindNext to a TSlist and then sort the string list using this compare function:
var
FileNames: TList<string>;
begin
FileNames := TList<string>.Create;
try
SearchForFiles(FileNames); //here you add all the file names
//sort file names a la windows 7 explorer
FileNames.Sort(System.Generics.Defaults.TComparer<string>.Construct(
function (const s1, s2: string): Integer
procedure ProcessPrefix(const fn: string; var prefix, number: string);
var
I: Integer;
begin
for I := length(fn) downto 1 do
if not TCharacter.IsDigit(fn[I]) then
begin
Prefix := Copy(fn, 1, I);
number := Copy(fn, I+1, MaxInt);
Break;
end;
end;
var
prefix1, prefix2: string;
number1, number2: string;
fn1, fn2: string;
begin
//compare filenames a la windows 7 explorer
fn1 := TPath.GetFileNameWithoutExtension(s1);
fn2 := TPath.GetFileNameWithoutExtension(s2);
ProcessPrefix(fn1, prefix1, number1);
ProcessPrefix(fn2, prefix2, number2);
if (Number1 <> '') and (Number2 <> '') then
begin
Result := CompareText(prefix1, prefix2);
if Result = 0 then
Result := CompareValue(StrToInt(number1), StrToInt(Number2));
end
else
Result := CompareText(s1, s2);
end
));
UseYourSortedFileNames(FileNames);
finally
FileNames.Free;
end;
end;
By "rank", you mean sort order.
The files are sorting in the proper order (based on the ASCII value of the characters). 2 comes after 19 because the comparison is only made up to the same number of characters in both names, and '2' comes after 1.
If you want them to sort properly as numbers, you need to left-pad the numbers with zeros so they're all the same width (eg., instead of SampleFile.2.png, use SampleFile.02.png). This will cause '02' to come before 19 so they sort correctly numerically.
You can fix the numbering issue by using something like:
PngFileName := Format('SampleFile.%.2d.png', [Counter]);
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.
I am trying to remotely read a binary (REG_BINARY) registry value, but I get nothing but junk back. Any ideas what is wrong with this code? I'm using Delphi 2010:
function GetBinaryRegistryData(ARootKey: HKEY; AKey, AValue, sMachine: string; var sResult: string): boolean;
var
MyReg: TRegistry;
RegDataType: TRegDataType;
DataSize, Len: integer;
sBinData: string;
bResult: Boolean;
begin
bResult := False;
MyReg := TRegistry.Create(KEY_QUERY_VALUE);
try
MyReg.RootKey := ARootKey;
if MyReg.RegistryConnect('\\' + sMachine) then
begin
if MyReg.KeyExists(AKey) then
begin
if MyReg.OpenKeyReadOnly(AKey) then
begin
try
RegDataType := MyReg.GetDataType(AValue);
if RegDataType = rdBinary then
begin
DataSize := MyReg.GetDataSize(AValue);
if DataSize > 0 then
begin
SetLength(sBinData, DataSize);
Len := MyReg.ReadBinaryData(AValue, PChar(sBinData)^, DataSize);
if Len <> DataSize then
raise Exception.Create(SysErrorMessage(ERROR_CANTREAD))
else
begin
sResult := sBinData;
bResult := True;
end;
end;
end;
except
MyReg.CloseKey;
end;
MyReg.CloseKey;
end;
end;
end;
finally
MyReg.Free;
end;
Result := bResult;
end;
And I call it like this:
GetBinaryRegistryData(
HKEY_LOCAL_MACHINE,
'\SOFTWARE\Microsoft\Windows NT\CurrentVersion',
'DigitalProductId', '192.168.100.105',
sProductId
);
WriteLn(sProductId);
The result I receive from the WriteLn on the console is:
ñ ♥ ???????????6Z ????1 ???????☺ ???♦ ??3 ? ??? ?
??
Assuming that you are already connected remotely, try using the GetDataAsString function
to read binary data from the registry.
sResult := MyReg.GetDataAsString(AValue);
You're using Delphi 2010, so all your characters are two bytes wide. When you set the length of your result string, you're allocating twice the amount of space you need. Then you call ReadBinaryData, and it fills half your buffer. There are two bytes of data in each character. Look at each byte separately, and you'll probably find that your data looks less garbage-like.
Don't use strings for storing arbitrary data. Use strings for storing text. To store arbitrary blobs of data, use TBytes, which is an array of bytes.