Directory TreeView in Delphi FMX - delphi

I made a directory TreeView in Delphi FMX, but when I expand 'C:\Windows\WinSxS' it contains 15000 folders. It took a lot of time, but it doesn't expand. On the other hand, when I tried to do it with a VCL TreeView, it worked fine, as it should. Is there any way to make it fast?
Here is my code:
function SlashSep(const Path, S: String): String;
begin
{$IF DEFINED(CLR)}
if Path[Length(Path)] <> '\' then
{$ELSE}
if AnsiLastChar(Path)^ <> '\' then
{$ENDIF}
Result := Path + '\' + S
else
Result := Path + S;
end;
procedure GetDir(const ParentDirectory: string; ParentItem: TTreeViewItem);
var
Status: Integer;
SearchRec: TSearchRec;
Node: TTreeViewItem;
begin
Status := FindFirst(SlashSep(ParentDirectory, '*.*'), faDirectory, SearchRec);
try
while Status = 0 do
begin
if (SearchRec.Attr and faDirectory = faDirectory) then
begin
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
Node := AddChild(ParentItem,ExtractFileName(SearchRec.Name));
Node.HasChildren := True;
end;
end;
Status := FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
end;
procedure TForm1.ItemOnExpanding(Sender: TObject; Node: TTreeViewItem);
var
i: Integer;
begin
for i := Node.Count - 1 downto 0 do
TreeView1.RemoveObject(Node.Items[i]);
Node.BeginUpdate;
GetDir(GetPathItem(node),node);
Node.EndUpdate;
end;
It's expanding from here:
procedure TCustomTreeView.ItemExpanded(const Item: TTreeViewItem);
var
I: Integer;
Child: TTreeViewItem;
AllowExpansion: Boolean;
begin
InvalidateGlobalList;
if Item.IsExpanded then
for I := 0 to Item.Count - 1 do
begin
Child := Item.Items[I];
if not Child.IsInflated then
Child.Inflate;
end;
RealignContent;
//end;
if Assigned(FOnExpanding) then
if Item.IsExpanded then
FOnExpanding(Self, Item, AllowExpansion)
else
if Assigned(FOnCollapsing) then
if not Item.IsExpanded then
FOnCollapsing(Self, Item, AllowExpansion)
end;

Related

Memo lines to TreeView

Good night friends,
I'm currently working on a project that involves enumeration of visible windows and their descendents (also visible).
And I can transfer all nodes of TreeView for a Memo (in text format) one by one, but now I'm trying to do the opposite (of necessity of the project).
Someone could help me with this here in StackOverflow?
Here is all the code that lists the windows on TreeView and after transfers it to one Memo.
function GetWindowTitle(hwnd: HWND): string;
begin
SetLength(Result, 255);
SetLength(Result, GetWindowText(hwnd, PChar(Result), 255));
end;
function GetWindowClass(hwnd: HWND): string;
begin
SetLength(Result, 255);
SetLength(Result, GetClassName(hwnd, PChar(Result), 255));
end;
function GetWindowInfo(hwnd: HWND): string;
begin
Result := GetWindowTitle(hwnd) + ' [' + GetWindowClass(hwnd) +
'] (' + {IntToStr}IntToHex(hwnd, 8) + ')';
end;
function EnumChildProc(hwnd: HWND; lParam: Integer): BOOL; stdcall;
var
NewNode, ParentNode: TTreeNode;
begin
Result := True;
ParentNode := TTreeNode(lParam);
if IsWindowVisible(hwnd) then
NewNode := ParentNode.Owner.AddChild(ParentNode,
GetWindowInfo(hwnd));
EnumChildWindows(hwnd, #EnumChildProc, Integer(NewNode));
end;
function EnumWindowsProc(hwnd: HWND; lParam: Integer): BOOL; stdcall;
var
NewNode: TTreeNode;
begin
Result := True;
if IsWindowVisible(hwnd) then
NewNode := TTreeView(lParam).Items.Add(nil, GetWindowInfo(hwnd));
EnumChildWindows(hwnd, #EnumChildProc, Integer(NewNode));
end;
procedure EnumWindowsTree(Tree: TTreeView);
begin
EnumWindows(#EnumWindowsProc, Integer(Tree));
end;
// Listing all windows in TreeView
procedure TForm2.Button1Click(Sender: TObject);
begin
TreeView1.Items.Clear;
EnumWindowsTree(TreeView1);
end;
//Tranfers all nodes of TreeView for a Memo (one by one)
procedure TForm2.Button3Click(Sender: TObject);
var I,P,Cnt : Integer;
ParentNode, ChildNode: TTreeNode;
begin
P := 65;
ParentNode := TreeView1.Items[0];
While ParentNode<>nil do
begin
if (ParentNode <> nil) then
begin
Memo1.Lines.Add(ParentNode.Text);
Cnt := 1;
ChildNode := ParentNode.GetFirstChild;
while (ChildNode <> nil) do
begin
Memo1.Lines.Add(ChildNode.Text);
if ChildNode.HasChildren then
begin
ParentNode:= ChildNode.GetFirstChild;
break;
end;
ChildNode := ChildNode.GetNextSibling;
Inc(Cnt);
end;
end;
if ChildNode=nil then
begin
if ParentNode.GetNextSibling<>nil then
ParentNode:=ParentNode.GetNextSibling
else
begin
while ParentNode.GetNextSibling=nil do
begin
if ParentNode.Parent<>nil then ParentNode:=ParentNode.Parent else break;
end;
if ParentNode<>nil then ParentNode:=ParentNode.GetNextSibling;
end;
end;
Inc(P);
end;
end;
It would better to use inbuilt methods of TreeView contents storing:
// Tranfers all nodes of TreeView for a Memo (one by one)
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
try
TreeView1.SaveToStream(MS);
MS.Position := 0;
Memo1.Lines.LoadFromStream(MS);
finally
Ms.Free;
end;
end;
// Tranfers all nodes to TreeView from a Memo
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
try
Memo1.Lines.SaveToStream(MS);
MS.Position := 0;
TreeView1.LoadFromStream(MS);
finally
Ms.Free;
end;
end;
Note that unnamed windows break formatting needed for correct restoring, so I've changed string format a bit: '.[' instead of space.
function GetWindowInfo(hwnd: HWND): string;
begin
Result := GetWindowTitle(hwnd) + '.[' + GetWindowClass(hwnd) + '] (' +
{ IntToStr } IntToHex(hwnd, 8) + ')';
end;

How can read in pictures and view them using a button Delphi

I know how to load and view one picture in delphi. However I would like to add a 'next image' button that brings up the next image in the file. I have 5 images in a file and i would like to scroll through them easily using a next button! I have tried to make the next button, But have no idea what code to put in!
Please help thanks.
Gpath is a global string variable.
procedure TPropertyForm.FormCreate(Sender: TObject);
begin
GPath := getcurrentdir + '\EmployeePhotos\';
EmployeeOpenPictureDialog.InitialDir := getcurrentdir + '\EmployeePhotos';
end;
procedure TPropertyForm.AttatchButtonClick(Sender: TObject);
var
st: string;
fsize, psize: integer;
begin
if EmployeeOpenPictureDialog.execute then
begin
st := EmployeeOpenPictureDialog.FileName;
psize := length(GPath);
fsize := length(st);
Properties.Photo := copy(st, psize + +1, fsize - psize)
end { endif };
PhotoImage.Hide;
if Properties.Photo <> '' then
begin
st := GPath + Properties.Photo;
if FileExists(st) then
begin
PhotoImage.Picture.LoadFromFile(st);
PhotoImage.Proportional := true;
PhotoImage.Show;
end
{ endif }
end; { endif }
end
procedure TPropertyForm.NextImageButtonClick(Sender: TObject);
begin
PhotoImage.Picture.LoadFromFile(st + 1);
end;
i think you want to load images from "Folder" and switch between them, if so try this code
place 2 TButtons and 1 TImage
uses jpeg;
public
{ Public declarations }
var
SL:TStringList;
ImgIndex:integer;
GPath:String;
procedure ListFileDir(Path: string; FileList: TStrings);
var
SR: TSearchRec;
begin
if FindFirst(Path + '*.jpg', faAnyFile, SR) = 0 then
begin
repeat
if (SR.Attr <> faDirectory) then
begin
FileList.Add(SR.Name);
end;
until FindNext(SR) <> 0;
FindClose(SR);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
GPath:= getcurrentdir + '\EmployeePhotos\';
SL:=TStringList.Create;
ListFileDir(GPath,SL);
Image1.Picture.LoadFromFile(GPath + SL.Strings[ImgIndex] );
end;
procedure TForm1.btnNextClick(Sender: TObject);
begin
ImgIndex:=ImgIndex+1;
if ImgIndex=SL.Count then ImgIndex :=0;
Image1.Picture.LoadFromFile(GPath + SL.Strings[ImgIndex] );
end;
procedure TForm1.btnPrevClick(Sender: TObject);
begin
ImgIndex:=ImgIndex-1;
if ImgIndex=-1 then ImgIndex :=SL.Count-1;
Image1.Picture.LoadFromFile(GPath + SL.Strings[ImgIndex] );
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
SL.Free;
end;

Delphi components install utility console application

Well I'm stumped.
I'm writing an installation support add-on for Smart Install Maker that will install some components for me- AlphaControls :)
And the add-on is a console application. But for some reason [down in the code] for adding packages to the "Known Packages" registry location, it wants to add an additional registry entry, even though the array size is only setup for 3. It's trying to add a .DPK file, even though the array is setup for .BPL. Soo... what the hell????
It works and all, except for that last nagging bit it tries to add.
Compile size is about 97/98k, after optimizing and compressing shrinks down to about 48k
So I guess my question is, can anyone spot the error I seem to be overlooking?
YES I KNOW- INNO SETUP, but... I've already spent the money on Smart Install Maker so I gotta use it.
No compile errors, justs adds an extra non .bpl file to registry
Code is as follows...
{Smart Install Maker installation support for components}
{for Delphi 7.0 environment only}
program pakghlp;
{$APPTYPE CONSOLE}
uses
Windows,
SysUtils,
Classes,
Registry;
var SPath,
BPLPath,
IDERoot,
DPKName: string;
const
BaseName = 'AlphaControls';
PackageRoot = 'AlphaControls\';
DPKFiles: array[1..5]
of string = ('acntD7_R.dpk',
'acntD7.dpk',
'aceD7_R.dpk',
'aceD7.dpk',
'AlphaDB7.dpk');
DPKArraySize = 5;
BPLFiles: array[1..3]
of string = ('aceD7.bpl',
'acntD7.bpl',
'AlphaDB7.bpl');
BPLDetails: array[1..3]
of string = ('AlphaControls extra',
'AlphaControls',
'AlphaControls DB-aware pack');
BPLFileQty = 3;
LookFor: array[1..2] of string = ('*.dcp','*.bpl');
LookForQty = 2;
RegPath = ';$(DELPHI)\Components\AlphaControls';
procedure InitVariables;
var
RegKey: TRegistry;
TargetKey: string;
LibPath: string;
begin
RegKey:= TRegistry.Create;
try
RegKey.RootKey := HKEY_CURRENT_USER;
TargetKey:= 'Software\Borland\Delphi\7.0';
if RegKey.OpenKeyReadOnly(TargetKey) then
begin
IDERoot:= RegKey.ReadString('RootDir');
RegKey.CloseKey;
TargetKey:= 'Software\Borland\Delphi\7.0\Library';
RegKey.OpenKeyReadOnly(TargetKey);
SPath:= RegKey.ReadString('Search Path');
LibPath:= RegKey.ReadString('Package DPL Output');
RegKey.CloseKey;
LibPath:= StringReplace(LibPath,'$(DELPHI)','',[rfIgnoreCase]);
BPLPath:= IDERoot + LibPath + '\';
end;
finally
RegKey.Free;
end;
end;
procedure GetListing(const SearchFor: String; ImportList:TStringList);
var SrchResult : TSearchRec;
begin
if FindFirst(SearchFor, faAnyFile, SrchResult) = 0 then
begin
repeat
ImportList.Add(SrchResult.name);
until FindNext(SrchResult) <> 0;
FindClose(SrchResult);
end;
end;
procedure GetBaseNames(Listing: TStringList);
var TempList: TStringList;
i: integer;
BaseName: string;
begin
TempList:= TStringList.Create;
TempList.Delimiter:= ';';
TempList.DelimitedText:= SPath;
Listing.Clear;
for i:= 0 to TempList.Count - 1 do
begin
BaseName:= TempList[i];
StringReplace(BaseName,'$(DELPHI)','X:\Dummy\Folder',[rfIgnoreCase]);
Listing.Add(ExtractFileName(BaseName));
end;
TempList.Free;
end;
function AlreadyExists: boolean;
var CheckList: TStringList;
i: integer;
Installed: boolean;
begin
CheckList:= TStringList.Create;
GetBaseNames(CheckList);
for i:= 0 to CheckList.Count -1 do
begin
if CheckList[i] = BaseName
then Installed:= true;
if Installed = true then break;
Installed:= false;
end;
CheckList.Free;
Result:= Installed;
end;
procedure ProcessIDE(InstallType: integer);
var RegKey: TRegistry;
TempList: TStringList;
i,j: integer;
NewSPath,
RegName,
RegValue,
DelEntry: string;
begin
RegKey:= TRegistry.Create;
case InstallType of
0: begin {-uninstall}
TempList:= TStringList.Create;
TempList.Delimiter:= ';';
TempList.DelimitedText:= SPath;
DelEntry:= copy(RegPath,2,Length(RegPath));
for i:= 0 to TempList.Count - 1 do
begin
if TempList[i] = DelEntry
then
begin
Templist.BeginUpdate;
Templist.Delete(i);
TempList.EndUpdate;
end;
end;
NewSPath:= TempList.DelimitedText;
try
RegKey.RootKey:= HKEY_CURRENT_USER;
RegKey.OpenKey('Software\Borland\Delphi\7.0\Library',false);
RegKey.WriteString('Search Path',NewSPath);
RegKey.CloseKey;
RegKey.OpenKey('Software\Borland\Delphi\7.0\Known Packages',false);
for i:= 0 to BPLFileQty do
begin
RegName:= BPLPath + BPLFiles[i];
RegKey.DeleteValue(RegName);
end;
finally
RegKey.CloseKey;
end;
TempList.Free;
end;
1: begin {-install}
SPath:= SPath + RegPath;
try
RegKey.RootKey:= HKEY_CURRENT_USER;
RegKey.OpenKey('Software\Borland\Delphi\7.0\Library',false);
RegKey.WriteString('Search Path',SPath);
RegKey.CloseKey;
RegKey.OpenKey('Software\Borland\Delphi\7.0\Known Packages',false);
for j:= 0 to BPLFileQty do
begin
RegName:= BPLPath + BPLFiles[j];
RegValue:= BPLDetails[j];
RegKey.WriteString(RegName,RegValue);
end;
finally
RegKey.CloseKey;
end;
end;
end;
RegKey.Free;
end;
procedure CompilePackage(PackageName: String; Wait: Boolean);
var
StartInfo : TStartupInfo;
ProcInfo : TProcessInformation;
CreateOK : Boolean;
begin
FillChar(StartInfo,SizeOf(TStartupInfo),#0);
FillChar(ProcInfo,SizeOf(TProcessInformation),#0);
StartInfo.cb := SizeOf(TStartupInfo);
CreateOK := CreateProcess(nil, PChar(PackageName), nil, nil,False,
CREATE_NEW_PROCESS_GROUP+NORMAL_PRIORITY_CLASS,
nil, nil, StartInfo, ProcInfo);
if CreateOK then
begin
if Wait then
WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end
else
begin
WriteLN('Unable to compile: ' + DPKName);
end;
CloseHandle(ProcInfo.hProcess);
CloseHandle(ProcInfo.hThread);
end;
procedure ProcessPackages;
var Package: string;
i: integer;
const DCC32 = 'DCC32 ';
begin
for i:= 1 to DPKArraySize do
begin
DPKName:= ExpandFileName(GetCurrentDir + '\..')
+ '\' + PackageRoot + DPKFiles[i];
Package:= DCC32 + '"' + DPKName + '"';
CompilePackage(Package,true);
Sleep(500);
end;
end;
procedure ProcessFiles(InstallType: integer);
var TempList: TStringList;
MoveList: TextFile;
i,j: integer;
FileFrom,
FileTo,
ParentDir,
SearchType: string;
begin
case InstallType of
0: begin {-uninstall}
AssignFile(MoveList,'pakghlp.dat');
Reset(MoveList);
while not eof(MoveList) do
begin
readLn(MoveList,FileFrom);
if FileExists(FileFrom)
then DeleteFile(PChar(FileFrom));
end;
CloseFile(MoveList);
DeleteFile(PChar('pakghlp.dat'));
end;
1: begin {-install}
ProcessPackages;
if FileExists('pakghlp.dat') then DeleteFile(PChar('pakghlp.dat'));
AssignFile(MoveList,'pakghlp.dat');
Rewrite(MoveList);
ParentDir:= ExpandFileName(GetCurrentDir + '\..') + '\';
TempList:= TStringList.Create;
for i:= 1 to LookForQty do // file extension types
begin
SearchType:= ParentDir + PackageRoot + LookFor[i];
GetListing(SearchType,TempList);
for j:= 0 to Templist.Count - 1 do
begin
FileFrom:= ParentDir + PackageRoot + TempList[j];
FileTo:= BPLPath + TempList[j];
CopyFile(PChar(FileFrom),PChar(FileTo),False);
DeleteFile(PChar(FileFrom));
WriteLn(MoveList,FileTo);
end;
end;
CloseFile(MoveList);
end;
end;
TempList.Free;
end;
procedure InstallComponents;
begin
InitVariables;
if AlreadyExists then ProcessFiles(1) // refresh corrupt .dcu's.
else
begin // didn't previously exist
ProcessFiles(1);
ProcessIDE(1);
end;
end;
procedure RemoveComponents;
begin
InitVariables;
ProcessFiles(0);
ProcessIDE(0);
end;
{ ----- Console Application Begins Here ------- }
begin
if ParamCount = 0 then exit;
if ParamStr(1) = '-install'
then InstallComponents;
if ParamStr(1) = '-uninstall'
then RemoveComponents
else exit; // garbage trap
end.
You issue it seems related to the index used to iterate over the BPLFiles array. which is 1 index based and you are using a 0 index based.
const
BPLFiles: array[1..3]
of string = ('aceD7.bpl',
'acntD7.bpl',
'AlphaDB7.bpl');
Chage this code
for i:= 0 to BPLFileQty do
begin
RegName:= BPLPath + BPLFiles[i];
RegKey.DeleteValue(RegName);
end;
To
for i:= 1 to BPLFileQty do
begin
RegName:= BPLPath + BPLFiles[i];
RegKey.DeleteValue(RegName);
end;
And this code
for j:= 0 to BPLFileQty do
begin
RegName:= BPLPath + BPLFiles[j];
RegValue:= BPLDetails[j];
RegKey.WriteString(RegName,RegValue);
end;
To
for j:= 1 to BPLFileQty do
begin
RegName:= BPLPath + BPLFiles[j];
RegValue:= BPLDetails[j];
RegKey.WriteString(RegName,RegValue);
end;

How can I get all installed components inside IDE? (Delphi)

How can I get all installed components in TStrings?
I think this code work only within packages:
uses TypInfo, ToolIntf, Exptintf;
procedure GetComponentNames(lst: TStrings);
var
i, k: Integer;
CRef: TClass;
strName: ShortString;
begin
lst.Clear;
for i := 0 to ToolServices.GetModuleCount-1 do
begin
for k := 0 to ToolServices.GetComponentCount(i)-1 do
begin
CRef := TClass(GetClass(ToolServices.GetComponentName(i, k)));
while CRef <> nil do
begin
strName := CRef.ClassName;
if lst.IndexOf(strName) = -1 then
lst.Add(strName);
if str <> 'TComponent' then
CRef := CRef.ClassParent
else
CRef := nil;
end;
end;
end;
end;
Or:
uses ToolsApi;
{....}
var
a, i: Integer;
begin
with (BorlandIDEServices as IOTAPackageServices) do
begin
for a := 0 to GetPackageCount - 1 do
begin
for i := 0 to GetComponentCount(a) - 1 do
begin
{get each component name with GetComponentName(a, i);}
// DoSomething
end;
end;
end;
end;
Thanks for help.
This example doesn't use the OpenAPI, it uses the Registry. It works but it also lists non-visual components amongst other hidden items.
procedure GetComponentNames(lst: TStrings);
var
i, j, iPos: Integer;
Reg: TRegistry;
sComponent: String;
slValues, slData: TStrings;
begin
Reg := TRegistry.Create;
slValues := TStringList.Create;
slData := TStringList.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
Reg.OpenKey('Software\Borland\Delphi\6.0\Palette', False); // Change reg key where appropriate
Reg.GetValueNames(slValues);
for i := 0 to Pred(slValues.Count) do
begin
lst.Append(slValues[i]);
lst.Append('----------');
slData.Delimiter := ';';
slData.DelimitedText := Reg.ReadString(slValues[i]);
for j := 0 to Pred(slData.Count) do
begin
sComponent := slData[j];
iPos := Pos('.', sComponent);
if (iPos > 0) then
Delete(sComponent, 1, iPos);
lst.Append(sComponent);
end;
end;
finally
slData.Free;
slValues.Free;
Reg.Free;
end; {try..finally}
end;
I'm not saying this is ideal but it does give you a list and a headstart.

delphi TRichEdit Set background color excluding spaces

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;

Resources