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 + -
显示快捷键?