mainfrm.pas

记事本

unit Mainfrm;
//****************************************************************//
//程序名：文本夫换软件                                            //
//作者：陈宏   2006.8.6框架设计                                   //
// 2006.8.7界面设计及代码设计                                     //
//2006.8.8快捷方式等设计                                          //
//****************************************************************//
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Menus, ComCtrls, ShellApi, ExtCtrls, Buttons, ToolWin,
  ImgList;
  
const
  NewLine=#13#10;   
  DefaultFilter='文本文件(*.txt)|*.txt|超文本文件(*.htm,*.html)|*.htm;*.html|'+
                'RTF文件(*.rtf)|*.rtf|Gb码文件(*.gb)|*.gb|批处理文件(*.bat)|'+
                '*.bat|配置文件(*.ini)|*.ini|C源程序(*.h,*.c,*.cpp)|*.h;*.c;'+
                '*.cpp|其它源程序(*.asm,*.bas……)|*.asm;;*.bas;*.prg;*.jav|所有文件(*.*)|*.*';

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    M_SetFrm: TMenuItem;
    RichEdit1: TRichEdit;
    M_ChageFrm: TMenuItem;
    M_Help1: TMenuItem;
    Timer1: TTimer;
    ImageList1: TImageList;
    M_Format: TMenuItem;
    FontDialog1: TFontDialog;
    N1: TMenuItem;
    F2: TMenuItem;
    E1: TMenuItem;
    M_Copy: TMenuItem;
    M_P: TMenuItem;
    M_Cut: TMenuItem;
    N3: TMenuItem;
    M_Z: TMenuItem;
    M_Del: TMenuItem;
    M_NewFiles: TMenuItem;
    M_Save: TMenuItem;
    M_SaveAs: TMenuItem;
    M_OpenFiles: TMenuItem;
    N4: TMenuItem;
    M_Exit: TMenuItem;
    N5: TMenuItem;
    M_CtrlA: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    N2: TMenuItem;
    M_PrintPage: TMenuItem;
    M_Help: TMenuItem;
    M_Font: TMenuItem;
    N6: TMenuItem;
    M_About: TMenuItem;
    N7: TMenuItem;
    M_Find: TMenuItem;
    M_FindNext: TMenuItem;
    PrinterSetupDialog: TPrinterSetupDialog;
    PrintDialog: TPrintDialog;
    FindDialog: TFindDialog;
    ReplaceDialog: TReplaceDialog;
    M_Replace: TMenuItem;
    M_Print: TMenuItem;
    M_AutoLines: TMenuItem;
    M_DateTime: TMenuItem;
    PopupMenu: TPopupMenu;
    PopupMenuUndo: TMenuItem;
    PopupMenuLine1: TMenuItem;
    PopupMenuCut: TMenuItem;
    PopupMenuCopy: TMenuItem;
    PopupMenuPaste: TMenuItem;
    PopupMenuDelete: TMenuItem;
    PopupMenuLine2: TMenuItem;
    PopupMenuSelectAll: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure M_SetFrmClick(Sender: TObject);
    procedure M_SaveClick(Sender: TObject);
    procedure M_SaveAsClick(Sender: TObject);
    procedure M_NewFilesClick(Sender: TObject);
    procedure M_OpenFilesClick(Sender: TObject);
    procedure M_HelpClick(Sender: TObject);
    procedure M_FontClick(Sender: TObject);
    procedure M_AutoLinesClick(Sender: TObject);
    procedure M_PrintPageClick(Sender: TObject);
    procedure M_PrintClick(Sender: TObject);
    procedure M_ExitClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure M_ZClick(Sender: TObject);
    procedure M_CutClick(Sender: TObject);
    procedure M_CopyClick(Sender: TObject);
    procedure M_PClick(Sender: TObject);
    procedure M_DelClick(Sender: TObject);
    procedure M_CtrlAClick(Sender: TObject);
    procedure M_FindClick(Sender: TObject);
    procedure M_FindNextClick(Sender: TObject);
    procedure M_ReplaceClick(Sender: TObject);
    procedure M_DateTimeClick(Sender: TObject);
    procedure FindDialogFind(Sender: TObject);
    procedure ReplaceDialogReplace(Sender: TObject);
    procedure ReplaceDialogFind(Sender: TObject);
    procedure M_AboutClick(Sender: TObject);
    procedure M_ChageFrmClick(Sender: TObject);
  private
    { Private declarations }    
    procedure DropFiles(var Msg: TMessage); message WM_DROPFILES;//拖动打开文件
    procedure OpenFile(Sender: TObject; FName: String);//打开文件
    function CheckFileSave(Sender: TObject):Integer;//检查文件保存与否
    procedure SaveFile(Sender: TObject; Style: Integer);//保存文件
    procedure UpdateCaption(Sender: TObject); //更新标题
    function PerformFind(Sender: TObject; FindString: String; SearchType: TSearchTypes):Boolean;//查找下一个
  public
    { Public declarations }
    p:TWinControl;
    A:TAnchors;
    X,Y,W,H,N:INTEGER;
    FindTextOld:string;
  end;

var
  MainForm: TMainForm;
  FileName, FileNameC: string;

implementation

uses Setfrm;

{$R *.dfm}

//***********************自定义函数区************************************//
//------------------------begin------------------------------------------//

//{{{{{{{{{{{{{{{{{{{{{{{{拖动打开文件{{{{{{{{{{{{{{{{{{{{{{{{{{{{//
procedure TMainForm.DropFiles(var Msg: TMessage);
var i, Count: integer;
  buffer: array[0..1024] of Char;
begin
  inherited;
  Count := DragQueryFile(Msg.WParam, $FFFFFFFF, nil, 256); // 第一次调用得到拖放文件的个数
  for i := 0 to Count - 1 do
  begin
    buffer[0] := #0;
    DragQueryFile(Msg.WParam, i, buffer, sizeof(buffer)); // 第二次调用得到文件名称
    Richedit1.Lines.LoadFromFile(buffer);
  end;
  FileName:= buffer;
  {FileNameC:= FileName;
  while Pos('\',FileNameC) > 0 do
      Delete(FileNameC,1,1); }
  Caption := '文本替换软件-'+ExtractFilename(FileName);
end; 
//}}}}}}}}}}}}}}}}}}}}}}}}}}}}}end}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}//


//{{{{{{{{{{{{{{{{{{{{{{{{打开文件{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{//
procedure TMainForm.OpenFile(Sender: TObject; FName: String);
begin
  if CheckFileSave(Sender)=IDCANCEL then
     Exit;
  if FName='' then
  begin
    OpenDialog1.Filter:=DefaultFilter;
    OpenDialog1.InitialDir:=ExtractFilePath(FileName);
    OpenDialog1.FileName:='';
    if OpenDialog1.Execute then
    begin
      if FileName=OpenDialog1.FileName then
      begin
        //Application.MessageBox(Pchar('文件 '+FileName+' 已经打开。'),'错误',MB_ICONINFORMATION);
        //exit;
      end
      else
        FileName:=OpenDialog1.FileName;
      end
    else
      Exit;
  end
  else
    if not FileExists(FName) then
    begin
      Application.MessageBox('此文件不存在！','打开',MB_ICONINFORMATION);
      Exit;
    end
    else if FName=FileName then
    begin
      //Application.MessageBox(Pchar('文件 '+FileName+' 已经打开。'),'错误',MB_ICONINFORMATION);
      //Exit;
    end
    else
      FileName:=FName;
  try
    RichEdit1.PlainText:=not (UpperCase(ExtractFileExt(FileName))='.RTF');
    Screen.Cursor:=crHourGlass;
    Refresh;
    RichEdit1.Lines.LoadFromFile(FileName);
  finally
    Screen.Cursor:=crDefault;
    UpdateCaption(Sender);
  end;
end;
//}}}}}}}}}}}}}}}}}}}}}}}}}}}}}end}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}//

//{{{{{{{{{{{{{{{{{{{{{{{{检查文件保存与否{{{{{{{{{{{{{{{{{{{{{{{{{{{{//
function TMainForm.CheckFileSave(Sender: TObject):Integer;
var
  Response:Integer;
  TempName:String;
begin
  Response:=-1;
  if Length(FileName)<>0 then
    TempName:=FileName
  else
    TempName:='无标题';
  if RichEdit1.Modified then
    Response:=Application.MessageBox(Pchar('文件 '+TempName+
         ' 的内容已经改变。'+NewLine+'想保存文件吗?'),
         Pchar(Application.Title),MB_ICONQUESTION+MB_YESNOCANCEL+MB_DEFBUTTON1);
  if Response=IDYES then
     SaveFile(Sender,0);
  Result:=Response;
end;
//}}}}}}}}}}}}}}}}}}}}}}}}}}}}}end}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}//

//{{{{{{{{{{{{{{{{{{{{{{{{保存文件{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{//
procedure TMainForm.SaveFile(Sender: TObject; Style: Integer);
var
  I:Integer;
  TempName:String;
begin
  SaveDialog1.Filter:=DefaultFilter;
  SaveDialog1.FileName:=FileName;
  TempName:=FileName;
  if FileName='' then
  begin
    SaveDialog1.Title:='保存';
    SaveDialog1.FileName:=Trim(RichEdit1.Lines[0]);
    if SaveDialog1.FileName<>'' then
      for I:=1 to Length(SaveDialog1.FileName) do
       if SaveDialog1.FileName[i] in ['/','\','*','?','<','>','|'] then
       begin
         SaveDialog1.FileName:='*.txt';
         break;
       end;
    if SaveDialog1.Execute then
      try
        FileName:=SaveDialog1.FileName;
        RichEdit1.Lines.SaveToFile(FileName);
        UpdateCaption(Sender);
      except
        Application.MessageBox(Pchar(Application.Title+'无法保存文件 '+FileName+' 。'),'错误',MB_ICONINFORMATION);
      end;
  end
  else
  begin
    if Style=1 then              //另存为...
    begin
      SaveDialog1.Title:='另存为';
      if SaveDialog1.Execute then
        tempname:=SaveDialog1.FileName;
    end;
    try
      RichEdit1.Lines.SaveToFile(TempName);
      RichEdit1.Modified:=False;
    except
      Application.MessageBox(Pchar(Application.Title+'无法保存文件 '+FileName+' 。'),'错误',MB_ICONINFORMATION);
    end;
  end;
end;  
//}}}}}}}}}}}}}}}}}}}}}}}}}}}}}end}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}//

//{{{{{{{{{{{{{{{{{{{{{{{{更新标题{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{//
procedure TMainForm.UpdateCaption(Sender: TObject);
begin
  if Length(FileName)<>0 then
      Caption:=Application.Title+' - '+ExtractFileName(FileName)
  else
    Caption:=Application.Title+' - 未命名';
  RichEdit1.Modified:=False;
end;
//}}}}}}}}}}}}}}}}}}}}}}}}}}}}}end}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}//

//{{{{{{{{{{{{{{{{{{{{{{{{查找下一个{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{//
function TMainForm.PerformFind(Sender: TObject; FindString: String; SearchType: TSearchTypes):Boolean;
var
  FoundAt, StartPos, ToEnd: Integer;
  str:string;
  label Start;
begin
  if FindTextOld = FindString then
    with RichEdit1 do
    begin
      Start: StartPos:=SelStart+SelLength;
      ToEnd:=GetTextLen-StartPos;
      FoundAt:=FindText(FindString,StartPos,ToEnd,SearchType);
      if FoundAt<>-1 then
      begin
        SelStart:=FoundAt;
        SelLength:=Length(FindString);
        if Seltext='' then
        begin
          Selstart:=Selstart+2;
          goto Start;
        end;
        Result:=True;
      end
      else
      begin
        str:= '找不到 '''''+PChar(FindString)+'''''';
        Application.MessageBox(PChar(str),'记事本',MB_ICONINFORMATION);
        FindDialog.CloseDialog;
        Result:=False;
      end;
    end
  else
  begin
    FindTextOld:= FindString; 
    Result:=True;
  end;
end;
//}}}}}}}}}}}}}}}}}}}}}}}}}}}}}end}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}//

//{{{{{{{{{{{{{{{{{{{{{{{{取程序版本号{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{//
function GetFileVersion(FileName: string): string;
  type
    PVerInfo = ^TVS_FIXEDFILEINFO;
    TVS_FIXEDFILEINFO = record
      dwSignature: longint;
      dwStrucVersion: longint;
      dwFileVersionMS: longint;
      dwFileVersionLS: longint;
      dwFileFlagsMask: longint;
      dwFileFlags: longint;
      dwFileOS: longint;
      dwFileType: longint;
      dwFileSubtype: longint;
      dwFileDateMS: longint;
      dwFileDateLS: longint;
    end;
var
  ExeNames: array[0..255] of char;
  //zKeyPath: array[0..255] of Char;
  VerInfo: PVerInfo;
  Buf: pointer;
  Sz: word;
  L, Len: Cardinal;
begin
  StrPCopy(ExeNames, FileName);
  Sz := GetFileVersionInfoSize(ExeNames, L);
  if Sz=0 then
  begin
    Result:='';
    Exit;
  end;

  try
    GetMem(Buf, Sz);
    try
      GetFileVersionInfo(ExeNames, 0, Sz, Buf);
      if VerQueryValue(Buf, '\', Pointer(VerInfo), Len) then
      begin
        Result := 'V'+IntToStr(HIWORD(VerInfo.dwFileVersionMS)) + '.' +
        IntToStr(LOWORD(VerInfo.dwFileVersionMS)) + '.' +
        IntToStr(HIWORD(VerInfo.dwFileVersionLS)) + '.' +
        IntToStr(LOWORD(VerInfo.dwFileVersionLS));

      end;
    finally
      FreeMem(Buf);