unt_main.pas

Delphi开发的QQ2000界面程序.rar

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 ] ), mtInformation, [ 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('无法查找用户，你没有登录到服务器'),pchar('QQ'), MB_Ok + MB_ICONWARNING)
end;

procedure TFrm_main.SpeedButton1Click(Sender: TObject);
begin
Application.MessageBox(pchar('没有登录服务器,不能进入聊天室'),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.