占位手记 (0分)

收藏！！！！

主题：锁定 CDROM 驱动器，使它不能按 Eject 退出
帖子 http://www.delphibbs.com/delphibbs/dispq.asp?lid=1666196 那段 C 代码
在 Delphi 中的转化如下：
=========================================================================
function LockCDEject(DriveLetter: Char;TheLock: Boolean): Boolean;
type
TMediaRecord=record
MediaParam:Boolean;
end;
PMediaRecord=^TMediaRecord;
var
Device:string;
DeviceFile:THANDLE;
Prevent:TMediaRecord;
OutBuffWord;
begin
Device:='//./'+DriveLetter+':';
DeviceFile:=CreateFile(PChar(Device),GENERIC_READ,3,nil,3,0,0);
Prevent.MediaParam:=TheLock;
Result:=DeviceIoControl(DeviceFile,$2D4804,@Prevent,SizeOf(TMediaRecord),
nil,0,OutBuff,nil);
CloseHandle(DeviceFile);
end;
=========================================================================
使用如下：
锁定：
procedure TForm1.Button1Click(Sender: TObject);
begin
LockCDEject('I',true);
end;
解除：
procedure TForm1.Button2Click(Sender: TObject);
begin
LockCDEject('I',false);
end;
原理一看就明白了，这里就不再描述。如果需要编程获得哪个驱动器是 CD-ROM ，看下面：
=========================================================================
var
sDrive:string;
Letter:Char;
i:integer;
DriveTypeWord;
begin
for i:=65 to 90do
begin
Letter:=Chr(i);
sDrive:=Letter+':/';
DriveType:=GetDriveType(PChar(sDrive));
if DriveType=DRIVE_CDROM then
begin
// 这里加自己的代码
end;
end;
end;

高手

//"大富翁P计划" 我看了老半天，也没有看到beta.
我还没来得及放上去就结束了：（
sky2008 是桂电的吧？：）

beta 可是熊恒兄？
久仰大名已 ＾O＾

别乱说，我很大吗？：）
难道说你就是传说中的XX？[]

非也
本人只是一Delphi业余爱好者

sky2008 兄几系的？应该大我一届吧？

此地不宜久留
邮件联系 邮件联系

倒是，这可是 小雨哥 的地盘啊：）
抱歉了。

>>>

DarwinZhang 在 http://www.webANYwhere.net/ 发表有一篇对图形的旋转算法的简析文章
推荐大家有空看看。还有一个 [数学小帮手] 程序可供下载使用(包括详细的帮助)。
使用良好的算法，可以使程序的执行效率大大提高，DarwinZhang 在演示中，使用了三种
不同的旋转算法，对图形有感觉的富翁一定会有兴趣的。

好东西，收藏

大富翁有了 KeyLife 功能后，这个帖子已经可以结束了。下面是我在这个贴子里的最后一篇，
关于 Windows 2000 和 XP 里的那个工具提示(带一个小箭头的，根据不同的选项，还可以
产生自动跟踪效果和气泡提示效果，本例只做了简单实现)：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
const // 以下是 API 常量 (只取了本程序用到的部分)
TTS_NOPREFIX=$2;
TTS_BALLOON=$40;
TTM_ADDTOOL=WM_USER+4;
TTF_TRANSPARENT=$100;
TTF_CENTERTIP=$2;
TTF_SUBCLASS=$10;
ICC_WIN95_CLASSES=$FF;
type
PTOOLINFO=^TOOLINFO;
tagTOOLINFO=packed record
cbSizeWord;
uFlagsWord;
hwnd:HWND;
uId:Longint;
rect:TRECT;
hinst:HINST;
lpszTextChar;
lParam:LPARAM;
end;
TOOLINFO=tagTOOLINFO;

PINITCOMMONCONTROLSEX=^INITCOMMONCONTROLSEX;
tagINITCOMMONCONTROLSEX=packed record
dwSizeWORD;
dwICCWORD;
end;
INITCOMMONCONTROLSEX=tagINITCOMMONCONTROLSEX;
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
hwndToolTips:HWnd;
ti:TOOLINFO;
iex:INITCOMMONCONTROLSEX;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
// 下面函数初始化 comctl32.dll
function InitCommonControlsEx_(icexINITCOMMONCONTROLSEX):BOOL;
stdcall;
external 'comctl32.dll' name 'InitCommonControlsEx';
procedure TForm1.FormCreate(Sender: TObject);
begin
iex.dwICC:=ICC_WIN95_CLASSES;
iex.dwSize:=SizeOf(INITCOMMONCONTROLSEX);
InitCommonControlsEx_(@iex);
hwndToolTips:= CreateWindow('tooltips_class32',
nil,
WS_POPUP or TTS_NOPREFIX or TTS_BALLOON,
0,0,0,0,0,0,
HINSTANCE,
nil);
if hwndToolTips <> 0 then
begin
ti.cbSize:=SizeOf(ti);
ti.uFlags:=TTF_SUBCLASS;
// or TTF_TRANSPARENT or TTF_CENTERTIP;
ti.hwnd:=Handle;
// 这个 Handle 是哪个窗口的，提示就出现在该窗口
ti.uId:=0;
ti.hinst:=HINSTANCE;
ti.lpszText:='这是一个测试的工具提示';
Windows.GetClientRect(Handle,ti.rect);
// 这个确定响应提示的是哪个窗口的范围矩形
SendMessage(hwndToolTips, TTM_ADDTOOL, 0,LPARAM(@ti));
end;
end;
end.
代码比较简单，不需要对 Form 的 Hint 做设置，当鼠标移动到 Form 上时就会出现工具提
示。其他效果只需要设置不同的参数标志，有兴趣可以试试。

？？？做什么呐？？

气泡提示这里也有一个 可以指定图标的(不是俺 写的：）)：
procedure ShowBalloonTip(Control: TWinControl;
Icon: integer;
Title: pchar;
Text: PWideChar);
//ShowBalloonTip(Button1, 1, 'Balloon Tooltip', 'Welcome http://dingbaosheng.delphibbs.com');
const
TOOLTIPS_CLASS = 'tooltips_class32';
TTS_ALWAYSTIP = $01;
TTS_NOPREFIX = $02;
TTS_BALLOON = $40;
TTF_SUBCLASS = $0010;
TTF_TRANSPARENT = $0100;
TTF_CENTERTIP = $0002;
TTM_ADDTOOL = $0400 + 50;
TTM_SETTITLE = (WM_USER + 32);
ICC_WIN95_CLASSES = $000000FF;
type
TOOLINFO = packed record
cbSize: integer;
uFlags: integer;
hwnd: THandle;
uId: integer;
rect: TRect;
hinst: THandle;
lpszText: PWideChar;
lParam: integer;
end;
var
hWndTip: THandle;
ti: TOOLINFO;
hWnd: THandle;
begin
hWnd := Control.Handle;
hWndTip := CreateWindow(TOOLTIPS_CLASS, nil,
WS_POPUP or TTS_NOPREFIX or TTS_BALLOON or TTS_ALWAYSTIP,
0, 0, 0, 0, hWnd, 0, HInstance, nil);
if hWndTip <> 0 then
begin
SetWindowPos(hWndTip, HWND_TOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
ti.cbSize := SizeOf(ti);
ti.uFlags := TTF_CENTERTIP or TTF_TRANSPARENT or TTF_SUBCLASS;
ti.hwnd := hWnd;
ti.lpszText := Text;
Windows.GetClientRect(hWnd, ti.rect);
SendMessage(hWndTip, TTM_ADDTOOL, 1, integer(@ti));
SendMessage(hWndTip, TTM_SETTITLE, Icon mod 4, Integer(Title));
end;
end;

不错，谢谢丁大哥补充。

To：小雨哥
千万别叫大哥 都给叫老掉了.
BTW:不见得有您老大咯， 嘻 ... ...

接受答案了.