unit MsdnExpert;
interface
uses
Classes, SysUtils, Windows, Forms, Menus, ActnList,
StdCtrls, ComCtrls, ExtCtrls, ToolWin, ToolsAPI;
{$DEFINE RUN_ON_SAME_THREAD}
{$DEFINE LANG_GB2312}
type
TMsdnExpert = class(TNotifierObject, IOTAWIzard, IOTAKeyboardBinding)
private
m_actOpenMsdn: TAction;
m_mnuHelp,
m_mnuOpenMsdn,
m_mnuLine: TMenuItem;
m_barControl: TControlBar;
m_barMsdn: TToolBar;
m_cboKeywords: TComboBox;
m_btnOpenMsdn: TToolButton;
m_nCookie: Integer;
m_funcOldOnMessage: TMessageEvent;
procedure InitMenu;
procedure DoneMenu;
procedure InitBar;
procedure DoneBar;
procedure InitKeyBinding;
procedure DoneKeyBinding;
procedure LoadConfig;
procedure SaveConfig;
procedure LookupKeyword(Keyword: string);
procedure OnUpdate(Sender: TObject);
procedure OnExecute(Sender: TObject);
{$IFDEF RUN_ON_SAME_THREAD}
procedure OnMessage(var Msg: TMsg; var Handled: Boolean);
{$ENDIF}
procedure OnKeywordsChange(Sender: TObject);
procedure OnSearchKeyword(const Context: IOTAKeyContext;
KeyCode: TShortcut; var BindingResult: TKeyBindingResult);
protected
{ IOTAWIzard }
function GetIDString: string;
function GetName: string;
function GetState: TWizardState;
procedure Execute;
{ IOTAKeyboardBinding}
function GetBindingType: TBindingType;
function GetDisplayName: string;
//function GetName: string;
procedure BindKeyboard(const BindingServices: IOTAKeyBindingServices);
end;
procedure Register;
var
Expert: TMsdnExpert;
implementation
{$IFDEF VER130}
{$IFDEF BCB}
{$DEFINE BCB5}
{$ELSE}
{$DEFINE DELPHI5}
{$ENDIF}
{$ENDIF}
{$IFDEF VER140}
{$IFDEF BCB}
{$DEFINE BCB6}
{$ELSE}
{$DEFINE DELPHI6}
{$ENDIF}
{$ENDIF}
uses
Graphics, FileCtrl, Registry, HtmlHlp;
resourcestring
{$IFDEF LANG_GB2312}
SIDString = 'Flier''s MSDN Expert';
SAppName = 'MSDN Expert';
SNoHelpMenu = '无法找到 Help 菜单项！';
SOpenMsdnHint = '打开 %s';
SSelectKeywordHint = '选择要在 %s 中查找的关键字';
SNoMsdnInstalled = '请先安装 MSDN ！';
SNoLanguage = '首选语言 [%s] 不存在！';
SNoCollection = '首选版本 [%s] 不存在！';
{$ELSE}
SIDString = 'Flier''s MSDN Expert';
SAppName = 'MSDN Expert';
SNoHelpMenu = 'Cannot find the "Help" menu item!';
SOpenMsdnHint = 'Open %s';
SSelectKeywordHint = 'Select keyword to search in the %s';
SNoMsdnInstalled = 'Please install MSDN first!';
SNoLanguage = 'Preferred language [%s] is not exists!';
SNoCollection = 'Preferred collection [%s] is not exists!';
{$ENDIF}
var
g_strMsdnPath, g_strMsdnName: string;
{ TMsdnExpert }
function TMsdnExpert.GetIDString: string;
begin
Result := SIDString;
end;
function TMsdnExpert.GetName: string;
begin
Result := SAppName;
end;
function TMsdnExpert.GetState: TWizardState;
begin
Result := [wsEnabled];
end;
procedure TMsdnExpert.Execute;
begin
ShowWindow(HtmlHelp(0, PChar(g_strMsdnPath), HH_DISPLAY_TOC, 0), SW_SHOWMA
XIMIZED);
end;
function TMsdnExpert.GetBindingType: TBindingType;
begin
Result := btPartial;
end;
function TMsdnExpert.GetDisplayName: string;
begin
Result := GetIDString;
end;
procedure TMsdnExpert.BindKeyboard(const BindingServices: IOTAKeyBindingServ
ices);
begin
BindingServices.AddKeyBinding([ShortCut(VK_F1, [ssCtrl])], OnSearchKeyword
, nil);
end;
procedure TMsdnExpert.InitMenu;
var
AIcon: TIcon;
strPath: string;
sr: TSearchRec;
begin
m_mnuHelp := (BorlandIDEServices as INTAServices).
MainMenu.Items.Find('Help'); // DO NOT LOCALIZE
if not Assigned(m_mnuHelp) then
raise Exception.Create(SNoHelpMenu);
m_actOpenMsdn := TAction.Create(nil);
m_actOpenMsdn.Caption := g_strMsdnName;
m_actOpenMsdn.Hint := Format(SOpenMsdnHint, [g_strMsdnName]);
m_actOpenMsdn.OnExecute := OnExecute;
m_actOpenMsdn.OnUpdate := OnUpdate;
m_actOpenMsdn.ImageIndex := -1;
strPath := ExtractFilePath(g_strMsdnPath);
if DirectoryExists(strPath) then
begin
if FindFirst(strPath + '*.ico', faAnyFile, sr) = 0 then
try
AIcon := TIcon.Create;
try
AIcon.LoadFromFile(strPath + sr.Name);
m_actOpenMsdn.ImageIndex := (BorlandIDEServices as INTAServices).
ImageList.AddIcon(AIcon);
finally
AIcon.Free;
end;
finally
SysUtils.FindClose(sr);
end;
end;
m_mnuOpenMsdn := TMenuItem.Create(nil);
m_mnuOpenMsdn.Action := m_actOpenMsdn;
m_mnuLine := TMenuItem.Create(nil);
m_mnuLine.Caption := '-';
m_mnuHelp.Insert(m_mnuHelp.Count - 1, m_mnuOpenMsdn);
m_mnuHelp.Insert(m_mnuHelp.Count - 1, m_mnuLine);
end;
procedure TMsdnExpert.DoneMenu;
begin
if m_actOpenMsdn.ImageIndex <> -1 then
(BorlandIDEServices as INTAServices).
ImageList.Delete(m_actOpenMsdn.ImageIndex);
m_mnuHelp.Remove(m_mnuOpenMsdn);
m_mnuHelp.Remove(m_mnuLine);
FreeAndNil(m_mnuOpenMsdn);
FreeAndNil(m_mnuLine);
FreeAndNil(m_actOpenMsdn);
end;
procedure TMsdnExpert.InitBar;
begin
{ ControlBar - m_barControl }
m_barControl := (BorlandIDEServices as INTAServices).
ToolBar[sStandardToolBar].Parent as TControlBar;
{ Toolbar - m_barMsdn }
m_barMsdn := TToolBar.Create(nil);
m_barMsdn.Visible := False;
m_barControl.InsertControl(m_barMsdn);
m_barMsdn.ShowHint := True;
m_barMsdn.EdgeInner := esNone;
m_barMsdn.EdgeOuter := esNone;
m_barMsdn.Flat := True;
m_barMsdn.Images := (BorlandIDEServices as INTAServices).ImageList
;
{ Combox - m_cboKeywords }
m_cboKeywords := TComboBox.Create(m_barMsdn);
m_cboKeywords.Visible := False;
m_cboKeywords.Hint := Format(SSelectKeywordHint, [g_strMsdnName]);
m_cboKeywords.Style := csDropDownList;
m_cboKeywords.OnChange := OnKeywordsChange;
m_cboKeywords.Width := 150;
m_barMsdn.InsertControl(m_cboKeywords);
m_cboKeywords.Left := 0;
m_cboKeywords.Top := 0;
m_cboKeywords.Visible := True;
{ ToolButton - m_btnOpenMsdn }
m_btnOpenMsdn := TToolButton.Create(m_barMsdn);
m_btnOpenMsdn.Visible := False;
m_btnOpenMsdn.Action := m_actOpenMsdn;
m_barMsdn.InsertControl(m_btnOpenMsdn);
m_btnOpenMsdn.Left := m_cboKeywords.Width;
m_btnOpenMsdn.Top := 0;
m_btnOpenMsdn.Visible := True;
{ Toolbar - m_barMsdn }
m_barMsdn.AutoSize := True;
m_barMsdn.Left := 0;
m_barMsdn.Top := m_barControl.Height;
m_barMsdn.Visible := True;
{ ControlBar - m_barControl }
m_barControl.AutoSize := True;
end;
procedure TMsdnExpert.DoneBar;
begin
m_barControl.RemoveControl(m_barMsdn);
FreeAndNil(m_barMsdn);
end;
procedure TMsdnExpert.InitKeyBinding;
begin
m_nCookie := (BorlandIDEServices as IOTAKeyboardServices).
AddKeyboardBinding(Self);
end;
procedure TMsdnExpert.DoneKeyBinding;
begin
(BorlandIDEServices as IOTAKeyboardServices).
RemoveKeyboardBinding(m_nCookie);
end;
const
// DO NOT LOCALIZE - Begin
keyRoot = '/SOFTWARE/Flier Studio/MSDN Expert';
{$IFDEF BCB6}
keyProduct = keyRoot + '/B6';
{$ELSE}{$IFDEF DELPHI6}
keyProduct = keyRoot + '/D6';
{$ELSE}{$IFDEF BCB5}
keyProduct = keyRoot + '/B5';
{$ELSE}{$IFDEF DELPHI5}
keyProduct = keyRoot + '/D5';
{$ELSE}
keyProduct = keyRoot;
{$ENDIF}{$ENDIF}{$ENDIF}{$ENDIF}
keyHistory = 'History';
valBarLeft = 'Toolbar.Left';
valBarTop = 'Toolbar.Top';
// DO NOT LOCALIZE - End
procedure TMsdnExpert.LoadConfig;
var
I: Integer;
lstHistory: TStringList;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKeyReadOnly(keyProduct) then
begin
if ValueExists(valBarLeft) then
m_barMsdn.Left := ReadInteger(valBarLeft);
if ValueExists(valBarTop) then
m_barMsdn.Top := ReadInteger(valBarTop);
if OpenKeyReadOnly(keyHistory) then
begin
lstHistory := TStringList.Create;
try
GetValueNames(lstHistory);
for I := 0 to lstHistory.Count - 1 do
m_cboKeywords.Items.Add(ReadString(lstHistory[I]));
finally
lstHistory.Free;
end;
end;
end;
finally
Free;
end;
end;
procedure TMsdnExpert.SaveConfig;
var
I: Integer;
begin
with TRegistry.Create do
try
RootKey := HKEY_CURRENT_USER;
if OpenKey(keyProduct, True) then
begin
WriteInteger(valBarLeft, m_barMsdn.Left);
WriteInteger(valBarTop, m_barMsdn.Top);
if OpenKey(keyHistory, True) then
for I := 0 to m_cboKeywords.Items.Count - 1 do
WriteString(IntToStr(I), m_cboKeywords.Items[I]);
end;
finally
Free;
end;
end;
procedure TMsdnExpert.LookupKeyword(Keyword: string);
const
MAX_HISTORY = 10;
var
Link: THHAKLink;
begin
Keyword := Trim(Keyword);
if Keyword = '' then
Exit;
HtmlHelp(0, PChar(g_strMsdnPath), HH_DISPLAY_INDEX, 0);
m_cboKeywords.ItemIndex := m_cboKeywords.Items.IndexOf(Keyword);
if m_cboKeywords.ItemIndex = -1 then
begin
if m_cboKeywords.Items.Count >= MAX_HISTORY then
m_cboKeywords.Items.Delete(m_cboKeywords.Items.Count - 1);
m_cboKeywords.Items.Insert(0, Keyword);
m_cboKeywords.ItemIndex := 0
end;
Link.cbStruct := SizeOf(Link);
Link.fReserved := False;
Link.pszKeywords := PChar(Keyword);
Link.pszUrl := nil;
Link.pszMsgText := nil;
Link.pszMsgTitle := nil;
Link.pszWindow := nil;
Link.fIndexOnFail := True;
ShowWindow(HtmlHelp(0, PChar(g_strMsdnPath), HH_KEYWORD_LOOKUP, DWORD(@Lin
k)), SW_SHOWMAXIMIZED);
end;
procedure TMsdnExpert.OnUpdate(Sender: TObject);
begin
m_actOpenMsdn.Enabled := FileExists(g_strMsdnPath);
end;
procedure TMsdnExpert.OnExecute(Sender: TObject);
begin
Execute;
end;
{$IFDEF RUN_ON_SAME_THREAD}
procedure TMsdnExpert.OnMessage(var Msg: TMsg; var Handled: Boolean);
begin
HtmlHelp(0, nil, HH_PRETRANSLATEMESSAGE, DWORD(@Msg));
end;
{$ENDIF}
procedure TMsdnExpert.OnKeywordsChange(Sender: TObject);
begin
LookupKeyword(m_cboKeywords.Text);
end;
procedure TMsdnExpert.OnSearchKeyword(const Context: IOTAKeyContext;
KeyCode: TShortcut; var BindingResult: TKeyBindingResult);
function GetCurrentToken: string;
var
OTAEditPosition: IOTAEditPosition;
begin
OTAEditPosition := (BorlandIDEServices as IOTAEditorServices).TopBuffer.
EditPosition;
while OTAEditPosition.Column > 0 do
begin
if not OTAEditPosition.IsWordCharacter then
Break;
OTAEditPosition.MoveRelative(0, -1);
end;
while True do
begin
OTAEditPosition.MoveRelative(0, 1);
if not OTAEditPosition.IsWordCharacter then
Break;
Result := Result + OTAEditPosition.Character
end;
end;
begin
LookupKeyword(GetCurrentToken);
BindingResult := krHandled;
end;
procedure Register;
begin
RegisterPackageWizard(Expert as IOTAWizard);
end;
procedure GetPreferredMsdn(var Path, Name: string);
// DO NOT LOCALIZE - Begin
const
keyCollections = '/SOFTWARE/Microsoft/HTML Help Collections/Developer Coll
ections';
valLanguage = 'Language';
valPreferred = 'Preferred';
valFilename = 'Filename';
// DO NOT LOCALIZE - End
var
strLanguage, strCollection: string;
lst: TStringList;
begin
with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
{ Open Collections }
if not KeyExists(keyCollections) then
raise Exception.Create(SNoMsdnInstalled);
if not OpenKeyReadOnly(keyCollections) then
RaiseLastWin32Error;
{ Open Preferred Language }
if ValueExists(valLanguage) then
strLanguage := ReadString(valLanguage)
else if HasSubKeys then
begin
lst := TStringList.Create;
try
GetKeyNames(lst);
strLanguage := lst[0];
WriteString(valLanguage, strLanguage);
finally
lst.Free;
end;
end
else
raise Exception.Create(SNoMsdnInstalled);
if not KeyExists(strLanguage) then
raise Exception.CreateFmt(SNoLanguage, [strLanguage]);
if not OpenKeyReadOnly(strLanguage) then
RaiseLastWin32Error;
{ Open Preferred Collection }
if ValueExists(valPreferred) then
strCollection := ReadString(valPreferred)
else if HasSubKeys then
begin
lst := TStringList.Create;
try
GetKeyNames(lst);
strCollection := lst[0];
WriteString(valPreferred, strCollection);
finally
lst.Free;
end;
end
else
raise Exception.Create(SNoMsdnInstalled);
if not KeyExists(strCollection) then
raise Exception.CreateFmt(SNoCollection, [strCollection]);
if not OpenKeyReadOnly(strCollection) then
RaiseLastWin32Error;
{ Read MSDN Path and Name }
Path := ReadString(valFilename);
Name := ReadString('');
finally
Free;
end;
end;
procedure InitExpert;
begin
Expert := TMsdnExpert.Create;
Expert._AddRef;
Expert.InitMenu;
Expert.InitBar;
Expert.InitKeyBinding;
Expert.LoadConfig;
end;
procedure DoneExpert;
begin
Expert.SaveConfig;
Expert.DoneKeyBinding;
Expert.DoneBar;
Expert.DoneMenu;
Expert._Release;
end;
{$IFDEF RUN_ON_SAME_THREAD}
threadvar
g_dwCookie: DWORD;
{$ENDIF}
initialization
GetPreferredMsdn(g_strMsdnPath, g_strMsdnName);
InitExpert;
{$IFDEF RUN_ON_SAME_THREAD}
Expert.m_funcOldOnMessage := Application.OnMessage;
Application.OnMessage := Expert.OnMessage;
HtmlHelp(0, nil, HH_INITIALIZE, DWORD(@g_dwCookie));
{$ENDIF}
finalization
HtmlHelp(0, nil, HH_CLOSE_ALL, 0);
{$IFDEF RUN_ON_SAME_THREAD}
HtmlHelp(0, nil, HH_UNINITIALIZE, g_dwCookie);
Application.OnMessage := Expert.m_funcOldOnMessage;
{$ENDIF}
DoneExpert;
end.
[
百宝箱] [
返回首页] [
上级目录] [
根目录] [
令狐冲精华区搜索] [
返回顶部] [
刷新] [
返回]
+
-
R
