headercustomdrawdemo.pas

来自「本系统前端界面采用WINDOWS 窗口风格」· PAS 代码 · 共 146 行

unit HeaderCustomDrawDemo;

// Virtual Treeview sample form demonstrating following features:
//   - Advanced header custom draw.
// Written by Mike Lischke.

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, VirtualTrees, StdCtrls, ExtCtrls;

type
  THeaderOwnerDrawForm = class(TForm)
    Label8: TLabel;
    HeaderCustomDrawTree: TVirtualStringTree;
    HeaderImages: TImageList;
    AnimationTimer: TTimer;
    procedure HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader; const PaintInfo: THeaderPaintInfo;
      var Elements: THeaderPaintElements);
    procedure HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; const PaintInfo: THeaderPaintInfo;
      const Elements: THeaderPaintElements);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure AnimationTimerTimer(Sender: TObject);
    procedure HeaderCustomDrawTreeHeaderMouseUp(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer);
    procedure HeaderCustomDrawTreeHeaderMouseDown(Sender: TVTHeader; Button: TMouseButton; Shift: TShiftState; X,
      Y: Integer);
    procedure HeaderCustomDrawTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
  private
    FBackBitmap1,
    FBackBitmap2,
    FCheckerBackground: TBitmap;
    FHeaderBitmap: TBitmap;
    FLeftPos: Integer;
    procedure CreateCheckerBackground;
    procedure PaintSelection(Bitmap: TBitmap);
    procedure FillBackground(R: TRect; Target: TCanvas);
  end;

var
  HeaderOwnerDrawForm: THeaderOwnerDrawForm;

//----------------------------------------------------------------------------------------------------------------------

implementation

uses
  States;
  
{$R *.dfm}

//----------------------------------------------------------------------------------------------------------------------

procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader; const PaintInfo: THeaderPaintInfo;
  var Elements: THeaderPaintElements);

// This event tells the tree which part we want to draw ourselves. Don't forget to enable custom drawing in the header
// options and switch the Style property of every column, which we handle here to vsOwnerDraw.

begin
  with PaintInfo do
  begin
    // First check the column member. If it is NoColumn then it's about the header background.
    if Column = nil then
      Elements := [hpeBackground] // No other flag is recognized for the header background.
    else
    begin
      // Using the index here ensures a column, regardless of its position, always has the same draw style.
      // By using the Position member, we could make a certain column place stand out, regardless of the column order.
      // Don't forget to change the AdvancedHeaderDraw event body accordingly after you changed the indicator here.
      case Column.Index of
        0: // Default drawing.
          ;
        1: // Background only customization.
          Include(Elements, hpeBackground);
        2: // Full customization (well, quite).
          Elements := [hpeBackground, hpeText{, hpeDropMark, hpeHeaderGlyph, hpeSortGlyph}];
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; const PaintInfo: THeaderPaintInfo;
  const Elements: THeaderPaintElements);

var
  S: string;
  Size: TSize;
  SourceRect,
  TargetRect: TRect;

begin
  with PaintInfo do
  begin
    // First check the column member. If it is NoColumn then it's about the header background.
    if Column = nil then
    begin
      if hpeBackground in Elements then
      begin
        TargetCanvas.Brush.Color := clBackground;
        TargetCanvas.FillRect(PaintRectangle);
      end;
    end
    else
    begin
      case Column.Index of
        0: // Will never come here.
          ;
        1: // Background only customization.
          begin
            FBackBitmap1.Width := PaintRectangle.Right - PaintRectangle.Left;
            FBackBitmap1.Height := PaintRectangle.Bottom - PaintRectangle.Top;
            FillBackground(PaintRectangle, FBackbitmap1.Canvas);
            if IsHoverIndex and MMXAvailable then
              PaintSelection(FBackBitmap1);
            TargetCanvas.Draw(PaintRectangle.Left, Paintrectangle.Top, FBackbitmap1);
          end;
        2: // Full customization. Check elements to learn what must be drawn in the various stages.
          begin
            if hpeBackground in Elements then
              with FBackBitmap2 do
              begin
                Width := PaintRectangle.Right - PaintRectangle.Left;
                Height := PaintRectangle.Bottom - PaintRectangle.Top;
                TargetRect := Rect(0, 0, Width, Height);
                Canvas.Brush.Color := clInfoBk;
                Canvas.FillRect(TargetRect);
                InflateRect(TargetRect, - 10, -10);
                SourceRect := TargetRect;
                OffsetRect(SourceRect, -SourceRect.Left + FLeftPos, -SourceRect.Top);
                Canvas.CopyRect(TargetRect, FHeaderBitmap.Canvas, SourceRect);

                TargetCanvas.Draw(PaintRectangle.Left, Paintrectangle.Top, FBackbitmap2);
              end;
            if hpeText in Elements then
            begin
              TargetCanvas.Font.Name := 'Webdings';
              TargetCanvas.Font.Charset := SYMBOL_CHARSET;
              TargetCanvas.Font.Size := 60;
              if IsHoverIndex then
                TargetCanvas.Font.Color := $80FF;
              S := '