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