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.