mxoutlookbarpro.pas

医院信息系统 方法一： 1.运行SQL Server 2000的查询分析器

  TmxEventBeforeDrawCommandButton = Procedure( Sender: TObject; ACanvas: TCanvas; Var AButtonRect: TRect; Var AFocusRect: TRect; Var AImageRect: TRect; Var ALabelRect: TRect ) Of Object;
  TmxEventDrawCommandButton = Procedure( Sender: TObject; ACanvas: TCanvas; AView: TmxButtonView; AState: TmxButtonState; AImageRect: TRect; ALabelRect: TRect ) Of Object;
  TmxEventAfterDrawCommandButton = Procedure( Sender: TObject; ACanvas: TCanvas; AImageRect: TRect; ALabelRect: TRect ) Of Object;
  TmxEventAfterChangeStyle = Procedure( Sender: TObject; NewStyle: TmxPreSet ) Of Object;
  TmxEventDragAllowed = Procedure( Sender: TmxOutlookBarPro; Button: TmxButton; Var Allowed: Boolean ) Of Object;
  TmxEventDragOver = Procedure( Sender: TmxOutlookBarPro; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TmxDropMode; Var Effect: Integer; Var Accept: Boolean ) Of Object;
  TmxEventDragEnter = Procedure( Sender: TmxOutlookBarPro; DataObject: IDataObject; Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TmxDropMode; Var Effect: Integer; Var Accept: Boolean ) Of Object;
  TmxEventDragDrop = Procedure( Sender: TmxOutlookBarPro; Source: TObject; DataObject: IDataObject; Const Formats: Array Of Word; Shift: TShiftState; Pt: TPoint; Var Effect: Integer; Mode: TmxDropMode ) Of Object;

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

  TmxFormatEtcArray = Array Of TFormatEtc;

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

  TmxFormatEtcList = Class
  Private

    FList: TmxFormatEtcArray;

    Function Get( Index: Integer ): TFormatEtc;
    Procedure Put( Index: Integer; Item: TFormatEtc );
    Function GetCount: Integer;

  Public

    Function Add( Item: TFormatEtc ): Integer;
    Procedure Clear;
    Procedure Delete( Index: Integer );
    Function Clone: TmxFormatEtcList;

    Property Count: Integer Read GetCount;
    Property Items[ Index: Integer ]: TFormatEtc Read Get Write Put;

  End;

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

  TmxEnumFormatEtc = Class( TInterfacedObject, IEnumFormatEtc )
  Protected

    FFormatEtcList: TmxFormatEtcList;
    FCurrentIndex: Integer;

  Public

    Constructor Create( FormatEtcList: TmxFormatEtcList );
    Destructor Destroy; Override;

    Function Next( Celt: Integer; Out Elt; PCeltFetched: PLongint ): HResult; Stdcall;
    Function Skip( Celt: Integer ): HResult; Stdcall;
    Function Reset: HResult; Stdcall;
    Function Clone( Out Enum: IEnumFormatEtc ): HResult; Stdcall;

  End;

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

  TmxDragDropManager = Class( TInterfacedObject, IDataObject, IDropSource, IDropTarget )
  Private

    FFormatEtcList: TmxFormatEtcList;
    FOwner, FDragSource: TmxOutlookBarPro;

  Public

    // TObject implementation
    Constructor Create( AOwner: TmxOutlookBarPro ); Virtual;
    Destructor Destroy; Override;

    // IUnknown
    // implement this method to get notified of interface releases (others are implemented in TInterfacedObject)
    Function _Release: Integer; Stdcall;

    // IDataObject implementation
    Function DAdvise( Const FormatEtc: TFormatEtc; advf: Integer; Const advSink: IAdviseSink; Out dwConnection: Integer ): HResult; Stdcall;
    Function DUnadvise( dwConnection: Integer ): HResult; Stdcall;
    Function EnumDAdvise( Out enumAdvise: IEnumStatData ): HResult; Stdcall;
    Function EnumFormatEtc( Direction: Integer; Out EnumFormatEtc: IEnumFormatEtc ): HResult; Stdcall;
    Function GetCanonicalFormatEtc( Const FormatEtc: TFormatEtc; Out FormatEtcOut: TFormatEtc ): HResult; Stdcall;
    Function GetData( Const FormatEtcIn: TFormatEtc; Out Medium: TStgMedium ): HResult; Stdcall;
    Function GetDataHere( Const FormatEtc: TFormatEtc; Out Medium: TStgMedium ): HResult; Stdcall;
    Function QueryGetData( Const FormatEtc: TFormatEtc ): HResult; Stdcall;
    Function RenderData( FormatEtc: TFormatEtc; Var StgMedium: TStgMedium ): HResult; Virtual;
    Function SetData( Const FormatEtc: TFormatEtc; Var Medium: TStgMedium; DoRelease: BOOL ): HResult; Stdcall;

    // IDropSource implementation
    Function GiveFeedback( Effect: Integer ): HResult; Stdcall;
    Function QueryContinueDrag( EscapePressed: BOOL; KeyState: Integer ): HResult; Stdcall;

    // IDropTarget implementation
    Function DragEnter( Const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; Var Effect: Integer ): HResult; Stdcall;
    Function DragOver( KeyState: Integer; Pt: TPoint; Var Effect: Integer ): HResult; Stdcall;
    Function DragLeave: HResult; Stdcall;
    Function Drop( Const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; Var Effect: Integer ): HResult; Stdcall;

    // TmxDropManager implementation
    Property DragSource: TmxOutlookBarPro Read FDragSource;

    Function GetDataSourceTree( DataObject: IDataObject ): TmxOutlookBarPro;
    Procedure SetOLEFormats;
  End;

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

  TmxButtonActionLink = Class( TControlActionLink )
  Protected

    FClient: TmxButton;

    Procedure AssignClient( AClient: TObject ); Override;
    Function IsCaptionLinked: Boolean; Override;
    Function IsEnabledLinked: Boolean; Override;
    Function IsHelpContextLinked: Boolean; Override;
    Function IsHintLinked: Boolean; Override;
    Function IsImageIndexLinked: Boolean; Override;
    Function IsVisibleLinked: Boolean; Override;
    Function IsOnExecuteLinked: Boolean; Override;
    Procedure SetCaption( Const AValue: String ); Override;
    Procedure SetEnabled( AValue: Boolean ); Override;
    Procedure SetHelpContext( AValue: THelpContext ); Override;
    Procedure SetHint( Const AValue: String ); Override;
    Procedure SetImageIndex( AValue: Integer ); Override;
    Procedure SetVisible( AValue: Boolean ); Override;
    Procedure SetOnExecute( AValue: TNotifyEvent ); Override;
  End;

  TmxButtonActionLinkClass = Class Of TmxButtonActionLink;

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

  TmxBorder = Class( TPersistent )
  Private

    FRect: TRect;
    FSeparator: Word;

    FOnChangeParameter: TNotifyEvent;

    Procedure SetData( Index: Integer; AValue: Word );
    Function GetData( Index: Integer ): Word;

  Protected

    Procedure Change; Dynamic;

  Public

    Property GetAsRect: TRect Read FRect;

    Constructor Create; Virtual;

    Procedure Assign( Source: TPersistent ); Override;
    Procedure AssignTo( Destination: TPersistent ); Override;

  Published

    Property Bottom: Word Index 2 Read GetData Write SetData Default 0;
    Property Left: Word Index 3 Read GetData Write SetData Default 0;
    Property Right: Word Index 4 Read GetData Write SetData Default 0;
    Property Separator: Word Index 5 Read GetData Write SetData Default 0;
    Property Top: Word Index 1 Read GetData Write SetData Default 0;

    Property OnChangeParameter: TNotifyEvent Read FOnChangeParameter Write FOnChangeParameter;

  End;

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

  TmxButtonImages = Class( TPersistent )
  Private

    FHot: TCustomImageList;
    FHotChangeLink: TChangeLink;
    FHotSmall: TCustomImageList;
    FHotSmallChangeLink: TChangeLink;

    FDisabled: TCustomImageList;
    FDisabledChangeLink: TChangeLink;
    FDisabledSmall: TCustomImageList;
    FDisabledSmallChangeLink: TChangeLink;

    FNormal: TCustomImageList;
    FNormalChangeLink: TChangeLink;
    FSmall: TCustomImageList;
    FSmallChangeLink: TChangeLink;

    FOwnerComponent: TComponent;

    FOnChangeParameter: TNotifyEvent;

    Procedure SetImages( Index: Integer; AValue: TCustomImageList );
    Procedure ImageListChange( Sender: TObject );

  Protected

    Procedure Change; Dynamic;

  Public

    Constructor Create( AOwner: TComponent ); Virtual;
    Destructor Destroy; Override;

    Procedure Assign( Source: TPersistent ); Override;
    Procedure AssignTo( Destination: TPersistent ); Override;

  Published

    Property Hot: TCustomImageList Index 2 Read FHot Write SetImages;
    Property HotSmall: TCustomImageList Index 4 Read FHotSmall Write SetImages;
    Property Normal: TCustomImageList Index 1 Read FNormal Write SetImages;
    Property Small: TCustomImageList Index 3 Read FSmall Write SetImages;
    Property Disabled: TCustomImageList Index 5 Read FDisabled Write SetImages;
    Property DisabledSmall: TCustomImageList Index 6 Read FDisabledSmall Write SetImages;

    Property OnChangeParameter: TNotifyEvent Read FOnChangeParameter Write FOnChangeParameter;

  End;

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

  TmxHeaderImages = Class( TPersistent )
  Private

    FHot: TCustomImageList;
    FHotChangeLink: TChangeLink;
    FNormal: TCustomImageList;
    FNormalChangeLink: TChangeLink;
    FOwnerComponent: TComponent;

    FOnChangeParameter: TNotifyEvent;

    Procedure SetImages( Index: Integer; AValue: TCustomImageList );
    Procedure ImageListChange( Sender: TObject );

  Protected

    Procedure Change; Dynamic;

  Public

    Constructor Create( AOwner: TComponent ); Virtual;
    Destructor Destroy; Override;

    Procedure Assign( Source: TPersistent ); Override;
    Procedure AssignTo( Destination: TPersistent ); Override;

  Published

    Property Hot: TCustomImageList Index 2 Read FHot Write SetImages;
    Property Normal: TCustomImageList Index 1 Read FNormal Write SetImages;

    Property OnChangeParameter: TNotifyEvent Read FOnChangeParameter Write FOnChangeParameter;

  End;

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

  TmxGradient = Class( TPersistent )
  Private

    FOldRect: TRect;
    FDirection: TmxGradientDirection;
    FBeginColor: TColor;
    FEndColor: TColor;
    FGradientStyle: TmxGradientStyle;
    FColorTable: Array[ 0..255 ] Of Longint;
    FBitmap: TBitmap;

    FOnChangeParameter: TNotifyEvent;

    Procedure SetColor( Index: Integer; AValue: TColor );
    Procedure SetGradientStyle( AValue: TmxGradientStyle );
    Procedure SetDirection( AValue: TmxGradientDirection );

    Procedure InternalDrawGradient( ACanvas: TCanvas; X, Y, Width, Height: Integer );

  Protected

    Procedure LoadColors;
    Procedure Change; Dynamic;

  Public

    Property GradientBitmap: TBitmap Read FBitmap;

    Constructor Create; Virtual;
    Destructor Destroy; Override;

    Procedure DrawGradient( ACanvas: TCanvas; ARect: TRect ); Virtual;

    Procedure Assign( Source: TPersistent ); Override;
    Procedure AssignTo( Destination: TPersistent ); Override;

  Published

    Property BeginColor: TColor Index 1 Read FBeginColor Write SetColor Default clBlack;
    Property DrawStyle: TmxGradientStyle Read FGradientStyle Write SetGradientStyle Default gtLeftToRight;
    Property Direction: TmxGradientDirection Read FDirection Write SetDirection Default gdNormal;
    Property EndColor: TColor Index 2 Read FEndColor Write SetColor Default clBlue;

    Property OnChangeParameter: TNotifyEvent Read FOnChangeParameter Write FOnChangeParameter;

  End;

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

  TmxCustomBackground = Class( TPersistent )
  Private

    FBackgroundBitmap: TBitmap;
    FAlphaBlend: Byte;
    FBitmapCopy: TmxBitmapCopy;
    FBackgroundStyle: TmxBackgroundStyle;
    FColor: TColor;
    FDrawing: Boolean;
    FGradient: TmxGradient;
    FGrayscale: Boolean;

    FOnChangeParameter: TNotifyEvent;

    Procedure SetBackgroundBitmap( AValue: TBitmap );
    Procedure SetBitmapCopy( AValue: TmxBitmapCopy );
    Procedure SetAlphaBlend( AValue: Byte );
    Procedure SetBackgroundStyle( AValue: TmxBackgroundStyle );
    Procedure SetColor( AValue: TColor );
    Procedure SetGrayscale( AValue: Boolean );
    Procedure SetOnChangeParameter( AValue: TNotifyEvent );

  Protected