开发工具:
文件大小: 871kb
下载次数: 0
上传时间: 2013-10-31
详细说明： 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(''); aHtml.Add(''); for i := 0 to aText.Count - 1 do aHtml.Add(aText.Strings[i] + '
'); aHtml.Add(''); aHtml.Add(''); aHtml.SaveToFile(sHtmlFile); finally aHtml.Free; end; finally aText.Free; end; end; Initialization StrFunction := TStringFunction.Create; Finalization StrFunction.Free; end. ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
