You've already forked lazarus-ccr
* Create branches and trunk directories
* Move files to trunk git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1035 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
@ -0,0 +1,312 @@
|
||||
unit HeaderCustomDrawDemo;
|
||||
|
||||
{$MODE Delphi}
|
||||
{$H+}
|
||||
|
||||
// Virtual Treeview sample form demonstrating following features:
|
||||
// - Advanced header custom draw.
|
||||
// Written by Mike Lischke.
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
LCLIntf, Types, SysUtils, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, VirtualTrees, StdCtrls, ExtCtrls, LResources, LCLType, LCLProc;
|
||||
|
||||
type
|
||||
THeaderOwnerDrawForm = class(TForm)
|
||||
Label8: TLabel;
|
||||
HeaderCustomDrawTree: TVirtualStringTree;
|
||||
HeaderImages: TImageList;
|
||||
AnimationTimer: TTimer;
|
||||
procedure HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader; var PaintInfo: THeaderPaintInfo;
|
||||
var Elements: THeaderPaintElements);
|
||||
procedure HeaderCustomDrawTreeAdvancedHeaderDraw(Sender: TVTHeader; var 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);
|
||||
procedure HeaderCustomDrawTreeGetText(Sender: TBaseVirtualTree;
|
||||
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
|
||||
var CellText: UTF8String);
|
||||
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, LclExt;
|
||||
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderDrawQueryElements(Sender: TVTHeader;
|
||||
var 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; var 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 := '�';
|
||||
Size := TargetCanvas.TextExtent(S);
|
||||
SetBkMode(TargetCanvas.Handle, TRANSPARENT);
|
||||
TargetCanvas.TextOut(PaintRectangle.Left + 10, Paintrectangle.Bottom - Size.cy, S);
|
||||
end;
|
||||
// Other elements go here.
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.CreateCheckerBackground;
|
||||
|
||||
begin
|
||||
FCheckerBackground := TBitmap.Create;
|
||||
with FCheckerBackground do
|
||||
begin
|
||||
Width := 16;
|
||||
Height := 16;
|
||||
Canvas.Brush.Color := clBtnShadow;
|
||||
Canvas.FillRect(Rect(0, 0, Width, Height));
|
||||
Canvas.Brush.Color := clBtnHighlight;
|
||||
Canvas.FillRect(Rect(0, 0, 8, 8));
|
||||
Canvas.FillRect(Rect(8, 8, 16, 16));
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.PaintSelection(Bitmap: TBitmap);
|
||||
|
||||
const
|
||||
Alpha = 75;
|
||||
|
||||
var
|
||||
R: TRect;
|
||||
|
||||
begin
|
||||
R := Rect(0, 0, Bitmap.Width, Bitmap.Height);
|
||||
VirtualTrees.AlphaBlend(0, Bitmap.Canvas.Handle, R, Point(0, 0), bmConstantAlphaAndColor, Alpha,
|
||||
ColorToRGB(clHighlight));
|
||||
with Bitmap do
|
||||
begin
|
||||
Canvas.Pen.Color := clHighlight;
|
||||
Canvas.Brush.Style := bsClear;
|
||||
Canvas.Rectangle(0, 0, Width, Height);
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.FillBackground(R: TRect; Target: TCanvas);
|
||||
|
||||
// Tiles the background image over the given target bitmap.
|
||||
|
||||
var
|
||||
X, Y: Integer;
|
||||
dX, dY: Integer;
|
||||
|
||||
begin
|
||||
with Target do
|
||||
begin
|
||||
dX := FCheckerBackground.Width;
|
||||
dY := FCheckerBackground.Height;
|
||||
|
||||
Y := 0;
|
||||
while Y < R.Bottom - R.Top do
|
||||
begin
|
||||
X := 0;
|
||||
while X < R.Right - R.Left do
|
||||
begin
|
||||
Draw(X, Y, FCheckerBackground);
|
||||
Inc(X, dX);
|
||||
end;
|
||||
Inc(Y, dY);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.FormCreate(Sender: TObject);
|
||||
|
||||
begin
|
||||
FBackBitmap1 := TBitmap.Create;
|
||||
FBackBitmap1.PixelFormat := OptimalPixelFormat;
|
||||
FBackBitmap2 := TBitmap.Create;
|
||||
//FBackBitmap2.PixelFormat := OptimalPixelFormat;
|
||||
CreateCheckerBackground;
|
||||
FHeaderBitmap := TBitmap.Create;
|
||||
FHeaderBitmap.LoadFromLazarusResource('Transcriptions');
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.FormDestroy(Sender: TObject);
|
||||
|
||||
begin
|
||||
FCheckerBackground.Free;
|
||||
FBackBitmap1.Free;
|
||||
FBackBitmap2.Free;
|
||||
FHeaderBitmap.Free;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.AnimationTimerTimer(Sender: TObject);
|
||||
|
||||
begin
|
||||
FLeftPos := (FLeftPos + FHeaderBitmap.Width div 2000) mod FHeaderBitmap.Width;
|
||||
with HeaderCustomDrawTree.Header do
|
||||
Invalidate(Columns[2]);
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderMouseUp(Sender: TVTHeader; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
|
||||
begin
|
||||
// Reenable animation after a drag operation.
|
||||
AnimationTimer.Enabled := True;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeHeaderMouseDown(Sender: TVTHeader; Button: TMouseButton;
|
||||
Shift: TShiftState; X, Y: Integer);
|
||||
|
||||
begin
|
||||
// Stop animation when mouse button is down.
|
||||
AnimationTimer.Enabled := False;
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeStateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);
|
||||
|
||||
begin
|
||||
if not (csDestroying in ComponentState) then
|
||||
UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
procedure THeaderOwnerDrawForm.HeaderCustomDrawTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
|
||||
Column: TColumnIndex; TextType: TVSTTextType; var CellText: UTF8String);
|
||||
|
||||
begin
|
||||
CellText := 'Some simple text.';
|
||||
end;
|
||||
|
||||
//----------------------------------------------------------------------------------------------------------------------
|
||||
|
||||
initialization
|
||||
{$i HeaderCustomDrawDemo.lrs}
|
||||
{$i bitmap.lrs}
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user