I have set Item as DynamicAppearance. Items are diferent sizes because I recalcualte needed size OnUpdateObject event.
Visualy everything looks as needed but it looks like ScrollTo does not see/know this and jumps somehere not there it should.
Tried to:
procedure ListViewScrollTo(const aListView: TListview);
var i, lHeight: Integer;
begin
aListView.Repaint;
lHeight := 0;
for i := 0 to aListView.Items.Count - 1 do
begin
if i = aListView.ItemIndex then
break;
lHeight := lHeight + aListView.Items[i].Height + Round(aListView.ItemSpaces.top + aListView.ItemSpaces.Bottom);
end;
aListView.strong textScrollViewPos := lHeight;
end;
But ListView.Items[i].Height is 0 moast of the time. Dont know why.
Here is my code that runs on OnUpdateObject (Bits and pices arround the web)
function GetTextHeight(const D: TListItemText; const Width: single; const Text: string): integer;
var
Layout: TTextLayout;
begin
Layout := TTextLayoutManager.DefaultTextLayout.Create;
try
Layout.BeginUpdate;
try
Layout.Font.Assign(D.Font);
Layout.VerticalAlign := D.TextVertAlign;
Layout.HorizontalAlign := D.TextAlign;
Layout.WordWrap := D.WordWrap;
Layout.Trimming := D.Trimming;
Layout.MaxSize := TPointF.Create(Width, TTextLayout.MaxLayoutSize.Y);
Layout.Text := Text;
finally
Layout.EndUpdate;
end;
//Size needs to be amanded for Scale oz Pixel density...
Result := Round(Layout.Height * GetScreenScale);
finally
Layout.Free;
end;
end;
function ListViewAutoSize(const Sender: TObject; const AItem: TListViewItem; aCustomItemTextName: string): Integer;
var
Drawable: TListItemText;
Text: string;
AvailableWidth: Single;
Names: TStringList;
SumHeight: Single;
begin
TListView(Sender).BeginUpdate;
SumHeight := 0;
Names := TStringList.Create;
try
Names.Delimiter := ';';
Names.StrictDelimiter := True;
Names.DelimitedText := aCustomItemTextName;
//do this for all items in aCustomUtemTextName
for var I := 0 to Names.Count - 1 do
begin
AvailableWidth := TListView(Sender).Width - TListView(Sender).ItemSpaces.Left - TListView(Sender).ItemSpaces.Right;
Drawable := TListItemText(AItem.View.FindDrawable(Names[i])); //find item by name
if assigned(Drawable) then
begin
//found
if Drawable.Visible then
begin
Text := Trim(Drawable.Text);
if Text <> '' then
begin
SumHeight := SumHeight;
Drawable.PlaceOffset.Y := SumHeight ;
Drawable.Height := GetTextHeight(Drawable, AvailableWidth, Text) * GetScreenScale;
SumHeight := SumHeight + Drawable.Height;
AItem.Height := Round(SumHeight);
Drawable.Width := AvailableWidth;
end else begin
Drawable.Height := 0;
end;
end;
end;
end;
//set Item size that everything is visible...
AItem.Height := Round(SumHeight);
Result := AItem.Height;
finally
Names.Free;
end;
TListView(Sender).EndUpdate;
end;
Anyone can help how can I transform this to work with tcxchecklistbox?
My Save procedure looks like...
procedure Tfrm_A.SaveCheckListBoxData(S: TMemoryStream;
CheckListBox: TCheckListBox);
var
i: longint;
b: boolean;
buf : string;
begin
S.Clear;
buf := CheckListBox.Items.Text;
i := Length(buf);
S.Write(i, SizeOf(i));
if i > 0 then begin
S.Write(buf[1], i);
for i:= 0 to Pred(CheckListBox.Items.Count) do
begin
b:= CheckListBox.Checked[i];
s.Write(b,1);
end;
end;
end;
My load procedure looks like...
procedure Tfrm_A.LoadCheckListBoxData(S: TMemoryStream;
CheckListBox: TChecklistBox);
var
i: longint;
b: Boolean;
buf : string;
begin
S.Position := 0;
S.Read(i, SizeOf(i));
if i > 0 then begin
SetLength(buf, i);
S.Read(buf[1], i);
CheckListBox.Items.Text := buf;
for i:= 0 to Pred(CheckListBox.Items.Count) do
begin
s.Read(b,1);
CheckListBox.Checked[i] := b;
end;
end;
end;
My problem is
buf := CheckListBox.Items.Text;
TcxChecklistbox has checklistbox.items[Index].textproperty
Thanks for the help!
You can use a TStringStream to do this. Basically, it's just a question of iterating the cxCheckBoxList Items and writing a character to the StringStream indicating whether the checkbox is checked, and then reading the stream back a character at a time.
function StateToString(Checked : Boolean) : String;
begin
if Checked then
Result := '+'
else
Result := '-';
end;
procedure TForm1.SaveStatesToStream(SS : TStringStream);
var
i : integer;
begin
SS.Clear;
SS.Position := 0;
for i := 0 to cxCheckListBox1.Items.Count - 1 do begin
SS.WriteString(StateToString(cxCheckListBox1.Items[i].Checked));
end;
Memo1.Lines.Add('>' + SS.DataString + '<');
end;
procedure TForm1.LoadStatesFromStream(SS : TStringStream);
var
i : integer;
S : String;
begin
CheckBoxList.ClearCheckmarks;
SS.Position := 0;
i := 0;
while (i <= cxCheckListBox1.Items.Count - 1) and (SS.Position < SS.Size) do begin
S := SS.ReadString(1);
cxCheckListBox1.Items[i].Checked := S = '+';
Inc(i);
end;
end;
Tested in Delphi Seattle
I'm having problems in my code but can not find the solution, already modified in various ways but no success.
Code:
private
{ Private declarations }
procedure getImgInfo(Sender: TObject; A, B: String);
And:
procedure TfMain.Button1Click(Sender: TObject);
var
i, Idx, Left, Top, Count : integer;
Graph : TGraphic;
Img : TImage;
EdPath, EdFileName : TEdit;
begin
openImg.Execute;
Left := 5;
Top := 5;
Count := 0;
Idx := 0;
for i:=0 to openImg.Files.Count-1 do
begin
try
begin
Graph := TPngImage.Create;
Graph.LoadFromFile(openImg.Files[i]);
EdPath := TEdit.Create(pImgs);
EdPath.Left := Left + 101;
EdPath.Visible := False;
EdPath.Text := ExtractFilePath(openImg.Files[i]);
EdFileName := TEdit.Create(pImgs);
EdFileName.Left := Left + 101;
EdFileName.Visible := False;
EdFileName.Text := ExtractFileName(openImg.Files[i]);
Img := TImage.Create(pImgs);
Img.Parent := pImgs;
Idx := Idx + 1;
Img.Name := 'Img_'+IntToStr(Idx);
Img.Width := 100;
Img.Height := 100;
Img.Left := Left;
Img.Proportional := True;
Left := Left + 101;
Img.Top := Top;
Img.Picture.Assign(Graph);
Img.BringToFront;
Count := Count + 1;
Img.OnClick := getImgInfo(Img, edPath.Text, edFileName.Text); //Error line
if Count = 2 then
begin
Left := 5;
Top := Top + 101;
Count := 0;
end;
end;
except on E : Exception do
ShowMessage('Error: :' + E.Message);
end;
end;
end;
Error:
[dcc32 Error] uMain.pas(74): E2010 Incompatible types: 'TNotifyEvent' and 'procedure, untyped pointer or untyped parameter'
What is wrong?
Thanks!
The OnClick event handler of TImage is a TNotifyEvent, so you can only assign such a procedure to it. This is a method (a procedure belonging to an object), and it takes a single parameter, Sender of type TObject. So this will work:
procedure TfMain.ImageClickHandler(Sender: TObject);
begin
// Do something
end;
...
Img.OnClick := ImageClickHandler;
You need some kind of data structure to store your data. Perhaps
type
TImageData = record
Image: TImage;
ImageTitle: string;
ImageFileName: string;
Photographer: string;
DateTaken: TDateTime;
end;
and
var
ImageData = array of TImageData;
Or, more similar to your code:
type
TImageData = record
Image: TImage;
AssociatedEditControl1,
AssociatedEditControl2: TEdit;
end;
var
ImageData = array of TImageData;
Then you set the length of ImageData to openImg.Files.Count, and use Image and AssociatedEditControl1 and AssociatedEditControl2 instead of the local variables. After all, you want to be able to access these controls easily. You could also set the Tag of the TImage to the current value of i, and then in ImageClickHandler, you can check Self.Tag to access ImageData[Self.Tag].AssociatedEditControl1, say.
(But I still think you should separate the internal data from the GUI better. You also need to fix your memory leak.)
Try something more like this instead:
type
PImageInfo = ^ImageInfo;
ImageInfo = record
Path: String;
FileName: String;
Img: TImage;
EdPath: TEdit;
EdFileName : TEdit;
// anything else you need...
end;
private
{ Private declarations }
Images: array of ImageInfo;
procedure ImageClicked(Sender: TObject);
procedure TfMain.Button1Click(Sender: TObject);
var
i, ImgLeft, ImgTop, Count : integer;
Graph : TGraphic;
Info: PImageInfo;
begin
if not openImg.Execute then Exit;
ImgLeft := 5;
ImgTop := 5;
Count := Length(Images);
try
SetLength(Images, Count + openImg.Files.Count);
for I := 0 to openImg.Files.Count-1 do
begin
Graph := TPngImage.Create;
try
Graph.LoadFromFile(openImg.Files[i]);
Info := #Images[Count];
Info.Path := ExtractFilePath(openImg.Files[i]);
Info.FileName := ExtractFileName(openImg.Files[i]);
Info.Img := nil;
Info.EdPath := nil;
Info.EdFileName := nil;
try
Info.EdPath := TEdit.Create(pImgs);
Info.EdPath.Left := ImgLeft + 101;
Info.EdPath.Visible := False;
Info.EdPath.Text := Path;
Info.EdFileName := TEdit.Create(pImgs);
Info.EdFileName.Left := ImgLeft + 101;
Info.EdFileName.Visible := False;
Info.EdFileName.Text := Images[Count].FileName;
Info.Img := TImage.Create(pImgs);
Info.Img.Parent := pImgs;
Info.Img.Tag := Count;
Info.Img.Name := 'Img_'+IntToStr(Count);
Info.Img.SetBounds(ImgLeft, ImgTop, 100, 100);
Info.Img.Proportional := True;
Info.Img.OnClick := ImageClicked;
Info.Img.Picture.Assign(Graph);
Info.Img.BringToFront;
except
Info.EdPath.Free;
Info.EdFileName.Free;
Info.Img.Free;
raise;
end;
finally
Graph.Free;
end;
Inc(Count);
if (Count mod 2) = 0 then
begin
ImgLeft := 5;
Inc(ImgTop, 101);
end else
Inc(ImgLeft, 101);
end;
except
on E : Exception do
begin
SetLength(Images, Count);
ShowMessage('Error: :' + E.Message);
end;
end;
end;
procedure TfMain.ImageClicked(Sender: TObject);
var
Info: PImageInfo;
begin
Info := #Images[(Sender as TImage).Tag];
// use Info as needed...
end;
I am trying to display a table using ShowMessage that looks like this:
short | Description for "short"
verylongtext | Description for "verylongtext"
How do I get two correctly aligned columns like that in a simple message dialog?
I tried to align the columns using spaces, but the font of ShowMessage is variable. Then I tried to align them using tab characters, but I do not know how to calculate the proper tab count for each row.
Is there a reliable way to calculate the tab count?
PS: I would like to avoid writing a custom dialog for this purpose.
You could use a list view in a custom dialog box, as well.
My class supports the standard Windows icons (and sounds): information, warning, error, confirmation, none. Here is the icon-less version:
It is easy to use:
TTableDialog.ShowTable
(
Self,
'Audio Properties',
['Duration', 'Samples per channel', 'Total data size', 'Channels', 'Bits per sample', 'Sample rate', 'Bitrate'],
['1 h 15 min 0 s', '216 000 000', '824 MB', '1', '32', '48 kHz', '1 536 kbit/sec'],
mtInformation
)
It supports DPI scaling (high DPI) and all Windows versions from Windows XP (it might work on Windows 2000 as well, I just haven't tested that) to Windows 10:
The table is a list view, so you get all its benefits, like a scrollbar, truncation ellipses, and tooltips:
You can also specify the dialog's size to make it fit the contents:
TTableDialog.ShowTable
(
Self,
'Audio Properties',
['Duration', 'Samples per channel', 'Total data size', 'Channels', 'Bits per sample', 'Sample rate', 'Bitrate', 'Maximum fractional sample value'],
['1 h 15 min 0 s', '216 000 000', '824 MB', '1', '32', '48 kHz', '1 536 kbit/sec', '0.1'],
mtInformation,
360,
240
)
Of course, the OK button is both Default and Cancel, so you can dismiss the dialog with Enter or Escape.
Finally, pressing Ctrl+C will copy the table to clipboard.
Full source code:
uses
ComCtrls, Math, Clipbrd;
type
TTableDialog = class
strict private
type TFormData = class(TComponent)
public
ListView: TListView;
IconKind: PWideChar;
Icon: HICON;
LIWSD: Boolean;
end;
class function Scale(X: Integer): Integer;
class procedure FormShow(Sender: TObject);
class procedure FormDestroy(Sender: TObject);
class procedure FormPaint(Sender: TObject);
class procedure FormKeyPress(Sender: TObject; var Key: Char);
class procedure LVToClipboard(AListView: TListView);
public
class procedure ShowTable(AOwner: TCustomForm; const ACaption: string;
const ANames, AValues: array of string;
ADialogType: TMsgDlgType = mtInformation;
const AWidth: Integer = 360; const AHeight: Integer = 200);
end;
class procedure TTableDialog.FormShow(Sender: TObject);
var
FormData: TFormData;
ComCtl: HMODULE;
LoadIconWithScaleDown: function(hinst: HINST; pszName: LPCWSTR; cx: Integer;
cy: Integer; var phico: HICON): HResult; stdcall;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
TForm(Sender).OnShow := nil;
FormData := TFormData(TForm(Sender).Tag);
if FormData.IconKind = nil then
Exit;
ComCtl := LoadLibrary('ComCtl32.dll');
if ComCtl <> 0 then
begin
try
LoadIconWithScaleDown := GetProcAddress(ComCtl, 'LoadIconWithScaleDown');
if Assigned(LoadIconWithScaleDown) then
FormData.LIWSD := Succeeded(LoadIconWithScaleDown(0, FormData.IconKind,
Scale(32), Scale(32), FormData.Icon));
finally
FreeLibrary(ComCtl);
end;
end;
if not FormData.LIWSD then
FormData.Icon := LoadIcon(0, FormData.IconKind);
end;
class procedure TTableDialog.FormDestroy(Sender: TObject);
var
FormData: TFormData;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
FormData := TFormData(TForm(Sender).Tag);
if (FormData.Icon <> 0) and FormData.LIWSD then
DestroyIcon(FormData.Icon);
end;
class procedure TTableDialog.FormKeyPress(Sender: TObject; var Key: Char);
var
FormData: TFormData;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
FormData := TFormData(TForm(Sender).Tag);
case Key of
^C:
LVToClipboard(FormData.ListView);
end;
end;
class procedure TTableDialog.FormPaint(Sender: TObject);
var
FormData: TFormData;
Frm: TForm;
Y: Integer;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
Frm := TForm(Sender);
FormData := TFormData(TForm(Sender).Tag);
Y := Frm.ClientHeight - Scale(25 + 8 + 8);
Frm.Canvas.Brush.Color := clWhite;
Frm.Canvas.FillRect(Rect(0, 0, Frm.ClientWidth, Y));
Frm.Canvas.Pen.Color := $00DFDFDF;
Frm.Canvas.MoveTo(0, Y);
Frm.Canvas.LineTo(Frm.ClientWidth, Y);
if FormData.Icon <> 0 then
DrawIconEx(Frm.Canvas.Handle, Scale(8), Scale(8), FormData.Icon,
Scale(32), Scale(32), 0, 0, DI_NORMAL);
end;
class procedure TTableDialog.LVToClipboard(AListView: TListView);
function GetRow(AIndex: Integer): string;
begin
if InRange(AIndex, 0, AListView.Items.Count - 1) and (AListView.Items[AIndex].SubItems.Count = 1) then
Result := AListView.Items[AIndex].Caption + #9 + AListView.Items[AIndex].SubItems[0]
else
Result := '';
end;
var
S: string;
i: Integer;
begin
if AListView = nil then
Exit;
S := GetRow(0);
for i := 1 to AListView.Items.Count - 1 do
S := S + sLineBreak + GetRow(i);
Clipboard.AsText := S;
end;
class function TTableDialog.Scale(X: Integer): Integer;
begin
Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;
class procedure TTableDialog.ShowTable(AOwner: TCustomForm; const ACaption: string;
const ANames, AValues: array of string;
ADialogType: TMsgDlgType = mtInformation;
const AWidth: Integer = 360; const AHeight: Integer = 200);
const
Sounds: array[TMsgDlgType] of Integer =
(MB_ICONWARNING, MB_ICONERROR, MB_ICONINFORMATION, MB_ICONQUESTION, 0);
Icons: array[TMsgDlgType] of MakeIntResource =
(IDI_WARNING, IDI_ERROR, IDI_INFORMATION, IDI_QUESTION, nil);
var
dlg: TForm;
lv: TListView;
btn: TButton;
i: Integer;
snd: Integer;
begin
if Length(ANames) <> Length(AValues) then
raise Exception.Create('The lengths of the columns don''t match.');
dlg := TForm.Create(AOwner);
try
dlg.BorderStyle := bsDialog;
dlg.Caption := ACaption;
dlg.Width := Scale(AWidth);
dlg.Height := Scale(AHeight);
dlg.Position := poOwnerFormCenter;
dlg.Scaled := False;
dlg.Font.Name := 'Segoe UI';
dlg.Font.Size := 9;
dlg.Tag := NativeInt(TFormData.Create(dlg));
TFormData(dlg.Tag).IconKind := Icons[ADialogType];
dlg.OnShow := FormShow;
dlg.OnDestroy := FormDestroy;
dlg.OnPaint := FormPaint;
dlg.OnKeyPress := FormKeyPress;
dlg.KeyPreview := True;
btn := TButton.Create(dlg);
btn.Parent := dlg;
btn.Caption := 'OK';
btn.Default := True;
btn.Cancel := True;
btn.ModalResult := mrOk;
btn.Width:= Scale(75);
btn.Height := Scale(25);
btn.Left := dlg.ClientWidth - btn.Width - Scale(8);
btn.Top := dlg.ClientHeight - btn.Height - Scale(8);
lv := TListView.Create(dlg);
TFormData(dlg.Tag).ListView := lv;
lv.Parent := dlg;
lv.DoubleBuffered := True;
lv.ReadOnly := True;
lv.BorderStyle := bsNone;
lv.Left := Scale(8) + IfThen(Icons[ADialogType] <> nil, Scale(32 + 8));
lv.Top := Scale(8);
lv.Width := dlg.ClientWidth - Scale(16) - IfThen(Icons[ADialogType] <> nil, Scale(32 + 8));
lv.Height := dlg.ClientHeight - Scale(16 + 8 + 4) - btn.Height;
lv.ViewStyle := vsReport;
lv.RowSelect := True;
lv.ShowColumnHeaders := False;
with lv.Columns.Add do
begin
Caption := 'Name';
Width := Scale(150);
end;
with lv.Columns.Add do
begin
Caption := 'Value';
Width := lv.ClientWidth - lv.Columns[0].Width -
GetSystemMetricsForWindow(SM_CXVSCROLL, dlg.Handle) - scale(2);
end;
for i := 0 to High(ANames) do
with lv.Items.Add do
begin
Caption := ANames[i];
SubItems.Add(AValues[i]);
end;
snd := Sounds[ADialogType];
if snd <> 0 then
MessageBeep(snd);
dlg.ShowModal;
finally
dlg.Free;
end;
end;
If you're not writing a custom dialog for this, when will you? It's not that hard. Just create a form, drop a TMemo on it and make that memo readonly. You can set a monospaced font like Courier New, and your problem is solved. You got the advantage of scrollbars and selection too, and you can choose to make it non-modal.
I would even recommend showing this type of data in a grid (like TStringGrid) instead of a memo or label.
Calculating how to display this text in a messagebox will require much more effort than just creating a custom dialog.
Just created something that shows a popup like this:
Just call the procedure below, and add a TStringList as a parameter.
Of course you could pimp this by using a TListView, icons, scrollbars, etc.
Put it in a separate unit, and you'll always be able to easily show stuff like this.
uses ..., StdCtrls, ExtCtrls;
procedure ShowTablePopup(SL:TStringList);
var
LButtonOK: TButton;
LMemo: TMemo;
LPanel: TPanel;
LForm: TForm;
begin
LForm := TForm.Create(Application);
LMemo := TMemo.Create(LForm);
LPanel := TPanel.Create(LForm);
LButtonOK := TButton.Create(LForm);
LForm.Left := 0;
LForm.Top := 0;
LForm.Caption := 'Values';
LForm.ClientHeight := 250;
LForm.ClientWidth := 400;
LMemo.Parent := LForm;
LMemo.AlignWithMargins := True;
LMemo.Left := 3;
LMemo.Top := 3;
LMemo.Width := 295;
LMemo.Height := 226;
LMemo.Align := alClient;
LMemo.Font.Name := 'Courier New';
LMemo.Lines.Assign(SL);
LPanel.Parent := LForm;
LPanel.Caption := '';
LPanel.Left := 0;
LPanel.Top := 232;
LPanel.Width := 301;
LPanel.Height := 37;
LPanel.Align := alBottom;
LPanel.BevelOuter := bvNone;
LButtonOK.Parent := LPanel;
LButtonOK.AlignWithMargins := True;
LButtonOK.Left := 223;
LButtonOK.Top := 3;
LButtonOK.Width := 75;
LButtonOK.Height := 31;
LButtonOK.Align := alRight;
LButtonOK.Caption := '&OK';
LButtonOK.ModalResult := mrOk;
LButtonOK.Default := True;
LForm.ShowModal;
end;
Example on how to use it:
var
SL:TStringList;
begin
SL := TStringList.Create;
try
SL.Add('short | Description for "short"');
SL.Add('verylongtext | Description for "verylongtext"');
ShowTablePopup(SL);
finally
SL.Free;
end;
end;
I found this code over the net. This puts background color to the selected texts on Trichedit:
uses
RichEdit;
procedure RE_SetSelBgColor(RichEdit: TRichEdit; AColor: TColor);
var
Format: CHARFORMAT2;
begin
FillChar(Format, SizeOf(Format), 0);
with Format do
begin
cbSize := SizeOf(Format);
dwMask := CFM_BACKCOLOR;
crBackColor := AColor;
Richedit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(#Format));
end;
end;
// Example: Set clYellow background color for the selected text.
procedure TForm1.Button1Click(Sender: TObject);
begin
RE_SetSelBgColor(RichEdit1, clYellow);
end;
However, what I need is to exclude space characters. Can someone help me? Any idea would be helpful?
My idea would be to select all space characters and then format it but then I don't know how to select them.
By the way, I am using delphi 2009.
#junmats, with this code you can select any word in a richedit control.
tested in Delphi 2010 and windows 7
uses
RichEdit;
procedure SetWordBackGroundColor(RichEdit : TRichEdit; aWord : String;AColor: TColor);
var
Format: CHARFORMAT2;
Index : Integer;
Len : Integer;
begin
FillChar(Format, SizeOf(Format), 0);
Format.cbSize := SizeOf(Format);
Format.dwMask := CFM_BACKCOLOR;
Format.crBackColor := AColor;
Index := 0;
Len := Length(RichEdit.Lines.Text) ;
Index := RichEdit.FindText(aWord, Index, Len, []);
while Index <> -1 do
begin
RichEdit.SelStart := Index;
RichEdit.SelLength := Length(aWord) ;
RichEdit.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(#Format));
Index := RichEdit.FindText(aWord,Index + Length(aWord),Len, []) ;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetWordBackGroundColor(RichEdit1,' ',clYellow);// will mark all spaces
end;
if you wanna select all words except the spaces, you can do something like this
Procedure GetListofWords(Text : String; var ListofWords : TStringList);
var
DummyStr : String;
FoundWord : String;
begin
DummyStr := Text;
FoundWord := '';
if (Length(Text) = 0) then exit;
while (Pos(' ', DummyStr) > 0) do
begin
FoundWord := Copy(DummyStr, 1, Pos(' ', DummyStr) - 1);
ListofWords.Add(FoundWord);
DummyStr := Copy(DummyStr, Pos(' ', DummyStr) + 1, Length(DummyStr) - Length(FoundWord) + 1);
end;
if (Length(DummyStr) > 0) then
ListofWords.Add(DummyStr);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ListofWords : TStringList;
i : integer;
begin
ListofWords:=TStringList.Create;
try
GetListofWords(RichEdit1.Lines.Text,ListofWords);
if ListofWords.Count>0 then
for i:=0 to ListofWords.Count - 1 do
SetWordBackGroundColor(RichEdit1,ListofWords[i],clYellow);
finally
ListofWords.Clear;
ListofWords.Free;
end;
end;