unit remain;
interface
uses
{...}
type
{...}
procedure SelectionChange(Sender: TObject);
{...}
private
FFileName:
string;
FUpdating: Boolean;
FDragOfs: Integer;
FDragging: Boolean;
function CurrText: TTextAttributes;
procedure GetFontNames;
procedure SetFileName(
const FileName:
String);
procedure CheckFileSave;
procedure SetupRuler;
procedure SetEditRect;
procedure UpdateCursorPos;
procedure WMDropFiles(
var Msg: TWMDropFiles);
message WM_DROPFILES;
procedure PerformFileOpen(
const AFileName:
string);
procedure SetModified(Value: Boolean);
end;
var
MainForm: TMainForm;
implementation
uses REAbout, RichEdit, ShellAPI, ReInit;
resourcestring
sSaveChanges = '
Save changes to %s?';
sOverWrite = '
OK to overwrite %s';
sUntitled = '
Untitled';
sModified = '
Modified';
sColRowInfo = '
Line: %3d Col: %3d';
const
RulerAdj = 4/3;
GutterWid = 6;
ENGLISH = (SUBLANG_ENGLISH_US
shl 10)
or LANG_ENGLISH;
FRENCH = (SUBLANG_FRENCH
shl 10)
or LANG_FRENCH;
GERMAN = (SUBLANG_GERMAN
shl 10)
or LANG_GERMAN;
{$R *.dfm}
procedure TMainForm.SelectionChange(Sender: TObject);
begin
with Editor.Paragraph
do
try
FUpdating := True;
FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid;
LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid;
RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj);
BoldButton.Down := fsBold
in Editor.SelAttributes.Style;
ItalicButton.Down := fsItalic
in Editor.SelAttributes.Style;
UnderlineButton.Down := fsUnderline
in Editor.SelAttributes.Style;
BulletsButton.Down := Boolean(Numbering);
FontSize.Text := IntToStr(Editor.SelAttributes.Size);
FontName.Text := Editor.SelAttributes.
Name;
case Ord(Alignment)
of
0: LeftAlign.Down := True;
1: RightAlign.Down := True;
2: CenterAlign.Down := True;
end;
UpdateCursorPos;
finally
FUpdating := False;
end;
end;
function TMainForm.CurrText: TTextAttributes;
begin
if Editor.SelLength > 0
then Result := Editor.SelAttributes
else Result := Editor.DefAttributes;
end;
function EnumFontsProc(
var LogFont: TLogFont;
var TextMetric: TTextMetric;
FontType: Integer; Data: Pointer): Integer;
stdcall;
begin
TStrings(Data).Add(LogFont.lfFaceName);
Result := 1;
end;
procedure TMainForm.GetFontNames;
var
DC: HDC;
begin
DC := GetDC(0);
EnumFonts(
DC,
nil, @EnumFontsProc, Pointer(FontName.Items));
ReleaseDC(0,
DC);
FontName.Sorted := True;
end;
procedure TMainForm.SetFileName(
const FileName:
String);
begin
FFileName := FileName;
Caption := Format('
%s - %s', [ExtractFileName(FileName), Application.Title]);
end;
procedure TMainForm.CheckFileSave;
var
SaveResp: Integer;
begin
if not Editor.Modified
then Exit;
SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]),
mtConfirmation, mbYesNoCancel, 0);
case SaveResp
of
idYes: FileSave(Self);
idNo:
{Nothing};
idCancel: Abort;
end;
end;
procedure TMainForm.SetupRuler;
var
I: Integer;
S:
String;
begin
SetLength(S, 201);
I := 1;
while I < 200
do
begin
S[I] := #9;
S[I+1] := '
|';
Inc(I, 2);
end;
Ruler.Caption := S;
end;
procedure TMainForm.SetEditRect;
var
R: TRect;
begin
with Editor
do
begin
R := Rect(GutterWid, 0, ClientWidth-GutterWid, ClientHeight);
SendMessage(
Handle, EM_SETRECT, 0, Longint(@R));
end;
end;
{ Event Handlers }
procedure TMainForm.FormCreate(Sender: TObject);
begin
Application.OnHint := ShowHint;
OpenDialog.InitialDir := ExtractFilePath(ParamStr(0));
SaveDialog.InitialDir := OpenDialog.InitialDir;
SetFileName(sUntitled);
GetFontNames;
SetupRuler;
SelectionChange(Self);
CurrText.
Name := DefFontData.
Name;
CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);
LanguageEnglish.Tag := ENGLISH;
LanguageFrench.Tag := FRENCH;
LanguageGerman.Tag := GERMAN;
case SysLocale.DefaultLCID
of
ENGLISH: SwitchLanguage(LanguageEnglish);
FRENCH: SwitchLanguage(LanguageFrench);
GERMAN: SwitchLanguage(LanguageGerman);
end;
end;
procedure TMainForm.ShowHint(Sender: TObject);
begin
if Length(Application.Hint) > 0
then
begin
StatusBar.SimplePanel := True;
StatusBar.SimpleText := Application.Hint;
end
else StatusBar.SimplePanel := False;
end;
procedure TMainForm.FileNew(Sender: TObject);
begin
SetFileName(sUntitled);
Editor.Lines.Clear;
Editor.Modified := False;
SetModified(False);
end;
procedure TMainForm.PerformFileOpen(
const AFileName:
string);
begin
Editor.Lines.LoadFromFile(AFileName);
SetFileName(AFileName);
Editor.SetFocus;
Editor.Modified := False;
SetModified(False);
end;
procedure TMainForm.FileOpen(Sender: TObject);
begin
CheckFileSave;
if OpenDialog.Execute
then
begin
PerformFileOpen(OpenDialog.FileName);
Editor.
ReadOnly := ofReadOnly
in OpenDialog.Options;
end;
end;
procedure TMainForm.FileSave(Sender: TObject);
begin
if FFileName = sUntitled
then
FileSaveAs(Sender)
else
begin
Editor.Lines.SaveToFile(FFileName);
Editor.Modified := False;
SetModified(False);
end;
end;
procedure TMainForm.FileSaveAs(Sender: TObject);
begin
if SaveDialog.Execute
then
begin
if FileExists(SaveDialog.FileName)
then
if MessageDlg(Format(sOverWrite, [SaveDialog.FileName]),
mtConfirmation, mbYesNoCancel, 0) <> idYes
then Exit;
Editor.Lines.SaveToFile(SaveDialog.FileName);
SetFileName(SaveDialog.FileName);
Editor.Modified := False;
SetModified(False);
end;
end;
procedure TMainForm.FilePrint(Sender: TObject);
begin
if PrintDialog.Execute
then
Editor.Print(FFileName);
end;
procedure TMainForm.FileExit(Sender: TObject);
begin
Close;
end;
procedure TMainForm.EditUndo(Sender: TObject);
begin
with Editor
do
if HandleAllocated
then SendMessage(
Handle, EM_UNDO, 0, 0);
end;
procedure TMainForm.EditCut(Sender: TObject);
begin
Editor.CutToClipboard;
end;
procedure TMainForm.EditCopy(Sender: TObject);
begin
Editor.CopyToClipboard;
end;
procedure TMainForm.EditPaste(Sender: TObject);
begin
Editor.PasteFromClipboard;
end;
procedure TMainForm.HelpAbout(Sender: TObject);
begin
with TAboutBox.Create(Self)
do
try
ShowModal;
finally
Free;
end;
end;
procedure TMainForm.SelectFont(Sender: TObject);
begin
FontDialog1.Font.Assign(Editor.SelAttributes);
if FontDialog1.Execute
then
CurrText.Assign(FontDialog1.Font);
SelectionChange(Self);
Editor.SetFocus;
end;
procedure TMainForm.RulerResize(Sender: TObject);
begin
RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2);
end;
procedure TMainForm.FormResize(Sender: TObject);
begin
SetEditRect;
SelectionChange(Sender);
end;
procedure TMainForm.FormPaint(Sender: TObject);
begin
SetEditRect;
end;
procedure TMainForm.BoldButtonClick(Sender: TObject);
begin
if FUpdating
then Exit;
if BoldButton.Down
then
CurrText.Style := CurrText.Style + [fsBold]
else
CurrText.Style := CurrText.Style - [fsBold];
end;
procedure TMainForm.ItalicButtonClick(Sender: TObject);
begin
if FUpdating
then Exit;
if ItalicButton.Down
then
CurrText.Style := CurrText.Style + [fsItalic]
else
CurrText.Style := CurrText.Style - [fsItalic];
end;
procedure TMainForm.FontSizeChange(Sender: TObject);
begin
if FUpdating
then Exit;
CurrText.Size := StrToInt(FontSize.Text);
end;
procedure TMainForm.AlignButtonClick(Sender: TObject);
begin
if FUpdating
then Exit;
Editor.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
end;
procedure TMainForm.FontNameChange(Sender: TObject);
begin
if FUpdating
then Exit;
CurrText.
Name := FontName.Items[FontName.ItemIndex];
end;
procedure TMainForm.UnderlineButtonClick(Sender: TObject);
begin
if FUpdating
then Exit;
if UnderlineButton.Down
then
CurrText.Style := CurrText.Style + [fsUnderline]
else
CurrText.Style := CurrText.Style - [fsUnderline];
end;
procedure TMainForm.BulletsButtonClick(Sender: TObject);
begin
if FUpdating
then Exit;
Editor.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
end;
procedure TMainForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
try
CheckFileSave;
except
CanClose := False;
end;
end;
{ Ruler Indent Dragging }
procedure TMainForm.RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragOfs := (TLabel(Sender).Width
div 2);
TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs;
FDragging := True;
end;
procedure TMainForm.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if FDragging
then
TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs
end;
procedure TMainForm.FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
Editor.Paragraph.FirstIndent := Trunc((FirstInd.Left+FDragOfs-GutterWid) / RulerAdj);
LeftIndMouseUp(Sender, Button, Shift, X, Y);
end;
procedure TMainForm.LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
Editor.Paragraph.LeftIndent := Trunc((LeftInd.Left+FDragOfs-GutterWid) / RulerAdj)-Editor.Paragraph.FirstIndent;
SelectionChange(Sender);
end;
procedure TMainForm.RightIndMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
Editor.Paragraph.RightIndent := Trunc((Ruler.ClientWidth-RightInd.Left+FDragOfs-2) / RulerAdj)-2*GutterWid;
SelectionChange(Sender);
end;
procedure TMainForm.UpdateCursorPos;
var
CharPos: TPoint;
begin
CharPos.Y := SendMessage(Editor.Handle, EM_EXLINEFROMCHAR, 0,
Editor.SelStart);
CharPos.X := (Editor.SelStart -
SendMessage(Editor.Handle, EM_LINEINDEX, CharPos.Y, 0));
Inc(CharPos.Y);
Inc(CharPos.X);
StatusBar.Panels[0].Text := Format(sColRowInfo, [CharPos.Y, CharPos.X]);
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
UpdateCursorPos;
DragAcceptFiles(
Handle, True);
RichEditChange(
nil);
Editor.SetFocus;
{ Check if we should load a file from the command line }
if (ParamCount > 0)
and FileExists(ParamStr(1))
then
PerformFileOpen(ParamStr(1));
end;
procedure TMainForm.WMDropFiles(
var Msg: TWMDropFiles);
var
CFileName:
array[0..MAX_PATH]
of Char;
begin
try
if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0
then
begin
CheckFileSave;
PerformFileOpen(CFileName);
Msg.Result := 0;
end;
finally
DragFinish(Msg.Drop);
end;
end;
procedure TMainForm.RichEditChange(Sender: TObject);
begin
SetModified(Editor.Modified);
end;
procedure TMainForm.SetModified(Value: Boolean);
begin
if Value
then StatusBar.Panels[1].Text := sModified
else StatusBar.Panels[1].Text := '
';
end;
procedure TMainForm.SwitchLanguage(Sender: TObject);
var
Name :
String;
Size : Integer;
begin
if LoadNewResourceModule(TComponent(Sender).Tag) <> 0
then
begin
Name := FontName.Text;
Size := StrToInt(FontSize.Text);
ReinitializeForms;
LanguageEnglish.Checked := LanguageEnglish = Sender;
LanguageFrench.Checked := LanguageFrench = Sender;
LanguageGerman.Checked := LanguageGerman = Sender;
CurrText.
Name :=
Name;
CurrText.Size := Size;
SelectionChange(Self);
FontName.SelLength := 0;
SetupRuler;
if Visible
then Editor.SetFocus;
end;
end;
procedure TMainForm.ActionList2Update(Action: TBasicAction;
var Handled: Boolean);
begin
{ Update the status of the edit commands }
EditCutCmd.Enabled := Editor.SelLength > 0;
EditCopyCmd.Enabled := EditCutCmd.Enabled;
if Editor.HandleAllocated
then
begin
EditUndoCmd.Enabled := Editor.Perform(EM_CANUNDO, 0, 0) <> 0;
EditPasteCmd.Enabled := Editor.Perform(EM_CANPASTE, 0, 0) <> 0;
end;
end;
procedure TMainForm.UpDown1Click(Sender: TObject; Button: TUDBtnType);
begin
end;
end.