home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1997 March / VPR9703A.ISO / VPR_DATA / PROGRAM / DELPHI / 9703 / MEMOFORM.PAS < prev   
Pascal/Delphi Source File  |  1996-12-27  |  8KB  |  308 lines
  1. unit memoform;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Menus, ComCtrls, Buttons, ExtCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     MainMenu1: TMainMenu;
  12.     File1: TMenuItem;
  13.     Exit1: TMenuItem;
  14.     N1: TMenuItem;
  15.     PrintSetup1: TMenuItem;
  16.     Print1: TMenuItem;
  17.     N2: TMenuItem;
  18.     SaveAs1: TMenuItem;
  19.     Save1: TMenuItem;
  20.     Open1: TMenuItem;
  21.     New1: TMenuItem;
  22.     Help1: TMenuItem;
  23.     About1: TMenuItem;
  24.     HowtoUseHelp1: TMenuItem;
  25.     SearchforHelpOn1: TMenuItem;
  26.     Contents1: TMenuItem;
  27.     OpenDialog1: TOpenDialog;
  28.     SaveDialog1: TSaveDialog;
  29.     RichEdit1: TRichEdit;
  30.     Edit1: TMenuItem;
  31.     Replace1: TMenuItem;
  32.     Find1: TMenuItem;
  33.     N4: TMenuItem;
  34.     Paste1: TMenuItem;
  35.     Copy1: TMenuItem;
  36.     Cut1: TMenuItem;
  37.     N5: TMenuItem;
  38.     Undo1: TMenuItem;
  39.     PrintDialog1: TPrintDialog;
  40.     PrinterSetupDialog1: TPrinterSetupDialog;
  41.     FindDialog1: TFindDialog;
  42.     ReplaceDialog1: TReplaceDialog;
  43.     Panel1: TPanel;
  44.     SpeedButton1: TSpeedButton;
  45.     SpeedButton2: TSpeedButton;
  46.     SpeedButton3: TSpeedButton;
  47.     SpeedButton4: TSpeedButton;
  48.     SpeedButton5: TSpeedButton;
  49.     SpeedButton6: TSpeedButton;
  50.     SpeedButton7: TSpeedButton;
  51.     SpeedButton8: TSpeedButton;
  52.     SpeedButton9: TSpeedButton;
  53.     SpeedButton10: TSpeedButton;
  54.     SpeedButton11: TSpeedButton;
  55.     procedure Open1Click(Sender: TObject);
  56.     procedure SaveAs1Click(Sender: TObject);
  57.     procedure New1Click(Sender: TObject);
  58.     procedure About1Click(Sender: TObject);
  59.     procedure Save1Click(Sender: TObject);
  60.     procedure FormCreate(Sender: TObject);
  61.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  62.     procedure Exit1Click(Sender: TObject);
  63.     procedure Undo1Click(Sender: TObject);
  64.     procedure Cut1Click(Sender: TObject);
  65.     procedure Copy1Click(Sender: TObject);
  66.     procedure Paste1Click(Sender: TObject);
  67.     procedure Print1Click(Sender: TObject);
  68.     procedure PrintSetup1Click(Sender: TObject);
  69.     procedure Find1Click(Sender: TObject);
  70.     procedure FindDialog1Find(Sender: TObject);
  71.     procedure Replace1Click(Sender: TObject);
  72.     procedure ReplaceDialog1Replace(Sender: TObject);
  73.   private
  74.     { Private 宣言 }
  75.   public
  76.     FileName: string;
  77.     function VerifyModified: Boolean;
  78.   end;
  79.  
  80. var
  81.   Form1: TForm1;
  82.  
  83. implementation
  84.  
  85. uses memoabt;
  86.  
  87. {$R *.DFM}
  88.  
  89. procedure TForm1.Exit1Click(Sender: TObject);
  90. begin
  91.   Close;
  92. end;
  93.  
  94. procedure TForm1.Open1Click(Sender: TObject);
  95. begin
  96.   if VerifyModified then
  97.   begin
  98.     if OpenDialog1.Execute then
  99.     begin
  100.       FileName := OpenDialog1.FileName;
  101.       Caption := 'メモ帳 - ' + FileName;
  102.       RichEdit1.Lines.LoadFromFile(FileName);
  103.       RichEdit1.Modified := False;
  104.     end;
  105.   end;
  106. end;
  107.  
  108. procedure TForm1.SaveAs1Click(Sender: TObject);
  109. begin
  110.   if SaveDialog1.Execute then
  111.   begin
  112.     FileName := SaveDialog1.FileName;
  113.     Caption := 'メモ帳 - ' + FileName;
  114.     RichEdit1.Lines.SaveToFile(FileName);
  115.     RichEdit1.Modified := False;
  116.   end
  117.   else
  118.     Abort;
  119. end;
  120.  
  121. procedure TForm1.New1Click(Sender: TObject);
  122. begin
  123.   if VerifyModified then
  124.   begin
  125.     FileName := 'Untitled';
  126.     Caption := 'メモ帳 - ' + FileName;
  127.     RichEdit1.Lines.Clear;
  128.     RichEdit1.Modified := False;
  129.   end;
  130. end;
  131.  
  132. procedure TForm1.About1Click(Sender: TObject);
  133. begin
  134.   AboutBox.ShowModal;
  135. end;
  136.  
  137. procedure TForm1.Save1Click(Sender: TObject);
  138. begin
  139.   if FileName = 'Untitled' then
  140.     SaveAs1Click(Sender)
  141.   else
  142.   begin
  143.     RichEdit1.Lines.SaveToFile(FileName);
  144.     RichEdit1.Modified := False;
  145.   end;
  146. end;
  147.  
  148. procedure TForm1.FormCreate(Sender: TObject);
  149. begin
  150.   FileName := 'Untitled';
  151.   Caption := 'メモ帳 - ' + FileName;
  152. end;
  153.  
  154. function TForm1.VerifyModified: Boolean;
  155. var
  156.   Ret: Word;
  157. begin
  158.   Result := True;
  159.   if RichEdit1.Modified then
  160.   begin
  161.     Ret := MessageDlg('テキストは変更されています。保存しますか？',
  162.                       mtConfirmation, mbYesNoCancel, 0);
  163.     case Ret of
  164.     mrYes: Save1Click(Self);
  165.     mrNo: ;
  166.     mrCancel: Result := False;
  167.     end;
  168.   end;
  169. end;
  170.  
  171. procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  172. begin
  173.   CanClose := VerifyModified;
  174. end;
  175.  
  176. procedure TForm1.Undo1Click(Sender: TObject);
  177. begin
  178.   RichEdit1.Perform(EM_UNDO, 0, 0);
  179. end;
  180.  
  181. procedure TForm1.Cut1Click(Sender: TObject);
  182. begin
  183.   RichEdit1.CutToClipboard;
  184. end;
  185.  
  186. procedure TForm1.Copy1Click(Sender: TObject);
  187. begin
  188.   RichEdit1.CopyToClipboard;
  189. end;
  190.  
  191. procedure TForm1.Paste1Click(Sender: TObject);
  192. begin
  193.   RichEdit1.PasteFromClipboard;
  194. end;
  195.  
  196. procedure TForm1.Print1Click(Sender: TObject);
  197. begin
  198.   if PrintDialog1.Execute then
  199.     RichEdit1.Print(FileName);
  200. end;
  201.  
  202. procedure TForm1.PrintSetup1Click(Sender: TObject);
  203. begin
  204.   PrinterSetupDialog1.Execute;
  205. end;
  206.  
  207. procedure TForm1.Find1Click(Sender: TObject);
  208. begin
  209.   FindDialog1.Execute;
  210. end;
  211.  
  212. procedure TForm1.FindDialog1Find(Sender: TObject);
  213. var
  214.   Op: TSearchTypes;
  215.   Pos, Len, Scrl: Integer;
  216. begin
  217.   with Sender as TFindDialog do
  218.   begin
  219.     { オプションの設定 }
  220.     Op := [];
  221.     if frMatchCase in Options then
  222.       Include(Op, stMatchCase);
  223.     if frWholeWord in Options then
  224.       Include(Op, stWholeWord);
  225.     { テキストの最大長を調べる }
  226.     Len := GetWindowTextLength(RichEdit1.Handle);
  227.     { 文字列検索 }
  228.     Pos := RichEdit1.FindText(FindText, RichEdit1.SelStart + 1, Len, Op);
  229.     { 検索結果 }
  230.     if Pos > 0 then
  231.     begin
  232.       RichEdit1.SelStart := Pos;
  233.       RichEdit1.SelLength := Length(FindText);
  234.       { カーソルが見える位置にスクロールする }
  235.       Scrl := RichEdit1.Perform(EM_LINEFROMCHAR, Pos, 0)
  236.             - RichEdit1.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
  237.       RichEdit1.Perform(EM_LINESCROLL, 0, Scrl);
  238.     end
  239.     else
  240.       ShowMessage('''' + FindText + ''' not found');
  241.     CloseDialog;
  242.   end;
  243. end;
  244.  
  245. procedure TForm1.Replace1Click(Sender: TObject);
  246. begin
  247.   ReplaceDialog1.Execute;
  248. end;
  249.  
  250. procedure TForm1.ReplaceDialog1Replace(Sender: TObject);
  251. var
  252.   Op: TSearchTypes;
  253.   Pos, SavePos, Len, Scrl: Integer;
  254. begin
  255.   with ReplaceDialog1 do
  256.   begin
  257.     { オプションの設定 }
  258.     Op := [];
  259.     if frMatchCase in Options then
  260.       Include(Op, stMatchCase);
  261.     if frWholeWord in Options then
  262.       Include(Op, stWholeWord);
  263.     { テキストの最大長を調べる }
  264.     Len := GetWindowTextLength(RichEdit1.Handle);
  265.     if frReplaceAll in Options then
  266.     begin
  267.       { 全置換の場合 }
  268.       Pos := RichEdit1.SelStart;
  269.       SavePos := Pos;
  270.       repeat
  271.         Pos := RichEdit1.FindText(FindText, Pos + 1, Len, Op);
  272.         if Pos > 0 then
  273.         begin
  274.           RichEdit1.SelStart := Pos;
  275.           RichEdit1.SelLength := Length(FindText);
  276.           RichEdit1.SelText := ReplaceText;
  277.         end;
  278.       until Pos < 0;
  279.       { カーソルは最初の位置に戻す }
  280.       RichEdit1.SelStart := SavePos;
  281.     end
  282.     else
  283.     begin
  284.       { 置換して次へ }
  285.       if (frMatchCase in Options)
  286.           and (CompareStr(RichEdit1.SelText, FindText) = 0) then
  287.         RichEdit1.SelText := ReplaceText
  288.       else if not (frMatchCase in Options)
  289.           and (CompareText(RichEdit1.SelText, FindText) = 0) then
  290.         RichEdit1.SelText := ReplaceText;
  291.       Pos := RichEdit1.FindText(FindText, RichEdit1.SelStart + 1, Len, Op);
  292.       if Pos > 0 then
  293.       begin
  294.         RichEdit1.SelStart := Pos;
  295.         RichEdit1.SelLength := Length(FindText);
  296.         Scrl := RichEdit1.Perform(EM_LINEFROMCHAR, Pos, 0)
  297.               - RichEdit1.Perform(EM_GETFIRSTVISIBLELINE, 0, 0);
  298.         RichEdit1.Perform(EM_LINESCROLL, 0, Scrl);
  299.       end
  300.       else
  301.         ShowMessage('''' + FindText + ''' not found');
  302.     end;
  303.     { CloseDialog; }
  304.   end;
  305. end;
  306.  
  307. end.
  308.