home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Demos / Richedit / remain.pas < prev    next >
Pascal/Delphi Source File  |  1999-08-11  |  16KB  |  603 lines
  1. unit REMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, Windows, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, ClipBrd,
  8.   ToolWin, ActnList, ImgList;
  9.  
  10. type
  11.   TMainForm = class(TForm)
  12.     MainMenu: TMainMenu;
  13.     FileNewItem: TMenuItem;
  14.     FileOpenItem: TMenuItem;
  15.     FileSaveItem: TMenuItem;
  16.     FileSaveAsItem: TMenuItem;
  17.     FilePrintItem: TMenuItem;
  18.     FileExitItem: TMenuItem;
  19.     EditUndoItem: TMenuItem;
  20.     EditCutItem: TMenuItem;
  21.     EditCopyItem: TMenuItem;
  22.     EditPasteItem: TMenuItem;
  23.     HelpAboutItem: TMenuItem;
  24.     OpenDialog: TOpenDialog;
  25.     SaveDialog: TSaveDialog;
  26.     PrintDialog: TPrintDialog;
  27.     Ruler: TPanel;
  28.     FontDialog1: TFontDialog;
  29.     FirstInd: TLabel;
  30.     LeftInd: TLabel;
  31.     RulerLine: TBevel;
  32.     RightInd: TLabel;
  33.     N5: TMenuItem;
  34.     miEditFont: TMenuItem;
  35.     Editor: TRichEdit;
  36.     StatusBar: TStatusBar;
  37.     StandardToolBar: TToolBar;
  38.     OpenButton: TToolButton;
  39.     SaveButton: TToolButton;
  40.     PrintButton: TToolButton;
  41.     ToolButton5: TToolButton;
  42.     UndoButton: TToolButton;
  43.     CutButton: TToolButton;
  44.     CopyButton: TToolButton;
  45.     PasteButton: TToolButton;
  46.     ToolButton10: TToolButton;
  47.     FontName: TComboBox;
  48.     FontSize: TEdit;
  49.     ToolButton11: TToolButton;
  50.     UpDown1: TUpDown;
  51.     BoldButton: TToolButton;
  52.     ItalicButton: TToolButton;
  53.     UnderlineButton: TToolButton;
  54.     ToolButton16: TToolButton;
  55.     LeftAlign: TToolButton;
  56.     CenterAlign: TToolButton;
  57.     RightAlign: TToolButton;
  58.     ToolButton20: TToolButton;
  59.     BulletsButton: TToolButton;
  60.     ToolbarImages: TImageList;
  61.     ActionList1: TActionList;
  62.     FileNewCmd: TAction;
  63.     FileOpenCmd: TAction;
  64.     FileSaveCmd: TAction;
  65.     FilePrintCmd: TAction;
  66.     FileExitCmd: TAction;
  67.     ToolButton1: TToolButton;
  68.     ToolButton2: TToolButton;
  69.     Bevel1: TBevel;
  70.     LanguageMenu: TMenuItem;
  71.     LanguageEnglish: TMenuItem;
  72.     LanguageGerman: TMenuItem;
  73.     EditCutCmd: TAction;
  74.     EditCopyCmd: TAction;
  75.     EditPasteCmd: TAction;
  76.     EditUndoCmd: TAction;
  77.     EditFontCmd: TAction;
  78.     FileSaveAsCmd: TAction;
  79.     LanguageFrench: TMenuItem;
  80.  
  81.     procedure SelectionChange(Sender: TObject);
  82.     procedure FormCreate(Sender: TObject);
  83.     procedure ShowHint(Sender: TObject);
  84.     procedure FileNew(Sender: TObject);
  85.     procedure FileOpen(Sender: TObject);
  86.     procedure FileSave(Sender: TObject);
  87.     procedure FileSaveAs(Sender: TObject);
  88.     procedure FilePrint(Sender: TObject);
  89.     procedure FileExit(Sender: TObject);
  90.     procedure EditUndo(Sender: TObject);
  91.     procedure EditCut(Sender: TObject);
  92.     procedure EditCopy(Sender: TObject);
  93.     procedure EditPaste(Sender: TObject);
  94.     procedure HelpAbout(Sender: TObject);
  95.     procedure SelectFont(Sender: TObject);
  96.     procedure RulerResize(Sender: TObject);
  97.     procedure FormResize(Sender: TObject);
  98.     procedure FormPaint(Sender: TObject);
  99.     procedure BoldButtonClick(Sender: TObject);
  100.     procedure ItalicButtonClick(Sender: TObject);
  101.     procedure FontSizeChange(Sender: TObject);
  102.     procedure AlignButtonClick(Sender: TObject);
  103.     procedure FontNameChange(Sender: TObject);
  104.     procedure UnderlineButtonClick(Sender: TObject);
  105.     procedure BulletsButtonClick(Sender: TObject);
  106.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  107.     procedure RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
  108.       Shift: TShiftState; X, Y: Integer);
  109.     procedure RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X,
  110.       Y: Integer);
  111.     procedure FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  112.       Shift: TShiftState; X, Y: Integer);
  113.     procedure LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  114.       Shift: TShiftState; X, Y: Integer);
  115.     procedure RightIndMouseUp(Sender: TObject; Button: TMouseButton;
  116.       Shift: TShiftState; X, Y: Integer);
  117.     procedure FormShow(Sender: TObject);
  118.     procedure RichEditChange(Sender: TObject);
  119.     procedure SwitchLanguage(Sender: TObject);
  120.     procedure ActionList2Update(Action: TBasicAction;
  121.       var Handled: Boolean);
  122.   private
  123.     FFileName: string;
  124.     FUpdating: Boolean;
  125.     FDragOfs: Integer;
  126.     FDragging: Boolean;
  127.     function CurrText: TTextAttributes;
  128.     procedure GetFontNames;
  129.     procedure SetFileName(const FileName: String);
  130.     procedure CheckFileSave;
  131.     procedure SetupRuler;
  132.     procedure SetEditRect;
  133.     procedure UpdateCursorPos;
  134.     procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  135.     procedure PerformFileOpen(const AFileName: string);
  136.     procedure SetModified(Value: Boolean);
  137.   end;
  138.  
  139. var
  140.   MainForm: TMainForm;
  141.  
  142. implementation
  143.  
  144. uses REAbout, RichEdit, ShellAPI, ReInit;
  145.  
  146. resourcestring
  147.   sSaveChanges = 'Save changes to %s?';
  148.   sOverWrite = 'OK to overwrite %s';
  149.   sUntitled = 'Untitled';
  150.   sModified = 'Modified';
  151.   sColRowInfo = 'Line: %3d   Col: %3d';
  152.  
  153. const
  154.   RulerAdj = 4/3;
  155.   GutterWid = 6;
  156.  
  157.   ENGLISH = (SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH;
  158.   FRENCH  = (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
  159.   GERMAN  = (SUBLANG_GERMAN shl 10) or LANG_GERMAN;
  160.  
  161. {$R *.DFM}
  162.  
  163. procedure TMainForm.SelectionChange(Sender: TObject);
  164. begin
  165.   with Editor.Paragraph do
  166.   try
  167.     FUpdating := True;
  168.     FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid;
  169.     LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid;
  170.     RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj);
  171.     BoldButton.Down := fsBold in Editor.SelAttributes.Style;
  172.     ItalicButton.Down := fsItalic in Editor.SelAttributes.Style;
  173.     UnderlineButton.Down := fsUnderline in Editor.SelAttributes.Style;
  174.     BulletsButton.Down := Boolean(Numbering);
  175.     FontSize.Text := IntToStr(Editor.SelAttributes.Size);
  176.     FontName.Text := Editor.SelAttributes.Name;
  177.     case Ord(Alignment) of
  178.       0: LeftAlign.Down := True;
  179.       1: RightAlign.Down := True;
  180.       2: CenterAlign.Down := True;
  181.     end;
  182.     UpdateCursorPos;
  183.   finally
  184.     FUpdating := False;
  185.   end;
  186. end;
  187.  
  188. function TMainForm.CurrText: TTextAttributes;
  189. begin
  190.   if Editor.SelLength > 0 then Result := Editor.SelAttributes
  191.   else Result := Editor.DefAttributes;
  192. end;
  193.  
  194. function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  195.   FontType: Integer; Data: Pointer): Integer; stdcall;
  196. begin
  197.   TStrings(Data).Add(LogFont.lfFaceName);
  198.   Result := 1;
  199. end;
  200.  
  201. procedure TMainForm.GetFontNames;
  202. var
  203.   DC: HDC;
  204. begin
  205.   DC := GetDC(0);
  206.   EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
  207.   ReleaseDC(0, DC);
  208.   FontName.Sorted := True;
  209. end;
  210.  
  211. procedure TMainForm.SetFileName(const FileName: String);
  212. begin
  213.   FFileName := FileName;
  214.   Caption := Format('%s - %s', [ExtractFileName(FileName), Application.Title]);
  215. end;
  216.  
  217. procedure TMainForm.CheckFileSave;
  218. var
  219.   SaveResp: Integer;
  220. begin
  221.   if not Editor.Modified then Exit;
  222.   SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]),
  223.     mtConfirmation, mbYesNoCancel, 0);
  224.   case SaveResp of
  225.     idYes: FileSave(Self);
  226.     idNo: {Nothing};
  227.     idCancel: Abort;
  228.   end;
  229. end;
  230.  
  231. procedure TMainForm.SetupRuler;
  232. var
  233.   I: Integer;
  234.   S: String;
  235. begin
  236.   SetLength(S, 201);
  237.   I := 1;
  238.   while I < 200 do
  239.   begin
  240.     S[I] := #9;
  241.     S[I+1] := '|';
  242.     Inc(I, 2);
  243.   end;
  244.   Ruler.Caption := S;
  245. end;
  246.  
  247. procedure TMainForm.SetEditRect;
  248. var
  249.   R: TRect;
  250. begin
  251.   with Editor do
  252.   begin
  253.     R := Rect(GutterWid, 0, ClientWidth-GutterWid, ClientHeight);
  254.     SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
  255.   end;
  256. end;
  257.  
  258. { Event Handlers }
  259.  
  260. procedure TMainForm.FormCreate(Sender: TObject);
  261. begin
  262.   Application.OnHint := ShowHint;
  263.   OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  264.   SaveDialog.InitialDir := OpenDialog.InitialDir;
  265.   SetFileName(sUntitled);
  266.   GetFontNames;
  267.   SetupRuler;
  268.   SelectionChange(Self);
  269.  
  270.   CurrText.Name := DefFontData.Name;
  271.   CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);
  272.  
  273.   LanguageEnglish.Tag := ENGLISH;
  274.   LanguageFrench.Tag := FRENCH;
  275.   LanguageGerman.Tag := GERMAN;
  276.   case SysLocale.DefaultLCID of
  277.     ENGLISH: SwitchLanguage(LanguageEnglish);
  278.     FRENCH: SwitchLanguage(LanguageFrench);
  279.     GERMAN: SwitchLanguage(LanguageGerman);
  280.   end;
  281. end;
  282.  
  283. procedure TMainForm.ShowHint(Sender: TObject);
  284. begin
  285.   if Length(Application.Hint) > 0 then
  286.   begin
  287.     StatusBar.SimplePanel := True;
  288.     StatusBar.SimpleText := Application.Hint;
  289.   end
  290.   else StatusBar.SimplePanel := False;
  291. end;
  292.  
  293. procedure TMainForm.FileNew(Sender: TObject);
  294. begin
  295.   SetFileName(sUntitled);
  296.   Editor.Lines.Clear;
  297.   Editor.Modified := False;
  298.   SetModified(False);
  299. end;
  300.  
  301. procedure TMainForm.PerformFileOpen(const AFileName: string);
  302. begin
  303.   Editor.Lines.LoadFromFile(AFileName);
  304.   SetFileName(AFileName);
  305.   Editor.SetFocus;
  306.   Editor.Modified := False;
  307.   SetModified(False);
  308. end;
  309.  
  310. procedure TMainForm.FileOpen(Sender: TObject);
  311. begin
  312.   CheckFileSave;
  313.   if OpenDialog.Execute then
  314.   begin
  315.     PerformFileOpen(OpenDialog.FileName);
  316.     Editor.ReadOnly := ofReadOnly in OpenDialog.Options;
  317.   end;
  318. end;
  319.  
  320. procedure TMainForm.FileSave(Sender: TObject);
  321. begin
  322.   if FFileName = sUntitled then
  323.     FileSaveAs(Sender)
  324.   else
  325.   begin
  326.     Editor.Lines.SaveToFile(FFileName);
  327.     Editor.Modified := False;
  328.     SetModified(False);
  329.   end;
  330. end;
  331.  
  332. procedure TMainForm.FileSaveAs(Sender: TObject);
  333. begin
  334.   if SaveDialog.Execute then
  335.   begin
  336.     if FileExists(SaveDialog.FileName) then
  337.       if MessageDlg(Format(sOverWrite, [SaveDialog.FileName]),
  338.         mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
  339.     Editor.Lines.SaveToFile(SaveDialog.FileName);
  340.     SetFileName(SaveDialog.FileName);
  341.     Editor.Modified := False;
  342.     SetModified(False);
  343.   end;
  344. end;
  345.  
  346. procedure TMainForm.FilePrint(Sender: TObject);
  347. begin
  348.   if PrintDialog.Execute then
  349.     Editor.Print(FFileName);
  350. end;
  351.  
  352. procedure TMainForm.FileExit(Sender: TObject);
  353. begin
  354.   Close;
  355. end;
  356.  
  357. procedure TMainForm.EditUndo(Sender: TObject);
  358. begin
  359.   with Editor do
  360.     if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
  361. end;
  362.  
  363. procedure TMainForm.EditCut(Sender: TObject);
  364. begin
  365.   Editor.CutToClipboard;
  366. end;
  367.  
  368. procedure TMainForm.EditCopy(Sender: TObject);
  369. begin
  370.   Editor.CopyToClipboard;
  371. end;
  372.  
  373. procedure TMainForm.EditPaste(Sender: TObject);
  374. begin
  375.   Editor.PasteFromClipboard;
  376. end;
  377.  
  378. procedure TMainForm.HelpAbout(Sender: TObject);
  379. begin
  380.   with TAboutBox.Create(Self) do
  381.   try
  382.     ShowModal;
  383.   finally
  384.     Free;
  385.   end;
  386. end;
  387.  
  388. procedure TMainForm.SelectFont(Sender: TObject);
  389. begin
  390.   FontDialog1.Font.Assign(Editor.SelAttributes);
  391.   if FontDialog1.Execute then
  392.     CurrText.Assign(FontDialog1.Font);
  393.   SelectionChange(Self);
  394.   Editor.SetFocus;
  395. end;
  396.  
  397. procedure TMainForm.RulerResize(Sender: TObject);
  398. begin
  399.   RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2);
  400. end;
  401.  
  402. procedure TMainForm.FormResize(Sender: TObject);
  403. begin
  404.   SetEditRect;
  405.   SelectionChange(Sender);
  406. end;
  407.  
  408. procedure TMainForm.FormPaint(Sender: TObject);
  409. begin
  410.   SetEditRect;
  411. end;
  412.  
  413. procedure TMainForm.BoldButtonClick(Sender: TObject);
  414. begin
  415.   if FUpdating then Exit;
  416.   if BoldButton.Down then
  417.     CurrText.Style := CurrText.Style + [fsBold]
  418.   else
  419.     CurrText.Style := CurrText.Style - [fsBold];
  420. end;
  421.  
  422. procedure TMainForm.ItalicButtonClick(Sender: TObject);
  423. begin
  424.   if FUpdating then Exit;
  425.   if ItalicButton.Down then
  426.     CurrText.Style := CurrText.Style + [fsItalic]
  427.   else
  428.     CurrText.Style := CurrText.Style - [fsItalic];
  429. end;
  430.  
  431. procedure TMainForm.FontSizeChange(Sender: TObject);
  432. begin
  433.   if FUpdating then Exit;
  434.   CurrText.Size := StrToInt(FontSize.Text);
  435. end;
  436.  
  437. procedure TMainForm.AlignButtonClick(Sender: TObject);
  438. begin
  439.   if FUpdating then Exit;
  440.   Editor.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
  441. end;
  442.  
  443. procedure TMainForm.FontNameChange(Sender: TObject);
  444. begin
  445.   if FUpdating then Exit;
  446.   CurrText.Name := FontName.Items[FontName.ItemIndex];
  447. end;
  448.  
  449. procedure TMainForm.UnderlineButtonClick(Sender: TObject);
  450. begin
  451.   if FUpdating then Exit;
  452.   if UnderlineButton.Down then
  453.     CurrText.Style := CurrText.Style + [fsUnderline]
  454.   else
  455.     CurrText.Style := CurrText.Style - [fsUnderline];
  456. end;
  457.  
  458. procedure TMainForm.BulletsButtonClick(Sender: TObject);
  459. begin
  460.   if FUpdating then Exit;
  461.   Editor.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
  462. end;
  463.  
  464. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  465. begin
  466.   try
  467.     CheckFileSave;
  468.   except
  469.     CanClose := False;
  470.   end;
  471. end;
  472.  
  473. { Ruler Indent Dragging }
  474.  
  475. procedure TMainForm.RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
  476.   Shift: TShiftState; X, Y: Integer);
  477. begin
  478.   FDragOfs := (TLabel(Sender).Width div 2);
  479.   TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs;
  480.   FDragging := True;
  481. end;
  482.  
  483. procedure TMainForm.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
  484.   X, Y: Integer);
  485. begin
  486.   if FDragging then
  487.     TLabel(Sender).Left :=  TLabel(Sender).Left+X-FDragOfs
  488. end;
  489.  
  490. procedure TMainForm.FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  491.   Shift: TShiftState; X, Y: Integer);
  492. begin
  493.   FDragging := False;
  494.   Editor.Paragraph.FirstIndent := Trunc((FirstInd.Left+FDragOfs-GutterWid) / RulerAdj);
  495.   LeftIndMouseUp(Sender, Button, Shift, X, Y);
  496. end;
  497.  
  498. procedure TMainForm.LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  499.   Shift: TShiftState; X, Y: Integer);
  500. begin
  501.   FDragging := False;
  502.   Editor.Paragraph.LeftIndent := Trunc((LeftInd.Left+FDragOfs-GutterWid) / RulerAdj)-Editor.Paragraph.FirstIndent;
  503.   SelectionChange(Sender);
  504. end;
  505.  
  506. procedure TMainForm.RightIndMouseUp(Sender: TObject; Button: TMouseButton;
  507.   Shift: TShiftState; X, Y: Integer);
  508. begin
  509.   FDragging := False;
  510.   Editor.Paragraph.RightIndent := Trunc((Ruler.ClientWidth-RightInd.Left+FDragOfs-2) / RulerAdj)-2*GutterWid;
  511.   SelectionChange(Sender);
  512. end;
  513.  
  514. procedure TMainForm.UpdateCursorPos;
  515. var
  516.   CharPos: TPoint;
  517. begin
  518.   CharPos.Y := SendMessage(Editor.Handle, EM_EXLINEFROMCHAR, 0,
  519.     Editor.SelStart);
  520.   CharPos.X := (Editor.SelStart -
  521.     SendMessage(Editor.Handle, EM_LINEINDEX, CharPos.Y, 0));
  522.   Inc(CharPos.Y);
  523.   Inc(CharPos.X);
  524.   StatusBar.Panels[0].Text := Format(sColRowInfo, [CharPos.Y, CharPos.X]);
  525. end;
  526.  
  527. procedure TMainForm.FormShow(Sender: TObject);
  528. begin
  529.   UpdateCursorPos;
  530.   DragAcceptFiles(Handle, True);
  531.   RichEditChange(nil);
  532.   Editor.SetFocus;
  533.   { Check if we should load a file from the command line }
  534.   if (ParamCount > 0) and FileExists(ParamStr(1)) then
  535.     PerformFileOpen(ParamStr(1));
  536. end;
  537.  
  538. procedure TMainForm.WMDropFiles(var Msg: TWMDropFiles);
  539. var
  540.   CFileName: array[0..MAX_PATH] of Char;
  541. begin
  542.   try
  543.     if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
  544.     begin
  545.       CheckFileSave;
  546.       PerformFileOpen(CFileName);
  547.       Msg.Result := 0;
  548.     end;
  549.   finally
  550.     DragFinish(Msg.Drop);
  551.   end;
  552. end;
  553.  
  554. procedure TMainForm.RichEditChange(Sender: TObject);
  555. begin
  556.   SetModified(Editor.Modified);
  557. end;
  558.  
  559. procedure TMainForm.SetModified(Value: Boolean);
  560. begin
  561.   if Value then StatusBar.Panels[1].Text := sModified
  562.   else StatusBar.Panels[1].Text := '';
  563. end;
  564.  
  565. procedure TMainForm.SwitchLanguage(Sender: TObject);
  566. var
  567.   Name : String;
  568.   Size : Integer;
  569. begin
  570.   if LoadNewResourceModule(TComponent(Sender).Tag) <> 0 then
  571.   begin
  572.     Name := FontName.Text;
  573.     Size := StrToInt(FontSize.Text);
  574.     ReinitializeForms;
  575.     LanguageEnglish.Checked := LanguageEnglish = Sender;
  576.     LanguageFrench.Checked  := LanguageFrench  = Sender;
  577.     LanguageGerman.Checked  := LanguageGerman  = Sender;
  578.  
  579.     CurrText.Name := Name;
  580.     CurrText.Size := Size;
  581.     SelectionChange(Self);
  582.     FontName.SelLength := 0;
  583.  
  584.     SetupRuler;
  585.     if Visible then Editor.SetFocus;
  586.   end;
  587. end;
  588.  
  589. procedure TMainForm.ActionList2Update(Action: TBasicAction;
  590.   var Handled: Boolean);
  591. begin
  592.  { Update the status of the edit commands }
  593.   EditCutCmd.Enabled := Editor.SelLength > 0;
  594.   EditCopyCmd.Enabled := EditCutCmd.Enabled;
  595.   if Editor.HandleAllocated then
  596.   begin
  597.     EditUndoCmd.Enabled := Editor.Perform(EM_CANUNDO, 0, 0) <> 0;
  598.     EditPasteCmd.Enabled := Editor.Perform(EM_CANPASTE, 0, 0) <> 0;
  599.   end;
  600. end;
  601.  
  602. end.
  603.