msnpopup.pas

delphi写的在任务栏弹出消息的小程序。

Var
  AppBar: TAppbarData;
Begin
  Result := -1;

  FillChar(AppBar, sizeof(AppBar), 0);
  AppBar.cbSize := Sizeof(AppBar);

  If ShAppBarMessage(ABM_GETTASKBARPOS, AppBar) <> 0 Then
   Begin
    If ((AppBar.rc.top = AppBar.rc.left) and (AppBar.rc.bottom > AppBar.rc.right)) Then
      Result := ABE_LEFT
    Else If ((AppBar.rc.top = AppBar.rc.left) and (AppBar.rc.bottom < AppBar.rc.right)) Then
      Result := ABE_TOP
    Else If (AppBar.rc.top > AppBar.rc.left) Then
      Result := ABE_BOTTOM
    Else
      Result := ABE_RIGHT;
   End;
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;

Function TfrmMSNPopUp.CalcColorIndex(StartColor, EndColor: TColor; Steps, ColorIndex: Integer): TColor;
Var
  BeginRGBValue: Array[0..2] Of Byte;
  RGBDifference: Array[0..2] Of Integer;
  Red, Green, Blue: Byte;
  NumColors: Integer;
Begin
  // Initialize
  NumColors := Steps;
  Dec(ColorIndex);

  // Values are set
  BeginRGBValue[0] := GetRValue(ColorToRGB(StartColor));
  BeginRGBValue[1] := GetGValue(ColorToRGB(StartColor));
  BeginRGBValue[2] := GetBValue(ColorToRGB(StartColor));
  RGBDifference[0] := GetRValue(ColorToRGB(EndColor)) - BeginRGBValue[0];
  RGBDifference[1] := GetGValue(ColorToRGB(EndColor)) - BeginRGBValue[1];
  RGBDifference[2] := GetBValue(ColorToRGB(EndColor)) - BeginRGBValue[2];

  // Calculate the bands color
  Red   := BeginRGBValue[0] + MulDiv(ColorIndex, RGBDifference[0], NumColors - 1);
  Green := BeginRGBValue[1] + MulDiv(ColorIndex, RGBDifference[1], NumColors - 1);
  Blue  := BeginRGBValue[2] + MulDiv(ColorIndex, RGBDifference[2], NumColors - 1);

  // The final color is returned
  Result := RGB(Red, Green, Blue);
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;

// add by Ahmed Hamed 20-3-2002
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.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.tmrScrollTimer(Sender: TObject);
Var
  r: TRect;
Begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);

  Case StoredBorder Of
    ABE_LEFT:
       Begin
        If (Self.Width + Scrollspeed) < sWidth Then
         Begin
          Self.Width := Self.Width + ScrollSpeed;
         End
        Else
         Begin
          Self.Width        := sWidth;
          tmrScroll.Enabled := False;
          tmrExit.Enabled   := True;
         End;
       End;

    ABE_TOP:
       Begin
        If (Self.Height + ScrollSpeed) < sHeight Then
         Begin
          Self.Height := Self.Height + ScrollSpeed;
         End
        Else
         Begin
          Self.Height       := sHeight;
          tmrScroll.Enabled := False;
          tmrExit.Enabled   := True;
         End;
       End;

    ABE_BOTTOM:
       Begin
        If (Self.Height + ScrollSpeed) < sHeight Then
         Begin
          Self.Top    := Self.Top - ScrollSpeed;
          Self.Height := Self.Height + ScrollSpeed;
         End
        Else
         Begin
          Self.Height := sHeight;

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

          tmrScroll.Enabled := False;
          tmrExit.Enabled   := True;
         End;
       End;

    ABE_RIGHT:
       Begin
        If (Self.Width + ScrollSpeed) < sWidth Then
         Begin
          Self.Left  := Self.Left - ScrollSpeed;
          Self.Width := Self.Width + ScrollSpeed;
         End
        Else
         Begin
          Self.Width := sWidth;

          //Jelmer
          Self.Left := r.Right - ParentMSNPopup.PopupStartX - Self.Width;

          tmrScroll.Enabled := False;
          tmrExit.Enabled   := True;
         End;
       End;
   End;
End;

Procedure TfrmMSNPopUp.imgGradientMouseUp(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.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.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 TMSNPopUp.SetBackground(Value: TBitmap);
Begin
  If Value <> Self.FBackground Then
   Begin
    Self.FBackground.Assign(Value);
   End;
End;

Function TfrmMSNPopUp.IsWinXP: Boolean;     // MS 12/01/2002
Begin
  Result := (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
End;

End.