?? unt_main.~pas
字號:
unit Unt_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ImgList, mxOutlookBar, ComCtrls, ToolWin, Buttons, ExtCtrls,
StdCtrls, shellapi, Menus;
type
TFrm_main = class(TForm)
mxOutlookBar1: TmxOutlookBar;
Header1: TmxOutlookBarHeader;
Header2: TmxOutlookBarHeader;
Header3: TmxOutlookBarHeader;
Header4: TmxOutlookBarHeader;
Button1: TOutlookButton;
ImageList1: TImageList;
Button2: TOutlookButton;
Button3: TOutlookButton;
Button4: TOutlookButton;
Button5: TOutlookButton;
Button6: TOutlookButton;
Button7: TOutlookButton;
Button8: TOutlookButton;
Button9: TOutlookButton;
Button10: TOutlookButton;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ImageList2: TImageList;
Panel9: TPanel;
Panel10: TPanel;
SpeedButton5: TSpeedButton;
Panel11: TPanel;
SpeedButton6: TSpeedButton;
Panel12: TPanel;
Panel1: TPanel;
Panel5: TPanel;
Panel6: TPanel;
SpeedButton2: TSpeedButton;
Panel7: TPanel;
SpeedButton4: TSpeedButton;
Panel8: TPanel;
Panel2: TPanel;
Panel3: TPanel;
SpeedButton1: TSpeedButton;
Panel4: TPanel;
SpeedButton3: TSpeedButton;
Panel13: TPanel;
Panel14: TPanel;
Panel15: TPanel;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
mxOutlookBar2: TmxOutlookBar;
Header5: TmxOutlookBarHeader;
Header6: TmxOutlookBarHeader;
mxOutlookBar3: TmxOutlookBar;
mxOutlookBarHeader1: TmxOutlookBarHeader;
mxOutlookBarHeader2: TmxOutlookBarHeader;
Header7: TmxOutlookBarHeader;
Header8: TmxOutlookBarHeader;
Header9: TmxOutlookBarHeader;
mxOutlookBar4: TmxOutlookBar;
mxOutlookBarHeader3: TmxOutlookBarHeader;
mxOutlookBarHeader4: TmxOutlookBarHeader;
Button11: TOutlookButton;
PopupMenu2: TPopupMenu;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure Button1DblClick(Sender: TObject);
private
TitleButton, TitleButton1 : TRect;
procedure ClickOutlookButton(Sender: TObject);
procedure DrawTitleButton;
{Paint-related messages}
procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
{Mouse down-related messages}
procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
function GetVerInfo : DWORD;
{ Private declarations }
public
{ Public declarations }
end;
const
htTitleBtn = htSizeLast + 1;
htTitleBtn1 = htSizeLast + 2;
var
Frm_main: TFrm_main;
implementation
{$R *.dfm}
{$R bmpres.res}
procedure TFrm_main.ClickOutlookButton(Sender: TObject);
Begin
If Not ( Sender Is TOutlookButton ) Then Exit;
MessageDlg( Format( '你選擇的是 %s', [ ( Sender As TOutlookButton ).Caption ] ), mtInfomation, [ mbOK ], 0 );
end;
procedure TFrm_main.DrawTitleButton;
var
bmap,bmap1 : Tbitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
// XFrame, {X and Y size of Sizeable area of Frame}
YFrame,
XTtlBit, {X and Y size of Bitmaps in caption}
YTtlBit : Integer;
begin
{Get size of form frame and bitmaps in title bar}
bmap := TBitmap.Create;
bmap1 := TBitmap.Create;
// XFrame := GetSystemMetrics(SM_CXFRAME);
YFrame := GetSystemMetrics(SM_CYFRAME);
XTtlBit := GetSystemMetrics(SM_CXSIZE);
YTtlBit := GetSystemMetrics(SM_CYSIZE);
// showmessage(inttostr(XTtlBit)+' '+inttostr(YTtlBit));
{$IFNDEF WIN32}
{ TitleButton := Bounds(Width - (4 * XTtlBit) - ((XTtlBit div 2) - 2),
YFrame - 1,
XTtlBit + 2,
YTtlBit + 2);
}
{$ELSE} {Delphi 2.0 positioning}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
begin
TitleButton := Bounds(Width - (XTtlBit) - ((XTtlBit div 2)+1),
YFrame + 2,
XTtlBit - 8,
YTtlBit - 7);
TitleButton1 := Bounds(Width - (XTtlBit) - ((XTtlBit div 2)+13),
YFrame + 2,
XTtlBit - 8,
YTtlBit - 7);
end
else
begin
TitleButton := Bounds(Width - (XTtlBit) - ((XTtlBit div 2)+2),
YFrame + 2,
XTtlBit - 8,
YTtlBit - 8);
TitleButton1 := Bounds(Width - (XTtlBit) - ((XTtlBit div 2)+14),
YFrame + 2,
XTtlBit - 8,
YTtlBit - 8);
// TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
// XFrame + 2,
// XTtlBit + 2,
// YTtlBit + 2);
end;
{$ENDIF}
Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
try
{Draw a button face on the TRect}
DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
DrawButtonFace(Canvas, TitleButton1, 1, bsAutoDetect, False, False, False);
if true then
begin
bmap.LoadFromResourceName(hinstance,'mypic2');
with TitleButton do
{$IFNDEF WIN32}
Canvas.Draw(Left + 1, Top + 1, bmap);
{$ELSE}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
Canvas.Draw(Left + 1, Top + 3, bmap)
// Canvas.TextOut(Left + 0, Top + 0, '--')
else
// Canvas.StretchDraw(TitleButton, bmap);
Canvas.Draw(Left + 1, Top + 2, bmap);
{$ENDIF}
bmap1.LoadFromResourceName(hinstance,'mypic1');
with TitleButton1 do
{$IFNDEF WIN32}
Canvas.Draw(Left + 1, Top + 1, bmap1);
{$ELSE}
if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
Canvas.Draw(Left + 2, Top + 2, bmap1)
else
Canvas.Draw(Left + 2, Top + 2, bmap1)
// Canvas.StretchDraw(TitleButton, bmap1);
{$ENDIF}
end;
finally
ReleaseDC(Self.Handle, Canvas.Handle);
bmap.Free;
bmap1.Free;
Canvas.Handle := 0;
end;
end;
{Paint triggering events}
procedure TFrm_main.WMNCActivate(var Msg : TWMNCActivate);
begin
Inherited;
DrawTitleButton;
end;
{Painting events}
procedure TFrm_main.WMNCPaint(var Msg : TWMNCPaint);
begin
Inherited;
DrawTitleButton;
end;
procedure TFrm_main.WMSetText(var Msg : TWMSetText);
begin
Inherited;
DrawTitleButton;
end;
{Mouse-related procedures}
procedure TFrm_main.WMNCHitTest(var Msg : TWMNCHitTest);
begin
Inherited;
{Check to see if the mouse was clicked in the area of the button}
with Msg do
begin
if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn;
if PtInRect(TitleButton1, Point(XPos - Left, YPos - Top)) then
Result := htTitleBtn1;
end;
end;
procedure TFrm_main.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
inherited;
if (Msg.HitTest = htTitleBtn) then
Application.Minimize;
if (Msg.HitTest = htTitleBtn1) then
Application.MessageBox(pchar('這是企企寫的仿QQ界面程序!'),pchar('QQ'), MB_Ok + MB_ICONINFORMATION);
end;
function TFrm_main.GetVerInfo : DWORD;
var
verInfo : TOSVERSIONINFO;
begin
GetVerInfo:=0;
verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(verInfo) then
Result := verInfo.dwPlatformID;
{Returns:
VER_PLATFORM_WIN32s Win32s on Windows 3.1
VER_PLATFORM_WIN32_WINDOWS Win32 on Windows 95
VER_PLATFORM_WIN32_NT Windows NT }
end;
procedure TFrm_main.FormCreate(Sender: TObject);
begin
width:=108;
// top:=trunc((screen.Height-height)/2)-10;
top:=30;
left:=screen.width-width-20;
end;
procedure TFrm_main.FormResize(Sender: TObject);
begin
if width<108 then width:=108;
if mxOutlookBar1.Visible then
mxOutlookBar1.Width:=Width-8;
if mxOutlookBar2.Visible then
mxOutlookBar2.Width:=Width-8;
if mxOutlookBar3.Visible then
mxOutlookBar3.Width:=Width-8;
if mxOutlookBar4.Visible then
mxOutlookBar4.Width:=Width-8;
SpeedButton3.Width:=Width-34;
SpeedButton4.Width:=Width-34;
SpeedButton5.Width:=Width-86;
Perform(WM_NCACTIVATE, Word(Active), 0);
end;
procedure TFrm_main.SpeedButton3Click(Sender: TObject);
begin
application.MessageBox(pchar('無法查找用戶,你沒有登錄到服務(wù)器'),pchar('QQ'), MB_Ok + MB_ICONWARNING)
end;
procedure TFrm_main.SpeedButton1Click(Sender: TObject);
begin
Application.MessageBox(pchar('沒有登錄服務(wù)器,不能進(jìn)入聊天室'),pchar('請返回'), MB_Ok + MB_ICONINFORMATION);
end;
procedure TFrm_main.SpeedButton2Click(Sender: TObject);
begin
shellexecute(Handle,nil,Pchar('http://www.qqyear.com'),nil,nil,SW_SHOWMAXIMIZED);
end;
procedure TFrm_main.SpeedButton4Click(Sender: TObject);
begin
Application.MessageBox(pchar('沒有消息'),pchar('QQ'), MB_Ok + MB_ICONINFORMATION);
end;
procedure TFrm_main.ToolButton1Click(Sender: TObject);
begin
mxOutlookBar2.Visible:=false;
mxOutlookBar3.Visible:=false;
mxOutlookBar4.Visible:=false;
mxOutlookBar1.Visible:=true;
end;
procedure TFrm_main.ToolButton2Click(Sender: TObject);
begin
mxOutlookBar1.Visible:=false;
mxOutlookBar2.Visible:=false;
mxOutlookBar4.Visible:=false;
mxOutlookBar3.Visible:=true;
end;
procedure TFrm_main.ToolButton3Click(Sender: TObject);
begin
mxOutlookBar1.Visible:=false;
mxOutlookBar3.Visible:=false;
mxOutlookBar4.Visible:=false;
mxOutlookBar2.Visible:=true;
end;
procedure TFrm_main.ToolButton4Click(Sender: TObject);
begin
mxOutlookBar1.Visible:=false;
mxOutlookBar2.Visible:=false;
mxOutlookBar3.Visible:=false;
mxOutlookBar4.Visible:=true;
end;
procedure TFrm_main.Button1DblClick(Sender: TObject);
begin
ClickOutlookButton(Sender);
end;
end.
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -