- 博客(0)
- 资源 (22)
- 收藏
- 关注
RSS订阅动态创建窗体如何相互通讯3
动态创建窗体如何相互通讯
这做的是一个像WINDOWS资源管理器
一个RTF文件管理器
描述
Form2,Form3,Form4都是独立存在的,同时完成独立的功能,相互不依赖。
最后把Form2,Form3,Form4集合放在FORM1上,实际上需要这3个的窗体Form2,Form3,Form4间相互得到改变后的变量值。
FORM2 文件夹列表
在FORM1中设置一初始文件夹路径
要实现的功能：当单击本窗体中的TreeView.node时，要求Form3.ListView的文件列表同时更新。
FORM3 文件列表
需要得到Form2当前选中的文件夹路径
要实现的功能：当本窗体中的ListView选中一个节点时时，同时Form4.RichtextBox 打开并读取这个文件。
FORM4是一个RFT编辑器
需要得到FORM3 文件列表中选中的文件完整路径
要实现的功能：当单击本窗体中的保存按钮，要保存Form3.ListView中选中的那个文件。
2013-11-27
DELPHI TXT 树文档 管理器
unit TreeViewFunctions;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, ComCtrls, Controls, Forms,
FileCtrl, StrUtils, Masks, Vcl.OleCtrls, SHDocVw, IOUtils;
procedure SaveTreeViewExplandState(TreeView: TTreeView; FileName: string);
procedure LoadTreeViewExplandState(TreeView: TTreeView; FileName: string);
function ExtractNewFolderPath(FileName: string; NewText: string): string;
procedure HideHideHorizontalScrollBar(TreeView: TTreeView);
function IsEmptyDir(sDir: String): Boolean;
function AttachMentsExists(FileName: String): Boolean;
procedure SetIcons(TreeView: TTreeView; list: TStringList);
procedure EnumText(s: string; aItem: TTreeNode);
function AttachmentsFolder(FileName: String): string;
function ExtractNodeFullPath(TreeView: TTreeView): string;
function Get_node_path(node: TTreeNode): string;
function ExtractTreeViewFileName(RootPath: string; TreeView: TTreeView): string;
///
/// Node.Selected := true; Node.Focused := true;
///
///
/// Node.Selected := true; Node.Focused := true;
///
///
/// Node.Selected := true; Node.Focused := true;
///
function OpenFile(Path: string; RichEdit: TRichEdit; TreeView: TTreeView)
: Boolean; overload;
function OpenFile(Path: string; Webbrowser: TWebbrowser; TreeView: TTreeView)
: Boolean; overload;
procedure GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode;
IncludeFiles: Boolean);
procedure DirToTreeView(Tree: TTreeView; Directory: string; Root: TTreeNode;
IncludeFiles: Boolean; FileExt: string);
procedure QSetPerpoty(TreeView: TTreeView);
function ItemExist(Text: string; TreeView: TTreeView): Boolean;
function RemoveDirs(folderPath: string): Boolean;
function __RenameFile(OldName: string; Title: string): Boolean;
function RenameFolder(filePath: string; Title: string): Boolean;
var
list: TStringList;
implementation
{
// "D:\C++Builder学习大全中文版\index.htm"
// "D:\C++Builder学习大全中文版\"
// "index_files"
// "D:\C++Builder学习大全中文版\index_files"
var
s, s1, s2: string;
begin
s := 'D:\C++Builder学习大全中文版\index.htm';
s1:=ExtractNewFolderPath(s,'_files');
s2 := ExtractNewFolderPath(s, '_AttachMents');
Memo1.lines.Add(s);
Memo1.Lines.Add(s1);
Memo1.lines.Add(s2);
end;
}
function ExtractNewFolderPath(FileName: string; NewText: string): string;
var
_filesFolder: string; // "D:\C++Builder学习大全中文版\"
_filesFolderName: string; // "index_files"
_filesFolderPath: String;
begin
_filesFolder := ExtractFilePath(FileName);
_filesFolderName := ChangeFileExt(ExtractFileName(FileName), '') + NewText;
_filesFolderPath := _filesFolder + _filesFolderName;
Result := _filesFolderPath;
end;
{
SaveTreeViewExplandState(TreeView1,'TreeView.txt');
}
procedure SaveTreeViewExplandState(TreeView: TTreeView; FileName: string);
var
list: TStringList;
i: Integer;
begin
list := TStringList.Create;
With TreeView do
begin
for i := 0 to Items.Count - 1 do
begin
if Items.Item[i].Expanded then
list.Add(IntToStr(i));
end;
list.Add(IntToStr(Selected.AbsoluteIndex));
end;
list.SaveToFile(FileName);
list.free;
end;
{
LoadTreeViewExplandState(TreeView1, 'abc.txt');
}
procedure LoadTreeViewExplandState(TreeView: TTreeView; FileName: string);
var
list: TStringList;
i: Integer;
node: TTreeNode;
begin
list := TStringList.Create;
with list do
begin
list.LoadFromFile(FileName);
for i := 0 to Count - 2 do // 最后一行放的是最后选中的那个节点索引
begin
TreeView.Items[StrToInt(list[i])].Expand(False);
end;
node := TreeView.Items[StrToInt(list[Count - 1])];
TreeView.Select(TreeView.Items[StrToInt(list[Count - 1])], []);
// node.Selected := True;
// node.Focused := True;
TreeView.SetFocus;
TreeView.Focused;
free;
end;
end;
{
FUNCTION ulong ShowScrollBar(ulong hwnd,ulong wBar,ulong bShow) LIBRARY "user32.dll"
constant long SB_HORZ = 0
constant long SB_VERT = 1
constant long SB_BOTH = 3
}
procedure HideHideHorizontalScrollBar(TreeView: TTreeView);
begin
// no responed NEW FORM TEST
// ShowScrollBar(TreeView.Handle,SB_HORZ,False);
end;
// procedure
// begin
// { 当拖拽的高度不够的时候自动滚动滚动条 }
// with TreeView1 do
// begin
// if (Y < 15) then
// SendMessage(Handle, WM_VSCROLL, SB_LINEUP, 0)
// else if (Height - Y < 15) then
// SendMessage(Handle, WM_VSCROLL, SB_LINEDOWN, 0);
// end;
// end;
{
返回 附件文件夹
"D:\C++Builder学习大全中文版\新建文本文档.htm"
D:\C++Builder学习大全中文版\新建文本文档_Attachments
}
function AttachmentsFolder(FileName: String): string;
begin
Result := ExtractFilePath(FileName) + ChangeFileExt(ExtractFileName(FileName),
'') + '_Attachments';
end;
function AttachMentsExists(FileName: String): Boolean;
var
f: string;
begin
f := ExtractFilePath(FileName) + ChangeFileExt(ExtractFileName(FileName), '')
+ '_Attachments';
Result := DirectoryExists(f);
end;
procedure EnumText(s: string; aItem: TTreeNode);
var
node: TTreeNode;
str: string;
begin
node := aItem;
while node nil do
begin
if s = '' then
str := node.Text
else
str := s + '\' + node.Text;
list.Add(str);
/// //////////////////////////
if node.HasChildren then
EnumText(str, node.getFirstChild);
node := node.getNextSibling;
end;
end;
function IsEmptyDir(sDir: String): Boolean;
var
sr: TSearchRec;
begin
Result := True;
if Copy(sDir, Length(sDir) - 1, 1) '\' then
sDir := sDir + '\';
if FindFirst(sDir + '*.*', faAnyFile, sr) = 0 then
repeat
if (sr.Name '.') and (sr.Name '..') then
begin
Result := False;
break;
end;
until FindNext(sr) 0;
FindClose(sr);
end;
{
是文件 夹的设置为1
是文件 的设置为 2
}
procedure SetIcons(TreeView: TTreeView; list: TStringList);
var
i: Integer;
begin
with TreeView do
begin
for i := 0 to Items.Count - 1 do
begin
if DirectoryExists(list.Strings[i]) then
begin
Items[i].ImageIndex := 0;
Items[i].SelectedIndex := 0;
Items[i].StateIndex := 0;
end;
if FileExists(list.Strings[i]) then
begin
Items[i].ImageIndex := 1;
Items[i].SelectedIndex := 1;
Items[i].StateIndex := 1;
end;
if (AttachMentsExists(list.Strings[i])) then
if not IsEmptyDir(AttachmentsFolder(list.Strings[i])) then
begin
// Form1.Memo1.LINES.Add( AttachmentsFolder(list.Strings[i]));
Items[i].ImageIndex := 2;
Items[i].SelectedIndex := 2;
Items[i].StateIndex := 2;
end;
end;
end;
end;
procedure QSetPerpoty(TreeView: TTreeView);
begin
with TreeView do
begin
// Align := alBottom;
// Anchors := [akLeft, akTop, akBottom, akRight];
Items.Clear;
// BorderStyle := bsNone;
Cursor := crHandPoint;
ReadOnly := True;
ShowHint := True;
RowSelect := True;
ShowButtons := True;
ShowRoot := True;
ShowLines := False;
SortType := stText;
HideSelection := False;
RightClickSelect := True;
DragMode := dmAutomatic;
// Color := RGB(238, 243, 246);
end;
end;
{
实际重命名
C:\windows\test.txt
C:\windows\csadsajas.txt
MoveFile(PChar('C:\1.txt'),PChar('C:\ABC.txt'));
if not __RenameFile('C:\tree.txt','TreeView') then
Application.MessageBox('重命名文件失败','重命名',MB_ICONERROR);
}
{ 重命名文件 }
function __RenameFile(OldName: string; Title: string): Boolean;
var
NewName: string;
begin
NewName := Format('%s%s%s', [ExtractFilePath(OldName), Title,
ExtractFileExt(OldName)]);
Result := MoveFile(PChar(OldName), PChar(NewName));
end;
// 重命名文件夹
// RenameFolder('C:\1\','2');
// MoveFile('C:\1','C:\2');
// MoveFile('C:\1\','C:\2\');
function RenameFolder(filePath: string; Title: string): Boolean;
var
s, s1: string;
begin
// filePath:='C:\Windows\System32\';
// s = ExtractFileDir(filepath) = 'C:\Windows\System32'
s := ExtractFileDir(filePath);
// s1 = ExtractFileDir(s) = 'C:\Windows'
// s1 ='C:\Windows' +'\'+ titles
s1 := ExtractFileDir(s) + '\' + Title;
Result := MoveFile(PChar(s), PChar(s1));
end;
{
IOUtils
}
function RemoveDirs(folderPath: string): Boolean;
begin
Result := False;
if TDirectory.IsEmpty(folderPath) then
begin
TDirectory.Delete(folderPath);
Result := True;
end
else
begin
if Application.MessageBox('确定要删除这个文件夹吗? 删除后无法恢复！', '提示',
MB_ICONQUESTION + MB_YESNO) = ID_YES then
begin
TDirectory.Delete(folderPath, True);
Result := True;
end;
end;
// if TDirectory.Exists(folderPath) then
// begin
// Application.MessageBox('删除文件失败'+#13#10+'文件正确被使用?','错误',MB_ICONERROR+MB_OK);
// Result:=False;
// end;
end;
{
if not ItemExist('Edit1.Text',TreeView1) then
TreeView1.Items.AddChild(Treeview1.Selected,'Edit1.Text');
}
function ItemExist(Text: string; TreeView: TTreeView): Boolean;
var
i: Integer;
begin
Result := False;
if (Trim(Text) '') then
begin
for i := 0 to TreeView.Items.Count - 1 do
if Trim(Text) = Trim(TreeView.Items[i].Text) then
begin
Result := True;
Exit;
end;
end;
Result := False;
end;
// ------------------------------------------------------------------------------
{ TreeView获得选中的完整路径
aaaa\ssss\bbbb
}
function ExtractNodeFullPath(TreeView: TTreeView): string;
var
Path: string;
Parent: TTreeNode;
// Node: TTreeNode;
begin
Path := TreeView.Selected.Text;
Parent := TreeView.Selected.Parent;
while Parent nil do
begin
Path := Parent.Text + '\' + Path;
Parent := Parent.Parent;
end;
Result := Path;
end;
function Get_node_path(node: TTreeNode): string;
var
Path: string;
TreeNode: TTreeNode;
begin
Path := node.Text;
TreeNode := node.Parent;
while TreeNode nil do
begin
Path := TreeNode.Text + '\' + Path;
TreeNode := TreeNode.Parent;
end;
Result := Path;
end;
{
获得文件完整路径
C:\abc\int.cpp
}
function ExtractTreeViewFileName(RootPath: string; TreeView: TTreeView): string;
var
FileName: string;
begin
Result := '';
if TreeView.Selected = nil then
Exit;
FileName := RootPath + ExtractNodeFullPath(TreeView); // 当前选中的文件名
if not FileExists(FileName) then
Exit;
Result := FileName;
end;
{ 用RICHEDIT打开TREEVIEW中的文件 }
function OpenFile(Path: string; RichEdit: TRichEdit; TreeView: TTreeView)
: Boolean; overload;
var
FileName: string;
begin
Result := False;
FileName := ExtractTreeViewFileName(Path, TreeView);
if FileExists(FileName) then
begin
RichEdit.Lines.LoadFromFile(FileName);
Result := True;
end
end;
function OpenFile(Path: string; Webbrowser: TWebbrowser; TreeView: TTreeView)
: Boolean; overload;
var
FileName: string;
begin
Result := False;
FileName := ExtractTreeViewFileName(Path, TreeView);
if FileExists(FileName) then
begin
Webbrowser.Navigate(FileName);
Result := True;
end
end;
{ 将1个目录里面所有的文件添加到TREEVIEW中
GetDirectories(TreeView1, 'D:\DATA', nil, True);
}
procedure GetDirectories(Tree: TTreeView; Directory: string; Item: TTreeNode;
IncludeFiles: Boolean);
var
SearchRec: TSearchRec;
ItemTemp: TTreeNode;
begin
Tree.Items.BeginUpdate;
if Directory[Length(Directory)] '\' then
Directory := Directory + '\';
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) and
(SearchRec.Name[1] '.') then
begin
if (SearchRec.Attr and faDirectory > 0) then
Item := Tree.Items.AddChild(Item, SearchRec.Name);
ItemTemp := Item.Parent;
GetDirectories(Tree, Directory + SearchRec.Name, Item,
IncludeFiles);
Item := ItemTemp;
end
else if IncludeFiles then
if SearchRec.Name[1] '.' then
Tree.Items.AddChild(Item, SearchRec.Name);
until FindNext(SearchRec) 0;
FindClose(SearchRec);
Tree.Items.EndUpdate;
end;
end;
{
将1个目录里面所有的文件添加到TREEVIEW中
DirToTreeView(TreeView1,'D:\Data\',nil,True,'.cpp');
}
procedure DirToTreeView(Tree: TTreeView; Directory: string; Root: TTreeNode;
IncludeFiles: Boolean; FileExt: string);
var
SearchRec: TSearchRec;
Node1: TTreeNode;
begin
with Tree.Items do
begin
BeginUpdate;
if Directory[Length(Directory)] '\' then
Directory := Directory + '\';
if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 then
begin
Application.ProcessMessages;
repeat
{ 添加文件夹 }
if (SearchRec.Attr and faDirectory = faDirectory) and
(SearchRec.Name[1] '.') then
begin
if SameText(RightStr(SearchRec.Name, 12), '_AttachMents') then
// 不添加 _AttachMents这个文件夹
Continue;
if (SearchRec.Attr and faDirectory > 0) then
Root := AddChild(Root, SearchRec.Name);
Node1 := Root.Parent;
DirToTreeView(Tree, Directory + SearchRec.Name, Root,
IncludeFiles, FileExt);
Root := Node1;
end
else if IncludeFiles then { 添加文件 }
if SearchRec.Name[1] '.' then
{ .TXT .txt .TxT .tXT 为一样的 }
if SameText(RightStr(SearchRec.Name, 4), FileExt)
then { 只添加 .CPP格式文件 }
AddChild(Root, SearchRec.Name);
until FindNext(SearchRec) 0;
FindClose(SearchRec)
end;
EndUpdate;
end;
end;
end.
2013-10-31
DELPHI文本整理器
DELPHI文本整理器 样式像记事本
// 字符串处理功能
unit StringFunctions;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Forms, Dialogs, StdCtrls,
Commctrl;
type
TStringFunction = class(TObject)
private
function IsUpper(ch: char): boolean;
function IsLower(ch: char): boolean;
function ToUpper(ch: char): char;
function ToLower(ch: char): char;
public
procedure ReplaceSelText(Edit: TCustomEdit; const s: String);
procedure UpperSelText(Edit: TCustomEdit);
procedure LowerSelText(Edit: TCustomEdit);
function UpperFistLetter(Memo: TMemo): string;
procedure ClearBlankLine(Memo: TMemo);
procedure ClearBlankSpace(Memo: TMemo);
procedure ClearNum(Memo: TMemo);
procedure ClearLetter(Memo: TMemo);
procedure InsertNumber(Memo: TMemo);
procedure InsertComment(Memo: TMemo);
procedure BatchReplaceString(Memo: TMemo);
procedure JustOneLine(Memo: TMemo);
procedure ReLine(Memo: TMemo; n: Integer);
procedure TextToHtml(sTextFile, sHtmlFile: string);
function Proper(const s: string): string;
function CNWordsCount(text: string): Integer;
function ENWordsCount(text: string): Integer;
end;
var
StrFunction: TStringFunction;
implementation
// 让代码设置Memo后可以让memo在Ctrl+Z撤销有效
procedure TStringFunction.ReplaceSelText(Edit: TCustomEdit; const s: String);
begin
SendMessage(Edit.Handle, EM_REPLACESEL, 1, LPARAM(PChar(s)));
// Edit.Perform(EM_REPLACESEL, 1, LPARAM(PChar(s)));
end;
// Edit显示行号
// ------------------------------------------------------------------------------
// 去除空行
// Memo1.Text := StringReplace(Memo1.Text, #13#10#13#10, #13#10, [rfReplaceAll]);
{
//无法撤销
//空行的去掉
//本行只有空格的也去掉
//全选
//复制到剪切板上
}
procedure TStringFunction.ClearBlankLine(Memo: TMemo);
var
i: Integer;
list: TStringList;
begin
with Memo do
begin
if Lines.Count > 0 then
begin
list := TStringList.Create;
for i := 0 to Lines.Count - 1 do
if (Trim(Lines[i]) <> '') then
list.Add(Lines[i]);
SelectAll;
ReplaceSelText(Memo, list.text);
list.Free;
end;
end;
end;
// 去除空格
// 将 空格替换为空
procedure TStringFunction.ClearBlankSpace(Memo: TMemo);
var
s: string;
begin
s := StringReplace(Memo.Lines.text, ' ', '', [rfReplaceAll]);
Memo.SelectAll;
ReplaceSelText(Memo, s);
end;
// 去除一字符串中的所有的数字
procedure TStringFunction.ClearNum(Memo: TMemo);
var
str: string;
i: Integer;
begin
str := '1234567890';
for i := 0 to Length(str) do
Memo.text := StringReplace(Memo.Lines.text, str[i], '', [rfReplaceAll]);
{ rfReplaceAll
TReplaceFlags = set of (rfReplaceAll, rfIgnoreCase);
}
end;
// 去除一字符串中的所有的字母
procedure TStringFunction.ClearLetter(Memo: TMemo);
var
str: string;
i: Integer;
begin
str := 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ';
for i := 0 to Length(str) do
Memo.text := StringReplace(Memo.Lines.text, str[i], '', [rfReplaceAll]);
end;
// 批量替换关键字
procedure TStringFunction.BatchReplaceString(Memo: TMemo);
var
i: Integer;
begin
for i := 0 to Length(Memo.Lines.text) do
Memo.text := StringReplace(Memo.Lines.text, Memo.Lines[i], '',
[rfReplaceAll]);
ClearBlankSpace(Memo);
end;
// ------------------------------------------------------------------------------
// 全角转半角
// 符号有哪些
procedure ConvertQtoB;
begin
end;
// 半角转换全角
procedure ConvertBtoQ;
begin
end;
{ 转换选中的文本大写 }
procedure TStringFunction.UpperSelText(Edit: TCustomEdit);
var
x, y: Integer;
begin
With Edit do
begin
x := SelStart;
y := SelLength;
if SelText <> '' then
begin
ReplaceSelText(Edit, UpperCase(SelText));
SelStart := x;
SelLength := y;
end
else
begin
Edit.SelectAll;
ReplaceSelText(Edit, UpperCase(Edit.text));
end;
end;
end;
{ 转换选中的文本小写 }
procedure TStringFunction.LowerSelText(Edit: TCustomEdit);
var
x, y: Integer;
begin
With Edit do
begin
x := SelStart;
y := SelLength;
if SelText <> '' then
begin
ReplaceSelText(Edit, LowerCase(SelText));
SelStart := x;
SelLength := y;
end
else
begin
Edit.SelectAll;
ReplaceSelText(Edit, LowerCase(Edit.text));
end;
end;
end;
{ 判断字符是否是大写字符 }
function TStringFunction.IsUpper(ch: char): boolean;
begin
Result := ch in ['A' .. 'Z'];
end;
{ 判断字符是否是小写字符 }
function TStringFunction.IsLower(ch: char): boolean;
begin
Result := ch in ['a' .. 'z'];
end;
{ 转换为大写字符 }
function TStringFunction.ToUpper(ch: char): char;
begin
Result := chr(ord(ch) and $DF);
end;
{ 转换为小写字符 }
function TStringFunction.ToLower(ch: char): char;
begin
Result := chr(ord(ch) or $20);
end;
{ Capitalizes First Letter Of Every Word In S 单语首字母大写 }
function TStringFunction.Proper(const s: string): string;
var
i: Integer;
CapitalizeNextLetter: boolean;
begin
Result := LowerCase(s);
CapitalizeNextLetter := True;
for i := 1 to Length(Result) do
begin
if CapitalizeNextLetter and IsLower(Result[i]) then
Result[i] := ToUpper(Result[i]);
CapitalizeNextLetter := Result[i] = ' ';
end;
end;
{ Memo选中的首字母大写 }
function TStringFunction.UpperFistLetter(Memo: TMemo): string;
var
i, j: Integer;
begin
with Memo do
begin
i := SelStart;
j := SelLength;
// SelText := Proper(SelText);
ReplaceSelText(Memo, Proper(SelText));
SelStart := i;
SelLength := j;
end;
end;
// ------------------------------------------------------------------------------
procedure TStringFunction.InsertNumber(Memo: TMemo);
var
i: Integer;
str: String;
begin
for i := 0 to Memo.Lines.Count do
begin
str := Format('%.4d. %s', [i, Memo.Lines[i]]);
Memo.Lines[i] := str;
Application.ProcessMessages;
end;
end;
// 注释和取消注释
// 获得选中的文本的起始行和结束行
procedure TStringFunction.InsertComment(Memo: TMemo);
var
str: string;
x, y: Integer;
begin
str := Memo.SelText;
x := Memo.SelStart;
y := Memo.SelLength;
if str = '' then
Exit;
// Memo.SetSelText('//' +str);
Memo.SelText := '//' + str;
Memo.SelStart := x + 2;
Memo.SelLength := y + 2;
end;
// ------------------------------------------------------------------------------
// 合并成一行
procedure TStringFunction.JustOneLine(Memo: TMemo);
var
s: string;
i: Integer;
begin
for i := 0 to Memo.Lines.Count - 1 do
s := s + Memo.Lines[i];
Memo.SelectAll;
ReplaceSelText(Memo, s);
end;
// ------------------------------------------------------------------------------
// 重新分行
{
var
n: Integer;
begin
n := StrToInt(InputBox('重新分行', '每行几个字符', '8'));
ReLine(Memo1, n);
end;
}
procedure TStringFunction.ReLine(Memo: TMemo; n: Integer);
var
s: string;
i, j, k: Integer;
L: TStringList;
begin
L := TStringList.Create;
j := 1;
for k := 0 to Memo.Lines.Count - 1 do
s := s + Memo.Lines[k];
if Trim(s) <> '' then
begin
for i := 0 to (Length(s) div n) do // 几行
begin
j := j + n;
L.Add(Copy(s, j - n, n)); // COPY 的第一位不是0是1 // 每行的字符
end;
end;
Memo.SelectAll;
ReplaceSelText(Memo, L.text);
L.Free;
end;
// ------------------------------------------------------------------------------
// 获得汉字字符个数
function TStringFunction.CNWordsCount(text: string): Integer;
var
i, sum, c: Integer;
begin
Result := 0;
c := 0;
sum := Length(text);
if sum = 0 then
Exit;
for i := 0 to sum do
begin
if ord(text[i]) >= 127 then
begin
Inc(c);
end;
end;
Result := c;
end;
// 获得非汉字字符个数
function TStringFunction.ENWordsCount(text: string): Integer;
var
i, sum, e: Integer;
begin
Result := 0;
e := 0;
sum := Length(text);
if sum = 0 then
Exit;
for i := 0 to sum do
begin
if (ord(text[i]) >= 33) and (ord(text[i]) <= 126) then
begin
Inc(e);
end;
end;
Result := e;
end;
{
TextToHtml('C:\1.txt','c:\2.htm');
}
procedure TStringFunction.TextToHtml(sTextFile, sHtmlFile: string);
var
aText: TStringList;
aHtml: TStringList;
i: Integer;
begin
aText := TStringList.Create;
try
aText.LoadFromFile(sTextFile);
aHtml := TStringList.Create;
try
aHtml.Clear;
aHtml.Add('<html>');
aHtml.Add('<body>');
for i := 0 to aText.Count - 1 do
aHtml.Add(aText.Strings[i] + '<br>');
aHtml.Add('</body>');
aHtml.Add('</html>');
aHtml.SaveToFile(sHtmlFile);
finally
aHtml.Free;
end;
finally
aText.Free;
end;
end;
Initialization
StrFunction := TStringFunction.Create;
Finalization
StrFunction.Free;
end.
2013-10-31
DELPHI搜索文件的示例
搜索TXT 文件的示例unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
Vcl.ExtCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Memo2: TMemo;
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit;
ButtonSearchFile: TButton;
FolderPath: TEdit;
FileExt: TEdit;
ProgressBar1: TProgressBar;
procedure ButtonSearchFileClick(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure SearchFile1(FileName: string; FindText: string);
function MakeFileList(Path, FileExt: string): TStringList;
function FileInUsed(FileName: TFileName): Boolean;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses StrUtils;
{$R *.dfm}
{
Search Options
KeyWord in file
FileName
FileSize
FileCreateTime
FileModifyTime
keyword
filepath
openfile
found
addListbox
}
var
FileNamePathList, FileNameList: TStringList;
procedure TForm1.FormCreate(Sender: TObject);
begin
FileNameList := TStringList.Create;
FileNamePathList := TStringList.Create;
end;
{
if FileInUsed
('D:\Administrator\Documents\MyProjects\FileSearch\Win32\Debug\Project1.exe')
then
ShowMessage('File is in use.')
else
ShowMessage('File not in use.');
}
function TForm1.FileInUsed(FileName: TFileName): Boolean;
var
HFileRes: HFILE;
begin
Result := False;
if not FileExists(FileName) then
Exit; // 如果文件不存在，返回false
HFileRes := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
Result := (HFileRes = INVALID_HANDLE_VALUE);
if not Result then
CloseHandle(HFileRes);
end;
procedure TForm1.SearchFile1(FileName: string; FindText: string);
var
SearchList: TStringList;
begin
try
SearchList := TStringList.Create;
if FileExists(FileName) and (not FileInUsed(FileName)) then
begin
SearchList.LoadFromFile(FileName);
if Boolean(Pos(UpperCase(FindText), UpperCase(SearchList.Text))) then
begin
FileNameList.Add(ExtractFileName(FileName));
FileNamePathList.Add(FileName);
end;
end;
finally
SearchList.Free;
end;
end;
procedure TForm1.ButtonSearchFileClick(Sender: TObject);
var
I, n: Integer;
List: TStringList;
begin
try
ButtonSearchFile.Caption := 'SearchFile';
List := TStringList.Create;
List.Clear;
FileNameList.Clear;
FileNamePathList.Clear;
List := MakeFileList(FolderPath.Text, FileExt.Text);
ProgressBar1.Max := List.Count;
for I := 0 to List.Count - 1 do
begin
Application.ProcessMessages;
SearchFile1(List[I], Edit1.Text);
ProgressBar1.Position := I;
end;
ListBox1.Items.Text := FileNameList.Text;
ButtonSearchFile.Caption := IntToStr(FileNamePathList.Count) + ' 条';
finally
List.Free;
end;
end;
{
这个过程得显示进度
}
function TForm1.MakeFileList(Path, FileExt: string): TStringList;
var
sch: TSearchrec;
begin
Result := TStringList.Create;
if RightStr(Trim(Path), 1) '\' then
Path := Trim(Path) + '\'
else
Path := Trim(Path);
if not DirectoryExists(Path) then
begin
Result.Clear;
Exit;
end;
if FindFirst(Path + '*', faAnyfile, sch) = 0 then
begin
repeat
Application.ProcessMessages;
if ((sch.Name = '.') or (sch.Name = '..')) then
Continue;
if DirectoryExists(Path + sch.Name) then
begin
Result.AddStrings(MakeFileList(Path + sch.Name, FileExt));
end
else
begin
if (UpperCase(ExtractFileExt(Path + sch.Name)) = UpperCase(FileExt))
or (FileExt = '.*') then
Result.Add(Path + sch.Name);
end;
until FindNext(sch) 0;
FindClose(sch);
end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
s: string;
txt: string;
begin
if not FileExists(FileNamePathList[ListBox1.ItemIndex]) then
Exit;
Memo2.Lines.LoadFromFile(FileNamePathList[ListBox1.ItemIndex]);
Caption := FileNamePathList[ListBox1.ItemIndex];
txt := Form1.Memo2.Text;
if Boolean(Pos(UpperCase(Edit1.Text), UpperCase(txt))) then
begin
Memo2.SetFocus;
Memo2.SelStart := Pos(UpperCase(Edit1.Text), UpperCase(txt)) - 1;
Memo2.SelLength := Length(Edit1.Text);
end;
end;
end.
2013-10-31
DELPHI版的 windows记事本
DELPHI版的 windows记事本
用MEMO实现的记事本的所有功能 由于之前的那个记事本在保存信息到注册表时 在WIN8 通不过（XP WIN7能通过）
所有这个修改了部分代码 使得在WIN8也能完好运行
2013-10-27
保存 和 打开 TREE VIEW的节点已经展开的状态
保存 和 打开 TREE VIEW的节点已经展开的状态
如果每次打开后能自动读取上次展开的状态就会非常快捷
http://www.cnblogs.com/xe2011/p/3388430.html
2013-10-25
ELPHI TreeView 文件目录树和 设置节点图标 完整
需要制作文档管理软件 这个非常有用的
1 文件夹 设置图标为
2 文件夹里没有文件的文件夹 设置图标为 没有
3 .HTML文档 设置图标为
4 有附件的 文档设置图标为
DELPHI XE 5测试通过
http://www.cnblogs.com/xe2011/p/3386257.html
2013-10-24
Delphi 像Windows一样 新建文件时重复时 重命名文件名
Delphi 像Windows一样 新建文件时重复时 重命名文件名
情况一：
第1次新建一个Txt文本 文件名为 新建文本文档
第2次新建一个Txt文本 文件名为 新建文本文档 (2)
第3 次新建一个Txt文本 文件名为 新建文本文档 (3)
...
第n 次新建一个Txt文本 文件名为 新建文本文档 (n)
情况二：
第1次新建一个Txt文本 文件名为 新建文本文档
第2次新建一个Txt文本 文件名为 新建文本文档 (2)
第3 次新建一个Txt文本 文件名为 新建文本文档 (3)
...
第n 次新建一个Txt文本 文件名为 新建文本文档 (n)
GIF
http://images.cnitblog.com/blog/300447/201310/23152112-e70b1686c48343e9b47ea0a507575da5.gif
2013-10-23
Delphi Memo 新建 打开 保存 另存 退出 的完美实现
如果不判断的话代码就非常简单了
Delphi XE5
这个代码实现了Windows记事本的主要功能。
新建，打开，保存，另存，退出。
文件拖拽打开文件 这主要是判断Memo内容是否修改过
http://www.cnblogs.com/xe2011/p/3374003.html
2013-10-17
Delphi TMemo字符串的查找完全实现
这是早上传的发现有问题 不能在Delphi Xe5中运行 但能在Delphi7中运行 我想删除它也没权限
http://download.csdn.net/detail/teststudio/6404077
所以重传下
Delphi TMemo字符串的查找完全实现
已经完全的解决Delphi TMemo的查找对话框 和 替换对话框 功能 的所有功能
查看 GIF
http://images.cnblogs.com/cnblogs_com/xe2011/524919/o_TFindDialog.gif
2013-10-16
Delphi TFindDialog TReplaceDialog对话框的使用
Delphi TFindDialog TReplaceDialog对话框的使用
使用 查找对话框实现在MEMO中进行字符串查找
使用 替换对话框实现在MEMO中进行字符串替换
请下载看就知道了 这种资源极少
2013-10-15
空空如也
TA创建的收藏夹 TA关注的收藏夹
TA关注的人