mxoutlookbar.pas

Delphi控件源码 Delphi控件源码

     BitmapImage: TBitmap;
{$IFNDEF DELPHI4_UP}
     D3_Image: TBitmap;
{$ENDIF}

     Procedure SetTransparentBackground( Control: TControl; ACanvas: TCanvas );
     Var
          DC: HDC;
          DCID: Integer;
          I: Integer;
          Rect_Control: TRect;
          Rect_Parent: TRect;
          Rect: TRect;
     Begin
          If ( Control = Nil ) Or ( Control.Parent = Nil ) Then Exit;

          DC := ACanvas.Handle;
          Control.Parent.ControlState := Control.Parent.ControlState + [ csPaintCopy ];

          Rect_Control := Bounds( Control.Left, Control.Top, Control.Width, Control.Height );

          DCID := SaveDC( DC );
          SetViewportOrgEx( DC, -Control.Left, -Control.Top, Nil );
          IntersectClipRect( DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight );
          TWinControlClass( Control.Parent ).PaintWindow( DC );
          RestoreDC( DC, DCID );

          For I := 0 To Control.Parent.ControlCount - 1 Do
          Begin
               If ( Control.Parent.Controls[ I ] <> Control ) Then Break;

               If ( Control.Parent.Controls[ I ] <> Nil ) And ( Control.Parent.Controls[ I ] Is TGraphicControl ) Then
               Begin
                    Rect_Parent := Bounds( Left, Top, Width, Height );

                    If IntersectRect( Rect, Rect_Control, Rect_Parent ) And Visible Then
                    Begin
                         With TGraphicControl( Control.Parent.Controls[ I ] ) Do
                         Begin
                              ControlState := ControlState + [ csPaintCopy ];
                              DCID := SaveDC( DC );
                              Try
                                   SetViewportOrgEx( DC, Left - Control.Left, Top - Control.Top, Nil );
                                   IntersectClipRect( DC, 0, 0, Width, Height );
                                   Perform( WM_PAINT, DC, 0 );
                              Finally
                                   RestoreDC( DC, DCID );
                                   ControlState := ControlState - [ csPaintCopy ];
                              End;
                         End;
                    End;
               End;
          End;

          Control.Parent.ControlState := Control.Parent.ControlState - [ csPaintCopy ];
     End;

Begin

{$IFDEF DELPHI4_UP}
     ControlState := ControlState + [ csCustomPaint ];
{$ELSE}
     D3_Image := TBitmap.Create;
{$ENDIF}

     BitmapImage := TBitmap.Create;
     BitmapImage.Width := Width;
     BitmapImage.Height := Height;

     If ( FTransparent ) And ( Not ( csDesigning In ComponentState ) ) Then
          SetTransparentBackground( Self, BitmapImage.Canvas ) Else
     Begin
          BitmapImage.Canvas.Brush.Color := Color;
          BitmapImage.Canvas.Brush.Style := bsSolid;
          BitmapImage.Canvas.FillRect( ClientRect );
     End;

     If FButtonStyle = bsLarge Then
     Begin
          ARect := Bounds( 0, 0, Width, Height );

          // *** Caption size ***

          BitmapImage.Canvas.Brush.Style := bsClear;
          BitmapImage.Canvas.Font := Self.Font;
          FontHeight := BitmapImage.Canvas.TextHeight( 'W' );

          // ********************

          If ( FLargeImages <> Nil ) And ( FImageIndex >= 0 ) Then
          Begin

{$IFNDEF DELPHI4_UP}
               FLargeImages.GetBitmap( FImageIndex, D3_Image );

               If D3_Image <> Nil Then
                    If Caption <> '' Then
                         Rect_Picture := Bounds( ( Width - D3_Image.Width ) Div 2, ( Height - D3_Image.Height - FontHeight - 2 ) Div 2, D3_Image.Width, D3_Image.Height ) Else
                         Rect_Picture := Bounds( ( Width - D3_Image.Width ) Div 2, ( Height - D3_Image.Height ) Div 2, D3_Image.Width, D3_Image.Height );
{$ELSE}
               If Caption <> '' Then
                    Rect_Picture := Bounds( ( Width - FLargeImages.Width ) Div 2, ( Height - FLargeImages.Height - FontHeight - 2 ) Div 2, FLargeImages.Width, FLargeImages.Height ) Else
                    Rect_Picture := Bounds( ( Width - FLargeImages.Width ) Div 2, ( Height - FLargeImages.Height ) Div 2, FLargeImages.Width, FLargeImages.Height );
{$ENDIF}

               If FButtonDown Then
                    FLargeImages.Draw( BitmapImage.Canvas, Rect_Picture.Left + 1, Rect_Picture.Top + 1, FImageIndex ) Else
                    FLargeImages.Draw( BitmapImage.Canvas, Rect_Picture.Left, Rect_Picture.Top, FImageIndex );
          End;

          // **********************

          If FButtonDown Then
               DrawEdge( BitmapImage.Canvas.Handle, ARect, BDR_SUNKENINNER, BF_RECT ) Else
               If FMouseInButton Then DrawEdge( BitmapImage.Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT );

          // *** Caption ***

          ARect.Top := ARect.Bottom - FontHeight - 2;

          If FButtonDown Then
          Begin
               Inc( ARect.Top );
               Inc( ARect.Left );
          End;

          Flags := DT_EXPANDTABS Or DT_VCENTER Or Alignments[ taCenter ];

{$IFDEF DELPHI4_UP}
          Flags := DrawTextBiDiModeFlags( Flags );
{$ENDIF}

          BitmapImage.Canvas.Font.Assign( Font );
          DrawText( BitmapImage.Canvas.Handle, PChar( Caption ), -1, ARect, Flags );
     End
     Else // *** SMALL BUTTONS ***
     Begin
          ARect := Bounds( 0, 0, Width, Height );

          // *** Caption size ***

          BitmapImage.Canvas.Brush.Style := bsClear;
          BitmapImage.Canvas.Font := Self.Font;
          FontHeight := BitmapImage.Canvas.TextHeight( 'W' );

          // ********************

          If ( FSmallImages <> Nil ) And ( FImageIndex >= 0 ) Then
          Begin
{$IFNDEF DELPHI4_UP}
               FSmallImages.GetBitmap( FImageIndex, D3_Image );

               If D3_Image <> Nil Then
               Begin
                    Rect_Picture := Bounds( 2, ( Height - D3_Image.Height ) Div 2, D3_Image.Width, D3_Image.Height );
                    ARect.Right := ARect.Left + D3_Image.Width + 4;
               End;
{$ELSE}
               Rect_Picture := Bounds( 2, ( Height - FSmallImages.Height ) Div 2, FSmallImages.Width, FSmallImages.Height );
               ARect.Right := ARect.Left + FSmallImages.Width + 4;
{$ENDIF}

               If FButtonDown Then
               Begin
                    FSmallImages.Draw( BitmapImage.Canvas, Rect_Picture.Left + 1, Rect_Picture.Top + 1, FImageIndex );
                    DrawEdge( BitmapImage.Canvas.Handle, ARect, BDR_SUNKENINNER, BF_RECT );
               End
               Else
               Begin
                    FSmallImages.Draw( BitmapImage.Canvas, Rect_Picture.Left, Rect_Picture.Top, FImageIndex );
                    If FMouseInButton Then DrawEdge( BitmapImage.Canvas.Handle, ARect, BDR_RAISEDOUTER, BF_RECT );
               End;

               ARect.Left := ARect.Right;
               ARect.Right := Width;
          End;

          // *** Caption ***

          ARect.Top := ARect.Top + ( ( ARect.Bottom - ARect.Top - FontHeight ) Div 2 );

          Flags := DT_EXPANDTABS Or DT_VCENTER Or Alignments[ taLeftJustify ];
{$IFDEF DELPHI4_UP}
          Flags := DrawTextBiDiModeFlags( Flags );
{$ENDIF}

          BitmapImage.Canvas.Font.Assign( Font );
          DrawText( BitmapImage.Canvas.Handle, PChar( Caption ), -1, ARect, Flags );
     End;

     Canvas.CopyRect( Rect( 0, 0, Width, Height ), BitmapImage.Canvas, Rect( 0, 0, Width, Height ) );
     BitmapImage.Free;

     If Focused And ( Not FMouseInButton ) Then
     Begin
          ARect := Bounds( 0, 0, Width, Height );
          InflateRect( ARect, -1, -1 );
          Canvas.Brush.Style := bsClear;
          Canvas.Pen.Style := psDot;
          Canvas.Rectangle( ARect.Left, ARect.Top, ARect.Right, ARect.Bottom );
     End;

{$IFDEF DELPHI4_UP}
     ControlState := ControlState - [ csCustomPaint ];
{$ELSE}
     D3_Image.Free;
{$ENDIF}
End;

// *************************************************************************************
// ** TOutlookButton.CMDialogChar, 4/20/01 2:55:25 PM
// *************************************************************************************

Procedure TOutlookButton.CMDialogChar( Var Message: TCMDialogChar );
Begin
     With Message Do
       
     If IsAccel( CharCode, Caption ) And 

{$IFDEF DELPHI4_UP}
     CanFocus And
{$ENDIF}

     ( Focused Or ( ( GetKeyState( VK_MENU ) And $8000 ) <> 0 ) ) Then Click Else Inherited;
End;

// *************************************************************************************
// ** TOutlookButton.SetButtonStyle, 4/12/01 4:09:56 PM
// *************************************************************************************

Procedure TOutlookButton.SetButtonStyle( Const Value: TButtonStyle );
Begin
     If FButtonStyle <> Value Then
     Begin
          FButtonStyle := Value;
          Repaint;
     End;
End;

// *************************************************************************************
// ** TOutlookButton.KeyDown, 5/16/01 10:10:26 AM
// *************************************************************************************

Procedure TOutlookButton.KeyDown( Var Key: Word; Shift: TShiftState );
Begin
     Inherited KeyDown( Key, Shift );

     If ( Key In [ VK_RETURN ] ) Then
     Begin
          Case Key Of
               VK_RETURN: Self.Click;
          End;
     End;
End;

// *************************************************************************************
// *************************************************************************************
// *************************************************************************************
// ** Constructor TGradient.Create;
// *************************************************************************************
// *************************************************************************************
// *************************************************************************************

Constructor TGradient.Create;
Begin
     Inherited Create;

     FStartColor := clBlack;
     FEndColor := clBlue;
     FGradientType := gtt2b;
     FBackStyle := bsNormal;
End;

// *************************************************************************************
// ** TGradient.SetGradientType, 4/13/01 5:39:43 PM
// *************************************************************************************

Procedure TGradient.SetGradientType( Value: TGradientType );
Begin
     If FGradientType <> Value Then
     Begin
          FGradientType := Value;
          Change;
     End;
End;

// *************************************************************************************
// ** TGradient.SetBackStyle, 4/13/01 5:43:55 PM
// *************************************************************************************

Procedure TGradient.SetBackStyle( Value: TBackStyle );
Begin
     If FBackStyle <> Value Then
     Begin
          FBackStyle := Value;
          Change;
     End;
End;

// *************************************************************************************
// ** Procedure TGradient.AssignTo;
// *************************************************************************************

Procedure TGradient.AssignTo( Dest: TPersistent );
Begin
     If Dest Is TGradient Then
          With TGradient( Dest ) Do
          Begin
               FStartColor := Self.FStartColor;
               FEndColor := Self.FEndColor;
               FGradientType := Self.FGradientType;
               FBackStyle := Self.FBackStyle;

               Change;
          End
     Else Inherited AssignTo( Dest );
End;

// *************************************************************************************
// ** TGradient.SetColor, 4/13/01 5:36:40 PM
// *************************************************************************************

Procedure TGradient.SetColor( Index: Integer; Value: TColor );
Begin
     Case Index Of
          1: If FStartColor <> Value Then FStartColor := Value;
          2: If FEndColor <> Value Then FEndColor := Value;
     End;

     Change;
End;

// *************************************************************************************
// ** TGradient.Change, 4/11/01 1:37:48 PM
// *************************************************************************************

Procedure TGradient.Change;
Begin
     If Assigned( FOnChange ) Then FOnChange( Self );
End;

// *************************************************************************************
// ** TGradient.PaintGradient, 4/13/01 5:45:50 PM
// *************************************************************************************