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:
Related
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;
I have a number of files in a directory, where each file has two lines, line 1 is the string that I want to put into my ListBox, and line 2 is the background color that I want that ListBox item to have (represented as an 8-digit hex value).
The contents of each file looks like this:
string
14603481
This is my code so far:
for i := 0 to PathList.Count - 1 do
begin
FileLines := TStringList.Create;
try
FileLines.LoadFromFile(PathList.Strings[i]);
s := FileLines[0]; { Loads string to add to ListBox1 }
RGBColor := FileLines[1];
finally
FileLines.Free;
end;
ListBox1.Items.AddObject(s, TObject(RGBColor)); { This code doesn't work, but hopefully you get what I'm }
end; { trying to do }
All other examples that do anything similar to this declare the color in the DrawItem procedure, but I need to set the color from within this for loop, since each entry will have a unique color.
How do I set the color of each item uniquely from within this loop?
The VCL's TListBox does not natively support any kind of per-item coloring. The TListBox.Font and TListBox.Color properties apply to all items equally.
To do what you are asking for, you will have to set the TListBox.Style property to lbOwnerDrawFixed and then use the TListBox.OnDrawItem event to custom-draw the items manually however you want, eg:
var
...
s: string;
RGBColor: Integer;
begin
...
for i := 0 to PathList.Count - 1 do
begin
FileLines := TStringList.Create;
try
FileLines.LoadFromFile(PathList[i]);
s := FileLines[0];
RGBColor := StrToInt(FileLines[1]);
finally
FileLines.Free;
end;
ListBox1.Items.AddObject(s, TObject(RGBColor));
end;
...
end;
...
procedure TMyForm.ListBox1DrawItem(Control: TWinControl;
Index: Integer; const Rect: TRect; State: TOwnerDrawState);
var
LB: TListBox;
begin
LB := TListBox(Control);
if odSelected in State then
begin
LB.Canvas.Brush.Color := clHighlight;
LB.Canvas.Font.Color := clHighlightText;
end else
begin
LB.Canvas.Brush.Color := TColor(Integer(LB.Items.Objects[Index]));
LB.Canvas.Font.Color := LB.Font.Color;
end;
LB.Canvas.FillRect(Rect);
LB.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, LB.Items[Index]);
if (odFocused in State) and not (odNoFocusRect in State) then
LB.Canvas.DrawFocusRect(Rect);
end;
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 Inherited form and a Ehlib dbgrid on it for selecting-listing records... The form is ready made for a lot of buttons and im using this form with different queries.
Like this...
If Dm.QrTmp.Active then Dm.QrTmp.Active:=False;
Dm.QrTmp.SQL.Clear;
Dm.QrTmp.SQL.Add(' SELECT ');
Dm.QrTmp.SQL.Add(' ch.cari_RECno AS KayitNo ');
Dm.QrTmp.SQL.Add(' FROM CARI_HESAPLAR ch ');
if FrmTmp=nil then FrmTmp:=TFrmTmp.Create(Self);
FrmTmp.StatusBar.Hide;
Dm.QrTmp.Open;
FrmTmp.DbGrid.DataSource:=Dm.DsQrTmp;
This query is cutted down but i have of course use a lot of fields. And Queries changes alot of time in the application.
The problem is column width. Manager wants to set column widths and restore them again. Actually my grid component supports save - restore column properties but as you can see my usage i m not using static columns. also i dont want to use xgrid.columns[0].width percent by percent.
Im using a ini in may app.
I want to add new section on it and named "Gridwidth"...
[Gridname]
Colwidths=x,y,z (where they are width values)
I'm now coding this line by line.
My write procedure is like this.
With dbgridx do
begin
For i:=0 to columns.count-1
begin
widthstr:=widthstr+Column[i].width+',';
end;
end;
Widthstr will be "15,23,45,67" etc...
But i want to know if this is good solution and if somebody know a better way and has some good code.
This should do it:
uses
IniFiles;
const
SETTINGS_FILE = 'Edijus\Settings.ini';
procedure TForm1.LoadDBGridColumnsWidth(const ADBGrid: TDBGrid);
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
i, j: integer;
_ParentClass: TWinControl;
begin
_SettingsPath := GetHomePath + PathDelim + SETTINGS_FILE;
if (not Assigned(ADBGrid)) or (not Assigned(ADBGrid.DataSource)) or
(not Assigned(ADBGrid.DataSource.DataSet)) then
Exit;
_MemIniU := TMemIniFile.Create(_SettingsPath, TEncoding.UTF8);
try
_ParentClass := ADBGrid.Parent;
while not(_ParentClass is TForm) do
_ParentClass := _ParentClass.Parent;
for i := 0 to Pred(ADBGrid.DataSource.DataSet.Fields.Count) do
for j := 0 to Pred(ADBGrid.Columns.Count) do
begin
if (ADBGrid.DataSource.DataSet.Fields[i].FieldName = ADBGrid.Columns[j]
.FieldName) then
ADBGrid.Columns[j].Width :=
_MemIniU.ReadInteger(_ParentClass.Name + '_' + ADBGrid.Name,
ADBGrid.Columns[j].FieldName, 64);
end;
finally
FreeAndNil(_MemIniU);
end;
end;
procedure TForm1.SaveDBGridColumnsWidth(const ADBGrid: TDBGrid);
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
i: integer;
_ParentClass: TWinControl;
begin
_SettingsPath := GetHomePath + PathDelim + SETTINGS_FILE;
if (not Assigned(ADBGrid)) or
(not ForceDirectories(ExtractFilePath(_SettingsPath))) then
Exit;
_MemIniU := TMemIniFile.Create(_SettingsPath, TEncoding.UTF8);
try
_ParentClass := ADBGrid.Parent;
while not(_ParentClass is TForm) do
_ParentClass := _ParentClass.Parent;
for i := 0 to Pred(ADBGrid.Columns.Count) do
if (ADBGrid.Columns[i].FieldName <> '') then
_MemIniU.WriteInteger(_ParentClass.Name + '_' + ADBGrid.Name,
ADBGrid.Columns[i].FieldName, ADBGrid.Columns[i].Width);
_MemIniU.UpdateFile;
finally
FreeAndNil(_MemIniU);
end;
end;
I want to export content of a TQuery to a CSV file without using a 3d part component(Delphi 7). From my knowledge this can not be accomplished with Delphi standard components.
My solution was to save the content in a StringList with a CSV format, and save it to a file.
Is there any comfortable solution?
PS:I don't want to use JvCsvDataSet or any component. Question is: can this be accomplished only with Delphi 7 or higher standard components?
Thank you in advance!
Of course it can.
You just have to do the work to properly output the CSV content (quoting properly, handling embedded quotes and commas, etc.). You can easily write the output using TFileStream, and get the data using the TQuery.Fields and TQuery.FieldCount properly.
I'll leave the fancy CSV quoting and special handling to you. This will take care of the easy part:
var
Stream: TFileStream;
i: Integer;
OutLine: string;
sTemp: string;
begin
Stream := TFileStream.Create('C:\Data\YourFile.csv', fmCreate);
try
while not Query1.Eof do
begin
// You'll need to add your special handling here where OutLine is built
OutLine := '';
for i := 0 to Query.FieldCount - 1 do
begin
sTemp := Query.Fields[i].AsString;
// Special handling to sTemp here
OutLine := OutLine + sTemp + ',';
end;
// Remove final unnecessary ','
SetLength(OutLine, Length(OutLine) - 1);
// Write line to file
Stream.Write(OutLine[1], Length(OutLine) * SizeOf(Char));
// Write line ending
Stream.Write(sLineBreak, Length(sLineBreak));
Query1.Next;
end;
finally
Stream.Free; // Saves the file
end;
end;
The original question asked for a solution using a StringList. So it would be something more like this. It will work with any TDataSet, not just a TQuery.
procedure WriteDataSetToCSV(DataSet: TDataSet, FileName: String);
var
List: TStringList;
S: String;
I: Integer;
begin
List := TStringList.Create;
try
DataSet.First;
while not DataSet.Eof do
begin
S := '';
for I := 0 to DataSet.FieldCount - 1 do
begin
if S > '' then
S := S + ',';
S := S + '"' + DataSet.Fields[I].AsString + '"';
end;
List.Add(S);
DataSet.Next;
end;
finally
List.SaveToFile(FileName);
List.Free;
end;
end;
You can add options to change the delimiter type or whatever.
This is like the Rob McDonell solution but with some enhancements: header, escape chars, enclosure only when required, and ";" separator.
You can easily disable this enhancements if not required.
procedure SaveToCSV(DataSet: TDataSet; FileName: String);
const
Delimiter: Char = ';'; // In order to be automatically recognized in Microsoft Excel use ";", not ","
Enclosure: Char = '"';
var
List: TStringList;
S: String;
I: Integer;
function EscapeString(s: string): string;
var
i: Integer;
begin
Result := StringReplace(s,Enclosure,Enclosure+Enclosure,[rfReplaceAll]);
if (Pos(Delimiter,s) > 0) OR (Pos(Enclosure,s) > 0) then // Comment this line for enclosure in every fields
Result := Enclosure+Result+Enclosure;
end;
procedure AddHeader;
var
I: Integer;
begin
S := '';
for I := 0 to DataSet.FieldCount - 1 do begin
if S > '' then
S := S + Delimiter;
S := S + EscapeString(DataSet.Fields[I].FieldName);
end;
List.Add(S);
end;
procedure AddRecord;
var
I: Integer;
begin
S := '';
for I := 0 to DataSet.FieldCount - 1 do begin
if S > '' then
S := S + Delimiter;
S := S + EscapeString(DataSet.Fields[I].AsString);
end;
List.Add(S);
end;
begin
List := TStringList.Create;
try
DataSet.DisableControls;
DataSet.First;
AddHeader; // Comment if header not required
while not DataSet.Eof do begin
AddRecord;
DataSet.Next;
end;
finally
List.SaveToFile(FileName);
DataSet.First;
DataSet.EnableControls;
List.Free;
end;
end;
Delphi does not provide any built-in access to .csv data.
However, following the VCL TXMLTransform paradigm, I wrote a TCsvTransform class helper that will translate a .csv structure to /from a TClientDataSet.
As for the initial question that was to export a TQuery to .csv, a simple TDataSetProvider will make the link between TQuery and TClientDataSet.
For more details about TCsvTransform, cf http://didier.cabale.free.fr/delphi.htm#uCsvTransform