main.pas

这是一个DELPHI7应用案例开发篇有配套程序种子光盘

        aItem := TMenuItem.Create(Self);
        aItem.Caption := '&'+IntToStr(i)+' '+MRUs[i];
        aItem.OnClick := MRUClick;
        aItem.Tag := i;

        MenuReopen.Insert(0, aItem);
    end;
end;

procedure TfrmMain.MRUClick(Sender: TObject);
begin
    with Sender as TMenuItem do
    begin
        OpenFile(MRU.GetList[Tag]);
    end;
end;

procedure TfrmMain.OpenFile(AFileName: String);
var
    AChild : Integer;
begin
    AChild := QueryChildByFile(AFileName);
    if AChild = -1 then
    begin
        frmChild := TfrmChild.Create(Self);
        frmChild.LoadFromFile(AFileName);
    end
    else
        MDIChildren[AChild].BringToFront;

    MRU.AddFile(AFileName);
    UpdateMRUMenu;        
end;

procedure TfrmMain.LoadIni;
var
    i, n: Integer;
begin
    n := INI.ReadInteger('MRU','MRUCount',0);
    for i:= 0 to n-1 do
    begin
        MRU.AddFile(INI.ReadString('MRU','MRUItem'+IntToStr(i),''));
    end;

    UpdateMRUMenu;
end;

procedure TfrmMain.SaveIni;
var
    i, n: Integer;
begin
    n := MRU.GetList.Count;
    INI.WriteInteger('MRU','MRUCount',n);

    for i:=0 to n-1 do
    begin
        INI.WriteString('MRU','MRUItem'+IntToStr(i),MRU.GetList[i]);
    end;
end;

procedure TfrmMain.UpdateStatusBar;
begin
    if ActiveMDIChild <> nil then
    begin
        with ActiveMDIChild as TfrmChild do
        begin
            StatusBar1.Panels[1].Text :=
                IntToStr(RichEdit1.CaretPos.X+1)+':'+
                IntToStr(RichEdit1.CaretPos.Y+1);

            If IsModified then
                StatusBar1.Panels[2].Text := 'Modified'
            else
                StatusBar1.Panels[2].Text := 'Already Saved';
        end;
    end;
end;

procedure TfrmMain.ApplicationEvents1Hint(Sender: TObject);
var
    tmpS:String;
begin
    tmpS := GetLongHint(Application.Hint);
    if Length(tmpS) <> 0 then
        StatusBar1.Panels[0].Text := tmpS
    else
        StatusBar1.Panels[0].Text := 'Ready';
end;

procedure TfrmMain.HelpWhatsThis1Execute(Sender: TObject);
begin
    HelpWhatsThis1.Checked := not HelpWhatsThis1.Checked;
    if HelpWhatsThis1.Checked then  //in help mode now
    begin
    //OldCursor is a form variable
        OldCursor := Screen.Cursor;
        Screen.Cursor := crHelp;
    end
    else
        Screen.Cursor := OldCursor;
end;

procedure TfrmMain.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
    Handled := False;
    
    if (Screen.ActiveForm = Self) or
        (Screen.ActiveForm = ActiveMDIChild) then
    case Msg.message of
    WM_LBUTTONDOWN:
        if HelpWhatsThis1.Checked then
            Handled := HandleMouseMsg(Msg.hwnd,
                                  mbLeft,
                                  KeysToShiftState(Msg.wParam),
                                  Loword(Msg.lParam),
                                  Hiword(Msg.lParam)
                                  );
    WM_RBUTTONUP:
        Handled := HandleMouseMsg(Msg.hwnd,
                                  mbRight,
                                  KeysToShiftState(Msg.wParam),
                                  Loword(Msg.lParam),
                                  Hiword(Msg.lParam)
                                  );
    end;
end;

function TfrmMain.HandleMouseMsg(CtlHandle: THandle; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer): boolean;
var
    FocusCtl: TWinControl;
    ClickCtl: TControl;
    ContextID: integer;
    Pt: TSmallPoint;
    function FindFocusControl(Ctl: TWinControl): TWinControl;
    var
        i: integer;
    begin
        Result := nil;
        if Ctl.handle = CtlHandle then result := Ctl
        else if (Ctl is TCustomCombobox) and (ChildWindowfromPoint(Ctl.handle, point(x,y)) = CtlHandle)
            then result := Ctl
        else begin
            for i := 0 to Ctl.controlcount-1 do
            begin
                if (Ctl.controls[i] is TWinControl)
                then result := FindFocusControl(TWinControl(ctl.controls[i]));
                if result <> nil then break;
            end;
        end;
    end;

    function FindContextID(Ctl: TControl): integer;
    begin
        if (Ctl is TControl) then
            Result := TControl(Ctl).HelpContext;

        if (Ctl is TLabel) and (TLabel(Ctl).FocusControl <> nil) then
            Result := TLabel(Ctl).FocusControl.HelpContext;

        if (Ctl is TToolButton) and (TToolButton(Ctl).Action <> nil) then
            Result := TAction(TToolButton(Ctl).Action).HelpContext;

        if (Result = 0) and (Ctl.parent <> nil) then
            Result := FindContextID(Ctl.parent);
    end;

begin
    Result := False;
    
    FocusCtl := FindFocusControl(self);
    if FocusCtl = nil then
        FocusCtl := Self; {it's the form}

    ClickCtl := FocusCtl.ControlAtPos(Point(x,y), true);
    if ClickCtl = nil then
        ClickCtl := FocusCtl; {no childs}

    ContextID := FindContextID(ClickCtl);
    if ContextID = 0 then
        ContextID := 99999; {our default topic}

    case Button of
    mbLeft:
        if (ClickCtl <> tbtWhatThis) then {this button turns off help mode}
        begin
            if ContextID < 0 then
                Application.HelpCommand(HELP_CONTEXT, abs(ContextID))
            else
            begin
                Application.HelpCommand(HELP_CONTEXTPOPUP, ContextID);
            end;
            
            Result := True;
        end;
    mbRight:
        begin
            Result := (not (ClickCtl is TCustomEdit)) and (not (ClickCtl is TCustomComboBox));
            if Result then
            begin
                PopupWhatsThis.tag := ContextID;
                Pt := PointToSmallPoint(FocusCtl.Clienttoscreen( point(x,y) ));
                if TLabel(ClickCtl).PopupMenu = nil then
                    WhatsThisPopupmenu.popup(Pt.x, Pt.y)
                else
                    TLabel(ClickCtl).PopupMenu.popup(Pt.x, Pt.y);
            end;
        end;
    end;
end;

procedure TfrmMain.PopupWhatsThisClick(Sender: TObject);
begin
     if TMenuItem(sender).tag < 0 then
        Application.HelpCommand(HELP_CONTEXT, abs(TMenuItem(Sender).tag))
     else
        Application.HelpCommand(HELP_CONTEXTPOPUP, TMenuItem(Sender).tag);
end;

end.

{ 在应用程序目录下查找插件文件 }
procedure TfrmMain.LoadPlugins;
var
　　sr: TSearchRec;
　　path: string;
　　Found: Integer;
begin
　　path := ExtractFilePath(Application.Exename);
　　try
　　Found := FindFirst(path + cPLUGIN_MASK, 0, sr);
　　while Found = 0 do begin
　　LoadPlugin(sr);
　　Found := FindNext(sr);
end;
　　finally
　　FindClose(sr);
end;
end;


{ 加载指定的插件 DLL. }
procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
　　Description: string;
　　LibHandle: Integer;
　　DescribeProc: TPluginDescribe;
begin
　　LibHandle := LoadLibrary(Pchar(sr.Name));
　　if LibHandle <> 0 then
    begin
　　    DescribeProc := GetProcAddress(LibHandle, cPLUGIN_DESCRIBE);
        if Assigned(DescribeProc) then
        begin
        　  DescribeProc(Description);
        　  memPlugins.Lines.Add(Description);
        end
        else
        begin
        　  MessageDlg('File "’ + sr.Name + ’" is not a valid plug-in.',
                mtInformation, [mbOK], 0);
        end;
    end
    else
        MessageDlg('An error occurred loading the plug-in "'+
            sr.Name + '".', mtError, [mbOK], 0);
end;

type
    TPluginDescribe = procedure(var Desc: string); stdcall;

uses
    Sharemem, SysUtils, Classes,
    main in ’main.pas’;

{$E plg.}

exports
DescribePlugin;

begin

end.