david
ab4c274533
git-svn-id: https://192.168.0.254/svn/Proyectos.Acana_FactuGES/trunk@4 3f40d355-893c-4141-8e64-b1d9be72e7e7
387 lines
11 KiB
ObjectPascal
387 lines
11 KiB
ObjectPascal
unit VistaRichEditor;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
|
Dialogs, RdxFrame, cxControls, cxContainer, cxEdit, cxTextEdit, cxMemo,
|
|
cxRichEdit, cxDBRichEdit, ComCtrls, StdCtrls, ToolWin, ImgList, ActnList,
|
|
Menus, ExtCtrls;
|
|
|
|
type
|
|
TfrVistaRichEdit = class(TRdxFrame)
|
|
Ruler: TPanel;
|
|
FontDialog1: TFontDialog;
|
|
FirstInd: TLabel;
|
|
LeftInd: TLabel;
|
|
RulerLine: TBevel;
|
|
RightInd: TLabel;
|
|
Editor: TRichEdit;
|
|
StatusBar: TStatusBar;
|
|
StandardToolBar: TToolBar;
|
|
UndoButton: TToolButton;
|
|
CutButton: TToolButton;
|
|
CopyButton: TToolButton;
|
|
PasteButton: TToolButton;
|
|
ToolButton10: TToolButton;
|
|
FontName: TComboBox;
|
|
FontSize: TEdit;
|
|
ToolButton11: TToolButton;
|
|
UpDown1: TUpDown;
|
|
BoldButton: TToolButton;
|
|
ItalicButton: TToolButton;
|
|
UnderlineButton: TToolButton;
|
|
ToolButton16: TToolButton;
|
|
LeftAlign: TToolButton;
|
|
CenterAlign: TToolButton;
|
|
RightAlign: TToolButton;
|
|
ToolButton20: TToolButton;
|
|
BulletsButton: TToolButton;
|
|
ToolbarImages: TImageList;
|
|
ToolButton2: TToolButton;
|
|
Bevel1: TBevel;
|
|
EditCutCmd: TAction;
|
|
EditCopyCmd: TAction;
|
|
EditPasteCmd: TAction;
|
|
EditUndoCmd: TAction;
|
|
EditFontCmd: TAction;
|
|
|
|
procedure SelectionChange(Sender: TObject);
|
|
procedure EditUndo(Sender: TObject);
|
|
procedure EditCut(Sender: TObject);
|
|
procedure EditCopy(Sender: TObject);
|
|
procedure EditPaste(Sender: TObject);
|
|
procedure SelectFont(Sender: TObject);
|
|
procedure RulerResize(Sender: TObject);
|
|
procedure FormResize(Sender: TObject);
|
|
procedure FormPaint(Sender: TObject);
|
|
procedure BoldButtonClick(Sender: TObject);
|
|
procedure ItalicButtonClick(Sender: TObject);
|
|
procedure FontSizeChange(Sender: TObject);
|
|
procedure AlignButtonClick(Sender: TObject);
|
|
procedure FontNameChange(Sender: TObject);
|
|
procedure UnderlineButtonClick(Sender: TObject);
|
|
procedure BulletsButtonClick(Sender: TObject);
|
|
procedure RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
procedure FirstIndMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure RightIndMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure RichEditChange(Sender: TObject);
|
|
procedure ActionList2Update(Action: TBasicAction;
|
|
var Handled: Boolean);
|
|
private
|
|
FFileName: string;
|
|
FUpdating: Boolean;
|
|
FDragOfs: Integer;
|
|
FDragging: Boolean;
|
|
function CurrText: TTextAttributes;
|
|
procedure GetFontNames;
|
|
procedure SetupRuler;
|
|
procedure SetEditRect;
|
|
procedure UpdateCursorPos;
|
|
procedure SetModified(Value: Boolean);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses RichEdit, ShellAPI;
|
|
|
|
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 TfrVistaRichEdit.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 TfrVistaRichEdit.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 TfrVistaRichEdit.GetFontNames;
|
|
var
|
|
DC: HDC;
|
|
begin
|
|
DC := GetDC(0);
|
|
EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
|
|
ReleaseDC(0, DC);
|
|
FontName.Sorted := True;
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.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 TfrVistaRichEdit.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 TfrVistaRichEdit.EditUndo(Sender: TObject);
|
|
begin
|
|
with Editor do
|
|
if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.EditCut(Sender: TObject);
|
|
begin
|
|
Editor.CutToClipboard;
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.EditCopy(Sender: TObject);
|
|
begin
|
|
Editor.CopyToClipboard;
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.EditPaste(Sender: TObject);
|
|
begin
|
|
Editor.PasteFromClipboard;
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.SelectFont(Sender: TObject);
|
|
begin
|
|
FontDialog1.Font.Assign(Editor.SelAttributes);
|
|
if FontDialog1.Execute then
|
|
CurrText.Assign(FontDialog1.Font);
|
|
SelectionChange(Self);
|
|
Editor.SetFocus;
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.RulerResize(Sender: TObject);
|
|
begin
|
|
RulerLine.Width := Ruler.ClientWidth - (RulerLine.Left*2);
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.FormResize(Sender: TObject);
|
|
begin
|
|
SetEditRect;
|
|
SelectionChange(Sender);
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.FormPaint(Sender: TObject);
|
|
begin
|
|
SetEditRect;
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.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 TfrVistaRichEdit.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 TfrVistaRichEdit.FontSizeChange(Sender: TObject);
|
|
begin
|
|
if FUpdating then Exit;
|
|
CurrText.Size := StrToInt(FontSize.Text);
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.AlignButtonClick(Sender: TObject);
|
|
begin
|
|
if FUpdating then Exit;
|
|
Editor.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.FontNameChange(Sender: TObject);
|
|
begin
|
|
if FUpdating then Exit;
|
|
CurrText.Name := FontName.Items[FontName.ItemIndex];
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.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 TfrVistaRichEdit.BulletsButtonClick(Sender: TObject);
|
|
begin
|
|
if FUpdating then Exit;
|
|
Editor.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
|
|
end;
|
|
|
|
{ Ruler Indent Dragging }
|
|
|
|
procedure TfrVistaRichEdit.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 TfrVistaRichEdit.RulerItemMouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
if FDragging then
|
|
TLabel(Sender).Left := TLabel(Sender).Left+X-FDragOfs
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.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 TfrVistaRichEdit.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 TfrVistaRichEdit.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 TfrVistaRichEdit.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 TfrVistaRichEdit.FormShow(Sender: TObject);
|
|
begin
|
|
UpdateCursorPos;
|
|
DragAcceptFiles(Handle, True);
|
|
RichEditChange(nil);
|
|
Editor.SetFocus;
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.RichEditChange(Sender: TObject);
|
|
begin
|
|
SetModified(Editor.Modified);
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.SetModified(Value: Boolean);
|
|
begin
|
|
if Value then StatusBar.Panels[1].Text := sModified
|
|
else StatusBar.Panels[1].Text := '';
|
|
end;
|
|
|
|
procedure TfrVistaRichEdit.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;
|
|
|
|
constructor TfrVistaRichEdit.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
GetFontNames;
|
|
SetupRuler;
|
|
SelectionChange(Self);
|
|
|
|
CurrText.Name := DefFontData.Name;
|
|
CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);
|
|
end;
|
|
|
|
end.
|