unit Unit2;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
ExtCtrls, Spin, RichMemo;
type
{ TForm2 }
TForm2 = class(TForm)
Button1: TButton;
cboFont: TComboBox;
ImageList1: TImageList;
Label1: TLabel;
Label2: TLabel;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
Panel2: TPanel;
RichMemo1: TRichMemo;
SaveDialog1: TSaveDialog;
SpinEdit1: TSpinEdit;
StatusBar1: TStatusBar;
TabControl1: TTabControl;
ToolBar1: TToolBar;
btnNew: TToolButton;
btnOpen: TToolButton;
btnSave: TToolButton;
Seperate: TToolButton;
BtnBold: TToolButton;
BtnItalic: TToolButton;
BtnUnderline: TToolButton;
procedure BtnBoldClick(Sender: TObject);
procedure BtnItalicClick(Sender: TObject);
procedure btnNewClick(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure BtnUnderlineClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure cboFontSelect(Sender: TObject);
procedure cboFontSizeSelect(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
procedure FormCreate(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure RichMemo1Change(Sender: TObject);
procedure PrepareToolbar();
procedure RichMemo1Click(Sender: TObject);
procedure SpinEdit1Change(Sender: TObject);
private
public
end;
var
SelFontFormat: TFontParams;
Form2: TForm2;
Filename: String = 'Untitled';
Filepath: String;
Saved: Boolean;
implementation
{$R *.lfm}
{ TForm2 }
procedure TForm2.PrepareToolbar();
var
Down: Boolean;
begin
cboFont.Caption:=SelFontFormat.Name;
SpinEdit1.Caption:=inttostr(SelFontFormat.Size);
if (fsBold in SelFontFormat.Style = true) then
btnBold.Down:=True
else
btnBold.Down:=False;
if (fsItalic in SelFontFormat.Style = true) then
btnItalic.Down:=True
else
btnItalic.Down:=False;
if (fsUnderline in SelFontFormat.Style = true) then
btnUnderline.Down:=True
else
btnUnderline.Down:=False;
end;
procedure TForm2.RichMemo1Click(Sender: TObject);
begin
RichMemo1.GetTextAttributes(RichMemo1.SelStart, SelFontFormat);
PrepareToolbar;
end;
procedure TForm2.SpinEdit1Change(Sender: TObject);
begin
end;
procedure TForm2.cboFontSelect(Sender: TObject);
begin
SelFontFormat.Name:=cboFont.Items[cboFont.ItemIndex];
RichMemo1.SetTextAttributes(RichMemo1.SelStart, RichMemo1.SelLength, SelFontFormat);
RichMemo1.SetFocus; // get focus to the rich memo
end;
procedure TForm2.cboFontSizeSelect(Sender: TObject);
begin
end;
procedure TForm2.FormCloseQuery(Sender: TObject; var CanClose: boolean);
var
Response: Integer;
begin
if not Saved then begin
Response:=MessageDlg('Save?', 'Do you wish to Save?',
mtConfirmation, mbYesNoCancel,0);
if Response = mrYes then begin
btnSaveClick(Sender); // we save it
CanClose:=True; // we let it close
end else if Response = mrNo then begin
CanClose:=True; // we let it close (but not save)
end else begin
CanClose:=False; // we don't need to close
end;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
cboFont.Items.Assign(Screen.Fonts);
cboFont.ItemIndex:=0;
end;
procedure TForm2.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
RichMemo1.GetTextAttributes(RichMemo1.SelStart, SelFontFormat);
PrepareToolbar;
end;
procedure TForm2.btnNewClick(Sender: TObject);
begin
RichMemo1.Clear;
Saved:=False;
Filename:='Untitled.rtf';
Filepath:='';
Caption:=Filename;
end;
procedure TForm2.BtnBoldClick(Sender: TObject);
begin
if (fsBold in SelFontFormat.Style = False) then
SelFontFormat.Style:=SelFontFormat.Style + [fsBold]
else
SelFontFormat.Style:=SelFontFormat.Style - [fsBold];
RichMemo1.SetTextAttributes(RichMemo1.SelStart,
RichMemo1.SelLength, SelFontFormat);
end;
procedure TForm2.BtnItalicClick(Sender: TObject);
begin
if (fsItalic in SelFontFormat.Style = False) then
SelFontFormat.Style:=SelFontFormat.Style + [fsItalic]
else
SelFontFormat.Style:=SelFontFormat.Style - [fsItalic];
RichMemo1.SetTextAttributes(RichMemo1.SelStart,
RichMemo1.SelLength, SelFontFormat);
end;
procedure TForm2.btnOpenClick(Sender: TObject);
var
fs : TFileStream;
begin
if OpenDialog1.Execute then begin
fs := nil;
try
// Utf8ToAnsi is required for windows
fs := TFileStream.Create(Utf8ToAnsi(OpenDialog1.FileName), fmOpenRead or fmShareDenyNone);
RichMemo1.LoadRichText(fs);
Saved:=True; // since we opened a saved file
Filename:=ExtractFileName(OpenDialog1.FileName);
Filepath:=ExtractFilePath(OpenDialog1.FileName);
Caption:=Filename;
except
end;
fs.Free;
end;
end;
procedure TForm2.btnSaveClick(Sender: TObject);
var
fs : TFileStream;
begin
if SaveDialog1.Execute then begin
fs := nil;
try
fs := TFileStream.Create( Utf8ToAnsi(SaveDialog1.FileName), fmCreate);
RichMemo1.SaveRichText(fs);
Saved:=True;
Filename:=ExtractFileName(SaveDialog1.FileName);
Filepath:=ExtractFilePath(SaveDialog1.FileName);
Caption:=Filename;
except
end;
fs.Free;
end;
end;
procedure TForm2.BtnUnderlineClick(Sender: TObject);
begin
if (fsUnderline in SelFontFormat.Style = False) then
SelFontFormat.Style:=SelFontFormat.Style + [fsUnderline]
else
SelFontFormat.Style:=SelFontFormat.Style - [fsUnderline];
RichMemo1.SetTextAttributes(RichMemo1.SelStart,
RichMemo1.SelLength, SelFontFormat);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
end;
procedure TForm2.RichMemo1Change(Sender: TObject);
begin
RichMemo1.GetTextAttributes(RichMemo1.SelStart, SelFontFormat);
Saved:=False;
end;
end.