home *** CD-ROM | disk | FTP | other *** search
- unit EditMain;
-
- interface
-
- uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- Menus, ComCtrls, StdCtrls, ShellAPI, ToolWin, ExtCtrls, RzPanel, Buttons,
- RichEdit, RzStatus, RichEdit2;
-
- type
- TForm1 = class(TForm)
- MainMenu1: TMainMenu;
- File1: TMenuItem;
- Edit1: TMenuItem;
- Format1: TMenuItem;
- Help1: TMenuItem;
- New1: TMenuItem;
- Open1: TMenuItem;
- Close1: TMenuItem;
- N1: TMenuItem;
- Save1: TMenuItem;
- SaveAs1: TMenuItem;
- N2: TMenuItem;
- SaveSetttings1: TMenuItem;
- Exit1: TMenuItem;
- RzToolbar1: TRzToolbar;
- FileNew: TSpeedButton;
- FileOpen: TSpeedButton;
- FileSave: TSpeedButton;
- FilePrint: TSpeedButton;
- RzSpacer1: TRzSpacer;
- SpeedButton5: TSpeedButton;
- SpeedButton6: TSpeedButton;
- SpeedButton7: TSpeedButton;
- RzSpacer2: TRzSpacer;
- UndoButton: TSpeedButton;
- EditCut: TSpeedButton;
- EditCopy: TSpeedButton;
- EditPaste: TSpeedButton;
- RzSpacer3: TRzSpacer;
- EditBold: TSpeedButton;
- EditItalic: TSpeedButton;
- EditUnderline: TSpeedButton;
- RzSpacer4: TRzSpacer;
- SpeedButton16: TSpeedButton;
- EditDelete: TSpeedButton;
- RzStatusBar1: TRzStatusBar;
- RzClockStatus1: TRzClockStatus;
- Font1: TMenuItem;
- N3: TMenuItem;
- Bold1: TMenuItem;
- Italic1: TMenuItem;
- Underline1: TMenuItem;
- Strikeout1: TMenuItem;
- RichEdit1: TRichEdit2;
- RzStatusPane1: TRzStatusPane;
- procedure FormCreate(Sender: TObject);
- procedure RichEdit2SelectionChange(Sender: TObject);
- procedure EditButtonClick (Sender: TObject);
- procedure EditSelectionClick(Sender: TObject);
- private
- { Private declarations }
- procedure EnableDisableToolBar;
- procedure URLLinkNotification (Link: Pointer);
- protected
- procedure WMNotify (var Message: TWMNotify); message wm_Notify;
- public
- { Public declarations }
- end;
-
- var
- Form1: TForm1;
-
- implementation
-
- {$R *.DFM}
-
- procedure TForm1.EnableDisableToolBar;
- var
- GotSelection: Boolean;
- SelStart, SelEnd: LongInt;
- begin
- UndoButton.Enabled := RichEdit1.Perform (em_CanUndo, 0, 0) <> 0;
- EditPaste.Enabled := IsClipboardFormatAvailable (cf_Text);
- RichEdit1.Perform (em_GetSel, Integer (@SelStart), Integer (@SelEnd));
- GotSelection := SelStart <> SelEnd;
- EditDelete.Enabled := GotSelection;
- EditCopy.Enabled := GotSelection;
- EditCut.Enabled := GotSelection;
- end;
-
- procedure TForm1.RichEdit2SelectionChange(Sender: TObject);
- begin
- EnableDisableToolBar;
- end;
-
- procedure TForm1.FormCreate(Sender: TObject);
- var
- mask: Integer;
- begin
- DragAcceptFiles (RichEdit1.Handle, True);
- EnableDisableToolBar;
- RichEdit1.Perform (em_AutoURLDetect, 1, 0);
- mask := RichEdit1.Perform (em_GetEventMask, 0, 0);
- mask := mask or enm_Link;
- RichEdit1.Perform (em_SetEventMask, 0, mask);
- end;
-
- procedure TForm1.EditButtonClick (Sender: TObject);
- begin
- with Sender as TSpeedButton do RichEdit1.Perform (Tag, 0, 0);
- EnableDisableToolBar;
- end;
-
- procedure TForm1.EditSelectionClick(Sender: TObject);
- var
- Style: Integer;
- cfm: TCharFormat;
- begin
- if Sender is TSpeedButton then Style := TSpeedButton(Sender).Tag else
- if Sender is TMenuItem then Style := TMenuItem(Sender).Tag else Exit;
- cfm.cbSize := sizeof (cfm);
- RichEdit1.Perform (em_GetCharFormat, Integer (True), Integer (@cfm));
- cfm.dwEffects := cfm.dwEffects xor Style;
- RichEdit1.Perform (em_SetCharFormat, scf_Selection, Integer (@cfm));
- EnableDisableToolBar;
- end;
-
- procedure TForm1.WMNotify (var Message: TWMNotify);
- begin
- if Message.NMHdr^.hwndFrom = RichEdit1.Handle then case Message.NMHdr^.code of
- en_Link: URLLinkNotification (Message.NMHdr);
- // Add other notification types here....
- end;
- end;
-
- procedure TForm1.URLLinkNotification (Link: Pointer);
- type
- // Need to redefine this - RICHTEXT.PAS gets it wrong!
- TTextRange = record
- chrg: TCharRange;
- lpstrText: PAnsiChar;
- end;
- var
- sz: String;
- TextRange: TTextRange;
- pENLink: ^TENLink absolute Link;
- begin
- with pENLink^ do begin
- SetLength (sz, chrg.cpMax - chrg.cpMin);
- TextRange.chrg := chrg;
- TextRange.lpstrText := Pointer (sz);
- RichEdit1.Perform (em_GetTextRange, 0, Integer (@TextRange));
-
- if Msg = wm_MouseMove then RzStatusPane1.Caption := sz
- else if Msg = wm_LButtonDown then ShellExecute (Handle, 'open', PChar (sz), Nil, Nil, sw_Show);
- end;
- end;
-
- end.
-