lxpopup.pas

专用于PC进销存软件

  imgGradient           := TImage.Create(Self);
  imgGradient.Parent    := pnlBorder;
  imgGradient.Align     := alClient;
  imgGradient.Anchors   := [akTop, akLeft, akRight, akBottom];
  imgGradient.OnMouseUp := Self.imgGradientMouseUp;

  lblText           := TLabel.Create(Self);
  lblText.ShowAccelChar := False;
  lblText.Layout    := tlCenter;
  lblText.AutoSize  := True;
  lblText.WordWrap  := True;
  lblText.Parent    := pnlBorder;
  lblText.Transparent := True;
  lblText.OnMouseUp := Self.lblTextMouseUp;
  lblText.Left      := 9;
  lblText.Top       := 49;
  lblText.Width     := 3;
  lblText.Height    := 13;

  lblTitle           := TLabel.Create(Self);
  lblTitle.ShowAccelChar := False;
  lblTitle.Parent    := pnlBorder;
  lblTitle.Transparent := True;
  lblTitle.Top       := 8;
  lblTitle.Left      := 48;
  lblTitle.OnMouseUp := Self.lblTitleMouseUp;

  tmrExit          := TTimer.Create(Self);
  tmrExit.Enabled  := False;
  tmrExit.OnTimer  := tmrExitTimer;
  tmrExit.Interval := 10000;

  tmrScroll          := TTimer.Create(Self);
  tmrScroll.Enabled  := False;
  tmrScroll.OnTimer  := tmrScrollTimer;
  tmrScroll.Interval := 25;
  // add by Ahmed Hamed 20-3-2002
  tmrScrollDown          := TTimer.Create(Self);
  tmrScrollDown.Enabled  := False;
  tmrScrollDown.OnTimer  := tmrScrollDownTimer;
  tmrScrollDown.Interval := 25;
  //
End;

procedure TfrmMSNPopUp.CreateParams(var Params: TCreateParams);
Const
  CS_DROPSHADOW = $00020000;   // MS 12/01/2002
Begin
  Inherited;
  Params.Style := Params.Style and not WS_CAPTION or WS_POPUP;

  If IsNT4 Then
    Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW
  Else
    Params.ExStyle := Params.ExStyle or WS_EX_TOOLWINDOW or WS_EX_NOACTIVATE;

  If (IsWinXP) Then
    Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;

  Params.WndParent := GetDesktopWindow;
End;

procedure TfrmMSNPopUp.DoClose(var Action: TCloseAction);
begin
  //Jelmer
  If CanClose = False Then
   Begin
    Action := caHide;
   End
  Else
   Begin
    If ParentMSNPopup.PopupCount > 0 Then
      Dec(ParentMSNPopup.PopupCount);
    Action := caFree;
   End;
  Inherited;
End;

procedure TfrmMSNPopUp.imgGradientMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
  // close the popup window on right click
  //Jelmer
  If Button = mbRight Then
   Begin
    If Assigned(Self.ParentMSNPopup.FOnClick) Then
     Begin
      CanClose := False;
      Self.ParentMSNPopup.FOnClick(Self.ParentMSNPopup);
      CanClose := True;
     End;
    Self.Close;
   End;
End;


function TfrmMSNPopUp.IsWinXP: Boolean;
begin
  Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
end;

procedure TfrmMSNPopUp.lblTextMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
  // close the popup window on right click
  //Jelmer
  If Button = mbRight Then
   Begin
    If Assigned(Self.ParentMSNPopup.FOnClick) Then
     Begin
      CanClose := False;
      Self.ParentMSNPopup.FOnClick(Self.ParentMSNPopup);
      CanClose := True;
     End;
    Self.Close;
   End;
End;

procedure TfrmMSNPopUp.lblTitleMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
  // close the popup window on click
  //Jelmer
  If Assigned(Self.ParentMSNPopup.FOnClick) Then
   Begin
    CanClose := False;
    Self.ParentMSNPopup.FOnClick(Self.ParentMSNPopup);
    CanClose := True;
   End;
  Self.Close;
End;

procedure TfrmMSNPopUp.PopUp;
Var
  r: TRect;
  gradient: TBitmap;
  i: Integer;
  tileX, tileY: Integer;
  //Jelmer
  OldLeft, OldTop: Integer;
Begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);

  Self.AutoScroll := False;

  Self.Height := sHeight;
  Self.Width  := sWidth;

  lblText.Cursor := Cursor;

  //Jelmer
  StoredBorder := ParentMSNPopup.GetEdge;
  CanClose     := True;

  Case StoredBorder Of
    ABE_LEFT:
       Begin
        Self.Left := r.Left + ParentMSNPopup.PopupStartX;

        //Jelmer
        Self.Top := r.Bottom - ParentMSNPopup.PopupStartY - Self.Height - ParentMSNPopup.NextPopupPos;
       End;

    ABE_TOP:
       Begin
        Self.Left := r.Right - Self.Width - ParentMSNPopup.PopupStartX;

        //Jelmer
        Self.Top := r.Top + ParentMSNPopup.PopupStartY + ParentMSNPopup.NextPopupPos;
       End;

    ABE_BOTTOM:
       Begin
        Self.Left := r.Right - Self.Width - ParentMSNPopup.PopupStartX;

        //Jelmer
        Self.Top := r.Bottom - ParentMSNPopup.PopupStartY - Self.Height - ParentMSNPopup.NextPopupPos;
       End;

    ABE_RIGHT:
       Begin
        Self.Left := r.Right - Self.Width - ParentMSNPopup.PopupStartX;

        //Jelmer
        Self.Top := r.Bottom - ParentMSNPopup.PopupStartY - Self.Height - ParentMSNPopup.NextPopupPos;
       End;
   End;

  //Jelmer
  PopupPos := ParentMSNPopup.NextPopupPos;
  If msnCascadePopups in ParentMSNPopup.FOptions = True Then
   Begin
    If (StoredBorder = ABE_BOTTOM) or (StoredBorder = ABE_TOP) Then
     Begin
      ParentMSNPopup.NextPopupPos := ParentMSNPopup.NextPopupPos + sHeight + ParentMSNPopup.FPopupMarge;
     End
    Else If (StoredBorder = ABE_RIGHT) or (StoredBorder = ABE_LEFT) Then
     Begin
      ParentMSNPopup.NextPopupPos := ParentMSNPopup.NextPopupPos + sHeight + ParentMSNPopup.FPopupMarge;
     End;
   End
  Else
    ParentMSNPopup.NextPopupPos := 0;

  lblTitle.Font    := TitleFont;
  lblTitle.Caption := Title;

  //Jelmer
  OldLeft := Left;
  OldTop  := Top;
  Left    := -Width - 10;
  Top     := -Height - 10;
  Visible := True;
  Visible := False;
  Left    := OldLeft;
  Top     := OldTop;

  imgGradient.Align := alClient;
  imgGradient.Align := alNone;
  pnlBorder.Align   := alNone;

  //Jelmer
  If Self.ParentMSNPopup.FBackground.Empty Then
   Begin
    gradient        := TBitmap.Create;
    gradient.Width  := imgGradient.Width;
    gradient.Height := imgGradient.Height;

    If Orientation = mbVertical Then
     Begin
      For i := 0 To gradient.Height Do
       Begin
        gradient.Canvas.Pen.Color := CalcColorIndex(Color1, Color2, gradient.Height + 1, i + 1);
        gradient.Canvas.MoveTo(0,i);
        gradient.Canvas.LineTo(gradient.Width, i);
       End;
     End;

    If Orientation = mbHorizontal Then
     Begin
      For i := 0 To gradient.Width Do
       Begin
        gradient.Canvas.Pen.Color := CalcColorIndex(Color1, Color2, gradient.Height + 1, i + 1);
        gradient.Canvas.MoveTo(i, 0);
        gradient.Canvas.LineTo(i, gradient.Height);
       End;
     End;

    imgGradient.Canvas.Draw(0,0,gradient);
    gradient.Free;
   End
  Else
   Begin
    //Jelmer
    //imgGradient.Canvas.
    ParentMSNPopup.FBackground.Transparent := True;

    // Anomy
    Case BGDrawMethod Of
      dmActualSize:
        imgGradient.Canvas.Draw(0, 0, ParentMSNPopup.BackgroundImage);
      dmTile:
         Begin
          tileX := 0;
          While tileX < imgGradient.Width Do
           Begin
            tileY := 0;
            While tileY < imgGradient.Height Do
             Begin
              imgGradient.Canvas.Draw(tileX, tileY, ParentMSNPopup.BackgroundImage);
              tileY := tileY + ParentMSNPopup.BackgroundImage.Height;
             End;
            tileX := tileX + ParentMSNPopup.BackgroundImage.Width;
           End;
         End;
      dmFit:
        imgGradient.Canvas.StretchDraw(Bounds(0,0,imgGradient.Width,
          imgGradient.Height),
          ParentMSNPopup.BackgroundImage
          );
     End;
   End;

  lblTitle.Left := 8;
  tmrExit.Interval := TimeOut * 1000;

  If bScroll Then
   Begin
    Case ParentMSNPopup.GetEdge Of
      ABE_TOP:
         Begin
          Self.Height := 1;
         End;

      ABE_BOTTOM:
         Begin
          Self.Top    := Self.Top + Self.Height;
          Self.Height := 1;
         End;

      ABE_LEFT:
         Begin
          Self.Width := 1;
         End;

      ABE_RIGHT:
         Begin
          Self.Left  := Self.Left + Self.Width;
          Self.Width := 1;
         End;
     End;
    tmrScroll.Enabled := True;
   End;

  If not bScroll Then
    tmrExit.Enabled := True;

  Self.FormStyle := fsStayOnTop;
  ShowWindow(Self.Handle, SW_SHOWNOACTIVATE);
  Self.Visible := True;

  lblText.Font := HoverFont;
  PositionText;

  lblText.Font := Font;
  PositionText;
End;

procedure TfrmMSNPopUp.PositionText;
Begin
  lblText.Caption := Text;
  lblText.Width   := pnlBorder.Width - 15;

  lblText.Left := Round((pnlBorder.Width - lblText.Width) / 2);
  lblText.Top  := Round((pnlBorder.Height - lblText.Height) / 2);
End;

procedure TfrmMSNPopUp.tmrExitTimer(Sender: TObject);
Begin
  // after several seconds, the popup window will disappear
  // add by Ahmed Hamed 20-3-2002
  tmrExit.Enabled       := False;
  tmrScrollDown.Enabled := True;
  //
End;

procedure TfrmMSNPopUp.tmrscrollDownTimer(Sender: TObject);
Var
  r: TRect;
Begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);

  Case StoredBorder Of
    ABE_LEFT:
       Begin
        If (Self.Width - Scrollspeed) > 0 Then
         Begin
          Self.Width := Self.Width - ScrollSpeed;
         End
        Else
          Self.Close;
       End;

    ABE_TOP:
       Begin
        If (Self.Height - ScrollSpeed) > 0 Then
         Begin
          Self.Height := Self.Height - ScrollSpeed;
         End
        Else
          Self.Close;
       End;

    ABE_BOTTOM:
       Begin
        If (Self.Height - ScrollSpeed) > 0 Then
         Begin
          Self.Top    := Self.Top + ScrollSpeed;
          Self.Height := Self.Height - ScrollSpeed;
         End
        Else
          Self.Close;
       End;

    ABE_RIGHT:
       Begin
        If (Self.Width - ScrollSpeed) > 0 Then
         Begin
          Self.Left  := Self.Left + ScrollSpeed;
          Self.Width := Self.Width - ScrollSpeed;
         End
        Else
          Self.Close;
       End;
   End;
End;

procedure TfrmMSNPopUp.tmrScrollTimer(Sender: TObject);
Var
  r: TRect;
Begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);

  Case StoredBorder Of
    ABE_LEFT:
       Begin
        If (Self.Width - Scrollspeed) > 0 Then
         Begin
          Self.Width := Self.Width - ScrollSpeed;
         End
        Else
          Self.Close;
       End;

    ABE_TOP:
       Begin
        If (Self.Height - ScrollSpeed) > 0 Then
         Begin
          Self.Height := Self.Height - ScrollSpeed;
         End
        Else
          Self.Close;
       End;

    ABE_BOTTOM:
       Begin
        If (Self.Height - ScrollSpeed) > 0 Then
         Begin
          Self.Top    := Self.Top + ScrollSpeed;
          Self.Height := Self.Height - ScrollSpeed;
         End
        Else
          Self.Close;
       End;

    ABE_RIGHT:
       Begin
        If (Self.Width - ScrollSpeed) > 0 Then
         Begin
          Self.Left  := Self.Left + ScrollSpeed;
          Self.Width := Self.Width - ScrollSpeed;
         End
        Else
          Self.Close;
       End;
   End;
End;
end.