home *** CD-ROM | disk | FTP | other *** search
/ DOS/V Power Report 1996 August / VPR9608A.BIN / del20try / install / data.z / REMAIN.PAS < prev    next >
Pascal/Delphi Source File  |  1996-05-08  |  13KB  |  467 lines
  1. unit REMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, ClipBrd;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     MainMenu: TMainMenu;
  12.     FileNewItem: TMenuItem;
  13.     FileOpenItem: TMenuItem;
  14.     FileSaveItem: TMenuItem;
  15.     FileSaveAsItem: TMenuItem;
  16.     FilePrintItem: TMenuItem;
  17.     FileExitItem: TMenuItem;
  18.     EditUndoItem: TMenuItem;
  19.     EditCutItem: TMenuItem;
  20.     EditCopyItem: TMenuItem;
  21.     EditPasteItem: TMenuItem;
  22.     HelpContentsItem: TMenuItem;
  23.     HelpSearchItem: TMenuItem;
  24.     HelpHowToUseItem: TMenuItem;
  25.     HelpAboutItem: TMenuItem;
  26.     OpenDialog: TOpenDialog;
  27.     SaveDialog: TSaveDialog;
  28.     PrintDialog: TPrintDialog;
  29.     SpeedBar: TPanel;
  30.     OpenButton: TSpeedButton;
  31.     SaveButton: TSpeedButton;
  32.     PrintButton: TSpeedButton;
  33.     UndoButton: TSpeedButton;
  34.     CutButton: TSpeedButton;
  35.     CopyButton: TSpeedButton;
  36.     PasteButton: TSpeedButton;
  37.     Ruler: TPanel;
  38.     Bevel1: TBevel;
  39.     FontDialog1: TFontDialog;
  40.     FirstInd: TLabel;
  41.     LeftInd: TLabel;
  42.     RulerLine: TBevel;
  43.     RightInd: TLabel;
  44.     N5: TMenuItem;
  45.     miEditFont: TMenuItem;
  46.     BoldButton: TSpeedButton;
  47.     FontName: TComboBox;
  48.     ItalicButton: TSpeedButton;
  49.     LeftAlign: TSpeedButton;
  50.     CenterAlign: TSpeedButton;
  51.     RightAlign: TSpeedButton;
  52.     UnderlineButton: TSpeedButton;
  53.     BulletsButton: TSpeedButton;
  54.     RichEdit1: TRichEdit;
  55.     StatusBar: TStatusBar;
  56.     FontSize: TEdit;
  57.     UpDown1: TUpDown;
  58.  
  59.     procedure SelectionChange(Sender: TObject);
  60.     procedure FormCreate(Sender: TObject);
  61.     procedure ShowHint(Sender: TObject);
  62.     procedure FileNew(Sender: TObject);
  63.     procedure FileOpen(Sender: TObject);
  64.     procedure FileSave(Sender: TObject);
  65.     procedure FileSaveAs(Sender: TObject);
  66.     procedure FilePrint(Sender: TObject);
  67.     procedure FileExit(Sender: TObject);
  68.     procedure EditUndo(Sender: TObject);
  69.     procedure EditCut(Sender: TObject);
  70.     procedure EditCopy(Sender: TObject);
  71.     procedure EditPaste(Sender: TObject);
  72.     procedure HelpContents(Sender: TObject);
  73.     procedure HelpSearch(Sender: TObject);
  74.     procedure HelpHowToUse(Sender: TObject);
  75.     procedure HelpAbout(Sender: TObject);
  76.     procedure SelectFont(Sender: TObject);
  77.     procedure RulerResize(Sender: TObject);
  78.     procedure FormResize(Sender: TObject);
  79.     procedure FormPaint(Sender: TObject);
  80.     procedure BoldButtonClick(Sender: TObject);
  81.     procedure ItalicButtonClick(Sender: TObject);
  82.     procedure FontSizeChange(Sender: TObject);
  83.     procedure AlignButtonClick(Sender: TObject);
  84.     procedure FontNameChange(Sender: TObject);
  85.     procedure UnderlineButtonClick(Sender: TObject);
  86.     procedure BulletsButtonClick(Sender: TObject);
  87.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  88.     procedure RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
  89.       Shift: TShiftState; X, Y: Integer);
  90.     procedure RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X,
  91.       Y: Integer);
  92.     procedure FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  93.       Shift: TShiftState; X, Y: Integer);
  94.     procedure LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  95.       Shift: TShiftState; X, Y: Integer);
  96.     procedure RightIndMouseUp(Sender: TObject; Button: TMouseButton;
  97.       Shift: TShiftState; X, Y: Integer);
  98.   private
  99.     FFileName: String;
  100.     FUpdating: Boolean;
  101.     FDragOfs: Integer;
  102.     FDragging: Boolean;
  103.     function CurrText: TTextAttributes;
  104.     procedure GetFontNames;
  105.     procedure SetFileName(const FileName: String);
  106.     procedure CheckFileSave;
  107.     procedure SetupRuler;
  108.     procedure SetEditRect;
  109.   end;
  110.  
  111. var
  112.   MainForm: TMainForm;
  113.  
  114. implementation
  115.  
  116. uses REAbout;
  117.  
  118. const
  119.   RulerAdj = 4/3;
  120.   GutterWid = 6;
  121.  
  122. {$R *.DFM}
  123.  
  124. procedure TMainForm.SelectionChange(Sender: TObject);
  125. begin
  126.   with RichEdit1.Paragraph do
  127.   try
  128.     FUpdating := True;
  129.     FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid;
  130.     LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid;
  131.     RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj);
  132.     BoldButton.Down := fsBold in RichEdit1.SelAttributes.Style;
  133.     ItalicButton.Down := fsItalic in RichEdit1.SelAttributes.Style;
  134.     UnderlineButton.Down := fsUnderline in RichEdit1.SelAttributes.Style;
  135.     BulletsButton.Down := Boolean(Numbering);
  136.     FontSize.Text := IntToStr(RichEdit1.SelAttributes.Size);
  137.     FontName.Text := RichEdit1.SelAttributes.Name;
  138.     case Ord(Alignment) of
  139.       0: LeftAlign.Down := True;
  140.       1: RightAlign.Down := True;
  141.       2: CenterAlign.Down := True;
  142.     end;
  143.   finally
  144.     FUpdating := False;
  145.   end;
  146. end;
  147.  
  148. function TMainForm.CurrText: TTextAttributes;
  149. begin
  150.   if RichEdit1.SelLength > 0 then
  151.     Result := RichEdit1.SelAttributes
  152.   else
  153.     Result := RichEdit1.DefAttributes;
  154. end;
  155.  
  156. function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  157.   FontType: Integer; Data: Pointer): Integer; stdcall;
  158. begin
  159.   TStrings(Data).Add(LogFont.lfFaceName);
  160.   Result := 1;
  161. end;
  162.  
  163. procedure TMainForm.GetFontNames;
  164. var
  165.   DC: HDC;
  166. begin
  167.   DC := GetDC(0);
  168.   EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
  169.   ReleaseDC(0, DC);
  170.   FontName.Sorted := True;
  171. end;
  172.  
  173. procedure TMainForm.SetFileName(const FileName: String);
  174. begin
  175.   FFileName := FileName;
  176.   Caption := Format('%s - %s', [ExtractFileName(FileName), Application.Title]);
  177. end;
  178.  
  179. procedure TMainForm.CheckFileSave;
  180. var
  181.   SaveResp: Integer;
  182. begin
  183.   if not RichEdit1.Modified then Exit;
  184.   SaveResp := MessageDlg(Format('Save changes to %s?', [FFileName]),
  185.     mtConfirmation, mbYesNoCancel, 0);
  186.   case SaveResp of
  187.     idYes: FileSave(Self);
  188.     idNo: {Nothing};
  189.     idCancel: Abort;
  190.   end;
  191. end;
  192.  
  193. procedure TMainForm.SetupRuler;
  194. var
  195.   I: Integer;
  196.   S: String;
  197. begin
  198.   SetLength(S, 201);
  199.   I := 1;
  200.   while I < 200 do
  201.   begin
  202.     S[I] := #9;
  203.     S[I+1] := '|';
  204.     Inc(I, 2);
  205.   end;
  206.   Ruler.Caption := S;
  207. end;
  208.  
  209. procedure TMainForm.SetEditRect;
  210. var
  211.   R: TRect;
  212. begin
  213.   with RichEdit1 do
  214.   begin
  215.     R := Rect(GutterWid, 0, ClientWidth-GutterWid, ClientHeight);
  216.     SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
  217.   end;
  218. end;
  219.  
  220. { Event Handlers }
  221.  
  222. procedure TMainForm.FormCreate(Sender: TObject);
  223. begin
  224.   Application.OnHint := ShowHint;
  225.   OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
  226.   SaveDialog.InitialDir := OpenDialog.InitialDir;
  227.   SetFileName('Untitled');
  228.   GetFontNames;
  229.   SetupRuler;
  230.   SelectionChange(Self);
  231. end;
  232.  
  233. procedure TMainForm.ShowHint(Sender: TObject);
  234. begin
  235.   StatusBar.SimpleText := Application.Hint;
  236. end;
  237.  
  238. procedure TMainForm.FileNew(Sender: TObject);
  239. begin
  240.   SetFileName('Untitled');
  241.   RichEdit1.Lines.Clear;
  242.   RichEdit1.Modified := False;
  243. end;
  244.  
  245. procedure TMainForm.FileOpen(Sender: TObject);
  246. begin
  247.   CheckFileSave;
  248.   if OpenDialog.Execute then
  249.   begin
  250.     RichEdit1.Lines.LoadFromFile(OpenDialog.FileName);
  251.     SetFileName(OpenDialog.FileName);
  252.     RichEdit1.SetFocus;
  253.     RichEdit1.Modified := False;
  254.     RichEdit1.ReadOnly := ofReadOnly in OpenDialog.Options;
  255.   end;
  256. end;
  257.  
  258. procedure TMainForm.FileSave(Sender: TObject);
  259. begin
  260.   if FFileName = 'Untitled' then
  261.     FileSaveAs(Sender)
  262.   else
  263.   begin
  264.     RichEdit1.Lines.SaveToFile(FFileName);
  265.     RichEdit1.Modified := False;
  266.   end;
  267. end;
  268.  
  269. procedure TMainForm.FileSaveAs(Sender: TObject);
  270. begin
  271.   if SaveDialog.Execute then
  272.   begin
  273.     if FileExists(SaveDialog.FileName) then
  274.       if MessageDlg(Format('OK to overwrite %s', [SaveDialog.FileName]),
  275.         mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
  276.     RichEdit1.Lines.SaveToFile(SaveDialog.FileName);
  277.     SetFileName(SaveDialog.FileName);
  278.     RichEdit1.Modified := False;
  279.   end;
  280. end;
  281.  
  282. procedure TMainForm.FilePrint(Sender: TObject);
  283. begin
  284.   if PrintDialog.Execute then
  285.     RichEdit1.Print(FFileName);
  286. end;
  287.  
  288. procedure TMainForm.FileExit(Sender: TObject);
  289. begin
  290.   Close;
  291. end;
  292.  
  293. procedure TMainForm.EditUndo(Sender: TObject);
  294. begin
  295.   with RichEdit1 do
  296.     if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
  297. end;
  298.  
  299. procedure TMainForm.EditCut(Sender: TObject);
  300. begin
  301.   RichEdit1.CutToClipboard;
  302. end;
  303.  
  304. procedure TMainForm.EditCopy(Sender: TObject);
  305. begin
  306.   RichEdit1.CopyToClipboard;
  307. end;
  308.  
  309. procedure TMainForm.EditPaste(Sender: TObject);
  310. begin
  311.   RichEdit1.PasteFromClipboard;
  312. end;
  313.  
  314. procedure TMainForm.HelpContents(Sender: TObject);
  315. begin
  316.   Application.HelpCommand(HELP_CONTENTS, 0);
  317. end;
  318.  
  319. procedure TMainForm.HelpSearch(Sender: TObject);
  320. const
  321.   EmptyString: PChar = '';
  322. begin
  323.   Application.HelpCommand(HELP_PARTIALKEY, Longint(EmptyString));
  324. end;
  325.  
  326. procedure TMainForm.HelpHowToUse(Sender: TObject);
  327. begin
  328.   Application.HelpCommand(HELP_HELPONHELP, 0);
  329. end;
  330.  
  331. procedure TMainForm.HelpAbout(Sender: TObject);
  332. begin
  333.   with TAboutBox.Create(Self) do
  334.   try
  335.     ShowModal;
  336.   finally
  337.     Free;
  338.   end;
  339. end;
  340.  
  341. procedure TMainForm.SelectFont(Sender: TObject);
  342. begin
  343.   FontDialog1.Font.Assign(RichEdit1.SelAttributes);
  344.   if FontDialog1.Execute then
  345.     CurrText.Assign(FontDialog1.Font);
  346.   RichEdit1.SetFocus;
  347. end;
  348.  
  349. procedure TMainForm.RulerResize(Sender: TObject);
  350. begin
  351.   RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2);
  352. end;
  353.  
  354. procedure TMainForm.FormResize(Sender: TObject);
  355. begin
  356.   SetEditRect;
  357.   SelectionChange(Sender);
  358. end;
  359.  
  360. procedure TMainForm.FormPaint(Sender: TObject);
  361. begin
  362.   SetEditRect;
  363. end;
  364.  
  365. procedure TMainForm.BoldButtonClick(Sender: TObject);
  366. begin
  367.   if FUpdating then Exit;
  368.   if BoldButton.Down then
  369.     CurrText.Style := CurrText.Style + [fsBold]
  370.   else
  371.     CurrText.Style := CurrText.Style - [fsBold];
  372. end;
  373.  
  374. procedure TMainForm.ItalicButtonClick(Sender: TObject);
  375. begin
  376.   if FUpdating then Exit;
  377.   if ItalicButton.Down then
  378.     CurrText.Style := CurrText.Style + [fsItalic]
  379.   else
  380.     CurrText.Style := CurrText.Style - [fsItalic];
  381. end;
  382.  
  383. procedure TMainForm.FontSizeChange(Sender: TObject);
  384. begin
  385.   if FUpdating then Exit;
  386.   CurrText.Size := StrToInt(FontSize.Text);
  387. end;
  388.  
  389. procedure TMainForm.AlignButtonClick(Sender: TObject);
  390. begin
  391.   if FUpdating then Exit;
  392.   RichEdit1.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
  393. end;
  394.  
  395. procedure TMainForm.FontNameChange(Sender: TObject);
  396. begin
  397.   if FUpdating then Exit;
  398.   CurrText.Name := FontName.Items[FontName.ItemIndex];
  399. end;
  400.  
  401. procedure TMainForm.UnderlineButtonClick(Sender: TObject);
  402. begin
  403.   if FUpdating then Exit;
  404.   if UnderlineButton.Down then
  405.     CurrText.Style := CurrText.Style + [fsUnderline]
  406.   else
  407.     CurrText.Style := CurrText.Style - [fsUnderline];
  408. end;
  409.  
  410. procedure TMainForm.BulletsButtonClick(Sender: TObject);
  411. begin
  412.   if FUpdating then Exit;
  413.   RichEdit1.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
  414. end;
  415.  
  416. procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  417. begin
  418.   try
  419.     CheckFileSave;
  420.   except
  421.     CanClose := False;
  422.   end;
  423. end;
  424.  
  425. { Ruler Indent Dragging }
  426.  
  427. procedure TMainForm.RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
  428.   Shift: TShiftState; X, Y: Integer);
  429. begin
  430.   FDragOfs := (TLabel(Sender).Width div 2);
  431.   TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs;
  432.   FDragging := True;
  433. end;
  434.  
  435. procedure TMainForm.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
  436.   X, Y: Integer);
  437. begin
  438.   if FDragging then
  439.     TLabel(Sender).Left :=  TLabel(Sender).Left+X-FDragOfs
  440. end;
  441.  
  442. procedure TMainForm.FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
  443.   Shift: TShiftState; X, Y: Integer);
  444. begin
  445.   FDragging := False;
  446.   RichEdit1.Paragraph.FirstIndent := Trunc((FirstInd.Left+FDragOfs-GutterWid) / RulerAdj);
  447.   LeftIndMouseUp(Sender, Button, Shift, X, Y);
  448. end;
  449.  
  450. procedure TMainForm.LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
  451.   Shift: TShiftState; X, Y: Integer);
  452. begin
  453.   FDragging := False;
  454.   RichEdit1.Paragraph.LeftIndent := Trunc((LeftInd.Left+FDragOfs-GutterWid) / RulerAdj)-RichEdit1.Paragraph.FirstIndent;
  455.   SelectionChange(Sender);
  456. end;
  457.  
  458. procedure TMainForm.RightIndMouseUp(Sender: TObject; Button: TMouseButton;
  459.   Shift: TShiftState; X, Y: Integer);
  460. begin
  461.   FDragging := False;
  462.   RichEdit1.Paragraph.RightIndent := Trunc((Ruler.ClientWidth-RightInd.Left+FDragOfs-2) / RulerAdj)-2*GutterWid;
  463.   SelectionChange(Sender);
  464. end;
  465.  
  466. end.
  467.