ariched.pas
来自「delphi编程控件」· PAS 代码 · 共 2,114 行 · 第 1/5 页
PAS
2,114 行
FBorderStyle := bsSingle;
FHiddenControls := TList.Create;
FHideScrollBars := True;
FHideSelection := True;
FMultiCharUndoRedo := True;
FRichEditStrings := TAutoRichEditStrings.Create;
TAutoRichEditStrings(FRichEditStrings).RichEdit := Self;
FDefAttributes := TAutoTextAttributes.Create(Self, atDefaultText);
FSelAttributes := TAutoTextAttributes.Create(Self, atSelected);
FParagraph := TAutoParaAttributes.Create(Self);
FScrollBars := ssVertical;
FUndoRedoLimit := 100;
FWantReturns := True;
FWantTabs := True;
FWordWrap := True;
TabStop := True;
DC := GetDC(0);
FScreenLogPixels := GetDeviceCaps(DC, LOGPIXELSY);
ReleaseDC(0, DC);
end;
destructor TCustomAutoRichEdit.Destroy;
begin
if TempStream <> nil then TempStream.Free;
if not (csDesigning in ComponentState) then
CallWindowProc(DefWndProc, Handle, WM_NCDESTROY, 0, 0);
FParagraph.Free;
FSelAttributes.Free;
FDefAttributes.Free;
FRichEditStrings.Free;
FHiddenControls.Free;
FRichEditOle._Release;
inherited Destroy;
end;
{ TCustomAutoRichEdit.IUnknown }
function TCustomAutoRichEdit.QueryInterface(const IID: TIID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then Result := S_OK
else Result := E_NOINTERFACE;
end;
function TCustomAutoRichEdit._AddRef: Integer;
begin
Inc(FRefCount);
Result := FRefCount;
end;
function TCustomAutoRichEdit._Release: Integer;
begin
Dec(FRefCount);
Result := FRefCount;
end;
{ TCustomAutoRichEdit.IRichEditOleCallback }
function TCustomAutoRichEdit.GetNewStorage(out stg: IStorage): HResult;
var
LockBytes: ILockBytes;
begin
OleCheck(CreateILockBytesOnHGlobal(0, True, LockBytes));
OleCheck(StgCreateDocfileOnILockBytes(LockBytes, STGM_READWRITE or
STGM_SHARE_EXCLUSIVE or STGM_CREATE, 0, Stg));
Result := S_OK;
end;
function TCustomAutoRichEdit.GetInPlaceContext(out Frame: IOleInPlaceFrame;
out Doc: IOleInPlaceUIWindow; lpFrameInfo: POleInPlaceFrameInfo): HResult;
var
Menu: TMainMenu;
begin
Frame := IOleInPlaceFrame(Self);
Doc := IOleInPlaceUIWindow(Self);
with lpFrameInfo^ do
begin
cb := SizeOf(lpFrameInfo^);
fMDIApp := False;
hwndFrame := GetMainForm.Handle;
Menu := GetMainMenu;
if Menu <> nil then
Menu.GetOle2AcceleratorTable(haccel, cAccelEntries, [0, 2, 4]);
end;
Result := S_OK;
end;
function TCustomAutoRichEdit.ShowContainerUI(fShow: BOOL): HResult;
var
rc: TRect;
I: Integer;
ParentForm: TForm;
Control: TWinControl;
begin
if fShow then
begin
SetRect(rc, 0, 0, 0, 0);
SetBorderSpace(@rc);
SetMenu(0, 0, 0);
GetParentForm(Self).DisableAlign;
for I := 0 to FHiddenControls.Count - 1 do
TWinControl(FHiddenControls[I]).Show;
FHiddenControls.Clear;
BoundsRect := OldBoundsRect;
GetParentForm(Self).EnableAlign;
Application.UnhookMainWindow(AppHook);
Application.MainForm.OnClose := PrevMainFormClose;
ParentForm := TForm(GetParentForm(Self));
if (ParentForm.FormStyle <> fsMDIChild) and
(ParentForm <> Application.MainForm) then
ParentForm.OnClose := PrevParentFormClose;
end
else
begin
OldBoundsRect := BoundsRect;
Control := Self;
while Control.Parent.Parent <> nil do Control := Control.Parent;
with GetParentForm(Self) do
begin
DisableAlign;
for I := 0 to ControlCount - 1 do
if (Controls[I] <> Control) and Controls[I].Visible then
begin
FHiddenControls.Add(Controls[I]);
Controls[I].Hide;
end;
EnableAlign;
end;
with Application.MainForm do
begin
PrevMainFormClose := OnClose;
OnClose := MainFormClose;
end;
ParentForm := TForm(GetParentForm(Self));
if (ParentForm.FormStyle <> fsMDIChild) and
(ParentForm <> Application.MainForm) then
with ParentForm do
begin
PrevParentFormClose := OnClose;
OnClose := ParentFormClose;
end;
Application.HookMainWindow(AppHook);
end;
Result := S_OK;
end;
function TCustomAutoRichEdit.QueryInsertObject(const clsid: TCLSID;
const stg: IStorage; cp: Longint): HResult;
begin
Result := NOERROR;
end;
function TCustomAutoRichEdit.DeleteObject(const oleobj: IOleObject): HResult;
begin
Result := NOERROR;
end;
function TCustomAutoRichEdit.QueryAcceptData(const dataobj: IDataObject;
var cfFormat: TClipFormat; reco: DWORD; fReally: BOOL;
hMetaPict: HGLOBAL): HResult;
begin
Result := S_OK;
end;
function TCustomAutoRichEdit.RichEditOleCallback_ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
Result := NOERROR;
end;
function TCustomAutoRichEdit.GetClipboardData(const chrg: TCharRange;
reco: DWORD; out dataobj: IDataObject): HResult;
begin
dataobj := nil;
Result := E_NOTIMPL;
end;
function TCustomAutoRichEdit.GetDragDropEffect(fDrag: BOOL;
grfKeyState: DWORD; var dwEffect: DWORD): HResult;
begin
Result := E_NOTIMPL;
end;
function TCustomAutoRichEdit.GetContextMenu(seltype: Word;
const oleobj: IOleObject; const chrg: TCharRange; out menu: HMENU): HResult;
var
Name: POleStr;
hMenuVerbs: HMenu;
VerbPopupMenu: TPopupMenu;
Item, SubItem: TMenuItem;
P: TPoint;
ACaption: PChar;
AState: UINT;
I: Integer;
EnumOleVerb: IEnumOleVerb;
function NewItem(ACaption: string; AEnabled: Boolean;
ATag: Integer): TMenuItem;
begin
Result := TMenuItem.Create(nil);
with Result do
begin
Caption := ACaption;
Enabled := AEnabled;
Tag := ATag;
OnClick := VerbPopupMenuClick;
end;
end;
begin
menu := CreatePopupMenu;
if oleobj <> nil then
begin
oleobj.GetUserType(USERCLASSTYPE_SHORT, Name);
OleUIAddVerbMenu(oleobj, PChar(WideCharToString(Name)), menu, 0,
0, 0, False, 0, hMenuVerbs);
end;
VerbPopupMenu := TPopupMenu.Create(Self);
with VerbPopupMenu.Items do
begin
Add(NewItem(sRichEditCutCaption, chrg.cpMin <> chrg.cpMax, -1));
Add(NewItem(sRichEditCopyCaption, chrg.cpMin <> chrg.cpMax, -2));
Add(NewItem(sRichEditPasteCaption, CanPaste, -3));
end;
if oleobj <> nil then
begin
GetMem(ACaption, 255);
GetMenuString(menu, 0, ACaption, 255, MF_BYPOSITION);
AState := GetMenuState(menu, 0, MF_BYPOSITION);
Item := TMenuItem.Create(nil);
with Item do
begin
Caption := ACaption;
Enabled := (AState and MF_DISABLED = 0);
if hMenuVerbs > 0 then
for I := 0 to GetMenuItemCount(hMenuVerbs) - 1 do
begin
GetMenuString(hMenuVerbs, I, ACaption, 255, MF_BYPOSITION);
AState := GetMenuState(hMenuVerbs, I, MF_BYPOSITION);
SubItem := TMenuItem.Create(nil);
with SubItem do
if AState and MF_SEPARATOR > 0 then Caption := '-'
else
begin
Caption := ACaption;
Tag := I;
OnClick := VerbPopupMenuClick;
end;
Add(SubItem);
end
else
begin
Enabled := (oleobj.EnumVerbs(EnumOleVerb) = 0);
if Enabled then
begin
Tag := GetMenuItemId(menu, 0);
OnClick := VerbPopupMenuClick;
end;
end;
Enabled := Enabled and not ReadOnly;
end;
VerbPopupMenu.Items.Add(NewLine);
VerbPopupMenu.Items.Add(Item);
FreeMem(ACaption, 255);
end;
DestroyMenu(menu);
GetCursorPos(P);
VerbPopupMenu.Popup(P.X, P.Y);
Result := S_OK;
end;
{ TCustomAutoRichEdit.IOleWindow }
function TCustomAutoRichEdit.GetWindow(out wnd: HWnd): HResult;
begin
wnd := GetParentForm(Self).Handle;
Result := S_OK;
end;
function TCustomAutoRichEdit.ContextSensitiveHelp(fEnterMode: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;
{ TCustomAutoRichEdit.IOleInPlaceUIWindow }
function TCustomAutoRichEdit.GetBorder(out rectBorder: TRect): HResult;
begin
Windows.GetClientRect(GetParentForm(Self).Handle, rectBorder);
Result := S_OK;
end;
function TCustomAutoRichEdit.RequestBorderSpace(const borderwidths: TRect): HResult;
begin
Result := S_OK;
end;
function TCustomAutoRichEdit.SetBorderSpace(pborderwidths: PRect): HResult;
var
rcClient: TRect;
rcOldEdit: TRect;
wndFrame: HWND;
begin
GetWindowRect(Handle, rcOldEdit);
wndFrame := GetParentForm(Self).Handle;
MapWindowPoints(0, wndFrame, rcOldEdit, 2);
Windows.GetClientRect(wndFrame, rcClient);
if pborderwidths <> nil then
begin
Inc(rcClient.Left, pborderwidths^.Left);
Inc(rcClient.Top, pborderwidths^.Top);
Dec(rcClient.Right, pborderwidths^.Right);
Dec(rcClient.Bottom, pborderwidths^.Bottom);
end;
SetWindowPos(Handle, 0, rcClient.Left, rcClient.Top,
rcClient.Right - rcClient.Left, rcClient.Bottom - rcClient.Top,
SWP_NOZORDER or SWP_NOACTIVATE);
Result := S_OK;
end;
function TCustomAutoRichEdit.SetActiveObject(const activeObject: IOleInPlaceActiveObject;
pszObjName: POleStr): HResult;
begin
Result := S_OK;
if activeObject = g_ActiveObject then Exit;
g_ActiveObject := activeObject;
end;
{ TCustomAutoRichEdit.IOleInPlaceFrame }
function TCustomAutoRichEdit.InsertMenus(hmenuShared: HMenu;
var menuWidths: TOleMenuGroupWidths): HResult;
var
Menu: TMainMenu;
begin
Menu := GetMainMenu;
if Menu <> nil then
Menu.PopulateOle2Menu(hmenuShared, [0, 2, 4], menuWidths.width);
Result := S_OK;
end;
function TCustomAutoRichEdit.SetMenu(hmenuShared: HMenu; holemenu: HMenu;
hwndActiveObject: HWnd): HResult;
var
Menu: TMainMenu;
wndFrame: HWND;
begin
Menu := GetMainMenu;
if Menu <> nil then
begin
Menu.SetOle2MenuHandle(hmenuShared);
wndFrame := Menu.WindowHandle;
end
else
begin
wndFrame := GetMainForm.Handle;
if holemenu > 0 then
Windows.SetMenu(wndFrame, hmenuShared)
else
Windows.SetMenu(wndFrame, 0);
DrawMenuBar(wndFrame);
end;
Result := OleSetMenuDescriptor(holemenu, wndFrame,
hwndActiveObject, Self, g_ActiveObject);
end;
function TCustomAutoRichEdit.RemoveMenus(hmenuShared: HMenu): HResult;
begin
while GetMenuItemCount(hmenuShared) > 0 do
RemoveMenu(hmenuShared, 0, MF_BYPOSITION);
Result := S_OK;
end;
function TCustomAutoRichEdit.SetStatusText(pszStatusText: POleStr): HResult;
begin
Result := E_NOTIMPL;
end;
function TCustomAutoRichEdit.EnableModeless(fEnable: BOOL): HResult;
begin
Result := E_NOTIMPL;
end;
function TCustomAutoRichEdit.TranslateAccelerator(var msg: TMsg; wID: Word): HResult;
var
Menu: TMainMenu;
begin
Menu := GetMainMenu;
if (Menu <> nil) and Menu.DispatchCommand(wID) then
Result := S_OK
else Result := S_FALSE;
end;
{ TCustomAutoRichEdit }
function TCustomAutoRichEdit.AppHook(var Message: TMessage): Boolean;
begin
Result := False;
if (Message.Msg = WM_ACTIVATEAPP) and (g_ActiveObject <> nil) then
g_ActiveObject.OnFrameWindowActivate(BOOL(Message.wParam));
end;
procedure TCustomAutoRichEdit.FindOne(Sender: TObject);
var
StartPos, FindLength, FoundAt: Integer;
Flags: TAutoSearchTypes;
P: TPoint;
CaretR, R, IntersectR: TRect;
begin
with TFindDialog(Sender) do
begin
if frDown in Options then
begin
if SelLength = 0 then StartPos := SelStart
else StartPos := SelStart + SelLength;
FindLength := Length(Text) - StartPos;
end
else
begin
StartPos := SelStart;
FindLength := -StartPos;
end;
Flags := [];
if frMatchCase in Options then Include(Flags, stM
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?