Delphi控件源码

开发平台：
Delphi

MMInst.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: +0351-8012255                   =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 20.01.1998 - 18:00:00 $                                      =}
{========================================================================}
unit MMInst;
interface
uses
  Windows,
  Messages,
  SysUtils;
function  InitiateDDE: Boolean;
procedure TerminateDDE;
function  CreateGroup(GName : String) : Boolean;
procedure CreateItem (ExeFile, Description, IconFile, IconNumber: String);
implementation
var
   Handle         : THandle;
   PMWnd          : THandle;
   PMLaunched     : Boolean;
   AppAtom        : TAtom;
   TopicAtom      : TAtom;
   HDDE           : THandle;
   DDEMessageSent : Word;
   Command        : array[0..512] of Char;
   Errr           : Boolean;
{-------------------------------------------------------------------------}
procedure NotifyDDE(LValue: LongInt);
begin
   case DDEMessageSent of
   WM_DDE_INITIATE: begin
   		      GlobalDeleteAtom(LoWord(LValue));
                      GlobalDeleteAtom(Hiword(LValue));
                      DDEMessageSent := 0;
                      Exit;
                    end;
    WM_DDE_EXECUTE: begin
		      GlobalFree(HDDE);
                      DDEMessageSent := 0;
                      Exit;
		    end;
   end;
end;
{------------------------------------------------------------------------}
function DDEWndProc(Window: HWND; Message, wParam: UINT; lParam: Longint): Longint;export; stdcall;
begin
   if (Window = Handle) and (Message = WM_DDE_ACK) then
   begin
      if PMWnd = 0 then PMWnd := wParam;
      NotifyDDE(lParam);
   end;
   Result := DefWindowProc(Window, Message, wParam, lParam);
end;
const
  TDDEWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @DDEWndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TDDEWindow');
{-------------------------------------------------------------------------}
function AllocateDDEWindow: HWND;
var
   TempClass: TWndClass;
   ClassRegistered: Boolean;
begin
   TDDEWindowClass.hInstance := HInstance;
   ClassRegistered := GetClassInfo(HInstance,
                      TDDEWindowClass.lpszClassName, TempClass);
    if not ClassRegistered then
    begin
       if ClassRegistered then
          UnregisterClass(TDDEWindowClass.lpszClassName, HInstance);
       RegisterClass(TDDEWindowClass);
    end;
    Result := CreateWindow(TDDEWindowClass.lpszClassName, '', 0,
                           0, 0, 0, 0, 0, 0, HInstance, nil);
end;
{-------------------------------------------------------------------------}
procedure ExecuteDDE (ATextString: PChar);
var
   Execute : PChar;
   Msg     : TMsg;
   i       : LongInt;
begin
   Errr := False;
   HDDE := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, strlen(ATextString) + 10);
   Execute := GlobalLock(HDDE);
   strcopy(Execute, ATextString);
   GlobalUnlock(HDDE);
   DDEMessageSent := WM_DDE_EXECUTE;
   PostMessage(PMWnd, WM_DDE_EXECUTE, Handle, HDDE);
   while (DDEMessageSent > 0) do
   begin
      GetMessage(Msg, Handle, 0, 0);
      TranslateMessage(Msg);
      DispatchMessage(Msg);
      if Errr then break;
   end;
end;
{-------------------------------------------------------------------------}
procedure TerminateDDE;
begin
   // ev. Send Message verwenden
   PostMessage(PMWnd, WM_DDE_TERMINATE, Handle, 0);
   DestroyWindow(Handle);
end;
{-------------------------------------------------------------------------}
function InitiateDDE: Boolean;
begin
   Result := false;
   Handle := AllocateDDEWindow;
   PMWnd := FindWindow('Progman', nil);
   if PMWnd = 0 then
   begin
      WinExec('PROGMAN.EXE', SW_NORMAL);
      PMWnd := GetActiveWindow;
      PMLaunched := TRUE;
   end;
   AppAtom  := GlobalAddAtom('PROGMAN');
   TopicAtom := GlobalAddAtom('PROGMAN');
   DDEMessageSent := WM_DDE_INITIATE;
   SendMessage(PMWnd, WM_DDE_INITIATE, Handle, MAKELONG(AppAtom, TopicAtom));
   Result := True;
end;
{---------------------------------------------------------------------}
function CreateGroup(GName : String) : Boolean;
var
  GroupName : Array[0..255] of Char;
begin
   Result := false;
   StrPCopy(GroupName, GName);
   StrCopy(Command, '[CreateGroup(');
   StrCat(Command, GroupName);
   StrCat(Command, ')]');
   ExecuteDDE(Command);
   StrCopy(Command, 'ShowGroup(');
   StrCat(Command, GroupName);
   (* 1 activates and shows the group opened at normal size.
        Other values are
      2 to activate the group and show it minimized,
      3 to activate the group and  show it maximized or
      7 to minimize the group without activating it.
   *)
   StrCat(Command, ',1)]');
   ExecuteDDE(Command);
   Result := True;
end;
{-------------------------------------------------------------------------}
procedure UCreateItem (PExeFile     : PChar;
                       PDescription : PChar;
                       PIconFile    : PChar;
                       PIconNumber  : PChar;
                   Var XCommand     : String);
Var
 Command : Array[0..255] of char;
begin
   strcat(strcat(strcopy(Command, '[AddItem('), PExeFile), ',');
   if strlen(PIconFile) <> 0 then
   begin
      strcat(strcat(Command, PDescription), ',');
      strcat(strcat(Command, PIconFile), ',');
      strcat(strcat(Command, PIconNumber), ')]');
   end
   else if strlen(PIconNumber) <> 0 then
   begin
      strcat(strcat(Command, PDescription), ',');
      strcat(strcat(Command, PExeFile), ',');
      strcat(strcat(Command, PIconNumber), ')]');
   end
   else strcat(strcat(Command, PDescription), ')]');
  XCommand:=StrPas(Command);
end;
{-------------------------------------------------------------------------}
procedure CreateItem (ExeFile, Description, IconFile, IconNumber: String);
var
   PExeFile, PDescription, PIconFile, PIconNumber: Array[0..255] of Char;
   XCommand : String;
begin
   StrPCopy(PExeFile, ExeFile);
   StrPCopy(PDescription, Description);
   StrPCopy(PIconFile, IconFile);
   StrPCopy(PIconNumber, IconNumber);
   UCreateItem (PExeFile,
                PDescription,
                PIconFile,
                PIconNumber,
                XCommand);
   StrPCopy(Command, XCommand);
   ExecuteDDE(Command);
end;
end.

						