Вот как бы я это сделал.
Создайте новый пакет, который будет установлен в IDE во время разработки. Если у вас есть под рукой существующий пакет, вы можете продолжить его использование. Убедитесь, что пакет requires designide пакет. Вы можете сделать это в менеджере проектов или просто просмотрев источник проекта и добавив designide к предложению requires.
Теперь добавьте следующий блок в ваш пакет.
unit MakeEditable;
interface
procedure Register;
implementation
uses
Windows, SysUtils, Menus, ToolsAPI;
type
TMakeEditable = class(TObject)
private
FEditorServices: IOTAEditorServices;
FFileMenu: TMenuItem;
FMakeEditable: TMenuItem;
function MenuItemWithCaptionLike(const Menu: TMenuItem; const DesiredCaption: string): TMenuItem;
procedure MakeEditableClick(Sender: TObject);
public
constructor Create;
destructor Destroy; override;
end;
constructor TMakeEditable.Create;
var
Index: Integer;
PreviousMenuItem: TMenuItem;
begin
inherited;
FEditorServices := (BorlandIDEServices as IOTAEditorServices);
FFileMenu := MenuItemWithCaptionLike((BorlandIDEServices as INTAServices40).MainMenu.Items, 'File');
if Assigned(FFileMenu) then begin
PreviousMenuItem := MenuItemWithCaptionLike(FFileMenu, 'Reopen');
if Assigned(PreviousMenuItem) then begin
Index := PreviousMenuItem.MenuIndex;
if Index>=0 then begin
FMakeEditable := TMenuItem.Create(FFileMenu);
FMakeEditable.Caption := 'Ma&ke Editable';
FMakeEditable.OnClick := MakeEditableClick;
FFileMenu.Insert(Index, FMakeEditable);
end;
end;
end;
end;
destructor TMakeEditable.Destroy;
begin
FMakeEditable.Free;
inherited;
end;
function TMakeEditable.MenuItemWithCaptionLike(const Menu: TMenuItem; const DesiredCaption: string): TMenuItem;
var
i: Integer;
Target, Found: string;
begin
Target := StringReplace(LowerCase(Trim(DesiredCaption)), '&', '', [rfReplaceAll, rfIgnoreCase]);
for i := 0 to Menu.Count-1 do begin
Result := Menu.Items[i];
Found := StringReplace(LowerCase(Trim(Result.Caption)), '&', '', [rfReplaceAll, rfIgnoreCase]);
if Pos(Target, Found)>0 then begin
exit;
end;
end;
Result := nil;
end;
procedure TMakeEditable.MakeEditableClick(Sender: TObject);
procedure MakeFileEditable(const FileName: string);
var
Attributes: DWORD;
begin
Attributes := GetFileAttributes(PChar(FileName));
SetFileAttributes(PChar(FileName), Attributes and not FILE_ATTRIBUTE_READONLY);
end;
var
FileName: string;
FileExt: string;
LinkedFileName: string;
EditBuffer: IOTAEditBuffer;
begin
EditBuffer := FEditorServices.TopBuffer;
FileName := EditBuffer.FileName;
if FileExists(FileName) then begin
MakeFileEditable(FileName);
EditBuffer.IsReadOnly := False;
FileExt := ExtractFileExt(FileName);
if SameText(FileExt,'.dfm') then begin
LinkedFileName := ChangeFileExt(FileName, '.pas');
end else if SameText(FileExt,'.pas') then begin
LinkedFileName := ChangeFileExt(FileName, '.dfm');
end else begin
LinkedFileName := '';
end;
if (LinkedFileName<>'') and FileExists(LinkedFileName) then begin
MakeFileEditable(LinkedFileName);
end;
end;
end;
var
MakeEditableInstance: TMakeEditable;
procedure Register;
begin
MakeEditableInstance := TMakeEditable.Create;
end;
initialization
finalization
MakeEditableInstance.Free;
end.
Когда вы скомпилируете и установите этот пакет, у вас теперь будет новый пункт меню в меню Файл, который одновременно очищает флаг только для чтения в буфере ввода и делает файл доступным для записи.
