控制IDE//zswang

示例: 添加Delphi菜单
获取代码编辑器文本
设置代码编辑器文本
语法高亮度为RTF格式
//DelphiExptLib.dpr
//mailto:wjhu111@21cn.com
//output directory=$(Delphi)
//search path=$(Delphi)
library DelphiExptLib;
uses
ExptIntf,
ToolIntf,
SysUtils,
Classes,
Dialogs,
Menus,
Forms,
DelphiExptUnit in 'DelphiExptUnit.pas' {FormDelphiExpt},
FuncUnit in 'FuncUnit.pas',
HighlightUnit in 'HighlightUnit.pas';
const
cMenuItemCaption = '&Zswang';
cMenuItemName = 'ZswangMenu';
cMenuItemHint = 'Control IDE';
type
TDelphiExpt = class(TComponent)
FFormDelphiExpt: TFormDelphiExpt;
procedure IMenuClickEvent(Sender: TIMenuItemIntf);
end;
{ TDelphiExpt }
procedure TDelphiExpt.IMenuClickEvent(Sender: TIMenuItemIntf);
begin
if not Assigned(FFormDelphiExpt) then
FFormDelphiExpt := TFormDelphiExpt.Create(Self);
FFormDelphiExpt.Show;
end;
var
vDelphiExpt: TDelphiExpt;
function InitExpert(ToolServices: TIToolServices;
RegisterProc: TExpertRegisterProc;
var Terminate: TExpertTerminateProc): Boolean; export; stdcall;
var
vIMainMenuIntf: TIMainMenuIntf;
vIMenuItemIntf: TIMenuItemIntf;
　
begin
Result := False;
ExptIntf.ToolServices := ToolServices;
Application.Handle := ToolServices.GetParentHandle;
　
if not Assigned(ToolServices) then Exit;
vIMainMenuIntf := ToolServices.GetMainMenu;
if not Assigned(vIMainMenuIntf) then Exit;
vIMenuItemIntf := vIMainMenuIntf.FindMenuItem('ToolsMenu');
vIMainMenuIntf.Free;
if not Assigned(vIMenuItemIntf) then Exit;
vDelphiExpt := TDelphiExpt.Create(Application);
vIMenuItemIntf.InsertItem(0, cMenuItemCaption, cMenuItemName,
cMenuItemHint, TextToShortCut('Ctrl+D'), 1, 2,
[mfInvalid, mfEnabled, mfVisible],
vDelphiExpt.IMenuClickEvent);
vIMenuItemIntf.Free;
Result := True;
end;
exports
InitExpert name ExpertEntryPoint;
end.
//DelphiExptUnit.pas
unit DelphiExptUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, FuncUnit, ExptIntf, EditIntf,
ComCtrls;
type
TFormDelphiExpt = class(TForm)
PanelButton: TPanel;
BitBtnGetText: TBitBtn;
BitBtnSetText: TBitBtn;
BitBtnClose: TBitBtn;
RichEditNote: TRichEdit;
BitBtnRTF: TBitBtn;
procedure PanelButtonResize(Sender: TObject);
procedure BitBtnGetTextClick(Sender: TObject);
procedure BitBtnSetTextClick(Sender: TObject);
procedure BitBtnCloseClick(Sender: TObject);
procedure BitBtnRTFClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
FVersion: string;
public
{ Public declarations }
end;
//var//
// FormDelphiExpt: TFormDelphiExpt;//
implementation
uses HighlightUnit;
{$R *.dfm}
procedure TFormDelphiExpt.PanelButtonResize(Sender: TObject);
begin
WinControlButton(TWinControl(Sender), 55, 20, 2);
end;
procedure TFormDelphiExpt.BitBtnGetTextClick(Sender: TObject);
var
vIModuleInterface: TIModuleInterface;
vIEditorInterface: TIEditorInterface;
begin
vIModuleInterface := ToolServices.GetModuleInterface(ToolServices.GetCurrentFile);
if not Assigned(vIModuleInterface) then Exit;
vIEditorInterface := vIModuleInterface.GetEditorInterface;
if not Assigned(vIEditorInterface) then Exit;
RichEditNote.Text := EditGetText(vIEditorInterface);
vIModuleInterface.Free;
vIEditorInterface.Free;
end;
procedure TFormDelphiExpt.BitBtnSetTextClick(Sender: TObject);
var
vIModuleInterface: TIModuleInterface;
vIEditorInterface: TIEditorInterface;
begin
vIModuleInterface := ToolServices.GetModuleInterface(ToolServices.GetCurrentFile);
if not Assigned(vIModuleInterface) then Exit;
vIEditorInterface := vIModuleInterface.GetEditorInterface;
if not Assigned(vIEditorInterface) then Exit;
EditSetText(vIEditorInterface, RichEditNote.Text);
vIModuleInterface.Free;
vIEditorInterface.Free;
end;
procedure TFormDelphiExpt.BitBtnCloseClick(Sender: TObject);
begin
Close;
end;
procedure TFormDelphiExpt.BitBtnRTFClick(Sender: TObject);
var
vIModuleInterface: TIModuleInterface;
vIEditorInterface: TIEditorInterface;
vIEditView: TIEditView;
vElement, vLineFlag: Integer;
vCol: Integer;
vLine: Longint;
vEdPos: TEditPos;
S: string;
begin
vIModuleInterface := ToolServices.GetModuleInterface(ToolServices.GetCurrentFile);
if not Assigned(vIModuleInterface) then Exit;
vIEditorInterface := vIModuleInterface.GetEditorInterface;
if not Assigned(vIEditorInterface) then Exit;
RichEditNote.Clear;
RichEditNote.Text := EditGetText(vIEditorInterface);
vIEditView := vIEditorInterface.GetView(0);
for vLine := 1 to vIEditorInterface.LinesInBuffer do begin
S := EditGetLine(vIEditorInterface, vLine, vLine);
for vCol := 1 to Length(S) do begin
vEdPos.Col := vCol;
vEdPos.Line := vLine;
vIEditView.GetAttributeAtPos(vEdPos, vElement, vLineFlag);
if not (vElement in [0..14]) then Continue;
case ByteType(S, vCol) of
mbSingleByte: begin
RichEditNote.CaretPos := Point(vCol - 1, vLine - 1);
RichEditNote.SelLength := 1;
with THighlight.Create(FVersion, vElement) do try
AssignTo(RichEditNote.SelAttributes);
finally
Free;
end;
end;
mbLeadByte: begin
RichEditNote.CaretPos := Point(vCol - 1, vLine - 1);
RichEditNote.SelLength := 2;
with THighlight.Create(FVersion, vElement) do try
AssignTo(RichEditNote.SelAttributes);
finally
Free;
end;
end;
end;
end;
end;
vIEditView.Free;
vIModuleInterface.Free;
vIEditorInterface.Free;
end;
procedure TFormDelphiExpt.FormCreate(Sender: TObject);
begin
if Pos('DELPHI4', UpperCase(ParamStr(0))) > 0 then
FVersion := '4.0'
else if Pos('DELPHI5', UpperCase(ParamStr(0))) > 0 then
FVersion := '5.0'
else if Pos('DELPHI6', UpperCase(ParamStr(0))) > 0 then
FVersion := '6.0'
else if Pos('DELPHI7', UpperCase(ParamStr(0))) > 0 then
FVersion := '7.0'
else FVersion := InputBox('Key', 'Input', '6.0');
end;
end.
//DelphiExptUnit.dfm
object FormDelphiExpt: TFormDelphiExpt
Left = 222
Top = 185
Width = 291
Height = 262
BorderStyle = bsSizeToolWin
Caption = 'FormDelphiExpt'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object PanelButton: TPanel
Left = 0
Top = 204
Width = 283
Height = 31
Align = alBottom
BevelOuter = bvNone
TabOrder = 0
OnResize = PanelButtonResize
object BitBtnGetText: TBitBtn
Left = 199
Top = 6
Width = 75
Height = 25
Caption = 'GetText'
TabOrder = 0
OnClick = BitBtnGetTextClick
end
object BitBtnSetText: TBitBtn
Left = 133
Top = 6
Width = 75
Height = 25
Caption = 'SetText'
TabOrder = 1
OnClick = BitBtnSetTextClick
end
object BitBtnClose: TBitBtn
Left = 69
Top = 6
Width = 75
Height = 25
Caption = 'Close'
TabOrder = 2
OnClick = BitBtnCloseClick
end
object BitBtnRTF: TBitBtn
Left = 3
Top = 6
Width = 75
Height = 25
Caption = 'RTF'
TabOrder = 3
OnClick = BitBtnRTFClick
end
end
object RichEditNote: TRichEdit
Left = 0
Top = 0
Width = 283
Height = 204
Align = alClient
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
Lines.Strings = (
'RichEditNote')
ParentFont = False
ScrollBars = ssBoth
TabOrder = 1
WordWrap = False
end
end
//FuncUnit.pas
unit FuncUnit;
interface
uses
ExptIntf, ToolIntf, SysUtils, EditIntf, VirtIntf, Controls, Classes, ExtCtrls,
Buttons, StdCtrls, DBCtrls;
function EditGetLine(mIEditorInterface: TIEditorInterface;
mBeginLine, mEndLine: Integer): string;
procedure EditSetLine(mIEditorInterface: TIEditorInterface;
mBeginLine, mEndLine: Integer; mText: string);
function EditGetText(mIEditorInterface: TIEditorInterface): string;
procedure EditSetText(mIEditorInterface: TIEditorInterface; mText: string);
procedure WinControlButton(mWinControl: TWinControl;
mButtonWidth, mButtonHeight, mSpaceWidth: Integer;
mAlignment: TAlignment = taRightJustify;
mIsCalcTop: Boolean = False);
　
implementation
function EditGetLine(mIEditorInterface: TIEditorInterface;
mBeginLine, mEndLine: Integer): string;
var
vCharPos: TCharPos;
vIEditReader: TIEditReader;
vIEditView: TIEditView;
vBegin, vEnd: Longint;
vBuffer: PChar;
vSize: Integer;
begin
Result := '';
if not Assigned(mIEditorInterface) then Exit;
vIEditView := mIEditorInterface.GetView(0);
vCharPos.Line := mBeginLine;
vCharPos.CharIndex := 1;
vBegin := vIEditView.CharPosToPos(vCharPos);
vCharPos.Line := mEndLine;
vCharPos.CharIndex := 1023;
vEnd := vIEditView.CharPosToPos(vCharPos);
if (vEnd < 0) or (vBegin < 0) then Exit;
vIEditReader := mIEditorInterface.CreateReader;
vSize := vEnd - vBegin;
GetMem(vBuffer, vSize);
vIEditReader.GetText(Pred(vBegin), vBuffer, vSize);
vIEditReader.Free;
vIEditView.Free;
Result := AdjustLineBreaks(Copy(vBuffer, 1, vSize));
FreeMem(vBuffer);
end; { EditGetLine }
procedure EditSetLine(mIEditorInterface: TIEditorInterface;
mBeginLine, mEndLine: Integer; mText: string);
var
vCharPos: TCharPos;
vIEditWriter: TIEditWriter;
vIEditView: TIEditView;
vBegin, vEnd: Longint;
begin
if not Assigned(mIEditorInterface) then Exit;
vIEditView := mIEditorInterface.GetView(0);
vCharPos.Line := mBeginLine;
vCharPos.CharIndex := 1;
vBegin := vIEditView.CharPosToPos(vCharPos);
vCharPos.Line := mEndLine;
vCharPos.CharIndex := 1023;
vEnd := vIEditView.CharPosToPos(vCharPos);
if (vEnd < 0) or (vBegin < 0) then Exit;
vIEditWriter := mIEditorInterface.CreateWriter;
vIEditWriter.CopyTo(Pred(vBegin));
vIEditWriter.DeleteTo(vEnd);
vIEditWriter.Insert(PChar(mText));
vIEditWriter.Free;
end; { EditSetLine }
function EditGetText(mIEditorInterface: TIEditorInterface): string;
begin
Result := EditGetLine(mIEditorInterface, 1, mIEditorInterface.LinesInBuffer);
end; { EditGetText }
procedure EditSetText(mIEditorInterface: TIEditorInterface; mText: string);
begin
EditSetLine(mIEditorInterface, 1, mIEditorInterface.LinesInBuffer, mText);
end; { EditSetText }
procedure WinControlButton(mWinControl: TWinControl;
mButtonWidth, mButtonHeight, mSpaceWidth: Integer;
mAlignment: TAlignment = taRightJustify;
mIsCalcTop: Boolean = False);
function fIsButton(mControl: TControl): Boolean;
begin
Result := (mControl is TSpeedButton) or (mControl is TButton) or
(mControl is TBitBtn) or (mControl is TDBNavigator);
end; { fIsButton }
var
I, J, K, vLeft, vTop: Integer;
begin
with mWinControl do begin
K := 0;
for I := 0 to Pred(ControlCount) do
if fIsButton(Controls) and Controls.Visible then Inc(K);
vTop := (ClientHeight - mButtonHeight) div 2;
case mAlignment of
taRightJustify: vLeft := (ClientWidth - (mButtonWidth * K + Pred(K) * mSpaceWidth));
taCenter: vLeft := (ClientWidth - (mButtonWidth * K + Pred(K) * mSpaceWidth)) div 2;
else vLeft := mSpaceWidth;
end;
J := 0;
for I := Pred(ControlCount) downto 0 do
if fIsButton(Controls) and Controls.Visible then begin
Controls.Left := vLeft;
if mIsCalcTop then Controls.Top := vTop;
Controls.Width := mButtonWidth;
vLeft := vLeft + mButtonWidth + mSpaceWidth;
Inc(J); if J > K then Break;
end;
end; { with }
end; { WinControlButton }
end.
//HighlightUnit.pas
//mailto:wjhu111@21cn.com
unit HighlightUnit;
interface
uses Messages, Windows, SysUtils, CommCtrl, Controls, Forms, Classes,
Menus, Graphics, StdCtrls, ComCtrls;
type
THighlight = class(TPersistent)
private
FItalic: Boolean;
FBold: Boolean;
FUnderline: Boolean;
FDefaultBackground: Boolean;
FDefaultForeground: Boolean;
FBackgroundColor: TColor;
FForegroundColor: TColor;
FFontSize: Integer;
FFontName: string;
public
constructor Create(AVersion: string; AName: string); overload;
constructor Create(AVersion: string; AElement: Integer); overload;
procedure AssignTo(Dest: TPersistent); override;
property BackgroundColor: TColor read FBackgroundColor write FBackgroundColor;
property DefaultBackground: Boolean read FDefaultBackground write FDefaultBackground;
property DefaultForeground: Boolean read FDefaultForeground write FDefaultForeground;
property ForegroundColor: TColor read FForegroundColor write FForegroundColor;
property Bold: Boolean read FBold write FBold;
property Italic: Boolean read FItalic write FItalic;
property Underline: Boolean read FUnderline write FUnderline;
property FontName: string read FFontName write FFontName;
property FontSize: Integer read FFontSize write FFontSize;
end;
implementation
uses
Registry;
const
cColorList: array[0..15] of TColor =
(
{0}clBlack,
{1}clMaroon,
{2}clGreen,
{3}clOlive,
{4}clNavy,
{5}clPurple,
{6}clTeal,
{7}clGray,
{8}clSilver,
{9}clRed,
{10}clLime,
{11}clYellow,
{12}clBlue,
{13}clFuchsia,
{14}clAqua,
{15}clWhite
);
const
cKeyList: array[0..14] of string =
(
{atWhiteSpace = 0;}'Whitespace',
{atComment = 1;}'Comment',
{atReservedWord = 2;}'Reserved word',
{atIdentifier = 3;}'Identifier',
{atSymbol = 4;}'Symbol',
{atString = 5;}'String',
{atNumber = 6;}'Number',
{atFloat = 7;}'Float',
{atOctal = 8;}'Octal',
{atHex = 9;}'Hex',
{atCharacter = 10;}'Character',
{atPreproc = 11;}'Preprocessor',
{atIllegal = 12;}'Illegal Char',
{atAssembler = 13;}'Assembler',
{SyntaxOff = 14;}'Tags'
);
{ THighlight }
procedure THighlight.AssignTo(Dest: TPersistent);
begin
if Dest is TFont then begin
TFont(Dest).Name := FFontName;
TFont(Dest).Size := FFontSize;
TFont(Dest).Color := FForegroundColor;
TFont(Dest).Style := [];
if FBold then
TFont(Dest).Style := TFont(Dest).Style + [fsBold]
else TFont(Dest).Style := TFont(Dest).Style - [fsBold];
if FUnderline then
TFont(Dest).Style := TFont(Dest).Style + [fsUnderline]
else TFont(Dest).Style := TFont(Dest).Style - [fsUnderline];
if FItalic then
TFont(Dest).Style := TFont(Dest).Style + [fsItalic]
else TFont(Dest).Style := TFont(Dest).Style - [fsItalic];
end else if Dest is TTextAttributes then begin
TTextAttributes(Dest).Name := FFontName;
TTextAttributes(Dest).Size := FFontSize;
TTextAttributes(Dest).Color := FForegroundColor;
TTextAttributes(Dest).Style := [];
if FBold then
TTextAttributes(Dest).Style := TTextAttributes(Dest).Style + [fsBold]
else TTextAttributes(Dest).Style := TTextAttributes(Dest).Style - [fsBold];
if FUnderline then
TTextAttributes(Dest).Style := TTextAttributes(Dest).Style + [fsUnderline]
else TTextAttributes(Dest).Style := TTextAttributes(Dest).Style - [fsUnderline];
if FItalic then
TTextAttributes(Dest).Style := TTextAttributes(Dest).Style + [fsItalic]
else TTextAttributes(Dest).Style := TTextAttributes(Dest).Style - [fsItalic];
end else inherited;
end;
constructor THighlight.Create(AVersion: string; AName: string);
begin
with TRegistry.Create do try
RootKey := HKEY_CURRENT_USER;
if OpenKey(Format('%s%s',
[AVersion, AName]), False) then begin
TryStrToBool(ReadString('Bold'), FBold);
TryStrToBool(ReadString('Italic'), FItalic);
TryStrToBool(ReadString('Underline'), FUnderline);
TryStrToBool(ReadString('Default Foreground'), FDefaultForeground);
TryStrToBool(ReadString('Default Background'), FDefaultBackground);
FForegroundColor := cColorList[ReadInteger('Foreground Color')];
FBackgroundColor := cColorList[ReadInteger('Background Color')];
CloseKey;
end;
if OpenKey(Format('%s',
[AVersion]), False) then begin
FFontName := ReadString('Editor Font');
FFontSize := ReadInteger('Font Size');
end;
finally
Free;
end;
end;
constructor THighlight.Create(AVersion: string; AElement: Integer);
begin
Create(AVersion, cKeyList[AElement]);
end;
end.
//RegExpertsApp.dpr//注册专用
//mailto:wjhu111@21cn.com
//output directory=$(Delphi)
program RegExpertsApp;
{$APPTYPE CONSOLE}
uses
Windows,
Registry,
SysUtils,
Dialogs;
const
cExpertName = 'DelphiExptLib';
var
vExpertKey: string;
　
begin
if Pos('DELPHI4', UpperCase(ParamStr(0))) > 0 then
vExpertKey := 'Software4.0'
else if Pos('DELPHI5', UpperCase(ParamStr(0))) > 0 then
vExpertKey := 'Software5.0'
else if Pos('DELPHI6', UpperCase(ParamStr(0))) > 0 then
vExpertKey := 'Software6.0'
else if Pos('DELPHI7', UpperCase(ParamStr(0))) > 0 then
vExpertKey := 'Software7.0'
else vExpertKey := InputBox('Key', 'Input', 'Software6.0');
with TRegistry.Create do try
RootKey := HKEY_CURRENT_USER;
if not OpenKey(vExpertKey, False) then begin
MessageDlg(Format('打开主键"%s"失败', [vExpertKey]), mtError, [mbOK], 0);
Exit;
end;
if ValueExists(cExpertName) then
if DeleteValue(cExpertName) then
MessageDlg(Format('删除键值"%s"成功', [cExpertName]),
mtInformation, [mbOK], 0)
else MessageDlg(Format('删除键值"%s"失败', [cExpertName]),
mtError, [mbOK], 0)
else begin
WriteString(cExpertName, ExtractFilePath(ParamStr(0)) + cExpertName + '.dll');
MessageDlg(Format('注册键值"%s"成功', [cExpertName]),
mtInformation, [mbOK], 0);
end;
finally
Free;
end;
end.
//请修改修改HighlightUnit.pas
//后来发现第一次安装
//在"HKEY_CURRENT_USER%s"没有变量
constructor THighlight.Create(AVersion: string; AName: string);
begin
with TRegistry.Create do try
RootKey := HKEY_CURRENT_USER;
if OpenKey(Format('%s%s',
[AVersion, AName]), False) then begin
TryStrToBool(ReadString('Bold'), FBold);
TryStrToBool(ReadString('Italic'), FItalic);
TryStrToBool(ReadString('Underline'), FUnderline);
TryStrToBool(ReadString('Default Foreground'), FDefaultForeground);
TryStrToBool(ReadString('Default Background'), FDefaultBackground);
FForegroundColor := cColorList[ReadInteger('Foreground Color')];
FBackgroundColor := cColorList[ReadInteger('Background Color')];
CloseKey;
end;
if OpenKey(Format('%s',
[AVersion]), False) then begin
//Begin~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
if ValueExists('Editor Font') then
FFontName := ReadString('Editor Font')
else FFontName := 'Courier New';
if ValueExists('Font Size') then
FFontSize := ReadInteger('Font Size')
else FFontSize := 10;
//End~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
end;
finally
Free;
end;
end;