🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: cn.bbs.comp.lang.delphi
Article #76

Re: �Ǹ�������delphiʵ��WINDOWS�ļ��±�������

#76
From: �������������
Date: Wed, 26 Oct 2005 13:13
353 lines
9784 bytes
unit TextEditor;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, AboutFM, HelpFM;

type
  TEditForm = class(TForm)
    MainMenu1: TMainMenu;
    MIFile: TMenuItem;
    MIEdit: TMenuItem;
    MIFormat: TMenuItem;
    MIHelp: TMenuItem;
    MINew: TMenuItem;
    MIOpen: TMenuItem;
    MISave: TMenuItem;
    MISaveAs: TMenuItem;
    N1: TMenuItem;
    MIPrinterSetup: TMenuItem;
    MIPrint: TMenuItem;
    N2: TMenuItem;
    MIExit: TMenuItem;
    MIUndo: TMenuItem;
    N3: TMenuItem;
    MICut: TMenuItem;
    MICopy: TMenuItem;
    MIPaste: TMenuItem;
    MIDelete: TMenuItem;
    N4: TMenuItem;
    MISelAll: TMenuItem;
    MIAutoWarp: TMenuItem;
    MIFont: TMenuItem;
    MIAbout: TMenuItem;
    Editor: TRichEdit;
    PopupMenu1: TPopupMenu;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    DgOpen: TOpenDialog;
    DgSave: TSaveDialog;
    DgFont: TFontDialog;
    DgPrint: TPrintDialog;
    DgPrinterSetup: TPrinterSetupDialog;
    DgFind: TFindDialog;
    DgReplace: TReplaceDialog;
    MIFind: TMenuItem;
    MIReplace: TMenuItem;
    N13: TMenuItem;
    MIFindNext: TMenuItem;
    MIJump: TMenuItem;
    MITimeDate: TMenuItem;
    MIView: TMenuItem;
    S1: TMenuItem;
    H1: TMenuItem;
    N14: TMenuItem;
    procedure MIExitClick(Sender: TObject);
    procedure MINewClick(Sender: TObject);
    procedure MISaveAsClick(Sender: TObject);
    procedure MISaveClick(Sender: TObject);
    procedure MIPrintClick(Sender: TObject);
    procedure MIPrinterSetupClick(Sender: TObject);
    procedure MIOpenClick(Sender: TObject);
    procedure MICutClick(Sender: TObject);
    procedure MICopyClick(Sender: TObject);
    procedure MIPasteClick(Sender: TObject);
    procedure MIDeleteClick(Sender: TObject);
    procedure MISelAllClick(Sender: TObject);
    procedure MIUndoClick(Sender: TObject);
    procedure MIFindClick(Sender: TObject);
    procedure DgFindFind(Sender: TObject);
    procedure MIReplaceClick(Sender: TObject);
    procedure DgReplaceReplace(Sender: TObject);
    procedure MIFontClick(Sender: TObject);
    procedure MIAutoWarpClick(Sender: TObject);
    procedure MIAboutClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure H1Click(Sender: TObject);
  private
    { Private declarations }
     PathName: string;
     HasUndo:Boolean;
  public
    { Public declarations }
    procedure CheckTextModified;
  end;

var
  EditForm: TEditForm;

const
  DefaultFileName = 'ÎÞ����Ìâ';

implementation

{$R *.dfm}

procedure TEditForm.CheckTextModified;
begin
    if Editor.Modified then
    begin
        case Application.MessageBox('ÎļþÃ&raqu
o;ÓÐ��£´æ,Òª��£´æ&A
circ;ð?',
        '��ʾ',MB_YESNO+MB_ICONQUESTION) of
            IDYES:
                    MISaveClick(Self);
        end;
    end;
end;


procedure TEditForm.MIExitClick(Sender: TObject);
begin
   close;
end;

procedure TEditForm.MINewClick(Sender: TObject);
begin
    CheckTextModified;
    Editor.Lines.Clear;
    Editor.Modified:=False;
    PathName:=DefaultFileName;
    Self.Caption:=DefaultFileName;  
end;

procedure TEditForm.MISaveAsClick(Sender: TObject);
begin
    DgSave.FileName := DefaultFileName;
  if DgSave.Execute then
  begin
    PathName := DgSave.FileName;
    if DgSave.FilterIndex=1 then
    begin
        Editor.PlainText:=True;
        PathName:=PathName+'.txt';
    end;
    if DgSave.FilterIndex=2 then
    begin
        Editor.PlainText:=False;
        PathName:=PathName+'.rtf';
    end;
    if DgSave.FilterIndex=3 then
    begin
        Editor.PlainText:=False;
    end;
    Editor.Lines.SaveToFile(PathName);
    Editor.Modified := False;
    Caption := ExtractFileName(PathName);

  end;
end;

procedure TEditForm.MISaveClick(Sender: TObject);
begin
   if PathName = DefaultFileName then
    MISaveAsClick(Sender)
  else
  begin
    Editor.Lines.SaveToFile(PathName);
    Editor.Modified := False;
  end;
end;

procedure TEditForm.MIPrintClick(Sender: TObject);
begin
    if DgPrint.Execute then
    Editor.Print(PathName);
end;

procedure TEditForm.MIPrinterSetupClick(Sender: TObject);
begin
     DgPrinterSetup.Execute;
end;

procedure TEditForm.MIOpenClick(Sender: TObject);
begin
      DgOpen.Execute;
end;

procedure TEditForm.MICutClick(Sender: TObject);
begin
    Editor.CutToClipboard;
end;

procedure TEditForm.MICopyClick(Sender: TObject);
begin
    Editor.CopyToClipboard;
end;

procedure TEditForm.MIPasteClick(Sender: TObject);
begin
      Editor.PasteFromClipboard;
end;

procedure TEditForm.MIDeleteClick(Sender: TObject);
begin
    Editor.ClearSelection;
end;

procedure TEditForm.MISelAllClick(Sender: TObject);
begin
     Editor.SelectAll;
end;

procedure TEditForm.MIUndoClick(Sender: TObject);
begin
       if not HasUndo then
       begin
         Editor.Undo;
         HasUndo:=True;
       end;  
end;

procedure TEditForm.MIFindClick(Sender: TObject);
begin
       DgFind.Execute;
end;

procedure TEditForm.DgFindFind(Sender: TObject);
var
  FoundPos,StartPos,FindLen:integer;
  st:TSearchTypes;
begin
    if not (frDown in DgFind.Options) then
    begin
        DgFind.CloseDialog;
        ShowMessage('¶Ô²»Æð,Ä¿&Cce
dil;��Ö»ÄÜÏ��ϲ��ÕÒ.'
);
        exit;
    end;
    StartPos:=Editor.SelStart+Editor.SelLength;
    FindLen:=Length(Editor.Text)-StartPos;
    st:=[];
    if frMatchCase in DgFind.Options then
      st:=st+[stMatchCase];
    if frWholeWord in DgFind.Options then
      st:=st+[stWholeWord];
    FoundPos:=Editor.FindText(DgFind.FindText,StartPos,FindLen,st);
    DgFind.CloseDialog;
    if FoundPos <> -1 then
    begin
        Editor.SelStart:=FoundPos;
        Editor.SelLength:=Length(DgFind.FindText);
    end
    else
        ShowMessage('&Atilde;&raquo;&Otilde;&Ograve;&micro;&frac12; '+DgFind.F
indText);
end;

procedure TEditForm.MIReplaceClick(Sender: TObject);
begin
   DgReplace.Execute;
end;

procedure TEditForm.DgReplaceReplace(Sender: TObject);
var
  FoundPos,StartPos,FindLen:integer;
  st:TSearchTypes;
begin
    if not (frDown in DgReplace.Options) then
    begin
        DgReplace.CloseDialog;
        ShowMessage('&para;&Ocirc;&sup2;&raquo;&AElig;&eth;,&Ouml;&raquo;&Auml
;&Uuml;&Iuml;��&Iuml;&Acirc;&Igrave;&aelig;&raquo;&raquo;');
        exit;
    end;
    StartPos:=Editor.SelStart+Editor.SelLength;
    FindLen:=Length(Editor.Text)-StartPos;  
    st:=[];
    if frMatchCase in DgReplace.Options then
      st:=st+[stMatchCase];
    if frWholeWord in DgReplace.Options then
      st:=st+[stWholeWord];
    FoundPos:=Editor.FindText(DgReplace.FindText,StartPos,FindLen,st);
    DgReplace.CloseDialog;
    if FoundPos <> -1 then
    begin
      while FoundPos <> -1 do
      begin
        Editor.SelStart:=FoundPos;
        Editor.SelLength:=Length(DgReplace.FindText);
        Editor.SelText:=DgReplace.ReplaceText;

        if not (frReplaceAll in DgReplace.Options) then
           break;

        StartPos:=Editor.SelStart+Length(DgReplace.ReplaceText);
        FindLen:=Length(Editor.Text)-StartPos;
        FoundPos:=Editor.FindText(DgReplace.FindText,
                                  StartPos,FindLen,st);
      end;
        ShowMessage('&Igrave;&aelig;&raquo;&raquo;&Iacute;����&Iuml;!');
    end
    else
        ShowMessage('&Icirc;&acute;&Otilde;&Ograve;&micro;&frac12; '+DgReplace
.FindText);

end;

procedure TEditForm.MIFontClick(Sender: TObject);
begin
    DgFont.Font.Assign(Editor.Font);
    if DgFont.Execute then
    Editor.SelAttributes.Assign(DgFont.Font);
end;

procedure TEditForm.MIAutoWarpClick(Sender: TObject);
begin
  with Editor do
  begin
    WordWrap := not WordWrap; 
    if WordWrap then
      ScrollBars := ssVertical
    else
      ScrollBars := ssBoth;
    MIAutoWarp.Checked := WordWrap;
  end;
end;

procedure TEditForm.MIAboutClick(Sender: TObject);
begin
   AboutForm.ShowModal;
end;

procedure TEditForm.FormCreate(Sender: TObject);
begin
  PathName := DefaultFileName;
  HasUndo:=False;
end;

procedure TEditForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
      CheckTextModified;
end;

procedure TEditForm.H1Click(Sender: TObject);
begin
   HelpForm.ShowModal;
end;

end.
--

�� ��Դ:�����Ļ����� http://bbs.cqupt.edu.cn��[FROM: 172.19.74.235]
Technical Details
Message-ID: <4KiZVi$RSF@bbs.cqupt.edu.cn>
Path: arc1-ca.pugleaf.net!g2news1.google.com!news3.google.com!news.glorb.com!nntp-server.pubsub.com!bbsnews.sdu.edu.cn!news.uestc.edu.cn!CQUPT

Show Full Headers
Complete Article Headers
X-Google-Thread: f7a78,bbd28735ced1eb6e
X-Google-Attributes: gidf7a78,public
X-Google-Language: ENGLISH,GB
Path: arc1-ca.pugleaf.net!g2news1.google.com!news3.google.com!news.glorb.com!nntp-server.pubsub.com!bbsnews.sdu.edu.cn!news.uestc.edu.cn!CQUPT
From: ufobug@bbs.cqupt.edu.cn-SPAM.no (�������������)
Newsgroups: cn.bbs.comp.lang.delphi
Subject: Re: �Ǹ�������delphiʵ��WINDOWS�ļ��±�������
Date: 26 Oct 2005 13:13:32 GMT
Organization: ��������
Message-ID: <4KiZVi$RSF@bbs.cqupt.edu.cn>
Mime-Version: 1.0
Content-Type: text/plain; charset="gb2312"
Content-Transfer-Encoding: 8bit
X-Filename: Delphi/M.1130332412.f0
Lines: 353