allocatehwnd的简单介绍
哪个版本的CxGrid控件可以装到Delphi2009中
D2009，Forms单元中AllocateHWnd只能供本单元使用，之所以用forms的方法，因为有linux和windows区分。
你不在linux下开发的话，直接把forms改为classes
constructor TdxThemeChangedEventReceiver.Create;
begin
inherited Create;
{$IFDEF DELPHI6}
FWindowHandle := {$IFNDEF CLR}Classes.{$ENDIF}AllocateHWnd(WndProc);
{$ELSE}
FWindowHandle := Classes.AllocateHWnd(WndProc);
{$ENDIF}
end;
我下的DevExpress_ExpressQuantumGrid_Suite_v6.22、V6.34等都不完整，其中最高版本才D11。
DevExprV4.6自动安装乱码不能用，但在安装过程中我偶然注意到里面的pas有D12，于是找到DevExprV4.6安装后的代码，发现最高版是D14。然后将相关的代码考出来手动编译安装就成功了。
在DELPHI中，无窗体的程序如何获取系统关机或注销的消息？
写一个类，给类分配一个窗口句柄，然后在窗口过程里查询关机或注销消息，然后再显示；不明白可以参考TTimer类
给你个例子吧，两个单元，拿回去保存编译一下就行了：
program NoFormMsg;
uses
SysUtils,
Windows,
Messages,
Classes,
NoFormMsgCls in 'NoFormMsgCls.pas';
var
MyNoForm: TNoFormMsgCls;
msg: tagMsg;
begin
{ TODO -oUser -cConsole Main : Insert code here }
MyNoForm := TNoFormMsgCls.Crerte;
try
while True do begin
PeekMessage(msg, MyNoForm.Handle, 0, 0, PM_NOREMOVE);
if msg.message = WM_CLOSE then break;
TranslateMessage(msg);
DispatchMessage(msg);
Sleep(1);
end;
finally
MyNoForm.Free;
end;
end.
unit NoFormMsgCls;
interface
uses
Windows, Classes, Messages, SysUtils;
type
TNoFormMsgCls = class
private
FHandle: THandle;
procedure WndProc(var msg: TMessage);
public
constructor Crerte();
destructor Destroy(); override;
property Handle: THandle read FHandle;
end;
implementation
{ TNoFormMsgCls }
constructor TNoFormMsgCls.Crerte;
begin
FHandle := Classes.AllocateHWnd(WndProc);
end;
destructor TNoFormMsgCls.Destroy;
begin
Classes.DeallocateHWnd(FHandle);
inherited;
end;
procedure TNoFormMsgCls.WndProc(var msg: TMessage);
begin
with Msg do
if Msg = WM_QUERYENDSESSION then begin
if (LParam and ENDSESSION_LOGOFF) 0 then begin
Result := 0;
MessageBox(FHandle, '注销啦！', '结束任务', MB_OK);
//PostMessage(FHandle, WM_CLOSE, 0, 0);
end
else begin
Result := 0;
MessageBox(FHandle, '关机啦！', '结束任务', MB_OK);
//PostMessage(FHandle, WM_CLOSE, 0, 0);
end;
end
else
Result := DefWindowProc(FHandle, Msg, wParam, lParam);
end;
end.
delphi usb拔除的是哪个guid
delphi 获取USB口拔出和插入的状态
unit USBDeviceNotify
//USB Device arrival or remove
interface
use
Windows, Messages, SysUtils, Classes, Form
type
PDevBroadcastHdr = ^DEV_BROADCAST_HDR
DEV_BROADCAST_HDR = packed record
dbch_size: DWORD
dbch_devicetype: DWORD
dbch_reserved: DWORD
end
PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE
DEV_BROADCAST_DEVICEINTERFACE = record
dbcc_size: DWORD
dbcc_devicetype: DWORD
dbcc_reserved: DWORD
dbcc_classguid: TGUID
dbcc_name: short
end
const
GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}'
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface cla
type
TUSBDeviceEvent = procedure(Sender: TObject; pDeviceData: PDevBroadcastDeviceInterface) of object
TUSBDeviceNotify = class(TComponent)
rivate
FWindowHandle: HWND
FOnUSBArrival: TUSBDeviceEvent
FOnUSBRemove: TUSBDeviceEvent
rocedure WndProc(var Msg: TMessage)
function USBRegister: Boolea
rotected
rocedure WMDeviceChange(var Msg: TMessage); dynamic
ublic
constructor Create(AOwner: TComponent); override
destructor Destroy; override
ublished
roperty OnUSBArrival: TUSBDeviceEvent read FOnUSBArrival write FOnUSBArrival
roperty OnUSBRemove: TUSBDeviceEvent read FOnUSBRemove write FOnUSBRemove
end
implementatio
constructor TUSBDeviceNotify.Create(AOwner: TComponent)
egi
inherited Create(AOwner)
FWindowHandle := AllocateHWnd(WndProc)
USBRegister
end
destructor TUSBDeviceNotify.Destroy
egi
DeallocateHWnd(FWindowHandle)
inherited Destroy
end
rocedure TUSBDeviceNotify.WndProc(var Msg: TMessage)
egi
if (Msg.Msg = WM_DEVICECHANGE) the
egi
try
WMDeviceChange(Msg)
except
Application.HandleException(Self)
end
end
else
Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam)
end
rocedure TUSBDeviceNotify.WMDeviceChange(var Msg: TMessage)
var
devType: Integer
Datos: PDevBroadcastHdr
Data: PDevBroadcastDeviceInterface
egi
if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) the
egi
Datos := PDevBroadcastHdr(Msg.lParam)
devType := Datos^.dbch_devicetype
if devType = DBT_DEVTYP_DEVICEINTERFACE the
egin // USB Device
Data := PDevBroadcastDeviceInterface(Msg.LParam)
if Msg.wParam = DBT_DEVICEARRIVAL the
egi
if Assigned(FOnUSBArrival) the
FOnUSBArrival(Self, pData)
end
else
egi
if Assigned(FOnUSBRemove) the
FOnUSBRemove(Self, pData)
end
end
end
end
function TUSBDeviceNotify.USBRegister: Boolea
var
dbi: DEV_BROADCAST_DEVICEINTERFACE
Size: Integer
r: Pointer
egi
Result := False
Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE)
ZeroMemory(@dbi, Size)
dbi.dbcc_size := Size
dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE
dbi.dbcc_reserved := 0
dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE
dbi.dbcc_name := 0
r := RegisterDeviceNotification(FWindowHandle, @dbi,
DEVICE_NOTIFY_WINDOW_HANDLE
if Assigned(r) the
Result := True
end
end.
delphi托盘弹出信息
你用的什么版本的Delphi啊？Delphi2005以上系统已经自带的托盘控件，如果是之前版本的，可以找第三方控件,下面的代码是Delphi2006自带的控件的源码，你可以保存成文件，直接引用，也可以注册成控件，直接放控件到Form上：
TCustomTrayIcon = class(TComponent)
private
FAnimate: Boolean;
FData: TNotifyIconData;
FIsClicked: Boolean;
FCurrentIcon: TIcon;
FIcon: TIcon;
FIconList: TImageList;
FPopupMenu: TPopupMenu;
FTimer: TTimer;
FHint: String;
FIconIndex: Integer;
FVisible: Boolean;
FOnMouseMove: TMouseMoveEvent;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnMouseDown: TMouseEvent;
FOnMouseUp: TMouseEvent;
FOnAnimate: TNotifyEvent;
FBalloonHint: string;
FBalloonTitle: string;
FBalloonFlags: TBalloonFlags;
class var
RM_TaskbarCreated: DWORD;
protected
procedure SetHint(const Value: string);
function GetAnimateInterval: Cardinal;
procedure SetAnimateInterval(Value: Cardinal);
procedure SetAnimate(Value: Boolean);
procedure SetBalloonHint(const Value: string);
function GetBalloonTimeout: Integer;
procedure SetBalloonTimeout(Value: Integer);
procedure SetBalloonTitle(const Value: string);
procedure SetVisible(Value: Boolean); virtual;
procedure SetIconIndex(Value: Integer); virtual;
procedure SetIcon(Value: TIcon);
procedure SetIconList(Value: TImageList);
procedure WindowProc(var Message: TMessage); virtual;
procedure DoOnAnimate(Sender: TObject); virtual;
property Data: TNotifyIconData read FData;
function Refresh(Message: Integer): Boolean; overload;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
procedure Refresh; overload;
procedure SetDefaultIcon;
procedure ShowBalloonHint; virtual;
property Animate: Boolean read FAnimate write SetAnimate default False;
property AnimateInterval: Cardinal read GetAnimateInterval write SetAnimateInterval default 1000;
property Hint: string read FHint write SetHint;
property BalloonHint: string read FBalloonHint write SetBalloonHint;
property BalloonTitle: string read FBalloonTitle write SetBalloonTitle;
property BalloonTimeout: Integer read GetBalloonTimeout write SetBalloonTimeout default 3000;
property BalloonFlags: TBalloonFlags read FBalloonFlags write FBalloonFlags default bfNone;
property Icon: TIcon read FIcon write SetIcon;
property Icons: TImageList read FIconList write SetIconList;
property IconIndex: Integer read FIconIndex write SetIconIndex default 0;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property Visible: Boolean read FVisible write SetVisible default False;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnAnimate: TNotifyEvent read FOnAnimate write FOnAnimate;
end;
TTrayIcon = class(TCustomTrayIcon)
published
property Animate;
property AnimateInterval;
property Hint;
property BalloonHint;
property BalloonTitle;
property BalloonTimeout;
property BalloonFlags;
property Icon;
property Icons;
property IconIndex;
property PopupMenu;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseMove;
property OnMouseUp;
property OnMouseDown;
property OnAnimate;
end;
{ TTrayIcon}
constructor TCustomTrayIcon.Create(Owner: TComponent);
begin
inherited;
FAnimate := False;
FBalloonFlags := bfNone;
BalloonTimeout := 3000;
FIcon := TIcon.Create;
FCurrentIcon := TIcon.Create;
FTimer := TTimer.Create(Nil);
FIconIndex := 0;
FVisible := False;
FIsClicked := False;
FTimer.Enabled := False;
FTimer.OnTimer := DoOnAnimate;
FTimer.Interval := 1000;
if not (csDesigning in ComponentState) then
begin
FillChar(FData, SizeOf(FData), 0);
FData.cbSize := SizeOf(FData);
FData.Wnd := Classes.AllocateHwnd(WindowProc);
FData.uID := FData.Wnd;
FData.uTimeout := 3000;
FData.hIcon := FCurrentIcon.Handle;
FData.uFlags := NIF_ICON or NIF_MESSAGE;
FData.uCallbackMessage := WM_SYSTEM_TRAY_MESSAGE;
StrPLCopy(FData.szTip, Application.Title, SizeOf(FData.szTip) - 1);
if Length(Application.Title) 0 then
FData.uFlags := FData.uFlags or NIF_TIP;
Refresh;
end;
end;
destructor TCustomTrayIcon.Destroy;
begin
if not (csDesigning in ComponentState) then
Refresh(NIM_DELETE);
FCurrentIcon.Free;
FIcon.Free;
FTimer.Free;
Classes.DeallocateHWnd(FData.Wnd);
inherited;
end;
procedure TCustomTrayIcon.SetVisible(Value: Boolean);
begin
if FVisible Value then
begin
FVisible := Value;
if (not FAnimate) or (FAnimate and FCurrentIcon.Empty) then
SetDefaultIcon;
if not (csDesigning in ComponentState) then
begin
if FVisible then
begin
if not Refresh(NIM_ADD) then
raise EOutOfResources.Create(STrayIconCreateError);
end
else if not (csLoading in ComponentState) then
begin
if not Refresh(NIM_DELETE) then
raise EOutOfResources.Create(STrayIconRemoveError);
end;
if FAnimate then
FTimer.Enabled := Value;
end;
end;
end;
procedure TCustomTrayIcon.SetIconList(Value: TImageList);
begin
if FIconList Value then
begin
FIconList := Value;
if not (csDesigning in ComponentState) then
begin
if Assigned(FIconList) then
FIconList.GetIcon(FIconIndex, FCurrentIcon)
else
SetDefaultIcon;
Refresh;
end;
end;
end;
procedure TCustomTrayIcon.SetHint(const Value: string);
begin
if CompareStr(FHint, Value) 0 then
begin
FHint := Value;
StrPLCopy(FData.szTip, FHint, SizeOf(FData.szTip) - 1);
if Length(Hint) 0 then
FData.uFlags := FData.uFlags or NIF_TIP
else
FData.uFlags := FData.uFlags and not NIF_TIP;
Refresh;
end;
end;
function TCustomTrayIcon.GetAnimateInterval: Cardinal;
begin
Result := FTimer.Interval;
end;
procedure TCustomTrayIcon.SetAnimateInterval(Value: Cardinal);
begin
FTimer.Interval := Value;
end;
procedure TCustomTrayIcon.SetAnimate(Value: Boolean);
begin
if FAnimate Value then
begin
FAnimate := Value;
if not (csDesigning in ComponentState) then
begin
if (FIconList nil) and (FIconList.Count 0) and Visible then
FTimer.Enabled := Value;
if (not FAnimate) and (not FCurrentIcon.Empty) then
FIcon.Assign(FCurrentIcon);
end;
end;
end;
{ Message handler for the hidden shell notification window. Most messages
use WM_SYSTEM_TRAY_MESSAGE as the Message ID, with WParam as the ID of the
shell notify icon data. LParam is a message ID for the actual message, e.g.,
WM_MOUSEMOVE. Another important message is WM_ENDSESSION, telling the shell
notify icon to delete itself, so Windows can shut down.
Send the usual events for the mouse messages. Also interpolate the OnClick
event when the user clicks the left button, and popup the menu, if there is
one, for right click events. }
procedure TCustomTrayIcon.WindowProc(var Message: TMessage);
{ Return the state of the shift keys. }
function ShiftState: TShiftState;
begin
Result := [];
if GetKeyState(VK_SHIFT) 0 then
Include(Result, ssShift);
if GetKeyState(VK_CONTROL) 0 then
Include(Result, ssCtrl);
if GetKeyState(VK_MENU) 0 then
Include(Result, ssAlt);
end;
var
Point: TPoint;
Shift: TShiftState;
begin
case Message.Msg of
WM_QUERYENDSESSION:
Message.Result := 1;
WM_ENDSESSION:
begin
if TWmEndSession(Message).EndSession then
Refresh(NIM_DELETE);
end;
WM_SYSTEM_TRAY_MESSAGE:
begin
case Message.lParam of
WM_MOUSEMOVE:
begin
if Assigned(FOnMouseMove) then
begin
Shift := ShiftState;
GetCursorPos(Point);
FOnMouseMove(Self, Shift, Point.X, Point.Y);
end;
end;
WM_LBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Point);
FOnMouseDown(Self, mbMiddle, Shift, Point.X, Point.Y);
end;
FIsClicked := True;
end;
WM_LBUTTONUP:
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Point);
if FIsClicked and Assigned(FOnClick) then
begin
FOnClick(Self);
FIsClicked := False;
end;
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, mbLeft, Shift, Point.X, Point.Y);
end;
WM_RBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Point);
FOnMouseDown(Self, mbRight, Shift, Point.X, Point.Y);
end;
end;
WM_RBUTTONUP:
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Point);
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, mbRight, Shift, Point.X, Point.Y);
if Assigned(FPopupMenu) then
begin
SetForegroundWindow(Application.Handle);
Application.ProcessMessages;
FPopupMenu.AutoPopup := False;
FPopupMenu.PopupComponent := Owner;
FPopupMenu.Popup(Point.x, Point.y);
end;
end;
WM_LBUTTONDBLCLK, WM_MBUTTONDBLCLK, WM_RBUTTONDBLCLK:
if Assigned(FOnDblClick) then
FOnDblClick(Self);
WM_MBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Point);
FOnMouseDown(Self, mbMiddle, Shift, Point.X, Point.Y);
end;
end;
WM_MBUTTONUP:
begin
if Assigned(FOnMouseUp) then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Point);
FOnMouseUp(Self, mbMiddle, Shift, Point.X, Point.Y);
end;
end;
NIN_BALLOONHIDE, NIN_BALLOONTIMEOUT:
begin
FData.uFlags := FData.uFlags and not NIF_INFO;
end;
end;
end;
else if (Message.Msg = RM_TaskBarCreated) and Visible then
Refresh(NIM_ADD);
end;
end;
procedure TCustomTrayIcon.Refresh;
begin
if not (csDesigning in ComponentState) then
begin
FData.hIcon := FCurrentIcon.Handle;
if Visible then
Refresh(NIM_MODIFY);
end;
end;
function TCustomTrayIcon.Refresh(Message: Integer): Boolean;
begin
Result := Shell_NotifyIcon(Message, @FData);
end;
procedure TCustomTrayIcon.SetIconIndex(Value: Integer);
begin
if FIconIndex Value then
begin
FIconIndex := Value;
if not (csDesigning in ComponentState) then
begin
if Assigned(FIconList) then
FIconList.GetIcon(FIconIndex, FCurrentIcon);
Refresh;
end;
end;
end;
procedure TCustomTrayIcon.DoOnAnimate(Sender: TObject);
begin
if Assigned(FOnAnimate) then
FOnAnimate(Self);
if Assigned(FIconList) and (FIconIndex FIconList.Count - 1) then
IconIndex := FIconIndex + 1
else
IconIndex := 0;
Refresh;
end;
procedure TCustomTrayIcon.SetIcon(Value: TIcon);
begin
FIcon.Assign(Value);
FCurrentIcon.Assign(Value);
Refresh;
end;
procedure TCustomTrayIcon.SetBalloonHint(const Value: string);
begin
if CompareStr(FBalloonHint, Value) 0 then
begin
FBalloonHint := Value;
StrPLCopy(FData.szInfo, FBalloonHint, SizeOf(FData.szInfo) - 1);
Refresh(NIM_MODIFY);
end;
end;
procedure TCustomTrayIcon.SetDefaultIcon;
begin
if not FIcon.Empty then
FCurrentIcon.Assign(FIcon)
else
FCurrentIcon.Assign(Application.Icon);
Refresh;
end;
procedure TCustomTrayIcon.SetBalloonTimeout(Value: Integer);
begin
FData.uTimeout := Value;
end;
function TCustomTrayIcon.GetBalloonTimeout: Integer;
begin
Result := FData.uTimeout;
end;
procedure TCustomTrayIcon.ShowBalloonHint;
begin
FData.uFlags := FData.uFlags or NIF_INFO;
FData.dwInfoFlags := Integer(FBalloonFlags);
Refresh(NIM_MODIFY);
end;
procedure TCustomTrayIcon.SetBalloonTitle(const Value: string);
begin
if CompareStr(FBalloonTitle, Value) 0 then
begin
FBalloonTitle := Value;
StrPLCopy(FData.szInfoTitle, FBalloonTitle, SizeOf(FData.szInfoTitle) - 1);
Refresh(NIM_MODIFY);
end;
end;
initialization
// 这段代码是为了让通知窗口重建的时候通知应用程序
TCustomTrayIcon.RM_TaskBarCreated := RegisterWindowMessage('TaskbarCreated');