bm_hintu.~pas

DELPHI办公全套管理系统

unit BM_HINTU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Menus;

type
  TBM_HINTF = class(TForm)
    Timer: TTimer;
    PopMenu: TPopupMenu;
    PopMenu_autohide: TMenuItem;
    PopMenu_top: TMenuItem;
    N5: TMenuItem;
    PopMenu_notclear: TMenuItem;
    PopMenu_hide: TMenuItem;
    Panel_main: TPanel;
    Image_caption: TImage;
    Label_caption: TLabel;
    SB_MIN: TSpeedButton;
    SB_tools: TSpeedButton;
    Memo_message: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SB_MINClick(Sender: TObject);
    procedure SB_toolsClick(Sender: TObject);
    procedure PopMenu_notshowClick(Sender: TObject);
    procedure PopMenu_alwaysshowClick(Sender: TObject);
    procedure PopMenu_autohideClick(Sender: TObject);
    procedure PopMenu_topClick(Sender: TObject);
    procedure PopMenu_notclearClick(Sender: TObject);
    procedure FormHide(Sender: TObject);
    procedure Image_captionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image_captionMouseMove(Sender: TObject; Shift: TShiftState;
      X, Y: Integer);
    procedure Image_captionMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Memo_messageDblClick(Sender: TObject);
  private
    { Private declarations }
    OriginalPos:TPoint;    // 记录原始位置
    CurrentPos:TPoint;     // 记录当前位置
    DownPos:TPoint;        // 记录鼠标按下时位置
    MouseLButtonDown:Boolean; 
  public
    { Public declarations }
  end;

var
  BM_HINTF: TBM_HINTF;

implementation

{$R *.dfm}

procedure TBM_HINTF.FormCreate(Sender: TObject);
var 
  hApp: HWND;
  rcApp, rcWork: TRect; 
begin
  rcWork.Top:=0; 
  rcWork.Left:=0;
  rcWork.Bottom:= GetSystemMetrics(SM_CYSCREEN); 
  rcWork.Right:= GetSystemMetrics(SM_CXSCREEN); 
  hApp := FindWindow('Shell_TrayWnd', '');
  if hApp <> 0 then
   begin
        //得到TASKBAR的尺寸
    GetWindowRect(hApp, rcApp);
    //得于TASKBAR的面积
    if rcApp.Right<rcWork.Right then
      rcWork.Left:=rcApp.Right; //TASKBAR在左
    if rcApp.Bottom<rcWork.Bottom then
      rcWork.Top:=rcApp.Bottom; //TASKBAR在上
    if rcApp.Left>0 then
      rcWork.Right:=rcApp.Left; //TASKBAR在右
    if rcApp.Top>0 then
      rcWork.Bottom:=rcApp.Top; //TASKBAR在下
  end;
  //得到工作区大小
  SystemParametersInfo (SPI_SETWORKAREA, 0, @rcWork, SPIF_SENDCHANGE );
  self.Left :=rcwork.Right - self.Width ;
  self.Top :=rcwork.Bottom - self.Height ;

end;

procedure TBM_HINTF.FormShow(Sender: TObject);
begin
   AnimateWindow(Self.Handle, 250, AW_CENTER or AW_ACTIVATE);
Image_caption.Repaint ;
  timer.Enabled :=true;
end;

procedure TBM_HINTF.SB_MINClick(Sender: TObject);
begin
self.Hide ;
end;

procedure TBM_HINTF.SB_toolsClick(Sender: TObject);
var
   MyPoint:TPoint;
   ScPoint:TPoint;
begin
   MyPoint.x:=SB_tools.Left;
   MyPoint.y:=SB_tools.Top + SB_tools.Height ;
   ScPoint:=ClientToScreen(MyPoint);
   PopMenu.Popup(ScPoint.X ,ScPoint.Y );

end;

procedure TBM_HINTF.PopMenu_notshowClick(Sender: TObject);
begin

  // PopMenu_notshow.Checked:=true;
   Timer.Interval :=1;
end;

procedure TBM_HINTF.PopMenu_alwaysshowClick(Sender: TObject);
begin
  // PopMenu_alwaysshow.Checked:=true ;
   Timer.Interval :=0;
end;

procedure TBM_HINTF.PopMenu_autohideClick(Sender: TObject);
begin
   PopMenu_autohide.Checked:=true ;
   Timer.Interval :=20000;
end;

procedure TBM_HINTF.PopMenu_topClick(Sender: TObject);
begin
   PopMenu_top.Checked :=not PopMenu_top.Checked;
   if PopMenu_top.Checked then
      self.FormStyle :=fsStayOnTop
   else
      self.FormStyle :=fsNormal;
end;

procedure TBM_HINTF.PopMenu_notclearClick(Sender: TObject);
begin
   Popmenu_notclear.Checked :=not Popmenu_notclear.Checked;
   if Popmenu_notclear.Checked then
   begin
      self.AlphaBlend :=false;
      self.Update ;
   end
   else
   begin
      self.AlphaBlend :=true;
      self.Update ;
   end;
end;

procedure TBM_HINTF.FormHide(Sender: TObject);
begin
   timer.Enabled :=false;
  
end;

procedure TBM_HINTF.Image_captionMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
    OriginalPos.x:=self.Left;         // 记录下原始坐标位置
     OriginalPos.y:=self.Top;
     DownPos.x:=X;                      // 鼠标按下的位置
     DownPos.y:=Y;
     DownPos:=ClientToScreen(DownPos);   // 将客户区坐标转换为屏幕坐标
     if Button = mbLeft then
          MouseLButtonDown:=True;
end;

procedure TBM_HINTF.Image_captionMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
     if MouseLButtonDown then
     begin
          CurrentPos.x:=X;
          CurrentPos.y:=Y;
          CurrentPos:=ClientToScreen(CurrentPos);  // 将客户区坐标转换为屏幕坐标
          // 确定窗体的新位置
          self.Left:=OriginalPos.x+(CurrentPos.x-DownPos.x);
          self.Top :=OriginalPos.y+(CurrentPos.y-DownPos.y);
     end;
end;

procedure TBM_HINTF.Image_captionMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   MouseLButtonDown:=False;
end;

procedure TBM_HINTF.Memo_messageDblClick(Sender: TObject);
begin
self.Hide ;
end;

end.