windows窗口和按钮Delphi为Windows窗 口标题栏添加新按钮
- 格式:pdf
- 大小:109.43 KB
- 文档页数:5
程序运行窗口在窗口的标题栏上添加了一个按钮,实现最小化到系统托盘右键菜单1、复制以下程序段到记事本中另存为文件:Type=ExeReference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\std ole2.tlb#OLE AutomationModule=TrayStartup="frmMain"HelpFile=""ExeName32="Project1.exe"Path32="..\..\..\..\..\..\WINDOWS\Desktop"Command32=""Name="Project1"HelpContextID="0"CompatibleMode="0"MajorVer=1MinorVer=0RevisionVer=0AutoIncrementVer=0ServerSupportFiles=0VersionCompanyName="None"CompilationType=0OptimizationType=0FavorPentiumPro(tm)=0CodeViewDebugInfo=0NoAliasing=0BoundsCheck=0OverflowCheck=0 FlPointCheck=0 FDIVCheck=0 UnroundedFP=0 StartMode=0 Unattended=0 Retained=0 ThreadPerObject=0 MaxNumberOfThreads=1[MS Transaction Server] AutoRefresh=1Begin VB.Form frmMainAutoRedraw = -1 'TrueCaption = "TitleBar Tray Button Demo"ClientHeight = 2040ClientLeft = 60ClientTop = 345ClientWidth = 4680LinkTopic = "Form1"ScaleHeight = 2040ScaleWidth = 4680StartUpPosition = 3 '窗口缺省Begin VB.Menu mnuPopUpCaption = ""Visible = 0 'FalseBegin VB.Menu mnuRestoreCaption = "Restore"EndEndEndAttribute VB_Name = "frmMain"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB_PredeclaredId = TrueAttribute VB_Exposed = FalsePrivate Sub Form_Load()Print "Right Click For Menu"Me.ScaleMode = vbPixels 'The API works in pixelsHook Me 'FormHook Hook()End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)If Button = 2 Then TrayMenu Me 'TrayNotify TrayMneu()End SubPrivate Sub Form_Unload(Cancel As Integer)UnHook 'FormHook UnHook()End SubAttribute VB_Name = "ToolTip"Const WS_EX_TOPMOST = &H8&Const TTS_ALWAYSTIP = &H1Const HWND_TOPMOST = -1Const SWP_NOACTIVATE = &H10Const SWP_NOMOVE = &H2Const SWP_NOSIZE = &H1Const WM_USER = &H400Const TTM_ADDTOOLA = (WM_USER + 4)Const TTF_SUBCLASS = &H10Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPublic Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongType TOOLINFOcbSize As LonguFlags As Longhwnd As Longuid As LongRECT As RECThinst As LonglpszText As StringlParam As LongEnd TypePublic hWndTT As LongPublic Sub CreateTip(hwndForm As Long, szText As String, rct As RECT)hWndTT = CreateWindowEx(WS_EX_TOPMOST, "tooltips_class32", "",TTS_ALWAYSTIP, _0, 0, 0, 0, hwndForm, 0&, App.hInstance, 0&)SetWindowPos hWndTT, HWND_TOPMOST, 0, 0, 0, 0, _SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATEDim TI As TOOLINFOWith TI.cbSize = Len(TI).uFlags = TTF_SUBCLASS.hwnd = hwndForm.uid = 1&.lpszText = szText & vbNullChar.RECT = rctEnd WithSendMessage hWndTT, TTM_ADDTOOLA, 0, TIEnd SubPublic Sub KillTip()DestroyWindow hWndTTEnd Sub4、复制以下程序段到记事本中另存为文件:Attribute VB_Name = "DrawButton"Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As LongDeclare Function GetTitleBarInfo Lib "user32" (ByVal hwnd As Long, pti As TitleBarInfo) As BooleanDeclare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As LongDeclare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As LongDeclare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As LongType RECTLeft As LongTop As LongRight As LongBottom As LongEnd TypeType TitleBarInfocbSize As LongrcTitleBar As RECT 'A RECT structure that receives the coordinates of the title barrgState(5) As Long 'An array that receives a DWORD value for each element of the title barEnd Type'rgState array Values'0 The titlebar Itself'1 Reserved'2 Min button'3 Max button'4 Help button'5 Close button''rgstate return constatnts'STATE_SYSTEM_FOCUSABLE = &H00100000'STATE_SYSTEM_INVISIBLE = &H00008000'STATE_SYSTEM_OFFSCREEN = &H00010000'STATE_SYSTEM_PRESSED = &H00000008'STATE_SYSTEM_UNAVAILABLE = &H00000001Const DFC_BUTTON = 4Const DFCS_BUTTONPUSH = &H10Const DFCS_PUSHED = &H200Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As LongPublic Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As LongPublic Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPublic Type POINTAPIx As Longy As LongEnd TypeConst SM_CXFRAME = 32Const COLOR_BTNTEXT = 18Dim lDC As LongPublic R As RECTPublic Sub ButtonDraw(frm As Form, bState As Boolean)Dim TBButtons As IntegerDim TBarHeight As IntegerDim TBButtonHeight As IntegerDim TBButtonWidth As IntegerDim DrawWidth As IntegerDim TBI As TitleBarInfoDim TBIRect As RECTDim bRslt As BooleanDim WinBorder As IntegerWith frmIf .BorderStyle = 0 Then Exit Sub ' Don't draw a button if there is no titlebar'----How Many Buttons in TitleBar------------------------------------------If Not .ControlBox Then TBButtons = 0If .ControlBox Then TBButtons = 1If .ControlBox And .WhatsThisButton ThenIf .BorderStyle < 4 ThenTBButtons = 2ElsetButtons = 1End IfEnd IfIf .ControlBox And .MinButton And .BorderStyle = 2 Then TBButtons = 3If .ControlBox And .MinButton And .BorderStyle = 5 Then TBButtons = 1If .ControlBox And .MaxButton And .BorderStyle = 2 Then TBButtons = 3If .ControlBox And .MaxButton And .BorderStyle = 5 Then TBButtons = 1'------------------------------------------------------------------------'----Get height of Titlebar----------------------------------------------'Using this method gets the height of the titlebar regardless of the window'style. It does, however, restrict its use to Win98/2000. So if you want to'use this code in Win95, then call GetSystemMetrics to find the windowstyle'and titlebar size.TBI.cbSize = Len(TBI)bRslt = GetTitleBarInfo(.hwnd, TBI)TBarHeight = TBIRect.Bottom - TBIRect.Top - 1'-----------------------------------------------------------------------'----Get WindowBorder Size----------------------------------------------If .BorderStyle = 2 Or .BorderStyle = 5 ThenR.Top = GetSystemMetrics(32) + 2WinBorder = R.Top - 6ElseR.Top = 5WinBorder = -1End IfEnd With'---------------------------------------------------------------------------'----Use Titlebar Height to determin button size----------------------------TBButtonHeight = TBarHeight - 4TBButtonWidth = TBButtonHeight + 2'and the size and space of the dot on the buttonDrawWidth = TBarHeight / 8'---------------------------------------------------------------------------'----Determin the position of our button------------------------------------R.Bottom = R.Top + TBButtonHeightSelect Case TBButtonsCase 1R.Right = frm.ScaleWidth - (TBButtonWidth) + WinBorderCase 2R.Right = frm.ScaleWidth - ((TBButtonWidth * 2) + 2) + WinBorderCase 3R.Right = frm.ScaleWidth - ((TBButtonWidth * 3) + 2) + WinBorderCase ElseEnd SelectR.Left = R.Right - TBButtonWidth'--------------------------------------------------------------------------'----Get the Widow DC so that we may draw in the title bar-----------------lDC = GetWindowDC(frm.hwnd)'--------------------------------------------------------------------------'----Determin the position of thedot--------------------------------------Dim StartXY As Integer, EndXY As IntegerSelect Case TBarHeightCase Is < 20StartXY = DrawWidth + 1EndXY = DrawWidth - 1Case ElseStartXY = (DrawWidth * 2)EndXY = DrawWidthEnd Select'--------------------------------------------------------------------------'----We have all the information we need So Draw the button----------------Dim rDot As RECTIf bState ThenDrawFrameControl lDC, R, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHEDrDot.Left = R.Right - (1 + StartXY): rDot.Top = R.Bottom - (1 + StartXY)rDot.Right = R.Right - (1 + EndXY): rDot.Bottom = R.Bottom - (1 + EndXY)ElseDrawFrameControl lDC, R, DFC_BUTTON, DFCS_BUTTONPUSHrDot.Left = R.Right - (2 + StartXY): rDot.Top = R.Bottom - (2 + StartXY)rDot.Right = R.Right - (2 + EndXY): rDot.Bottom = R.Bottom - (2 + EndXY)End IfFillRect lDC, rDot, GetSysColorBrush(COLOR_BTNTEXT)'---------------------------------------------------------------------------'----SetTooltip------------------------------------------------------------ Dim TTRect As RECTTTRect.Bottom = R.Bottom + (TBarHeight - ((TBarHeight * 2) + WinBorder + 5))TTRect.Left = R.Left - (4 - WinBorder)TTRect.Right = R.Right - (4 - WinBorder)TTRect.Top = R.Top + (TBarHeight - ((TBarHeight * 2) + WinBorder + 5))KillTip 'ToolTip KillTip()CreateTip appForm.hwnd, "System Tray", TTRect 'ToolTip CreateTip()End Sub5、复制以下程序段到记事本中另存为文件:Attribute VB_Name = "TrayNotify"Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As LongDeclare Function CreatePopupMenu Lib "user32" () As LongDeclare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, ByVal lprc As Any) As LongDeclare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As LongDeclare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As LongType NOTIFYICONDATAcbSize As Longhwnd As Longuid As LonguFlags As LonguCallbackMessage As LonghIcon As Longsztip As String * 64End TypeConst NIM_ADD = &H0Const NIM_DELETE = &H2Const NIM_MODIFY = &H1Const NIF_MESSAGE = &H1Const NIF_ICON = &H2Const NIF_TIP = &H4Const MF_GRAYED = &H1&Const MF_STRING = &H0&Const MF_SEPARATOR = &H800&Const TPM_NONOTIFY = &H80&Const TPM_RETURNCMD = &H100&Public bTraySet As BooleanDim lMenu As LongPublic Sub TraySet(frm As Form, sztip As String, hIcon As Long)Dim NID As NOTIFYICONDATAWith NID.cbSize = Len(NID).hIcon = hIcon.sztip = sztip & vbNullChar.uCallbackMessage = WM_LBUTTONUP.uFlags = NIF_MESSAGE Or NIF_ICON Or NIF_TIP .uid = 1&End WithShell_NotifyIcon NIM_ADD, NIDbTraySet = TrueEnd SubPublic Sub TrayRestore(frm As Form)Dim NID As NOTIFYICONDATAWith NID.cbSize = Len(NID).uid = 1&End WithShell_NotifyIcon NIM_DELETE, NIDbTraySet = FalseEnd SubPublic Sub TrayMenu(frm As Form)Dim hMenu As Long, tMenu As LongDim MP As POINTAPIGetCursorPos MPhMenu = CreatePopupMenu()If bTraySet ThenAppendMenu hMenu, MF_STRING, 1000, "Restore" ElseAppendMenu hMenu, MF_STRING Or MF_GRAYED, 1000, "Restore"End IfAppendMenu hMenu, MF_SEPARATOR, 0&, 0&AppendMenu hMenu, MF_STRING, 1010, "Exit"tMenu = TrackPopupMenu(hMenu, TPM_NONOTIFY Or TPM_RETURNCMD, MP.x, MP.y, 0&, frm.hwnd, 0&)Select Case tMenuCase 1000TrayRestore frmCase 1010TrayRestore frmUnHookUnload frmCase Else'do nothingEnd SelectDestroyMenu hMenuEnd Sub6、复制以下程序段到记事本中另存为文件:Attribute VB_Name = "FormHook"Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _ (ByVal lpPrevWndFunc As Long, _ByVal hwnd As Long, _ByVal Msg As Long, _ByVal wParam As Long, _ByVal lParam As Long) As LongDeclare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hwnd As Long, _ByVal nIndex As Long, _ByVal dwNewLong As Long) As LongDeclare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPublic Const GWL_WNDPROC = -4Public Const WM_LBUTTONDOWN = &H201Public Const WM_LBUTTONUP = &H202Public Const WM_MOUSEMOVE = &H200Public Const WM_NCMOUSEMOVE = &HA0Public Const WM_NCLBUTTONDOWN = &HA1Public Const WM_NCLBUTTONUP = &HA2Public Const WM_NCLBUTTONDBLCLK = &HA3Public Const WM_NCRBUTTONDOWN = &HA4Public Const WM_NCRBUTTONUP = &HA5Public Const WM_ACTIVATE = &H6Public Const WM_NCPAINT = &H85Public Const WM_PAINT = &HFPublic Const WM_ACTIVATEAPP = &H1CPublic Const WM_MOUSEACTIVATE = &H21Public Const WM_COMMAND = &H111Public Const WM_NCACTIVATE = &H86Public Const WM_DESTROY = &H2Public Const WM_SIZE = &H5Global lpPrevWndProc As LongGlobal gHW As LongGlobal appForm As FormPrivate Function MakePoints(lParam As Long) As POINTAPIDim hexstr As Stringhexstr = Right("00000000" & Hex(lParam), 8)MakePoints.x = CLng("&H" & Right(hexstr, 4)) - (appForm.Left / Screen.TwipsPerPixelX)MakePoints.y = CLng("&H" & Left(hexstr, 4)) - (appForm.Top / Screen.TwipsPerPixelY)End FunctionPublic Sub Hook(frm As Form)Set appForm = frmlpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)End SubPublic Sub UnHook()Dim lngReturnValue As LonglngReturnValue = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc) End SubFunction WindowProc(ByVal hwnd As Long, _ByVal uMsg As Long, _ByVal wParam As Long, _ByVal lParam As Long) As Long'------------------------------------------------------------------------------'Messing around in here can cause allsorts of problems.'So, if you must, make sure you save everytihing you want to keep 'before you run the program.'Don't run anything outside of a message selection as it will be 'executed so many times per second that it will slow down system response.Dim lRslt As LongDim retProc As BooleanStatic STButtonState As BooleanStatic Toggle As BooleanStatic i As IntegerOn Error Resume NextSelect Case uMsgCase WM_DESTROYTrayRestore appFormKillTip 'ToolTip KillTip()UnHookretProc = TrueCase WM_NCMOUSEMOVE'Only draw the button when necessaryIf GetAsyncKeyState(vbLeftButton) < 0 ThenIf OverButton(lParam) ThenIf Toggle = False ThenToggle = TrueButtonDraw appForm, Toggle 'DrawButton ButtonDraw()End IfElseIf Toggle = True ThenToggle = FalseButtonDraw appForm, Toggle 'DrawButton ButtonDraw()End IfEnd IfElseSTButtonState = FalseretProc = TrueEnd IfCase WM_NCLBUTTONDOWNIf OverButton(lParam) ThenSTButtonState = TrueButtonDraw appForm, True 'DrawButton ButtonDraw()ElseSTButtonState = FalseretProc = TrueEnd IfCase WM_NCLBUTTONUPSTButtonState = FalseIf OverButton(lParam) ThenTraySet appForm, appForm.Caption, appForm.Icon'TrayNotify TraySet()ButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = FalseElseretProc = TrueEnd IfCase WM_LBUTTONUPSTButtonState = FalseButtonDraw appForm, False 'DrawButton ButtonDraw()If GetAsyncKeyState(vbLeftButton) < 0 And bTraySet Then TrayMenu appForm 'TrayNotify TrayMenu()End IfretProc = TrueCase WM_NCLBUTTONDBLCLK, WM_NCRBUTTONDOWNIf Not OverButton(lParam) ThenretProc = TrueEnd IfCase WM_SIZE, WM_NCPAINT, WM_PAINT, WM_COMMANDButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = TrueCase WM_ACTIVATEAPP, WM_NCACTIVATE, WM_ACTIVATE, WM_MOUSEACTIVATEButtonDraw appForm, False 'DrawButton ButtonDraw()retProc = TrueCase ElseretProc = TrueEnd SelectIf retProc ThenWindowProc = CallWindowProc(lpPrevWndProc, hwnd, uMsg, wParam, lParam)ElseWindowProc = 0End IfEnd FunctionPrivate Function OverButton(lParam As Long) As Boolean Dim MP As POINTAPIMP = MakePoints(lParam)If PtInRect(R, MP.x, MP.y) Then OverButton = True End Function双击工程文件:运行,就可以看到效果。
Delphi自定义窗体(最大化、最小化、关闭、窗体的移动)Uses ShellAPI;1、//最小化procedure TForm1.btn1Click(Sender: TObject);varI, J, X, Y: Word;begin//第一种:最小化在屏幕的左下角,不是常见的最小化// WindowState := wsMinimized;//第儿种:最小化在任务栏里面,是常见的最小化postmessage(Self.Handle,WM_SYSCOMMAND,SC_MINIMIZ E,0);end;2、//最大化/正常的按钮procedure TForm1.btn2Click(Sender: TObject);varabd: TAppBarData;beginif WindowState = wsMaximized thenWindowState := wsNormalelsebeginWindowState := wsMaximized; // BorderStyle为 bsNoneabd.cbSize := sizeof(abd);SHAppBarMessage(ABM_GETTASKBARPOS, abd); //读取任务的区域Self.Height := Self.Height - (abd.rc.Bottom - abd.rc.Top); //预留出任务的位置end;end;3、//关闭procedure TForm1.btn3Click(Sender: TObject);beginClose;end;4、//窗体的移动procedure TForm1.lbl1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);beginif Button=Mbleft thenbeginReleaseCapture;Perform(WM_NCLBUTTONDOWN,HTCAPTION,0);//消息处理end;end;5、//查找应用程序中已经创建的窗体function FindForm(FormName: string): TForm;vari:Integer;beginResult := nil;for i:=0 to ponentCount-1 dobeginif ponents[i].Name = FormName thenbeginResult := TForm(ponents[i]);Break; end; end; end;。
如何在标题栏上增加按钮大家在使用某些软件的过程中,有没有注意到有些软件有一些很有趣的东西。
比如说在主窗口的标题栏上居然有一个按钮。
在Internet中随处可见这样的小控件。
按钮怎么可以加入到非客户区(Client)呢?在这里,最关键的一点就是,大家不要被传统知识误导:真的认为它是一个按钮。
有名柄(handle)的控件当然不能放在标题栏上了。
有经验的程序员用Spy++跟踪一下的话,马上就会发现其中的秘密。
它并不是一个按钮,只不过是处理成按钮的样子罢了。
既然知道了所以然,那么我们为什么不能自己来做一个呢,当然没问题,下面我们就用Delphi来实现它,讲注意我的注解。
在具体实例之前,我们应该知道几个关于标题栏的重要的消息:WM_NCPAINT:重画标题栏消息。
我们必须截住它,可以在这里重画按钮;WM_NCLBUTTONDOWN:在标题栏上按下鼠标左键消息。
我们可以截住它,在标题栏上画出按钮按下的样子,并且可以在其中进行自已的单击事件的处理,使得它像一个按钮;WM_NCLBUTTONUP:在标题栏上释放鼠标左键消息。
我们可以截住它,在标题栏上画出按钮弹起的样子;WM_NCLBUTTONDBLCLK:在标题栏上双击鼠标左键消息。
我们可以截住它,当在按钮区域双击时,我们就该使其无效,从而避免窗体执行最大化和还原操作。
WM_NCRBUTTONDOWN:在标题栏上按下鼠标右键消息。
我们可以截住它,当在按钮区域双击时,我们就该使其无效,从而避免弹出窗体按制菜单。
WM_NCMOUSEMOVE:在标题栏上移动鼠标消息。
我们可以截住它,当鼠标移出按钮区域时,我们就必须画出按钮没有被按下,即凸起时的样子。
WM_NCACTIVATE:当标题栏在激活与非激活之间切换时收到该消息。
我们可以截住它,当该窗口处理激活状态时,我们可以做一些事情,比如说将我们的标题栏按钮上的字体变灰或变黑来指示该窗口的当前状态。
下面我没有加入该项功能,如果大家感兴趣的话,可以自己完成。
Delphi界面设计专辑[前言:]界面的美观和用户亲和性是应用软件成功的首要条件,因此界面往往是程序员最费心的地方。
在这个专辑中,将向读者全面介绍Delphi中界面设计的原则和技巧窗体设计制作固定大小的Form固定的Form像一个对话框,何不试试下面的语句巧用Delphi制作溅射屏幕精心编写的WINDOWS程序显示启动注意事项,称之为溅射屏幕(splash screen)。
利用一点儿小小的内容,即可给程序的显示添加不少色彩LED数码管仿真显示程序在电子设备上广泛地使用LED数码管显示数据,在许多应用软件中也经常模拟LED数码管显示数据,使程序画面看起来很有特色菜单设计DELPHI中自适应表单的实现我们知道,屏幕分辨率的设置影响着表单布局,假设你的机器上屏幕分辨率是800*600,而最终要分发应用的机器分辨率为640*480,或1024*768,这样你原先设计的表单在新机器上势必会走样作非常规程序菜单掌握delphi高级秘籍大家可能见过诸如金山毒霸,瑞星杀毒,以及五笔输入法等等在系统托盘(即右下角有时间和输入法图标的地方)在的控制菜单,而在正常的任务栏(即屏幕最下方的“开始”按钮的右边的各式各样)中却不出现按钮的程序,即我们常说的在后台运行的程序用Delphi制作动态菜单所谓动态菜单是指菜单项随着程序的操作变化而变化。
现在,我们用Delphi来实现这一功能,具体步骤如下工具栏和状态条为Windows窗口标题栏添加新按钮对于我们熟悉的标准windows窗口来讲,标题栏上一般包含有3个按钮,即最大化按钮,最小化按钮和关闭按钮。
你想不想在Windows的窗口标题栏上添加一个新的自定义按钮用Delphi4实现风Word97格的工具栏用过Word97的人对它的工具栏印象很深刻,因为它的风格很“酷”,同样IE4.0的工具栏也有类似的风格,Win98的出现,使这种风格的工具栏得到了推广如何隐藏和显示Windows的任务条如果隐藏和显示Windows的任务条?仅仅调用以下的函数就可以.其他技巧Delphi利用Windows GDI实现文字倾斜在Delphi开发环境中,文字的输出效果一般都是头上脚下的"正统"字符,如何输出带有一定倾斜角度的文字以达到特殊的显示效果呢Delphi之三十六计之界面篇设置状态栏面板对象的Style为OwnerDraw,并在状态栏对象的DrawPanel事件中书写以下代码利用COM技术实现外壳扩展的属性页当用户在资源管理器中调用右键菜单时,会显示一个"属性"菜单项,点击属性菜单项会显示一个属性页,用户可以获得甚至修改文件信息制作固定大小的Form固定的Form像一个对话框,何不试试下面的语句?C++ Builder请参照Delphi的例子Delphi您可以覆写CreateParams() 这个TWinControl 的虚拟程序, 改变form的wc.Stylee, 将WS_SYSMENU 这个旗标解除, 这样, 就不会有左上角的SystemMenuBox 了.至於不能移动.缩小/放大, 可以自已拦下WM_NCHITTEST, 然後一概回应滑鼠点在视窗Client 区域, 相信这个视窗就呆呆的不会动了.详情可以查一下Win32API Help 的CreateWindow() 与WM_NCHITTEST 的说明.unit Unit1;interfaceusesWindows, Messages, SysUtils, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;typeTForm1 = class(TForm)Button1: TButton;procedure Button1Click(Sender: TObject);private{ Private declarations }procedure WMNCHitTest(var Msg: TMessage); message WM_NCHITTEST;protectedprocedure CreateParams(var Params: TCreateParams); override;public{ Public declarations }end;varForm1: TForm1;implementation{$R *.DFM}巧用Delphi制作溅射屏幕精心编写的WINDOWS程序显示启动注意事项,称之为溅射屏幕(splash screen)。
13.1 Delphi 快捷键Ctrl+K+3 在代码编辑框中设定/取消书签3Ctrl+K+4 在代码编辑框中设定/取消书签4Ctrl+K+5 在代码编辑框中设定/取消书签5Ctrl+K+6 在代码编辑框中设定/取消书签6Ctrl+K+7 在代码编辑框中设定/取消书签7Ctrl+K+8 在代码编辑框中设定/取消书签8Ctrl+K+9 在代码编辑框中设定/取消书签9Ctrl+K+B 在代码编辑框中标记块开始Ctrl+K+C 在代码编辑框中拷贝块Ctrl+K+H 在代码编辑框中隐藏/显示选定块Ctrl+K+I 在代码编辑框中把选定块按设定的缩进值进行右缩进Ctrl+K+K 在代码编辑框中标记块结尾Ctrl+K+L 在代码编辑框中标记本行为块Ctrl+K+N 在代码编辑框中把块转化为大写Ctrl+K+O 在代码编辑框中把块转化为小写Ctrl+K+R 在代码编辑框中以块的方式读入文件Ctrl+K+T 在代码编辑框中标记本词为块Ctrl+K+U 在代码编辑框中把选定块按设定的缩进值进行左缩进Ctrl+K+V 在代码编辑框中移动选定块Ctrl+K+W 在代码编辑框中把选定块写入文件Ctrl+K+Y 在代码编辑框中删除选定块Ctrl+L 再次查找Ctrl+Left 在表单上向左移动当前控件Ctrl+Left Arrow 向左移一个词Ctrl+N 在代码编辑器中插入新行Ctrl+O+C 在代码编辑框中设定一个列块Ctrl+O+L 在代码编辑框中设定一个行块Ctrl+Q+0 在代码编辑框中定位到书签0Ctrl+Q+1 在代码编辑框中定位到书签1Ctrl+Q+2 在代码编辑框中定位到书签2Ctrl+Q+3 在代码编辑框中定位到书签3Ctrl+Q+4 在代码编辑框中定位到书签4Ctrl+Q+5 在代码编辑框中定位到书签5Ctrl+Q+6 在代码编辑框中定位到书签6Ctrl+Q+7 在代码编辑框中定位到书签7Ctrl+Q+8 在代码编辑框中定位到书签8Ctrl+Q+9 在代码编辑框中定位到书签9Ctrl+Q+B 在代码编辑框中移动到块开头Ctrl+Q+K 在代码编辑框中移动到块结尾Ctrl+R 显示替换窗口Ctrl+Righ 在表单上向右移动当前控件Ctrl+Right Arrow 向右移一个词Ctrl+Shift+C 通过函数或过程的声明生成其代码编辑框架Ctrl+Shift+F11 显示工程配置窗口Ctrl+Space 显示代码自动完成窗口(与汉字输入法的快捷键冲突)Ctrl+Tab 在代码编辑框的各页中切换Ctrl+UP 在表单上向上移动当前控件Ctrl+V 粘贴F1 上下文敏感帮助F11 显示对象查看器F12 在表单和代码编辑框间切换F3 再次查找F4 运行至光标处F5 设置/取消断点F7 进入式运行(进入子函数)F8 跨越式运行(跳过子函数)F9 运行(编译并运行)。
delphi下用windowsapi创建窗体Delphi 下用Windows API 创建窗体// Delphi 下调用Windows API 创建窗体. //// 模板-------BY Hottey 2004-4-13-0:18 //// 作者网站: //program delphi;useswindows,messages;consthellostr=‘Hello World!‘;{$R delphi.res}//窗口消息处理函数.function MyWinProc(hWnd:THandle;uMsg:UINT;wParam,lPa ram:Cardinal):Cardinal;export;stdcall;varhdca,hdcb:THandle; //设备描述表句柄.rect:TRect; //矩形结构.font:HFont;ps:TPaintStruct; //绘图结构.beginresult:=0;case uMsg ofWM_PAINT:beginhdca:=BeginPaint(hWnd,ps);SetBkMode(hdca, Transparent);SetBkColor(hdca,GetBkColor(hdca));GetClientRect(hWnd,rect); //获取窗口客户区的尺寸.DrawText(hdca,Pchar(hellostr),-1,rect,DT_SINGLELINE or DT_CENTER or DT_VCENTER);// TextOut(hdc,100,40,hellostr,Length(hellostr));EndPaint(hWnd,ps);end;WM_CREATE:beginhdcb := GetDC(hWnd);font := CreateFont(45, 0, 0, 0, FW_normal, 0, 0, 0, ansi_chars et, out_default_precis, clip_default_precis,default_quality, 34, PChar(‘Arial‘));SelectObject(hdcb, font);ReleaseDC(hWnd, hdcb);end;WM_DESTROY:PostQuitMessage(0)else//使用缺省的窗口消息处理函数.result:=DefWindowProc(hWnd,uMsg,wParam,lParam);end;end;//主程序开始.varMsg :TMsg; //消息结构.hWnd,hInst :THandle; //Windows 窗口句柄.WinClass :TWndClassEx; //Windows 窗口类结构.beginhInst:=GetModuleHandle(nil); // get the application instanc eWinClass.cbSize:=SizeOf(TWndClassEx);WinClass.lpszClassName:=‘MyWindow‘; //类名.WinClass.style:=CS_HREDRAW or CS_VREDRAW or CS_OWN DC;WinClass.hInstance:=hInst; //程序的实例句柄.//设置窗口消息处理函数.WinClass.lpfnWndProc:=@MyWinProc; //窗口过程.WinClass.cbClsExtra:=0; //以下两个域用于在类结构和Windows内部保存的窗口结构WinClass.cbWndExtra:=0; //中预留一些额外空间.WinClass.hIcon:=LoadIcon(hInstance,MakeIntResource(‘M AINICON‘));WinClass.hIconsm:=LoadIcon(hInstance,MakeIntResource(‘MAINICON‘));WinClass.hCursor:=LoadCursor(0,IDC_Arrow);//GetStockObject 获取一个图形对象,在这里是获取绘制窗口背景的刷子,返回一个白色刷子的句柄.WinClass.hbrBackground:=HBRUSH(GetStockObject(white_ Brush));WinClass.lpszMenuName:=nil; //指定窗口类菜单.//向Windows 注册窗口类.if RegisterClassEx(WinClass)=0 thenbeginMessageBox(0,‘Registeration Error!‘,‘SDK/API‘,MB_OK);Exit;end;//建立窗口对象.hWnd:=CreateWindowEx(WS_EX_OVERLAPPEDWINDOW, //扩展的窗口风格.WinClass.lpszClassName, //类名.‘Hello Window‘, //窗口标题.WS_OVERLAPPEDWINDOW, //窗口风格.CW_USEDEFAULT, //窗口左上角相对于屏幕左上角的初始位置x.0, //....右y.CW_USEDEFAULT, //窗口宽度x.0, //窗口高度y.0, //父窗口句柄.0, //窗口菜单句柄.hInst, //程序实例句柄.nil); //创建参数指针.if hWnd<>0 thenbeginShowWindow(hWnd,SW_SHOWNORMAL); //显示窗口.UpdateWindow(hWnd); //指示窗口刷新自己.SetWindowPos(hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_N OMOVE + SWP_NOSIZE);endelseMessa geBox(0,‘Window not Created!‘,‘SDK/API‘,MB_O K);//主消息循环程序.while GetMessage(Msg,0,0,0) dobeginTranslateMessage(Msg); //转换某些键盘消息.DispatchMessage(Msg); //将消息发送给窗口过程.end;end.>其实Windows 编程是每个学写程序的人都要掌握的,学Delphi 时也最好能先学习Windos编程(最少要知道).以上代码虽说不如在Delphi中直接来个New->Form来的快,但它能告诉你本质的东西.能让你更好的了解消息循环以及其他.而这些正是让New出来的窗体给掩盖的部分.。
windows窗口和按钮:Delphi为Windows窗口标题栏添加新按钮
疯狂代码 / ĵ:http://Delphi/Article45154.html
张海航 ; ;
对于我们熟悉标准windows窗口来讲标题栏上般包含有3个按钮即最大化按钮最小化按钮和关闭按钮你想不想在Windows窗口标题栏上添加个新自定义按钮满足你个性化需求从而也使自己窗口更具特色呢?!
下面我们就讨论下在delphi中如何给窗口标题栏上添加新按钮
、实现起来要定义以下过程:
1、 定义DrawCaptButton过程这个过程功能是在指定位置画出按钮
在过程中要使用win32GetMetrics得到窗口大小和标题按钮大小;使用delphiBounds定义个矩形这个矩形就是新按钮位置;再定义个小矩形这个矩形是为了填写文本;最后就delphi中比较有用drawbuttonface把按钮画出来
2、 每次我们对窗口进行操作例如最大化操作或最小化操作新按钮就会消失为了解决这个问题我们对所有消息要进行处理给每个消息编写个过程对按钮进行重画
A、定义WMNCPa(var Msg:TWMNCPa)过程处理消息WM_NCPa
B、定义WMNCActivate(var Msg :TWMNCActivate)过程处理消息WM_NCACTIVATE
C、定义WMSetText(var Msg:TWMSetText)过程处理消息WM_SETTEXT
D、定义WMNCHitTest(var Msg :TWMNCHitTest)过程处理消息WM_NCHITTEST ; ;
E、定义WMNCLButtonDown(var Msg : TWMNCLButtonDown)过程处理消息
WM_NCLBUTTONDOWN
2、 具体源如下:
我们结合源来讲述过程实现从中可以看出对win32以及drawbuttonface使用思路方法
unit Main; ; ;
erface
uses
Windows, Buttons, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; type
TForm1 = (TForm)
procedure FormResize(Sender: TObject);
private
CaptionBtn : TRect;
procedure DrawCaptButton;
procedure WMNCPa(var Msg : TWMNCPa); message WM_NCPa;
procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE; procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message
WM_NCLBUTTONDOWN;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
const
htCaptionBtn = htSizeLast + 1;
{$R *.DFM}
procedure TForm1.DrawCaptButton;
file://drawcapbuttton过程具体实现
var
xFrame,
yFrame,
xSize,
ySize : Integer;
R : TRect;
begin
xFrame := GetMetrics(SM_CXFRAME);
yFrame := GetMetrics(SM_CYFRAME);
file://把窗口宽度置于变量xFrame,把窗口高度置于变量yFrame
xSize:= GetMetrics(SM_CXSIZE);
ySize:= GetMetrics(SM_CYSIZE);
// 把标题栏按钮宽度置于变量xSize,把标题栏按钮高度置于变量ySize
CaptionBtn := Bounds(Width - xFrame - 4*xSize + 2,
yFrame + 2, xSize - 2, ySize - 4);
file://定义出新标题按钮位置值放在变量CaptionBtn中
Canvas.Handle := GetWindowDC(Self.Handle);
file://得到窗口句柄 ; ;
:= 'Symbol';
Canvas.Font.Color := clBlue;
Canvas.Font.Style := [fsBold];
Canvas.Pen.Color := clYellow;
Canvas.Brush.Color := clBtnFace;
file://定义画布字体、画笔、刷子等属性
try
DrawButtonFace(Canvas, CaptionBtn, 1, bsAutoDetect, False, False, False); file://在画布上画出定义按钮
R := Bounds(Width - xFrame - 4 * xSize + 2,
yFrame + 3, xSize - 6, ySize - 7);
file://在新按钮上画出个小矩形
with CaptionBtn do
Canvas.TextRect(R, R.Left + 2, R.Top - 1, 'W');
file://在上面画出小矩形上填写个'w'
finally
ReleaseDC(Self.Handle, Canvas.Handle);
Canvas.Handle := 0;
file://容错处理如果出现异常把句柄释放掉
end;
end;
procedure TForm1.WMNCPa(var Msg : TWMNCPa);
//WMNCPa过程具体实现该过程在绘制窗口时被
begin
inherited;//继承默认消息处理
DrawCaptButton;//对按钮进行重画
end;
procedure TForm1. (var Msg : TWMNCActivate);
// WMNCActivate过程和WMNCPa过程实现思路方法相同该过程在窗口非客户区要更改为激活状态或非激活状态时被
begin
inherited;
DrawCaptButton;
end;
procedure TForm1.WMSetText(var Msg : TWMSetText);
// WMSetText过程和WMNCPa过程实现思路方法相同该过程在设置窗口文本时被
begin
inherited;
DrawCaptButton;
end;
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
file:// WMNCHitTest过程和WMNCPa过程实现思路方法相同该过程在光标移动或鼠标按钮被按下或鼠标按钮被释放时
begin
inherited;
with Msg do
PtInRect(CaptionBtn, Po(XPos - Left, YPos - Top)) then
Result := htCaptionBtn;//判断鼠标所在位置是否在新按钮矩形范围内如果在返回新按钮标识值
end;
procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
// WMNCLButtonDown过程和WMNCPa过程实现思路方法相同当光标处于窗口非客户区范围内鼠标左键被按下时该过程
begin
inherited;
(Msg.HitTest = htCaptionBtn) then
ShowMessage('你点击是标题栏上新按钮');
file://判断被点击是否是新按钮如果是显示上面信息在这里你可以按你需要编写代码
end;
procedure TForm1.FormResize(Sender: TObject);
begin
Perform(WM_NCACTIVATE, Word(Active), 0); ; ;
file://如果窗口大小改变则重画标题栏
end;
end.
; ;
3、 执行结果
如图1-1所示标题栏上出现个新按钮
通过以上举例过程相信你能根据自己具体要求利用Delphi设计出别具特色Windows窗口来! 2008-12-26 2:39:17
疯狂代码 /。