unitmain.pas

一百个病毒的源代码 包括熊猫烧香等 极其具有研究价值

unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, Menus,Registry;

//如果你认为该记事本能满足你的需要，并觉得值得，希望你给我寄10元钱，
//如果你认为不值，请给我寄一张PostCard，或来一封EMail以资鼓励。
//我的地址：深圳市福田区联合广场41楼恒星威电子有限公司GPS部。
//我的EMail地址：[e-mail];
//我的主页：aizb.126.com;
type
  TFormMain = class(TForm)
    RichEdit1: TRichEdit;
    MainMenu1: TMainMenu;
    MenuFile: TMenuItem;
    ItemNew: TMenuItem;
    ItemOpen: TMenuItem;
    ItemSave: TMenuItem;
    ItemSaveAs: TMenuItem;
    N2: TMenuItem;
    ItemPageSet: TMenuItem;
    ItemPrint: TMenuItem;
    N4: TMenuItem;
    ItemClose: TMenuItem;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    N1: TMenuItem;
    ItemFont: TMenuItem;
    FontDialog1: TFontDialog;
    PopupMenu1: TPopupMenu;
    ItemUndo: TMenuItem;
    N3: TMenuItem;
    ItemRedo: TMenuItem;
    ItemCut: TMenuItem;
    ItemCopy: TMenuItem;
    ItemPaste: TMenuItem;
    ItemDelete: TMenuItem;
    N5: TMenuItem;
    ItemSelectAll: TMenuItem;
    N6: TMenuItem;
    ItemFindText: TMenuItem;
    ItemFindAndReplace: TMenuItem;
    FindDialog1: TFindDialog;
    MenuEdit: TMenuItem;
    ItemUndo1: TMenuItem;
    ItemRedo1: TMenuItem;
    N7: TMenuItem;
    ItemCut1: TMenuItem;
    ItemCopy1: TMenuItem;
    ItemPaste1: TMenuItem;
    ItemDelete1: TMenuItem;
    N8: TMenuItem;
    ItemSelectAll1: TMenuItem;
    N9: TMenuItem;
    ItemFind1: TMenuItem;
    ItemFindAndPlace1: TMenuItem;
    N10: TMenuItem;
    ItemAutoWarp1: TMenuItem;
    N11: TMenuItem;
    ItemAutoWarp: TMenuItem;
    ReplaceDialog1: TReplaceDialog;
    H1: TMenuItem;
    N12: TMenuItem;
    procedure ItemNewClick(Sender: TObject);
    procedure ItemOpenClick(Sender: TObject);
    procedure ItemSaveClick(Sender: TObject);
    procedure ItemSaveAsClick(Sender: TObject);
    procedure ItemPageSetClick(Sender: TObject);
    procedure ItemPrintClick(Sender: TObject);
    procedure ItemCloseClick(Sender: TObject);
    procedure ItemFontClick(Sender: TObject);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure ItemUndoClick(Sender: TObject);
    procedure ItemRedoClick(Sender: TObject);
    procedure ItemCutClick(Sender: TObject);
    procedure ItemCopyClick(Sender: TObject);
    procedure ItemPasteClick(Sender: TObject);
    procedure ItemDeleteClick(Sender: TObject);
    procedure ItemSelectAllClick(Sender: TObject);
    procedure ItemFindTextClick(Sender: TObject);
    procedure FindDialog1Find(Sender: TObject);
    procedure ItemAutoWarp1Click(Sender: TObject);
    procedure ItemFindAndReplaceClick(Sender: TObject);
    procedure ReplaceDialog1Replace(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MenuFileClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    sFileName:String;
    Function CheckHasModified:Boolean;
    Function SaveAsFile:Boolean;
    Function SaveFile:Boolean;
    Function MyOpenFile(FileName:String):Boolean;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation
Uses RichEdit;
{$R *.DFM}

function TFormMain.CheckHasModified: Boolean;
begin
  Result:=not RichEdit1.Modified;
  if not Result then
  begin
    Case Application.MessageBox('文件没有保存！需要保存吗？','提示',MB_YESNO+MB_ICONQUESTION) of
      IDYES:Result:=SaveFile;
      IDNo:Result:=True;
    end;
  end;
end;

procedure TFormMain.ItemNewClick(Sender: TObject);
begin
  if CheckHasModified then
  begin
    RichEdit1.Lines.Clear;
    RichEdit1.Modified:=False;
    sFileName:='新文件';
  end;
end;

function TFormMain.SaveAsFile: Boolean;
begin
  Result:=False;
  if SaveDialog1.Execute then
  begin
    RichEdit1.Lines.SaveToFile(SaveDialog1.FileName);
    RichEdit1.Modified:=False;
    sFileName:=SaveDialog1.FileName;
    Result:=True;
  end;
end;

procedure TFormMain.ItemOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    MyOpenFile(OpenDialog1.FileName);
end;

procedure TFormMain.ItemSaveClick(Sender: TObject);
begin
  SaveFile;
end;

function TFormMain.SaveFile: Boolean;
begin
  if sFileName='新文件' then
    Result:=SaveAsFile
  else
  begin
    RichEdit1.Lines.SaveToFile(sFileName);
    RichEdit1.Modified:=False;
    Result:=True;
  end;
end;

procedure TFormMain.ItemSaveAsClick(Sender: TObject);
begin
  SaveAsFile;
end;

procedure TFormMain.ItemPageSetClick(Sender: TObject);
begin
//
end;

procedure TFormMain.ItemPrintClick(Sender: TObject);
begin
  RichEdit1.Print(sFileName);
end;

procedure TFormMain.ItemCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.ItemFontClick(Sender: TObject);
begin
  FontDialog1.Font.Assign(RichEdit1.Font);
  if FontDialog1.Execute then
    RichEdit1.Font.Assign(FontDialog1.Font);
end;

procedure TFormMain.PopupMenu1Popup(Sender: TObject);
begin
  ItemUndo.Enabled:=(RichEdit1.Perform(EM_CANUNDO,0,0)<>0);
  ItemRedo.Enabled:=(RichEdit1.Perform(EM_CANREDO,0,0)<>0);
  ItemCut.Enabled:=(RichEdit1.Perform(EM_SELECTIONTYPE,0,0)<>0);
  ItemCopy.Enabled:=ItemCut.Enabled;
  ItemPaste.Enabled:=(RichEdit1.Perform(EM_CANPASTE,0,0)<>0);
  ItemAutoWarp.Checked:=RichEdit1.WordWrap;
  ItemUndo1.Enabled:=(RichEdit1.Perform(EM_CANUNDO,0,0)<>0);
  ItemRedo1.Enabled:=(RichEdit1.Perform(EM_CANREDO,0,0)<>0);
  ItemCut1.Enabled:=(RichEdit1.Perform(EM_SELECTIONTYPE,0,0)<>0);
  ItemCopy1.Enabled:=ItemCut.Enabled;
  ItemPaste1.Enabled:=(RichEdit1.Perform(EM_CANPASTE,0,0)<>0);
  ItemAutoWarp1.Checked:=RichEdit1.WordWrap;
end;

procedure TFormMain.ItemUndoClick(Sender: TObject);
begin
  RichEdit1.Perform(EM_UNDO,0,0);
end;

procedure TFormMain.ItemRedoClick(Sender: TObject);
begin
  RichEdit1.Perform(EM_REDO,0,0);
end;

procedure TFormMain.ItemCutClick(Sender: TObject);
begin
  RichEdit1.Perform(WM_CUT,0,0);
end;

procedure TFormMain.ItemCopyClick(Sender: TObject);
begin
  RichEdit1.Perform(WM_COPY,0,0);
end;

procedure TFormMain.ItemPasteClick(Sender: TObject);
begin
  RichEdit1.Perform(WM_Paste,0,0);
end;

procedure TFormMain.ItemDeleteClick(Sender: TObject);
begin
  RichEdit1.Perform(WM_CLEAR,0,0);
end;

procedure TFormMain.ItemSelectAllClick(Sender: TObject);
begin
  RichEdit1.SelectAll;
end;

procedure TFormMain.ItemFindTextClick(Sender: TObject);
Var P:TPoint;
begin
  P:=Point(0,0);
  P:=RichEdit1.ClientToScreen(P);
  FindDialog1.Position := P;
  FindDialog1.Execute;
end;

procedure TFormMain.FindDialog1Find(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  st:TSearchTypes;
begin
  with RichEdit1 do
  begin
    { begin the search after the current selection if there is one }
    { otherwise, begin at the start of the text }
    StartPos := SelStart + SelLength;
    { ToEnd is the length from StartPos to the end of the text in the rich edit control }
    ToEnd := Length(RichEdit1.Text) - StartPos;
    st:=[];
    if frMatchCase in FindDialog1.Options then
      st:=st+[stMatchCase];
    if frWholeWord in FindDialog1.Options then
      st:=st+[stWholeWord];
    FoundAt := FindText(FindDialog1.FindText, StartPos, ToEnd, st);
    if FoundAt <> -1 then
    begin
      SelStart := FoundAt;
      SelLength := Length(FindDialog1.FindText);
    end else
      ShowMessage('查找完成！')
  end;
end;

procedure TFormMain.ItemAutoWarp1Click(Sender: TObject);
begin
  RichEdit1.WordWrap:=not RichEdit1.WordWrap;
  ItemAutoWarp1.Checked:=RichEdit1.WordWrap;
  ItemAutoWarp.Checked:=RichEdit1.WordWrap;
end;

Function TFormMain.MyOpenFile(FileName:String):Boolean;
begin
  Result:=False;
  if CheckHasModified then
  begin
    try
      RichEdit1.Lines.LoadFromFile(FileName);
      RichEdit1.Modified:=False;
      sFileName:=FileName;
      Result:=True;
    except
      on E:Exception do
        ShowMessage(E.Message);
    end;
  end;
end;

procedure TFormMain.ItemFindAndReplaceClick(Sender: TObject);
Var P:TPoint;
begin
  P:=Point(0,0);
  P:=RichEdit1.ClientToScreen(P);
  ReplaceDialog1.Position := P;
  ReplaceDialog1.Execute;
end;

procedure TFormMain.ReplaceDialog1Replace(Sender: TObject);
var
  FoundAt: LongInt;
  StartPos, ToEnd: Integer;
  st:TSearchTypes;
begin
  with RichEdit1 do
  begin
    { begin the search after the current selection if there is one }
    { otherwise, begin at the start of the text }
    StartPos := SelStart + SelLength;
    { ToEnd is the length from StartPos to the end of the text in the rich edit control }
    ToEnd := Length(RichEdit1.Text) - StartPos;
    st:=[];
    if frMatchCase in ReplaceDialog1.Options then
      st:=st+[stMatchCase];
    if frWholeWord in ReplaceDialog1.Options then
      st:=st+[stWholeWord];
    FoundAt := FindText(ReplaceDialog1.FindText, StartPos, ToEnd, st);
    While FoundAt <> -1 do
    begin
      SelStart := FoundAt;
      SelLength := Length(ReplaceDialog1.FindText);
      Perform(EM_REPLACESEL,1,Integer(PChar(ReplaceDialog1.ReplaceText)));
      SelStart := FoundAt;
      SelLength := Length(ReplaceDialog1.ReplaceText);
      if not (frReplaceAll in ReplaceDialog1.Options) then
        Break;
      StartPos:=SelStart;
      ToEnd := Length(RichEdit1.Text) - StartPos;
      FoundAt := FindText(ReplaceDialog1.FindText, StartPos, ToEnd, st);
    end;
    FoundAt := FindText(ReplaceDialog1.FindText, StartPos, ToEnd, st);
    if FoundAt=-1 then
      ShowMessage('替换完成！');
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
Var s1FileName,TemStr,ParamString:String;
 i,FromIndex,ToIndex,iPos:Integer;
 Reg:TRegistry;
begin
  try
    Reg:=TRegistry.Create;
    try
      Reg.RootKey:=HKEY_CLASSES_ROOT;
      Reg.OpenKey('*\Shell\MyNotePad',True);
      Reg.WriteString('','用我的记事本打开');
      Reg.CloseKey;
      Reg.OpenKey('*\Shell\MyNotePad\Command',True);
      Reg.WriteString('','"'+ParamStr(0)+'" "%1"');
      Reg.CloseKey;
    finally
      Reg.Free;
    end;
  except
  end;
  if ParamCount>=1 then
  begin
    i:=1;
    ParamString:=ParamStr(i);
    While (ParamString[1]='/') and (i<=ParamCount) do
    begin
      Inc(i);
      ParamString:=ParamStr(i);
    end;
    FromIndex:=i;
    ParamString:=ParamStr(i);
    if ParamString[1]='/' then
      Exit;
    While i<=ParamCount do
    begin
      if ParamString[1]='/' then
        Break;
      Inc(i);
      ParamString:=ParamStr(i);
    end;
    ToIndex:=i;
    s1FileName:=GetCommandLine;
    ParamString:=ParamStr(FromIndex);
    iPos:=Pos(ParamString,s1FileName);
    TemStr:=ParamString;
    Delete(s1FileName,1,iPos-1+length(TemStr));
    For i:=FromIndex+1 to ToIndex do
    begin
      ParamString:=ParamStr(i);
      iPos:=pos(ParamString,s1FileName);
      TemStr:=TemStr+copy(s1FileName,1,iPos+length(ParamString));
    end;
    s1FileName:=TemStr;
    MyOpenFile(s1FileName);
    For i:=1 to ParamCount do
    begin
      if (ParamStr(i)='/p') or (ParamStr(i)='/P') then
      begin
        if Application.MessageBox('打印吗？','提示',MB_YESNO+MB_ICONQUESTION)=IDYes then
          RichEdit1.Print(sFileName);
        Break;
      end;
    end;
  end;
end;

procedure TFormMain.MenuFileClick(Sender: TObject);
begin
  ItemSave.Enabled:=RichEdit1.Modified;
end;

procedure TFormMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose:=not RichEdit1.Modified;
  if not CanClose then
  begin
    Case Application.MessageBox('文件没有保存！需要保存吗？','提示',MB_YESNOCANCEL+MB_ICONQUESTION) of
      IDYES:CanClose:=SaveFile;
      IDNo:CanClose:=True;
    end;
  end;
end;

end.