MultiDesktop1.1 |
|
|
|
lovejingtao
一般會員   發表：10 回覆：33 積分：13 註冊：2003-04-16 發送簡訊給我 |
MultiDesktop1.1 冷静的思考问题
充满激情的工作
|
|
japhenchen
高階會員  發表：51 回覆：444 積分：184 註冊：2003-07-23 發送簡訊給我 |
|
|
japhenchen
高階會員 發表：51 回覆：444 積分：184 註冊：2003-07-23 發送簡訊給我 |
|
|
lovejingtao
一般會員 發表：10 回覆：33 積分：13 註冊：2003-04-16 發送簡訊給我 |
Only run at:Windows NT WorkStation,Windows NT Server和Windows2000. code is easy..
unit MultiDesktop; interface uses
Windows, Messages, Classes, Variants; type
TMultiDesktop = class(TComponent)
private
{ Private declarations }
m_hDesktop:HDESK;
FStrDesktopName:string;
bStartExplorer:Bool; FStrVersion:string;
FStrAbout:string;
procedure SetVersion(const StrVersion:String);
procedure SetAbout(const StrVersion:String);
procedure SetDeskTopName(const StrDeskTopName:String);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function Open:Bool;
procedure Close;
function Switch:Bool;
function DefaultDesktop:Bool;
published
{ Published declarations }
property DeskTopName :string read FStrDesktopName write SetDeskTopName;
property Version :string read FStrVersion write SetVersion;
property About :string read FStrAbout write SetAbout;
end; procedure Register; implementation procedure Register;
begin
RegisterComponents('138soft', [TMultiDesktop]);
end; { TMultiDesktop }
function _CloseWinDowsProc(hWnd:HWND;lParam:LPARAM):BOOL; stdcall;
var
dwProcessId:DWORD;
begin
GetWindowThreadProcessId(hWnd,dwProcessId);
if GetCurrentProcessId=dwProcessId then
PostMessage(hWnd,WM_CLOSE,0,0)
else
PostMessage(hWnd,WM_QUIT,0,0);
Result:=True;
end; procedure TMultiDesktop.Close;
begin
if m_hDesktop<>NULL then
Windows.EnumDesktopWindows(m_hDesktop,@_CloseWinDowsProc,0);
Windows.CloseDesktop(m_hDesktop);
m_hDesktop:=0;
end; constructor TMultiDesktop.Create(AOwner: TComponent);
begin
inherited;
FStrDesktopName:='138soft';
bStartExplorer:=False;
FStrVersion:='1.1';
FStrAbout:='http://www.138soft.com.2003,12,3.';
//if not(csDesigning in ComponentState) then Open;
end; destructor TMultiDesktop.Destroy;
begin
//if not(csDesigning in ComponentState) then Close;
inherited;
end; function TMultiDesktop.Open: Bool;
var
dwRights:DWORD;
begin
if FStrDesktopName='' then FStrDesktopName:='138soft';
dwRights:=DESKTOP_READOBJECTS or
DESKTOP_CREATEWINDOW or
DESKTOP_CREATEMENU or
DESKTOP_HOOKCONTROL or
DESKTOP_JOURNALRECORD or
DESKTOP_JOURNALPLAYBACK or
DESKTOP_ENUMERATE or
DESKTOP_WRITEOBJECTS or
DESKTOP_SWITCHDESKTOP or
STANDARD_RIGHTS_REQUIRED or
READ_CONTROL or
WRITE_DAC or
WRITE_OWNER;
m_hDesktop:=Windows.CreateDesktop(Pchar(FStrDesktopName),nil,nil,DF_ALLOWOTHERACCOUNTHOOK,dwRights,nil);
Result:=m_hDesktop<>NULL;
end; procedure TMultiDesktop.SetDeskTopName(const StrDeskTopName: String);
function Trim(const S: string): string;
var
I, L: Integer;
begin
L := Length(S);
I := 1;
while (I <= L) and (S[I] <= ' ') do Inc(I);
if I > L then Result := '' else
begin
while S[L] <= ' ' do Dec(L);
Result := Copy(S, I, L - I 1);
end;
end;
begin
if Trim(StrDeskTopName)='' then
MessageBox(0,'The DeskTopName Cann''t be NULL!','TMultiDesktop',MB_ICONINFORMATION MB_TOPMOST)
else
FStrDesktopName:=StrDeskTopName;
end; function TMultiDesktop.Switch: Bool;
var
pi:TProcessInformation;
si:TStartupInfo;
begin
Result:=Windows.SwitchDesktop(m_hDesktop);
if not bStartExplorer then
begin
bStartExplorer:=True;
ZeroMemory(@pi,Sizeof(pi));
ZeroMemory(@si,Sizeof(si));
si.cb:=SizeOf(TSTARTUPINFO);
si.lpDesktop:=Pchar(FStrDesktopName);
CreateProcess(nil,'explorer.exe',nil,nil,True,CREATE_DEFAULT_ERROR_MODE or CREATE_SEPARATE_WOW_VDM,nil,nil,si,pi);
CloseHandle(pi.hProcess);
end; end; function TMultiDesktop.DefaultDesktop: Bool;
function SwitchTo(lpszName: Pchar): Bool;
var
hDesktop:HDESK;
bReturn:Bool;
begin
Result:=False;
hDesktop:=OpenDesktop(lpszName,DF_ALLOWOTHERACCOUNTHOOK,FALSE,DESKTOP_SWITCHDESKTOP);
if hDesktop=NULL then Exit;
bReturn:=Windows.SwitchDesktop(hDesktop);
CloseDesktop(hDesktop);
Result:=bReturn;
end;
begin
Result:=SwitchTo('Default');
end; procedure TMultiDesktop.SetVersion(const StrVersion: String);
begin
;
end; procedure TMultiDesktop.SetAbout(const StrVersion: String);
begin
;
end; initialization
finalization
end. 冷静的思考问题
充满激情的工作
|
發表時間：2004-06-30 10:58:36
IP:220.173.xxx.xxx 未訂閱
附加檔案：系統時間：2024-07-01 21:35:57
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |