pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Merge fixes from 4.8 branch to trunk

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2788 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
blikblum
2013-09-07 19:08:28 +00:00
parent d40caa283a
commit d67d6d0a63
56 changed files with 2436 additions and 1236 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
components/virtualtreeview-new/trunk/VTConfig.inc
View File

@ -30,9 +30,20 @@
{$define EnableAlphaBlend}
{.$define EnableAccessible}
{$define ThemeSupport}
{$if defined(LCLWin32) or defined(LCLWinCE)}
{$define LCLWin}
{$endif}
{.$define DEBUG_VTV}
{$define USE_DELPHICOMPAT}
//since
{$if not defined(USE_DELPHICOMPAT) and not defined(LCLWin)}
{$define INCOMPLETE_WINAPI}
{$endif}
//under linux the performance is poor with threading enabled
{$ifdef Windows}
{$define EnableThreadSupport}
{$endif}
{$ifdef CPU64}
{$define PACKARRAYPASCAL}
{$endif}

1506
components/virtualtreeview-new/trunk/VirtualTrees.pas
View File

File diff suppressed because it is too large Load Diff

18
components/virtualtreeview-new/trunk/demos/advanced/Advanced.lpi
View File

@ -1,20 +1,21 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@ -41,6 +42,7 @@
<Unit0>
<Filename Value="Advanced.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="Advanced"/>
</Unit0>
<Unit1>
<Filename Value="WindowsXPStyleDemo.pas"/>
@ -132,6 +134,7 @@
<IsPartOfProject Value="True"/>
<ComponentName Value="StateForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="States"/>
</Unit12>
<Unit13>
@ -150,8 +153,13 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

2
components/virtualtreeview-new/trunk/demos/advanced/AlignDemo.pas
View File

@ -11,7 +11,7 @@ interface
uses
SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ComCtrls, ExtCtrls, Menus, LResources;
StdCtrls, ComCtrls, VirtualTrees, ExtCtrls, Menus, LResources;
type
TAlignForm = class(TForm)

14
components/virtualtreeview-new/trunk/demos/advanced/DrawTreeDemo.pas
View File

@ -20,8 +20,8 @@ uses
{$ifdef Windows}
Windows,
{$endif}
LCLIntf, delphicompat, LCLType, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
VirtualTrees, StdCtrls, ComCtrls, shlobjext, LResources;
LCLIntf, delphicompat, LCLType, SysUtils, Classes, ComCtrls, Graphics, Controls, Forms, Dialogs,
VirtualTrees, StdCtrls, shlobjext, LResources, FileUtil;
type
TDrawTreeForm = class(TForm)
@ -96,10 +96,10 @@ var
SR: TSearchRec;
begin
Result := FindFirst(IncludeTrailingPathDelimiter(Folder) + {$ifdef Windows}'*.*'{$else}'*'{$endif},
Result := FindFirstUTF8(IncludeTrailingPathDelimiter(Folder) + {$ifdef Windows}'*.*'{$else}'*'{$endif},
faAnyFile, SR) = 0;
if Result then
FindClose(SR);
FindCloseUTF8(SR);
end;
//----------------------------------------------------------------------------------------------------------------------
@ -529,7 +529,7 @@ var
begin
Data := Sender.GetNodeData(Node);
if FindFirst(IncludeTrailingPathDelimiter(Data.FullPath) + {$ifdef Windows}'*.*'{$else}'*'{$endif},
if FindFirstUTF8(IncludeTrailingPathDelimiter(Data.FullPath) + {$ifdef Windows}'*.*'{$else}'*'{$endif},
faAnyFile, SR) = 0 then
begin
Screen.Cursor := crHourGlass;
@ -554,14 +554,14 @@ begin
Sender.ValidateNode(Node, False);
end;
end;
until FindNext(SR) <> 0;
until FindNextUTF8(SR) <> 0;
ChildCount := Sender.ChildCount[Node];
// finally sort node
if ChildCount > 0 then
Sender.Sort(Node, 0, TVirtualStringTree(Sender).Header.SortDirection, False);
finally
FindClose(SR);
FindCloseUTF8(SR);
Screen.Cursor := crDefault;
end;
end;

40
components/virtualtreeview-new/trunk/demos/advanced/Editors.pas
View File

@ -9,8 +9,7 @@ interface
uses
LCLIntf, delphicompat, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ExtDlgs, Buttons, ExtCtrls, ComCtrls,
MaskEdit, LCLType, EditBtn;
StdCtrls, VirtualTrees, Buttons, ExtCtrls, MaskEdit, LCLType, EditBtn;
type
// Describes the type of value a property tree node stores in its data property.
@ -36,6 +35,9 @@ type
end;
// Our own edit link to implement several different node editors.
{ TPropertyEditLink }
TPropertyEditLink = class(TInterfacedObject, IVTEditLink)
private
FEdit: TWinControl; // One of the property editor classes.
@ -43,6 +45,7 @@ type
FNode: PVirtualNode; // The node being edited.
FColumn: Integer; // The column of the node being edited.
protected
procedure EditExit(Sender: TObject);
procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
public
destructor Destroy; override;
@ -201,12 +204,17 @@ uses
destructor TPropertyEditLink.Destroy;
begin
FEdit.Free;
Application.ReleaseComponent(FEdit);
inherited;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertyEditLink.EditExit(Sender: TObject);
begin
FTree.EndEditNode;
end;
procedure TPropertyEditLink.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
@ -252,7 +260,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.BeginEdit: Boolean;
function TPropertyEditLink.BeginEdit: Boolean; stdcall;
begin
Result := True;
@ -262,7 +270,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.CancelEdit: Boolean;
function TPropertyEditLink.CancelEdit: Boolean; stdcall;
begin
Result := True;
@ -271,7 +279,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.EndEdit: Boolean;
function TPropertyEditLink.EndEdit: Boolean; stdcall;
var
Data: PPropertyData;
@ -304,7 +312,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.GetBounds: TRect;
function TPropertyEditLink.GetBounds: TRect; stdcall;
begin
Result := FEdit.BoundsRect;
@ -312,7 +320,8 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
function TPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex): Boolean; stdcall;
var
Data: PPropertyData;
@ -336,7 +345,6 @@ begin
Visible := False;
Parent := Tree;
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtPickString:
@ -351,7 +359,6 @@ begin
Items.Add('Standard');
Items.Add('Additional');
Items.Add('Win32');
OnKeyDown := EditKeyDown;
end;
end;
vtNumber:
@ -363,7 +370,6 @@ begin
Parent := Tree;
EditMask := '9999';
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtPickNumber:
@ -374,7 +380,6 @@ begin
Visible := False;
Parent := Tree;
Text := Data.Value;
OnKeyDown := EditKeyDown;
end;
end;
vtMemo:
@ -388,7 +393,6 @@ begin
Parent := Tree;
Text := Data.Value;
Items.Add(Data.Value);
OnKeyDown := EditKeyDown;
end;
end;
vtDate:
@ -399,17 +403,21 @@ begin
Visible := False;
Parent := Tree;
Date := StrToDate(Data.Value);
OnKeyDown := EditKeyDown;
end;
end;
else
Result := False;
end;
if Result then
begin
FEdit.OnKeyDown := EditKeyDown;
FEdit.OnExit := EditExit;
end;
end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertyEditLink.ProcessMessage(var Message: TMessage);
procedure TPropertyEditLink.ProcessMessage(var Message: TMessage); stdcall;
begin
FEdit.WindowProc(Message);
@ -417,7 +425,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TPropertyEditLink.SetBounds(R: TRect);
procedure TPropertyEditLink.SetBounds(R: TRect); stdcall;
var
Dummy: Integer;

2
components/virtualtreeview-new/trunk/demos/advanced/GridDemo.pas
View File

@ -79,7 +79,7 @@ begin
if Node.Index mod 6 = 0 then
Color := $49DDEF // $70A33F // $436BFF
else
Color := VST5.Color;
Color := VST5.Brush.Color;
EraseAction := eaColor;
end;
end;

2
components/virtualtreeview-new/trunk/demos/advanced/HeaderCustomDrawDemo.pas
View File

@ -106,7 +106,7 @@ begin
begin
if hpeBackground in Elements then
begin
TargetCanvas.Brush.Color := clBackground;
TargetCanvas.Brush.Color := clBtnFace;
TargetCanvas.FillRect(PaintRectangle);
end;
end

2
components/virtualtreeview-new/trunk/demos/advanced/PropertiesDemo.pas
View File

@ -198,7 +198,7 @@ begin
// to start a new edit operation if the last one is still in progress. So we post us a special message and
// in the message handler we then can start editing the new node. This works because the posted message
// is first executed *after* this event and the message, which triggered it is finished.
PostMessage(Self.Handle, WM_STARTEDITING, Integer(Node), 0);
PostMessage(Self.Handle, WM_STARTEDITING, PtrInt(Node), 0);
end;
end;
end;

52
components/virtualtreeview-new/trunk/demos/advanced/SpeedDemo.lfm
View File

@ -9,30 +9,29 @@ object SpeedForm: TSpeedForm
ClientWidth = 566
Font.Height = -13
Font.Name = 'MS Sans Serif'
LCLVersion = '0.9.29'
Visible = True
LCLVersion = '1.1'
object Label1: TLabel
Left = 7
Height = 18
Height = 16
Top = 8
Width = 156
Width = 139
Caption = 'Last operation duration:'
ParentColor = False
end
object Label3: TLabel
Left = 6
Height = 18
Top = 508
Width = 104
Height = 16
Top = 510
Width = 93
Anchors = [akLeft, akBottom]
Caption = 'Nodes in tree: 0'
ParentColor = False
end
object Label6: TLabel
Left = 164
Height = 18
Top = 508
Width = 73
Height = 16
Top = 510
Width = 67
Anchors = [akLeft, akBottom]
Caption = 'Selected: 0'
ParentColor = False
@ -42,9 +41,9 @@ object SpeedForm: TSpeedForm
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = VST1
Left = 261
Height = 102
Height = 16
Top = 24
Width = 296
Width = 1203
BorderSpacing.Left = 4
Caption = 'Test how fast the Virtual Treeview is. You can add and delete nodes as much as you like (provided your system has enough memory). An upper limit of one million nodes for a 128MB system is a good start.'
ParentColor = False
@ -56,9 +55,9 @@ object SpeedForm: TSpeedForm
AnchorSideTop.Control = Label4
AnchorSideTop.Side = asrBottom
Left = 261
Height = 18
Top = 136
Width = 135
Height = 16
Top = 50
Width = 121
BorderSpacing.Left = 4
BorderSpacing.Top = 10
Caption = 'As an orientation:'
@ -74,9 +73,9 @@ object SpeedForm: TSpeedForm
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
Left = 265
Height = 60
Top = 156
Width = 292
Height = 16
Top = 68
Width = 520
BorderSpacing.Left = 8
BorderSpacing.Top = 2
Caption = '1.000.000 nodes on Windows XP Pro, 650Mhz Athlon, 256 MB RAM, take ~ 850ms to add.'
@ -89,9 +88,9 @@ object SpeedForm: TSpeedForm
AnchorSideTop.Control = Label5
AnchorSideTop.Side = asrBottom
Left = 265
Height = 39
Top = 218
Width = 292
Height = 16
Top = 86
Width = 519
BorderSpacing.Left = 8
BorderSpacing.Top = 2
Caption = '5.000.000 nodes on Windows XP Pro, 1.8Ghz Pentium M , 1 GB RAM, are added in ~1.6s.'
@ -1576,7 +1575,6 @@ object SpeedForm: TSpeedForm
TreeOptions.SelectionOptions = [toMultiSelect]
OnChange = VST1Change
OnGetText = VST1GetText
OnStateChange = VST1StateChange
OnStructureChange = VST1StructureChange
end
object GroupBox2: TGroupBox
@ -1588,15 +1586,15 @@ object SpeedForm: TSpeedForm
Width = 281
Anchors = [akRight, akBottom]
Caption = ' Background '
ClientHeight = 38
ClientHeight = 39
ClientWidth = 277
DragMode = dmAutomatic
TabOrder = 1
object SBCheckBox: TCheckBox
Left = 24
Height = 22
Height = 20
Top = 10
Width = 140
Width = 129
Caption = 'Show Background'
OnClick = SBCheckBoxClick
TabOrder = 0
@ -1622,7 +1620,7 @@ object SpeedForm: TSpeedForm
Anchors = [akRight, akBottom]
BorderSpacing.Bottom = 10
Caption = ' Add and remove nodes '
ClientHeight = 103
ClientHeight = 104
ClientWidth = 277
TabOrder = 2
object AddRootButton: TButton
@ -1637,7 +1635,7 @@ object SpeedForm: TSpeedForm
end
object NodeCountEdit: TEdit
Left = 12
Height = 27
Height = 24
Top = 16
Width = 81
TabOrder = 1

2
components/virtualtreeview-new/trunk/demos/advanced/SpeedDemo.pas
View File

@ -11,7 +11,7 @@ interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, VirtualTrees, ExtDlgs, ComCtrls, Menus, LResources, Buttons;
StdCtrls, VirtualTrees, ExtDlgs, Menus, LResources, Buttons;
type
TSpeedForm = class(TForm)

2
components/virtualtreeview-new/trunk/demos/advanced/WindowsXPStyleDemo.pas
View File

@ -10,7 +10,7 @@ interface
uses
LCLIntf, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, ComCtrls, Menus, StdCtrls,
Dialogs, ComCtrls, VirtualTrees, Menus, StdCtrls,
LResources, Printers, PrintersDlgs, ExtCtrls;
type

71
components/virtualtreeview-new/trunk/demos/dataarray/Main.lfm
View File

@ -1,40 +1,41 @@
object Form1: TForm1
Left = 188
Height = 437
Height = 434
Top = 104
Width = 612
ActiveControl = Button1
Width = 648
ActiveControl = MyTree
Caption = 'Form1'
ClientHeight = 437
ClientWidth = 612
ClientHeight = 434
ClientWidth = 648
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnClose = FormClose
OnCreate = FormCreate
LCLVersion = '0.9.27'
Position = poScreenCenter
LCLVersion = '0.9.29'
object Label1: TLabel
Left = 207
Left = 224
Height = 14
Top = 351
Width = 149
Top = 348
Width = 174
Anchors = [akRight, akBottom]
Caption = 'Array data of the clicked node'
Caption = 'Array data of the clicked node:'
ParentColor = False
end
object Label2: TLabel
Left = 367
Left = 224
Height = 14
Top = 335
Width = 222
Top = 382
Width = 256
Anchors = [akRight, akBottom]
Caption = 'Find and show the node by specific array index'
ParentColor = False
end
object Label3: TLabel
Left = 367
Left = 224
Height = 14
Top = 351
Width = 237
Top = 398
Width = 274
Anchors = [akRight, akBottom]
Caption = 'Type index to get related tree node on the screen:'
ParentColor = False
@ -42,7 +43,7 @@ object Form1: TForm1
object Button1: TButton
Left = 8
Height = 25
Top = 342
Top = 344
Width = 83
Anchors = [akLeft, akBottom]
BorderSpacing.InnerBorder = 4
@ -53,7 +54,7 @@ object Form1: TForm1
object btnDelete: TButton
Left = 96
Height = 25
Top = 342
Top = 344
Width = 97
Anchors = [akLeft, akBottom]
BorderSpacing.InnerBorder = 4
@ -62,18 +63,21 @@ object Form1: TForm1
TabOrder = 1
end
object Edit1: TEdit
Left = 208
Height = 21
Top = 376
Width = 153
Anchors = [akRight, akBottom]
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
Left = 402
Height = 23
Top = 344
Width = 170
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 4
ReadOnly = True
TabOrder = 2
end
object btnCleanAll: TButton
Left = 56
Height = 25
Top = 374
Top = 376
Width = 75
Anchors = [akLeft, akBottom]
BorderSpacing.InnerBorder = 4
@ -82,25 +86,29 @@ object Form1: TForm1
TabOrder = 3
end
object Edit2: TEdit
Left = 368
Height = 21
Top = 378
AnchorSideLeft.Control = Label3
AnchorSideLeft.Side = asrBottom
Left = 502
Height = 23
Top = 394
Width = 97
Anchors = [akRight, akBottom]
Anchors = [akLeft, akBottom]
BorderSpacing.Left = 4
OnChange = Edit2Change
TabOrder = 4
end
object MyTree: TVirtualStringTree
Left = 3
Height = 321
Height = 326
Top = 8
Width = 605
Width = 641
Anchors = [akTop, akLeft, akRight, akBottom]
AutoScrollDelay = 1
BorderStyle = bsSingle
DefaultText = 'Node'
Header.AutoSizeIndex = 0
Header.Columns = <
item
Position = 0
Text = 'Text'
Width = 150
end
@ -115,6 +123,7 @@ object Form1: TForm1
Text = 'Random'
Width = 100
end>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Options = [hoColumnResize, hoDblClickResize, hoDrag, hoShowSortGlyphs, hoVisible]

18
components/virtualtreeview-new/trunk/demos/dataarray/dataarray.lpi
View File

@ -1,23 +1,24 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
@ -52,8 +53,13 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>

2
components/virtualtreeview-new/trunk/demos/dataarray/dataarray.lpr
View File

@ -10,6 +10,8 @@ uses
Forms
{ add your units here }, virtualtreeview_package, Main;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);

61
components/virtualtreeview-new/trunk/demos/dragdrop/fmain.lfm Normal file
View File

@ -0,0 +1,61 @@
object MainForm: TMainForm
Left = 569
Height = 349
Top = 219
Width = 454
Caption = 'VTV Drag and Drop'
ClientHeight = 349
ClientWidth = 454
Position = poScreenCenter
LCLVersion = '1.1'
object VirtualStringTree1: TVirtualStringTree
Left = 8
Height = 315
Top = 26
Width = 200
DefaultText = 'Node'
DragMode = dmAutomatic
DragType = dtVCL
Header.AutoSizeIndex = 0
Header.Columns = <>
Header.DefaultHeight = 17
Header.MainColumn = -1
RootNodeCount = 30
TabOrder = 0
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
OnDragOver = VirtualStringTree1DragOver
OnDragDrop = VirtualStringTree1DragDrop
OnGetText = VirtualStringTree1GetText
OnGetNodeDataSize = VirtualStringTree1GetNodeDataSize
OnInitNode = VirtualStringTree1InitNode
end
object ListBox1: TListBox
Left = 248
Height = 315
Top = 26
Width = 200
DragMode = dmAutomatic
Items.Strings = (
'List Item 1'
'List Item 2'
'List Item 3'
'List Item 4'
'List Item 5'
'List Item 6'
)
ItemHeight = 15
OnDragDrop = ListBox1DragDrop
OnDragOver = ListBox1DragOver
ScrollWidth = 190
TabOrder = 1
end
object ShowHeaderCheckBox: TCheckBox
Left = 8
Height = 19
Top = 3
Width = 90
Caption = 'Show Header'
OnChange = ShowHeaderCheckBoxChange
TabOrder = 2
end
end

146
components/virtualtreeview-new/trunk/demos/dragdrop/fmain.pas Normal file
View File

@ -0,0 +1,146 @@
unit fMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
VirtualTrees, {$ifdef windows}ActiveX{$else}FakeActiveX{$endif};
type
{ TMainForm }
TMainForm = class(TForm)
ShowHeaderCheckBox: TCheckBox;
ListBox1: TListBox;
VirtualStringTree1: TVirtualStringTree;
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure ShowHeaderCheckBoxChange(Sender: TObject);
procedure VirtualStringTree1DragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; const Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure VirtualStringTree1DragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
procedure VirtualStringTree1GetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure VirtualStringTree1GetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
procedure VirtualStringTree1InitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
private
{ private declarations }
public
{ public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
type
TNodeData = record
Title: String;
end;
PNodeData = ^TNodeData;
{ TMainForm }
procedure TMainForm.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
begin
CellText := PNodeData(Sender.GetNodeData(Node))^.Title;
end;
procedure TMainForm.VirtualStringTree1InitNode(Sender: TBaseVirtualTree;
ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
begin
PNodeData(Sender.GetNodeData(Node))^.Title := 'VTV Item ' + IntToStr(Node^.Index);
end;
procedure TMainForm.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := (Source = VirtualStringTree1) or (Source = ListBox1);
end;
procedure TMainForm.ShowHeaderCheckBoxChange(Sender: TObject);
begin
if ShowHeaderCheckBox.Checked then
VirtualStringTree1.Header.Options := VirtualStringTree1.Header.Options + [hoVisible]
else
VirtualStringTree1.Header.Options := VirtualStringTree1.Header.Options - [hoVisible];
end;
procedure TMainForm.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
Node: PVirtualNode;
begin
if Source = VirtualStringTree1 then
begin
Node := VirtualStringTree1.FocusedNode;
if Node <> nil then
ListBox1.Items.Append(VirtualStringTree1.Text[Node, 0]);
end;
end;
procedure TMainForm.VirtualStringTree1DragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; const Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
Node: PVirtualNode;
NodeTitle: String;
begin
case Mode of
dmAbove: Node := Sender.InsertNode(Sender.DropTargetNode, amInsertBefore);
dmBelow: Node := Sender.InsertNode(Sender.DropTargetNode, amInsertAfter);
dmNowhere: Exit;
else
Node := Sender.AddChild(Sender.DropTargetNode);
end;
Sender.ValidateNode(Node, True);
if Source = ListBox1 then
begin
if ListBox1.ItemIndex = -1 then
NodeTitle := 'Unknow Item from List'
else
NodeTitle := ListBox1.Items[ListBox1.ItemIndex];
end
else if Source = Sender then
begin
if Sender.FocusedNode <> nil then
NodeTitle := VirtualStringTree1.Text[Sender.FocusedNode, 0]
else
NodeTitle := 'Unknow Source Node';
end
else
NodeTitle := 'Unknow Source Control';
PNodeData(Sender.GetNodeData(Node))^.Title := NodeTitle;
end;
procedure TMainForm.VirtualStringTree1DragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; const Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
begin
Accept := (Sender = VirtualStringTree1) or (Source = ListBox1);
end;
procedure TMainForm.VirtualStringTree1GetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TNodeData);
end;
end.

91
components/virtualtreeview-new/trunk/demos/dragdrop/vtvdragdrop.lpi Normal file
View File

@ -0,0 +1,91 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="virtualtreeview_package"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="vtvdragdrop.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="vtvdragdrop"/>
</Unit0>
<Unit1>
<Filename Value="fmain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="vtvdragdrop"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
components/virtualtreeview-new/trunk/demos/dragdrop/vtvdragdrop.lpr Normal file
View File

@ -0,0 +1,21 @@
program vtvdragdrop;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, fMain, virtualtreeview_package
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

7
components/virtualtreeview-new/trunk/demos/images/Unit1.lfm
View File

@ -10,10 +10,12 @@ object Form1: TForm1
Font.Height = -11
Font.Name = 'MS Sans Serif'
OnCreate = FormCreate
LCLVersion = '0.9.27'
LCLVersion = '0.9.29'
object VST1: TVirtualStringTree
Cursor = 63
Left = 0
Height = 440
Top = 0
Width = 500
Align = alClient
CheckImageKind = ckXP
@ -22,10 +24,12 @@ object Form1: TForm1
DragMode = dmAutomatic
DragOperations = [doCopy, doMove, doLink]
DrawSelectionMode = smBlendedRectangle
Header.AutoSizeIndex = 0
Header.Columns = <
item
Hint = 'Glavna kolona'
ImageIndex = 0
Position = 0
Text = 'Main'
Width = 200
end
@ -46,6 +50,7 @@ object Form1: TForm1
Text = 'Percent'
Width = 150
end>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Height = 24

3
components/virtualtreeview-new/trunk/demos/images/images.lpi
View File

@ -17,7 +17,6 @@
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
@ -43,9 +42,9 @@
</Unit0>
<Unit1>
<Filename Value="Unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>

2
components/virtualtreeview-new/trunk/demos/images/images.lpr
View File

@ -2,7 +2,7 @@ program images;
{$mode objfpc}{$H+}
{$define DEBUG_VTV}
{.$define DEBUG_VTV}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}

18
components/virtualtreeview-new/trunk/demos/mininal/minimal_lcl.lpi
View File

@ -1,23 +1,24 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
@ -52,8 +53,13 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

2
components/virtualtreeview-new/trunk/demos/mininal/minimal_lcl.lpr
View File

@ -10,6 +10,8 @@ uses
Forms
{ add your units here }, Main;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm,MainForm);

22
components/virtualtreeview-new/trunk/demos/objects/mvcdemo.lpi
View File

@ -1,22 +1,24 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Version Value="6"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
@ -45,11 +47,10 @@
</Unit0>
<Unit1>
<Filename Value="MVCDemoMain.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="fmMVCDemo"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<ResourceFilename Value="MVCDemoMain.lrs"/>
<UnitName Value="MVCDemoMain"/>
</Unit1>
<Unit2>
@ -65,8 +66,13 @@
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>

2
components/virtualtreeview-new/trunk/demos/objects/mvcdemo.lpr
View File

@ -10,6 +10,8 @@ uses
Forms
{ add your units here }, MVCDemoMain, lclextensions_package;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TfmMVCDemo, fmMVCDemo);

87
components/virtualtreeview-new/trunk/demos/ole/Main.lfm
View File

@ -1,23 +1,23 @@
object MainForm: TMainForm
Left = 192
Height = 575
Top = 261
Left = 356
Height = 574
Top = 70
Width = 790
ActiveControl = Button1
Caption = 'Demo for drag''n drop and clipboard transfers'
ClientHeight = 575
ClientHeight = 574
ClientWidth = 790
Font.CharSet = ANSI_CHARSET
Font.Height = -12
Font.Name = 'Arial'
OnCreate = FormCreate
LCLVersion = '0.9.27'
LCLVersion = '1.1'
Visible = True
object Label1: TLabel
Left = 10
Height = 15
Left = 8
Height = 14
Top = 96
Width = 239
Width = 238
Caption = 'Tree 1 uses OLE when initiating a drag operation.'
Font.CharSet = ANSI_CHARSET
Font.Height = -11
@ -26,7 +26,7 @@ object MainForm: TMainForm
ParentFont = False
end
object Label2: TLabel
Left = 360
Left = 364
Height = 33
Top = 80
Width = 337
@ -40,7 +40,9 @@ object MainForm: TMainForm
WordWrap = True
end
object Panel3: TPanel
Left = 0
Height = 69
Top = 0
Width = 790
Align = alTop
ClientHeight = 69
@ -67,7 +69,7 @@ object MainForm: TMainForm
object Button1: TButton
Left = 705
Height = 25
Top = 527
Top = 526
Width = 75
Anchors = [akRight, akBottom]
BorderSpacing.InnerBorder = 4
@ -92,7 +94,6 @@ object MainForm: TMainForm
Height = 180
Top = 116
Width = 330
BorderStyle = bsSingle
ClipboardFormats.Strings = (
'Plain text'
'Unicode text'
@ -109,9 +110,12 @@ object MainForm: TMainForm
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Lucida Sans Unicode'
Header.AutoSizeIndex = 0
Header.Columns = <>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Height = 24
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
HintMode = hmTooltip
@ -137,7 +141,6 @@ object MainForm: TMainForm
Height = 180
Top = 116
Width = 330
BorderStyle = bsSingle
ClipboardFormats.Strings = (
'CSV'
'HTML Format'
@ -156,9 +159,12 @@ object MainForm: TMainForm
Font.CharSet = ANSI_CHARSET
Font.Height = -11
Font.Name = 'Verdana'
Header.AutoSizeIndex = 0
Header.Columns = <>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Sans Serif'
Header.Height = 24
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
HintMode = hmTooltip
@ -179,32 +185,33 @@ object MainForm: TMainForm
OnNewText = Tree1NewText
end
object PageControl1: TPageControl
Left = 12
Height = 245
Top = 308
Width = 685
ActivePage = TabSheet1
Left = 8
Height = 224
Top = 328
Width = 686
ActivePage = LogTabSheet
Anchors = [akTop, akLeft, akBottom]
TabIndex = 3
TabIndex = 1
TabOrder = 5
object RichTextTabSheet: TTabSheet
Caption = 'Rich text'
ClientHeight = 217
ClientWidth = 677
ClientHeight = 196
ClientWidth = 678
ImageIndex = 1
TabVisible = False
object Label3: TLabel
Left = 8
Height = 15
Top = 8
Width = 453
Width = 452
Caption = 'You can use the rich edit control as source and as target. It initiates OLE drag'' drop.'
ParentColor = False
end
end
object LogTabSheet: TTabSheet
Caption = 'Drag''n drop operation log'
ClientHeight = 217
ClientWidth = 677
ClientHeight = 196
ClientWidth = 678
object Label7: TLabel
Left = 6
Height = 41
@ -217,18 +224,19 @@ object MainForm: TMainForm
end
object LogListBox: TListBox
Left = 4
Height = 143
Height = 122
Hint = 'Use the list box to initiate a VCL drag''n drop.'
Top = 56
Width = 661
Width = 662
Anchors = [akTop, akLeft, akRight, akBottom]
DragMode = dmAutomatic
ItemHeight = 0
ParentShowHint = False
ShowHint = True
TabOrder = 0
end
object Button2: TButton
Left = 590
Left = 591
Height = 25
Top = 10
Width = 75
@ -241,7 +249,7 @@ object MainForm: TMainForm
end
object TabSheet2: TTabSheet
Caption = 'More info'
ClientHeight = 217
ClientHeight = 197
ClientWidth = 677
ImageIndex = 3
object Label4: TLabel
@ -277,7 +285,7 @@ object MainForm: TMainForm
end
object TabSheet1: TTabSheet
Caption = 'Tips'
ClientHeight = 217
ClientHeight = 197
ClientWidth = 677
ImageIndex = 2
object Label8: TLabel
@ -302,24 +310,39 @@ object MainForm: TMainForm
end
end
end
object ShowHeader1CheckBox: TCheckBox
Left = 8
Height = 19
Top = 302
Width = 95
Caption = 'Show Header'
OnChange = ShowHeader1CheckBoxChange
TabOrder = 6
end
object ShowHeader2CheckBox: TCheckBox
Left = 364
Height = 19
Top = 302
Width = 95
Caption = 'Show Header'
OnChange = ShowHeader2CheckBoxChange
TabOrder = 7
end
object ActionList1: TActionList
left = 724
top = 156
object CutAction: TAction
Caption = 'Cut'
DisableIfNoHandler = True
OnExecute = CutActionExecute
ShortCut = 16472
end
object CopyAction: TAction
Caption = 'Copy'
DisableIfNoHandler = True
OnExecute = CopyActionExecute
ShortCut = 16451
end
object PasteAction: TAction
Caption = 'Paste'
DisableIfNoHandler = True
OnExecute = PasteActionExecute
ShortCut = 16470
end
@ -327,6 +350,8 @@ object MainForm: TMainForm
object FontDialog: TFontDialog
Font.Height = -11
Font.Name = 'MS Sans Serif'
MinFontSize = 0
MaxFontSize = 0
left = 756
top = 168
end

24
components/virtualtreeview-new/trunk/demos/ole/Main.pas
View File

@ -19,6 +19,7 @@ type
TMainForm = class(TForm)
ActionList1: TActionList;
ShowHeader1CheckBox: TCheckBox;
CutAction: TAction;
CopyAction: TAction;
PasteAction: TAction;
@ -27,6 +28,7 @@ type
Label6: TLabel;
Button1: TButton;
Button3: TButton;
ShowHeader2CheckBox: TCheckBox;
Tree2: TVirtualStringTree;
Label1: TLabel;
Tree1: TVirtualStringTree;
@ -51,6 +53,8 @@ type
procedure CutActionExecute(Sender: TObject);
procedure CopyActionExecute(Sender: TObject);
procedure PasteActionExecute(Sender: TObject);
procedure ShowHeader1CheckBoxChange(Sender: TObject);
procedure ShowHeader2CheckBoxChange(Sender: TObject);
procedure TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure Tree1GetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var Text: String);
@ -71,7 +75,7 @@ type
procedure AddUnicodeText(DataObject: IDataObject; Target: TVirtualStringTree; Mode: TVTNodeAttachMode);
procedure AddVCLText(Target: TVirtualStringTree; const Text: String; Mode: TVTNodeAttachMode);
function FindCPFormatDescription(CPFormat: Word): string;
procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; Effect: Integer;
procedure InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray; Effect: LongWord;
Mode: TVTNodeAttachMode);
end;
@ -187,6 +191,22 @@ begin
// RichEdit1.PasteFromClipboard;
end;
procedure TMainForm.ShowHeader1CheckBoxChange(Sender: TObject);
begin
if ShowHeader1CheckBox.Checked then
Tree1.Header.Options := Tree1.Header.Options + [hoVisible]
else
Tree1.Header.Options := Tree1.Header.Options - [hoVisible];
end;
procedure TMainForm.ShowHeader2CheckBoxChange(Sender: TObject);
begin
if ShowHeader2CheckBox.Checked then
Tree2.Header.Options := Tree2.Header.Options + [hoVisible]
else
Tree2.Header.Options := Tree2.Header.Options - [hoVisible];
end;
procedure TMainForm.TreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
Data: PNodeData;
@ -633,7 +653,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
procedure TMainForm.InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray;
Effect: Integer; Mode: TVTNodeAttachMode);
Effect: LongWord; Mode: TVTNodeAttachMode);
var
FormatAccepted: Boolean;

15
components/virtualtreeview-new/trunk/demos/ole/ole.lpi
View File

@ -1,20 +1,22 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
@ -42,20 +44,21 @@
</Unit0>
<Unit1>
<Filename Value="Main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>

2
components/virtualtreeview-new/trunk/demos/ole/ole.lpr
View File

@ -10,6 +10,8 @@ uses
Forms
{ add your units here }, Main;
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);

54
components/virtualtreeview-new/trunk/demos/unicode/fmain.lfm
View File

@ -3,32 +3,37 @@ object MainForm: TMainForm
Height = 504
Top = 166
Width = 613
Caption = 'Unicode Demo'
Caption = 'VirtualTreeView Unicode Demo'
ClientHeight = 504
ClientWidth = 613
OnCreate = FormCreate
LCLVersion = '0.9.27'
object MainNotebook: TNotebook
Position = poDesktopCenter
LCLVersion = '1.1'
object MainNotebook: TPageControl
Left = 0
Height = 504
Top = 0
Width = 613
ActivePage = WelcomePage
Align = alClient
PageIndex = 0
TabIndex = 0
TabOrder = 0
object WelcomePage: TPage
object WelcomePage: TTabSheet
Caption = 'Welcome Translations'
ClientWidth = 605
ClientHeight = 478
ClientHeight = 465
ClientWidth = 607
object WelcomeTree: TVirtualStringTree
Left = 3
Height = 444
Height = 431
Top = 31
Width = 599
Width = 601
Align = alClient
BorderSpacing.Around = 3
BorderStyle = bsSingle
DefaultText = 'Node'
Header.AutoSizeIndex = 0
Header.Columns = <
item
Position = 0
Text = 'Language'
Width = 200
end
@ -37,18 +42,22 @@ object MainForm: TMainForm
Text = 'Translation'
Width = 200
end>
Header.DefaultHeight = 17
Header.Height = 20
Header.Options = [hoColumnResize, hoDrag, hoVisible]
TabOrder = 0
OnFreeNode = WelcomeTreeFreeNode
OnGetText = WelcomeTreeGetText
end
object WelcomeTopPanel: TPanel
Left = 0
Height = 28
Width = 605
Top = 0
Width = 607
Align = alTop
BevelOuter = bvNone
ClientHeight = 28
ClientWidth = 605
ClientWidth = 607
TabOrder = 1
object ChooseWelcomeFontButton: TButton
Left = 4
@ -63,23 +72,24 @@ object MainForm: TMainForm
end
end
end
object LCLTextPage: TPage
object LCLTextPage: TTabSheet
Caption = 'LCL Text'
ClientWidth = 605
ClientHeight = 478
ClientHeight = 465
ClientWidth = 607
object LCLTextTree: TVirtualStringTree
Left = 3
Height = 440
Top = 3
Width = 272
BorderSpacing.Around = 3
BorderStyle = bsSingle
DefaultText = 'Node'
Header.AutoSizeIndex = 0
Header.Columns = <>
Header.DefaultHeight = 17
Header.MainColumn = -1
Header.Options = [hoColumnResize, hoDrag]
TabOrder = 0
TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.MiscOptions = [toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
OnFreeNode = LCLTextTreeFreeNode
OnGetText = LCLTextTreeGetText
OnNewText = LCLTextTreeNewText
@ -95,7 +105,7 @@ object MainForm: TMainForm
end
object TextEdit: TEdit
Left = 284
Height = 23
Height = 21
Top = 2
Width = 184
TabOrder = 2
@ -105,7 +115,7 @@ object MainForm: TMainForm
Height = 21
Top = 58
Width = 184
ItemHeight = 13
ItemHeight = 0
Items.Strings = (
'Não'
'Coração'
@ -132,8 +142,10 @@ object MainForm: TMainForm
'Coração'
'Sim'
)
ItemHeight = 13
ItemHeight = 0
ScrollWidth = 182
TabOrder = 5
TopIndex = -1
end
object AddListTextButton: TButton
Left = 476
@ -172,6 +184,8 @@ object MainForm: TMainForm
end
end
object FontDialog1: TFontDialog
MinFontSize = 0
MaxFontSize = 0
left = 136
top = 24
end

8
components/virtualtreeview-new/trunk/demos/unicode/fmain.pas
View File

@ -6,7 +6,7 @@ interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, VirtualTrees, StdCtrls, LCLProc;
ExtCtrls, VirtualTrees, StdCtrls, LCLProc, ComCtrls;
type
@ -24,12 +24,12 @@ type
TextComboBox: TComboBox;
TextEdit: TEdit;
FontDialog1: TFontDialog;
MainNotebook: TNotebook;
LCLTextPage: TPage;
MainNotebook: TPageControl;
LCLTextPage: TTabsheet;
LCLTextTree: TVirtualStringTree;
WelcomeTopPanel: TPanel;
WelcomeTree: TVirtualStringTree;
WelcomePage: TPage;
WelcomePage: TTabsheet;
procedure AddComboTextButtonClick(Sender: TObject);
procedure AddEditTextButtonClick(Sender: TObject);
procedure AddListTextButtonClick(Sender: TObject);

31
components/virtualtreeview-new/trunk/demos/unicode/unicode.lpi
View File

@ -1,22 +1,20 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<Icon Value="0"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
@ -26,7 +24,7 @@
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
<LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
@ -46,16 +44,24 @@
</Unit0>
<Unit1>
<Filename Value="fmain.pas"/>
<ComponentName Value="MainForm"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="fMain"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="10"/>
<PathDelim Value="\"/>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>
@ -64,6 +70,9 @@
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>

6
components/virtualtreeview-new/trunk/demos/unicode/unicode.lpr
View File

@ -8,12 +8,12 @@ uses
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms
{ you can add units after this }, fMain, LResources, virtualtreeview_package;
{ you can add units after this }, fMain;
{$IFDEF WINDOWS}{$R unicode.rc}{$ENDIF}
{$R *.res}
begin
{$I unicode.lrs}
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;

6
components/virtualtreeview-new/trunk/demos/vtbasic/VTDBExample.pas
View File

@ -22,7 +22,7 @@ unit VTDBExample;
interface
uses
delphicompat, LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
delphicompat, LCLIntf, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, LCLType,
VirtualTrees, StdCtrls, ExtCtrls, sqlite3ds, Menus, VTreeData, Buttons, LResources;
type
@ -113,8 +113,8 @@ implementation
r : TRect;
begin
{get size of desktop}
//todo: not implemented under gtk
{$ifdef Windows}
{$ifdef LCLWin32}
//todo: enable when SPI_GETWORKAREA is implemented
SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
Height := r.Bottom-Top;
Width := r.Right-Left;

23
components/virtualtreeview-new/trunk/demos/vtbasic/VTNoData.lfm
View File

@ -3,7 +3,7 @@ object frmVTNoData: TfrmVTNoData
Height = 346
Top = 154
Width = 401
ActiveControl = VT
ActiveControl = Panel1
Caption = 'Basic VT as a Tree (no node data used)'
ClientHeight = 346
ClientWidth = 401
@ -14,9 +14,11 @@ object frmVTNoData: TfrmVTNoData
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poDefaultPosOnly
LCLVersion = '0.9.27'
LCLVersion = '0.9.29'
object Panel1: TPanel
Left = 0
Height = 346
Top = 0
Width = 401
Align = alClient
BevelOuter = bvNone
@ -31,9 +33,10 @@ object frmVTNoData: TfrmVTNoData
Top = 7
Width = 387
Align = alClient
BorderStyle = bsSingle
DefaultText = 'Node'
Header.AutoSizeIndex = 0
Header.Columns = <>
Header.DefaultHeight = 17
Header.Font.Height = -11
Header.Font.Name = 'MS Shell Dlg 2'
Header.MainColumn = -1
@ -64,7 +67,7 @@ object frmVTNoData: TfrmVTNoData
Left = 9
Height = 14
Top = 9
Width = 76
Width = 82
Alignment = taCenter
Caption = 'VT.TreeOptions'
Font.Color = clRed
@ -75,27 +78,27 @@ object frmVTNoData: TfrmVTNoData
end
object chkCheckBoxes: TCheckBox
Left = 180
Height = 17
Height = 22
Top = 7
Width = 81
Width = 93
Caption = 'Check Boxes'
OnClick = chkCheckBoxesClick
TabOrder = 0
end
object chkFullExpand: TCheckBox
Left = 100
Height = 17
Height = 22
Top = 7
Width = 75
Width = 86
Caption = 'Full Expand'
OnClick = chkFullExpandClick
TabOrder = 1
end
object chkShowLevel: TCheckBox
Left = 271
Height = 17
Height = 22
Top = 7
Width = 74
Width = 86
Caption = 'Show Level'
OnClick = chkShowLevelClick
TabOrder = 2

12
components/virtualtreeview-new/trunk/demos/vtbasic/VTNoData.pas
View File

@ -20,7 +20,7 @@ interface
uses
delphicompat, LCLIntf, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, ExtCtrls, StdCtrls, LResources;
Dialogs, VirtualTrees, ExtCtrls, StdCtrls, LResources, LCLType;
type
TfrmVTNoData =
@ -167,7 +167,9 @@ implementation
'VariableNodeHeight',
'FullRowDrag',
'NodeHeightResize',
'NodeHeightDblClickResize'
'NodeHeightDblClickResize',
'EditOnClick',
'EditOnDblClick'
);
aPaintOpts : array[0..Ord(High(TVTPaintOption ))] of string[25] =
@ -191,7 +193,8 @@ implementation
'UseBlendedSelection', // Enable alpha blending for node selections.
'StaticBackground',
'ChildrenAbove',
'FixedIndent'
'FixedIndent',
'UseExplorerTheme'
);
aSelOpts : array[0..Ord(High(TVTSelectionOption))] of string[25] =
@ -268,8 +271,9 @@ implementation
var
r : TRect;
begin
{$ifdef LCLWin32}
//todo: enable when SPI_GETWORKAREA is implemented
{get size of desktop}
{$ifdef Windows}
SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
Height := r.Bottom-Top;
{$endif}

7
components/virtualtreeview-new/trunk/demos/vtbasic/ViewCode.pas
View File

@ -3,8 +3,8 @@ unit ViewCode;
interface
uses
delphicompat, LCLIntf, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, LResources, SynHighlighterPas, SynEdit;
DelphiCompat, LCLIntf, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, LResources, SynHighlighterPas, SynEdit, LCLType;
type
@ -29,7 +29,8 @@ implementation
r : TRect;
begin
{get size of desktop}
{$ifdef Windows}
{$ifdef LCLWin32}
//todo: enable when SPI_GETWORKAREA is implemented
SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
Height := r.Bottom-Top;
Width := r.Right-Left;

30
components/virtualtreeview-new/trunk/demos/vtbasic/vtbasic.lpi
View File

@ -1,23 +1,24 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<Version Value="7"/>
<General>
<Flags>
<AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
<UseXPManifest Value="True"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<DestinationDirectory Value="$(TestDir)\publishedproject\"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
@ -50,9 +51,9 @@
</Unit0>
<Unit1>
<Filename Value="Main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmMain"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit1>
@ -63,17 +64,17 @@
</Unit2>
<Unit3>
<Filename Value="VTNoData.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmVTNoData"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="VTNoData"/>
</Unit3>
<Unit4>
<Filename Value="VTPropEdit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmVTPropEdit"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="VTPropEdit"/>
</Unit4>
@ -84,32 +85,37 @@
</Unit5>
<Unit6>
<Filename Value="ViewCode.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmViewCode"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ViewCode"/>
</Unit6>
<Unit7>
<Filename Value="VTCheckList.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmVTCheckList"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="VTCheckList"/>
</Unit7>
<Unit8>
<Filename Value="VTDBExample.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frmVTDBExample"/>
<HasResources Value="True"/>
<IsPartOfProject Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="VTDBExample"/>
</Unit8>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Version Value="11"/>
<PathDelim Value="\"/>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Options>
<Win32>

2
components/virtualtreeview-new/trunk/demos/vtbasic/vtbasic.lpr
View File

@ -14,6 +14,8 @@ uses
{$endif}
;
{$R *.res}
begin
{$ifdef DEBUG_VTV}
Logger.Channels.Add(TIPCChannel.Create);

23
components/virtualtreeview-new/trunk/include/intf/carbon/vtgraphicsi.inc Normal file
View File

@ -0,0 +1,23 @@
//todo: properly implement
procedure AlphaBlend(Source, Destination: HDC; const R: TRect; const Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer);
begin
case Mode of
bmConstantAlpha,
bmPerPixelAlpha,
bmMasterAlpha,
bmConstantAlphaAndColor:
begin
BitBlt(Destination, Target.X, Target.Y, R.Right - R.Left, R.Bottom - R.Top, Source, R.Left, R.Right, SRCCOPY);
end;
end;
end;
function CalculateScanline(Bits: Pointer; Width, Height, Row: Integer): Pointer;
begin
Result := nil;
end;
function GetBitmapBitsFromBitmap(Bitmap: HBITMAP): Pointer;
begin
Result := nil;
end;

5
components/virtualtreeview-new/trunk/include/intf/dummydragmanager.inc
View File

@ -666,6 +666,7 @@ function TVTDragManager.GetIsDropTarget: Boolean;
begin
//Result := FIsDropTarget;
Result := True;
end;
//----------------------------------------------------------------------------------------------------------------------
@ -754,7 +755,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.GiveFeedback(Effect: Integer): HResult;
function TVTDragManager.GiveFeedback(Effect: LongWord): HResult;
begin
//Result := DRAGDROP_S_USEDEFAULTCURSORS;
@ -762,7 +763,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult;
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult;
var
RButton,

13
components/virtualtreeview-new/trunk/include/intf/gtk2/vtgraphicsi.inc
View File

@ -1,12 +1,17 @@
uses
gtkdef, gdk2, GTKProc, Cairo;
gtk2def, gdk2, GTK2Proc, Cairo, LCLVersion;
{$MACRO ON}
{$if lcl_fullversion > 1000000}
{$define TGtk2DeviceContext:=TGtkDeviceContext}
{$endif}
function gdk_cairo_create(drawable: PGdkDrawable): Pcairo_t cdecl external gdklib;
procedure AlphaBlend(Source, Destination: HDC; const R: TRect; const Target: TPoint; Mode: TBlendMode; ConstantAlpha, Bias: Integer);
function GetContext(GtkDC: TGtkDeviceContext): Pcairo_t;
function GetContext(GtkDC: TGtk2DeviceContext): Pcairo_t;
begin
Result := nil;
if (GtkDC <> nil) and (GtkDC.Drawable <> nil) then
@ -14,8 +19,8 @@ procedure AlphaBlend(Source, Destination: HDC; const R: TRect; const Target: TPo
end;
var
SrcDC: TGtkDeviceContext absolute Source;
DestDC: TGtkDeviceContext absolute Destination;
SrcDC: TGtk2DeviceContext absolute Source;
DestDC: TGtk2DeviceContext absolute Destination;
SrcContext, DestContext: Pcairo_t;
begin
case Mode of

398
components/virtualtreeview-new/trunk/include/intf/qt/vtgraphicsi.inc
View File

@ -1,6 +1,8 @@
uses
qt4, qtobjects;
{$ASMMODE INTEL}
procedure AlphaBlendLineConstant(Source, Destination: Pointer; Count: Integer; ConstantAlpha, Bias: Integer);
// Blends a line of Count pixels from Source to Destination using a constant alpha value.
@ -8,13 +10,106 @@ procedure AlphaBlendLineConstant(Source, Destination: Pointer; Count: Integer; C
// ConstantAlpha must be in the range 0..255 where 0 means totally transparent (destination pixel only)
// and 255 totally opaque (source pixel only).
// Bias is an additional value which gets added to every component and must be in the range -128..127
//
asm
{$ifdef CPU64}
//windows
// RCX contains Source
// RDX contains Destination
// R8D contains Count
// R9D contains ConstantAlpha
// Bias is on the stack
//non windows
// RDI contains Source
// RSI contains Destination
// EDX contains Count
// ECX contains ConstantAlpha
// R8D contains Bias
//.NOFRAME
// Load XMM3 with the constant alpha value (replicate it for every component).
// Expand it to word size.
{$ifdef windows}
MOVD XMM3, R9D // ConstantAlpha
{$else}
MOVD XMM3, ECX // ConstantAlpha
{$endif}
PUNPCKLWD XMM3, XMM3
PUNPCKLDQ XMM3, XMM3
// Load XMM5 with the bias value.
{$ifdef windows}
MOVD XMM5, [Bias]
{$else}
MOVD XMM5, R8D //Bias
{$endif}
PUNPCKLWD XMM5, XMM5
PUNPCKLDQ XMM5, XMM5
// Load XMM4 with 128 to allow for saturated biasing.
MOV R10D, 128
MOVD XMM4, R10D
PUNPCKLWD XMM4, XMM4
PUNPCKLDQ XMM4, XMM4
@1: // The pixel loop calculates an entire pixel in one run.
// Note: The pixel byte values are expanded into the higher bytes of a word due
// to the way unpacking works. We compensate for this with an extra shift.
{$ifdef windows}
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
{$else}
MOVD XMM1, DWORD PTR [RDI] // data is unaligned
MOVD XMM2, DWORD PTR [RSI] // data is unaligned
{$endif}
PXOR XMM0, XMM0 // clear source pixel register for unpacking
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
PSRLW XMM0, 8 // move higher bytes to lower bytes
PXOR XMM1, XMM1 // clear target pixel register for unpacking
PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
PSRLW XMM1, 8 // move higher bytes to lower bytes
// calculation is: target = (alpha * (source - target) + 256 * target) / 256
PSUBW XMM0, XMM1 // source - target
PMULLW XMM0, XMM3 // alpha * (source - target)
PADDW XMM0, XMM2 // add target (in shifted form)
PSRLW XMM0, 8 // divide by 256
// Bias is accounted for by conversion of range 0..255 to -128..127,
// doing a saturated add and convert back to 0..255.
PSUBW XMM0, XMM4
PADDSW XMM0, XMM5
PADDW XMM0, XMM4
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
{$ifdef windows}
MOVD DWORD PTR [RDX], XMM0 // store the result
{$else}
MOVD DWORD PTR [RSI], XMM0 // store the result
{$endif}
@3:
{$ifdef windows}
ADD RCX, 4
ADD RDX, 4
DEC R8D
{$else}
ADD RDI, 4
ADD RSI, 4
DEC EDX
{$endif}
JNZ @1
{$else}
// EAX contains Source
// EDX contains Destination
// ECX contains Count
// ConstantAlpha and Bias are on the stack
asm
PUSH ESI // save used registers
PUSH EDI
@ -71,6 +166,7 @@ asm
JNZ @1
POP EDI
POP ESI
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -80,13 +176,100 @@ procedure AlphaBlendLinePerPixel(Source, Destination: Pointer; Count, Bias: Inte
// Blends a line of Count pixels from Source to Destination using the alpha value of the source pixels.
// The layout of a pixel must be BGRA.
// Bias is an additional value which gets added to every component and must be in the range -128..127
//
asm
{$ifdef CPU64}
//windows
// RCX contains Source
// RDX contains Destination
// R8D contains Count
// R9D contains Bias
//non windows
// RDI contains Source
// RSI contains Destination
// EDX contains Count
// ECX contains Bias
//.NOFRAME
// Load XMM5 with the bias value.
{$ifdef windows}
MOVD XMM5, R9D // Bias
{$else}
MOVD XMM5, ECX // Bias
{$endif}
PUNPCKLWD XMM5, XMM5
PUNPCKLDQ XMM5, XMM5
// Load XMM4 with 128 to allow for saturated biasing.
MOV R10D, 128
MOVD XMM4, R10D
PUNPCKLWD XMM4, XMM4
PUNPCKLDQ XMM4, XMM4
@1: // The pixel loop calculates an entire pixel in one run.
// Note: The pixel byte values are expanded into the higher bytes of a word due
// to the way unpacking works. We compensate for this with an extra shift.
{$ifdef windows}
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
{$else}
MOVD XMM1, DWORD PTR [RDI] // data is unaligned
MOVD XMM2, DWORD PTR [RSI] // data is unaligned
{$endif}
PXOR XMM0, XMM0 // clear source pixel register for unpacking
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
PSRLW XMM0, 8 // move higher bytes to lower bytes
PXOR XMM1, XMM1 // clear target pixel register for unpacking
PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
PSRLW XMM1, 8 // move higher bytes to lower bytes
// Load XMM3 with the source alpha value (replicate it for every component).
// Expand it to word size.
MOVQ XMM3, XMM0
PUNPCKHWD XMM3, XMM3
PUNPCKHDQ XMM3, XMM3
// calculation is: target = (alpha * (source - target) + 256 * target) / 256
PSUBW XMM0, XMM1 // source - target
PMULLW XMM0, XMM3 // alpha * (source - target)
PADDW XMM0, XMM2 // add target (in shifted form)
PSRLW XMM0, 8 // divide by 256
// Bias is accounted for by conversion of range 0..255 to -128..127,
// doing a saturated add and convert back to 0..255.
PSUBW XMM0, XMM4
PADDSW XMM0, XMM5
PADDW XMM0, XMM4
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
{$ifdef windows}
MOVD DWORD PTR [RDX], XMM0 // store the result
{$else}
MOVD DWORD PTR [RSI], XMM0 // store the result
{$endif}
@3:
{$ifdef windows}
ADD RCX, 4
ADD RDX, 4
DEC R8D
{$else}
ADD RDI, 4
ADD RSI, 4
DEC EDX
{$endif}
JNZ @1
{$else}
// EAX contains Source
// EDX contains Destination
// ECX contains Count
// Bias is on the stack
asm
PUSH ESI // save used registers
PUSH EDI
@ -142,6 +325,7 @@ asm
JNZ @1
POP EDI
POP ESI
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -152,13 +336,115 @@ procedure AlphaBlendLineMaster(Source, Destination: Pointer; Count: Integer; Con
// The layout of a pixel must be BGRA.
// ConstantAlpha must be in the range 0..255.
// Bias is an additional value which gets added to every component and must be in the range -128..127
//
asm
{$ifdef CPU64}
//windows
// RCX contains Source
// RDX contains Destination
// R8D contains Count
// R9D contains ConstantAlpha
// Bias is on the stack
//non windows
// RDI contains Source
// RSI contains Destination
// EDX contains Count
// ECX contains ConstantAlpha
// R8D contains Bias
//.SAVENV XMM6 //todo see how implement in fpc
// Load XMM3 with the constant alpha value (replicate it for every component).
// Expand it to word size.
{$ifdef windows}
MOVD XMM3, R9D // ConstantAlpha
{$else}
MOVD XMM3, ECX // ConstantAlpha
{$endif}
PUNPCKLWD XMM3, XMM3
PUNPCKLDQ XMM3, XMM3
// Load XMM5 with the bias value.
{$ifdef windows}
MOV R10D, [Bias]
MOVD XMM5, R10D
{$else}
MOVD XMM5, R8D
{$endif}
PUNPCKLWD XMM5, XMM5
PUNPCKLDQ XMM5, XMM5
// Load XMM4 with 128 to allow for saturated biasing.
MOV R10D, 128
MOVD XMM4, R10D
PUNPCKLWD XMM4, XMM4
PUNPCKLDQ XMM4, XMM4
@1: // The pixel loop calculates an entire pixel in one run.
// Note: The pixel byte values are expanded into the higher bytes of a word due
// to the way unpacking works. We compensate for this with an extra shift.
{$ifdef windows}
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
{$else}
MOVD XMM1, DWORD PTR [RDI] // data is unaligned
MOVD XMM2, DWORD PTR [RSI] // data is unaligned
{$endif}
PXOR XMM0, XMM0 // clear source pixel register for unpacking
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
PSRLW XMM0, 8 // move higher bytes to lower bytes
PXOR XMM1, XMM1 // clear target pixel register for unpacking
PUNPCKLBW XMM1, XMM2{[RCX]} // unpack target pixel byte values into words
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
PSRLW XMM1, 8 // move higher bytes to lower bytes
// Load XMM6 with the source alpha value (replicate it for every component).
// Expand it to word size.
MOVQ XMM6, XMM0
PUNPCKHWD XMM6, XMM6
PUNPCKHDQ XMM6, XMM6
PMULLW XMM6, XMM3 // source alpha * master alpha
PSRLW XMM6, 8 // divide by 256
// calculation is: target = (alpha * master alpha * (source - target) + 256 * target) / 256
PSUBW XMM0, XMM1 // source - target
PMULLW XMM0, XMM6 // alpha * (source - target)
PADDW XMM0, XMM2 // add target (in shifted form)
PSRLW XMM0, 8 // divide by 256
// Bias is accounted for by conversion of range 0..255 to -128..127,
// doing a saturated add and convert back to 0..255.
PSUBW XMM0, XMM4
PADDSW XMM0, XMM5
PADDW XMM0, XMM4
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
{$ifdef windows}
MOVD DWORD PTR [RDX], XMM0 // store the result
{$else}
MOVD DWORD PTR [RSI], XMM0 // store the result
{$endif}
@3:
{$ifdef windows}
ADD RCX, 4
ADD RDX, 4
DEC R8D
{$else}
ADD RDI, 4
ADD RSI, 4
DEC EDX
{$endif}
JNZ @1
{$else}
// EAX contains Source
// EDX contains Destination
// ECX contains Count
// ConstantAlpha and Bias are on the stack
asm
PUSH ESI // save used registers
PUSH EDI
@ -223,6 +509,7 @@ asm
JNZ @1
POP EDI
POP ESI
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -232,13 +519,94 @@ procedure AlphaBlendLineMasterAndColor(Destination: Pointer; Count: Integer; Con
// Blends a line of Count pixels in Destination against the given color using a constant alpha value.
// The layout of a pixel must be BGRA and Color must be rrggbb00 (as stored by a COLORREF).
// ConstantAlpha must be in the range 0..255.
//
asm
{$ifdef CPU64}
//windows
// RCX contains Destination
// EDX contains Count
// R8D contains ConstantAlpha
// R9D contains Color
//non windows
// RDI contains Destination
// ESI contains Count
// EDX contains ConstantAlpha
// ECX contains Color
//.NOFRAME
// The used formula is: target = (alpha * color + (256 - alpha) * target) / 256.
// alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance.
// The remaining calculation is therefore: target = (F1 + F2 * target) / 256
// Load XMM3 with the constant alpha value (replicate it for every component).
// Expand it to word size. (Every calculation here works on word sized operands.)
{$ifdef windows}
MOVD XMM3, R8D // ConstantAlpha
{$else}
MOVD XMM3, EDX // ConstantAlpha
{$endif}
PUNPCKLWD XMM3, XMM3
PUNPCKLDQ XMM3, XMM3
// Calculate factor 2.
MOV R10D, $100
MOVD XMM2, R10D
PUNPCKLWD XMM2, XMM2
PUNPCKLDQ XMM2, XMM2
PSUBW XMM2, XMM3 // XMM2 contains now: 255 - alpha = F2
// Now calculate factor 1. Alpha is still in XMM3, but the r and b components of Color must be swapped.
{$ifdef windows}
BSWAP R9D // Color
ROR R9D, 8
MOVD XMM1, R9D // Load the color and convert to word sized values.
{$else}
BSWAP ECX // Color
ROR ECX, 8
MOVD XMM1, ECX // Load the color and convert to word sized values.
{$endif}
PXOR XMM4, XMM4
PUNPCKLBW XMM1, XMM4
PMULLW XMM1, XMM3 // XMM1 contains now: color * alpha = F1
@1: // The pixel loop calculates an entire pixel in one run.
{$ifdef windows}
MOVD XMM0, DWORD PTR [RCX]
{$else}
MOVD XMM0, DWORD PTR [RDI]
{$endif}
PUNPCKLBW XMM0, XMM4
PMULLW XMM0, XMM2 // calculate F1 + F2 * target
PADDW XMM0, XMM1
PSRLW XMM0, 8 // divide by 256
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
{$ifdef windows}
MOVD DWORD PTR [RCX], XMM0 // store the result
ADD RCX, 4
DEC EDX
{$else}
MOVD DWORD PTR [RDI], XMM0 // store the result
ADD RDI, 4
DEC ESI
{$endif}
JNZ @1
{$else}
// EAX contains Destination
// EDX contains Count
// ECX contains ConstantAlpha
// Color is passed on the stack
asm
// The used formula is: target = (alpha * color + (256 - alpha) * target) / 256.
// alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance.
// The remaining calculation is therefore: target = (F1 + F2 * target) / 256
@ -279,6 +647,7 @@ asm
ADD EAX, 4
DEC EDX
JNZ @1
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -287,9 +656,17 @@ procedure EMMS;
// Reset MMX state to use the FPU for other tasks again.
{$ifdef CPU64}
inline;
begin
end;
{$else}
asm
DB $0F, $77 /// EMMS
end;
{$endif}
//----------------------------------------------------------------------------------------------------------------------
@ -386,6 +763,11 @@ var
begin
if not IsRectEmpty(R) then
begin
{$ifdef CPU64}
//avoid MasterAlpha due to incomplete AlphaBlendLineMaster. See comment in procedure
if Mode = bmMasterAlpha then
Mode := bmConstantAlpha;
{$endif}
// Note: it is tempting to optimize the special cases for constant alpha 0 and 255 by just ignoring soure
// (alpha = 0) or simply do a blit (alpha = 255). But this does not take the bias into account.
case Mode of

281
components/virtualtreeview-new/trunk/include/intf/win32/vtgraphicsi.inc
View File

@ -1,4 +1,6 @@
{$ASMMODE INTEL}
procedure AlphaBlendLineConstant(Source, Destination: Pointer; Count: Integer; ConstantAlpha, Bias: Integer);
// Blends a line of Count pixels from Source to Destination using a constant alpha value.
@ -6,13 +8,75 @@ procedure AlphaBlendLineConstant(Source, Destination: Pointer; Count: Integer; C
// ConstantAlpha must be in the range 0..255 where 0 means totally transparent (destination pixel only)
// and 255 totally opaque (source pixel only).
// Bias is an additional value which gets added to every component and must be in the range -128..127
//
asm
{$ifdef CPU64}
// RCX contains Source
// RDX contains Destination
// R8D contains Count
// R9D contains ConstantAlpha
// Bias is on the stack
//.NOFRAME
// Load XMM3 with the constant alpha value (replicate it for every component).
// Expand it to word size.
MOVD XMM3, R9D // ConstantAlpha
PUNPCKLWD XMM3, XMM3
PUNPCKLDQ XMM3, XMM3
// Load XMM5 with the bias value.
MOVD XMM5, [Bias]
PUNPCKLWD XMM5, XMM5
PUNPCKLDQ XMM5, XMM5
// Load XMM4 with 128 to allow for saturated biasing.
MOV R10D, 128
MOVD XMM4, R10D
PUNPCKLWD XMM4, XMM4
PUNPCKLDQ XMM4, XMM4
@1: // The pixel loop calculates an entire pixel in one run.
// Note: The pixel byte values are expanded into the higher bytes of a word due
// to the way unpacking works. We compensate for this with an extra shift.
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
PXOR XMM0, XMM0 // clear source pixel register for unpacking
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
PSRLW XMM0, 8 // move higher bytes to lower bytes
PXOR XMM1, XMM1 // clear target pixel register for unpacking
PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
PSRLW XMM1, 8 // move higher bytes to lower bytes
// calculation is: target = (alpha * (source - target) + 256 * target) / 256
PSUBW XMM0, XMM1 // source - target
PMULLW XMM0, XMM3 // alpha * (source - target)
PADDW XMM0, XMM2 // add target (in shifted form)
PSRLW XMM0, 8 // divide by 256
// Bias is accounted for by conversion of range 0..255 to -128..127,
// doing a saturated add and convert back to 0..255.
PSUBW XMM0, XMM4
PADDSW XMM0, XMM5
PADDW XMM0, XMM4
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
MOVD DWORD PTR [RDX], XMM0 // store the result
@3:
ADD RCX, 4
ADD RDX, 4
DEC R8D
JNZ @1
{$else}
// EAX contains Source
// EDX contains Destination
// ECX contains Count
// ConstantAlpha and Bias are on the stack
asm
PUSH ESI // save used registers
PUSH EDI
@ -69,6 +133,7 @@ asm
JNZ @1
POP EDI
POP ESI
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -78,13 +143,74 @@ procedure AlphaBlendLinePerPixel(Source, Destination: Pointer; Count, Bias: Inte
// Blends a line of Count pixels from Source to Destination using the alpha value of the source pixels.
// The layout of a pixel must be BGRA.
// Bias is an additional value which gets added to every component and must be in the range -128..127
//
asm
{$ifdef CPU64}
// RCX contains Source
// RDX contains Destination
// R8D contains Count
// R9D contains Bias
//.NOFRAME
// Load XMM5 with the bias value.
MOVD XMM5, R9D // Bias
PUNPCKLWD XMM5, XMM5
PUNPCKLDQ XMM5, XMM5
// Load XMM4 with 128 to allow for saturated biasing.
MOV R10D, 128
MOVD XMM4, R10D
PUNPCKLWD XMM4, XMM4
PUNPCKLDQ XMM4, XMM4
@1: // The pixel loop calculates an entire pixel in one run.
// Note: The pixel byte values are expanded into the higher bytes of a word due
// to the way unpacking works. We compensate for this with an extra shift.
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
PXOR XMM0, XMM0 // clear source pixel register for unpacking
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
PSRLW XMM0, 8 // move higher bytes to lower bytes
PXOR XMM1, XMM1 // clear target pixel register for unpacking
PUNPCKLBW XMM1, XMM2{[RDX]} // unpack target pixel byte values into words
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
PSRLW XMM1, 8 // move higher bytes to lower bytes
// Load XMM3 with the source alpha value (replicate it for every component).
// Expand it to word size.
MOVQ XMM3, XMM0
PUNPCKHWD XMM3, XMM3
PUNPCKHDQ XMM3, XMM3
// calculation is: target = (alpha * (source - target) + 256 * target) / 256
PSUBW XMM0, XMM1 // source - target
PMULLW XMM0, XMM3 // alpha * (source - target)
PADDW XMM0, XMM2 // add target (in shifted form)
PSRLW XMM0, 8 // divide by 256
// Bias is accounted for by conversion of range 0..255 to -128..127,
// doing a saturated add and convert back to 0..255.
PSUBW XMM0, XMM4
PADDSW XMM0, XMM5
PADDW XMM0, XMM4
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
MOVD DWORD PTR [RDX], XMM0 // store the result
@3:
ADD RCX, 4
ADD RDX, 4
DEC R8D
JNZ @1
{$else}
// EAX contains Source
// EDX contains Destination
// ECX contains Count
// Bias is on the stack
asm
PUSH ESI // save used registers
PUSH EDI
@ -140,6 +266,7 @@ asm
JNZ @1
POP EDI
POP ESI
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -150,13 +277,84 @@ procedure AlphaBlendLineMaster(Source, Destination: Pointer; Count: Integer; Con
// The layout of a pixel must be BGRA.
// ConstantAlpha must be in the range 0..255.
// Bias is an additional value which gets added to every component and must be in the range -128..127
//
asm
{$ifdef CPU64}
// RCX contains Source
// RDX contains Destination
// R8D contains Count
// R9D contains ConstantAlpha
// Bias is on the stack
//.SAVENV XMM6 //todo see how implement in fpc AlphaBlendLineMaster
// Load XMM3 with the constant alpha value (replicate it for every component).
// Expand it to word size.
MOVD XMM3, R9D // ConstantAlpha
PUNPCKLWD XMM3, XMM3
PUNPCKLDQ XMM3, XMM3
// Load XMM5 with the bias value.
MOV R10D, [Bias]
MOVD XMM5, R10D
PUNPCKLWD XMM5, XMM5
PUNPCKLDQ XMM5, XMM5
// Load XMM4 with 128 to allow for saturated biasing.
MOV R10D, 128
MOVD XMM4, R10D
PUNPCKLWD XMM4, XMM4
PUNPCKLDQ XMM4, XMM4
@1: // The pixel loop calculates an entire pixel in one run.
// Note: The pixel byte values are expanded into the higher bytes of a word due
// to the way unpacking works. We compensate for this with an extra shift.
MOVD XMM1, DWORD PTR [RCX] // data is unaligned
MOVD XMM2, DWORD PTR [RDX] // data is unaligned
PXOR XMM0, XMM0 // clear source pixel register for unpacking
PUNPCKLBW XMM0, XMM1{[RCX]} // unpack source pixel byte values into words
PSRLW XMM0, 8 // move higher bytes to lower bytes
PXOR XMM1, XMM1 // clear target pixel register for unpacking
PUNPCKLBW XMM1, XMM2{[RCX]} // unpack target pixel byte values into words
MOVQ XMM2, XMM1 // make a copy of the shifted values, we need them again
PSRLW XMM1, 8 // move higher bytes to lower bytes
// Load XMM6 with the source alpha value (replicate it for every component).
// Expand it to word size.
MOVQ XMM6, XMM0
PUNPCKHWD XMM6, XMM6
PUNPCKHDQ XMM6, XMM6
PMULLW XMM6, XMM3 // source alpha * master alpha
PSRLW XMM6, 8 // divide by 256
// calculation is: target = (alpha * master alpha * (source - target) + 256 * target) / 256
PSUBW XMM0, XMM1 // source - target
PMULLW XMM0, XMM6 // alpha * (source - target)
PADDW XMM0, XMM2 // add target (in shifted form)
PSRLW XMM0, 8 // divide by 256
// Bias is accounted for by conversion of range 0..255 to -128..127,
// doing a saturated add and convert back to 0..255.
PSUBW XMM0, XMM4
PADDSW XMM0, XMM5
PADDW XMM0, XMM4
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
MOVD DWORD PTR [RDX], XMM0 // store the result
@3:
ADD RCX, 4
ADD RDX, 4
DEC R8D
JNZ @1
{$else}
// EAX contains Source
// EDX contains Destination
// ECX contains Count
// ConstantAlpha and Bias are on the stack
asm
PUSH ESI // save used registers
PUSH EDI
@ -221,6 +419,7 @@ asm
JNZ @1
POP EDI
POP ESI
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -230,13 +429,65 @@ procedure AlphaBlendLineMasterAndColor(Destination: Pointer; Count: Integer; Con
// Blends a line of Count pixels in Destination against the given color using a constant alpha value.
// The layout of a pixel must be BGRA and Color must be rrggbb00 (as stored by a COLORREF).
// ConstantAlpha must be in the range 0..255.
//
asm
{$ifdef CPU64}
// RCX contains Destination
// EDX contains Count
// R8D contains ConstantAlpha
// R9D contains Color
//.NOFRAME
// The used formula is: target = (alpha * color + (256 - alpha) * target) / 256.
// alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance.
// The remaining calculation is therefore: target = (F1 + F2 * target) / 256
// Load XMM3 with the constant alpha value (replicate it for every component).
// Expand it to word size. (Every calculation here works on word sized operands.)
MOVD XMM3, R8D // ConstantAlpha
PUNPCKLWD XMM3, XMM3
PUNPCKLDQ XMM3, XMM3
// Calculate factor 2.
MOV R10D, $100
MOVD XMM2, R10D
PUNPCKLWD XMM2, XMM2
PUNPCKLDQ XMM2, XMM2
PSUBW XMM2, XMM3 // XMM2 contains now: 255 - alpha = F2
// Now calculate factor 1. Alpha is still in XMM3, but the r and b components of Color must be swapped.
BSWAP R9D // Color
ROR R9D, 8
MOVD XMM1, R9D // Load the color and convert to word sized values.
PXOR XMM4, XMM4
PUNPCKLBW XMM1, XMM4
PMULLW XMM1, XMM3 // XMM1 contains now: color * alpha = F1
@1: // The pixel loop calculates an entire pixel in one run.
MOVD XMM0, DWORD PTR [RCX]
PUNPCKLBW XMM0, XMM4
PMULLW XMM0, XMM2 // calculate F1 + F2 * target
PADDW XMM0, XMM1
PSRLW XMM0, 8 // divide by 256
PACKUSWB XMM0, XMM0 // convert words to bytes with saturation
MOVD DWORD PTR [RCX], XMM0 // store the result
ADD RCX, 4
DEC EDX
JNZ @1
{$else}
// EAX contains Destination
// EDX contains Count
// ECX contains ConstantAlpha
// Color is passed on the stack
asm
// The used formula is: target = (alpha * color + (256 - alpha) * target) / 256.
// alpha * color (factor 1) and 256 - alpha (factor 2) are constant values which can be calculated in advance.
// The remaining calculation is therefore: target = (F1 + F2 * target) / 256
@ -277,6 +528,7 @@ asm
ADD EAX, 4
DEC EDX
JNZ @1
{$endif}
end;
//----------------------------------------------------------------------------------------------------------------------
@ -285,9 +537,17 @@ procedure EMMS;
// Reset MMX state to use the FPU for other tasks again.
{$ifdef CPU64}
inline;
begin
end;
{$else}
asm
DB $0F, $77 /// EMMS
end;
{$endif}
//----------------------------------------------------------------------------------------------------------------------
@ -383,6 +643,11 @@ var
begin
if not IsRectEmpty(R) then
begin
{$ifdef CPU64}
//avoid MasterAlpha due to incomplete AlphaBlendLineMaster. See comment in procedure
if Mode = bmMasterAlpha then
Mode := bmConstantAlpha;
{$endif}
// Note: it is tempting to optimize the special cases for constant alpha 0 and 255 by just ignoring soure
// (alpha = 0) or simply do a blit (alpha = 255). But this does not take the bias into account.
case Mode of

14
components/virtualtreeview-new/trunk/include/intf/win32/vtvdragmanager.inc
View File

@ -481,7 +481,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDataObject.SetData(const FormatEtc: TFormatEtc; {$ifdef VER2_0}var{$else}const{$endif} Medium: TStgMedium; DoRelease: BOOL): HResult;
function TVTDataObject.SetData(const FormatEtc: TFormatEtc; const Medium: TStgMedium; DoRelease: BOOL): HResult;
// Allows dynamic adding to the IDataObject during its existance. Most noteably it is used to implement
// IDropSourceHelper and allows to set a special format for optimized moves during a shell transfer.
@ -686,7 +686,11 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.GiveFeedback(Effect: Integer): HResult;
{$IF FPC_FULLVERSION < 020601}
function TVTDragManager.GiveFeedback(Effect: Longint): HResult;
{$ELSE}
function TVTDragManager.GiveFeedback(Effect: LongWord): HResult;
{$ENDIF}
begin
Result := DRAGDROP_S_USEDEFAULTCURSORS;
@ -694,7 +698,11 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult;
{$IF FPC_FULLVERSION < 020601}
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Longint): HResult;
{$ELSE}
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult;
{$ENDIF}
var
RButton,

18
components/virtualtreeview-new/trunk/units/carbon/virtualdragmanager.pas
View File

@ -291,8 +291,8 @@ type
IDropSource = interface(IUnknown)
['{00000121-0000-0000-C000-000000000046}']
function QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint):HResult;StdCall;
function GiveFeedback(dwEffect: Longint): HResult;StdCall;
grfKeyState: LongWord):HResult;StdCall;
function GiveFeedback(dwEffect: LongWord): HResult;StdCall;
end;
@ -332,10 +332,10 @@ type
IDropTargetHelper = interface(IUnknown)
[SID_IDropTargetHelper]
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function DragLeave: HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Show(fShow: Boolean): HRESULT; stdcall;
end;
@ -434,8 +434,8 @@ type
function DragOver(KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
function Drop(const DataObject: IDataObject; KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
procedure ForceDragLeave; stdcall;
function GiveFeedback(Effect: Integer): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall;
function GiveFeedback(Effect: LongWord): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult; stdcall;
end;
//Ole helper functions
@ -1583,7 +1583,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.GiveFeedback(Effect: Integer): HResult;
function TVTDragManager.GiveFeedback(Effect: LongWord): HResult;
begin
{$ifdef DEBUG_VTV}Logger.SendError([lcOle],'Ole function called in Linux');{$endif}
@ -1593,7 +1593,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult;
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult;
var
RButton,

4
components/virtualtreeview-new/trunk/units/dummyactivex.inc
View File

@ -281,8 +281,8 @@ type
IDropSource = interface(IUnknown)
['{00000121-0000-0000-C000-000000000046}']
function QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint):HResult;StdCall;
function GiveFeedback(dwEffect: Longint): HResult;StdCall;
grfKeyState: DWORD):HResult;StdCall;
function GiveFeedback(dwEffect: DWORD): HResult;StdCall;
end;

18
components/virtualtreeview-new/trunk/units/gtk/virtualdragmanager.pas
View File

@ -291,8 +291,8 @@ type
IDropSource = interface(IUnknown)
['{00000121-0000-0000-C000-000000000046}']
function QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint):HResult;StdCall;
function GiveFeedback(dwEffect: Longint): HResult;StdCall;
grfKeyState: LongWord):HResult;StdCall;
function GiveFeedback(dwEffect: LongWord): HResult;StdCall;
end;
@ -332,10 +332,10 @@ type
IDropTargetHelper = interface(IUnknown)
[SID_IDropTargetHelper]
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function DragLeave: HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Show(fShow: Boolean): HRESULT; stdcall;
end;
@ -434,8 +434,8 @@ type
function DragOver(KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
function Drop(const DataObject: IDataObject; KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
procedure ForceDragLeave; stdcall;
function GiveFeedback(Effect: Integer): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall;
function GiveFeedback(Effect: LongWord): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult; stdcall;
end;
//Ole helper functions
@ -1583,7 +1583,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.GiveFeedback(Effect: Integer): HResult;
function TVTDragManager.GiveFeedback(Effect: LongWord): HResult;
begin
{$ifdef DEBUG_VTV}Logger.SendError([lcOle],'Ole function called in Linux');{$endif}
@ -1593,7 +1593,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult;
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult;
var
RButton,

12
components/virtualtreeview-new/trunk/units/gtk2/fakemmsystem.pas
View File

@ -5,7 +5,7 @@ unit fakemmsystem;
interface
uses
Classes, SysUtils, Types;
Classes, SysUtils, Types, LCLIntf;
function timeBeginPeriod(x1: DWord): DWord;
@ -17,21 +17,17 @@ implementation
function timeBeginPeriod(x1: DWord): DWord;
begin
//
end;
function timeEndPeriod(x1: DWord): DWord;
begin
//
end;
function timeGetTime: DWORD;
var
ATime: TSystemTime;
begin
//todo: properly implement
GetLocalTime(ATime);
Result := ATime.MilliSecond;
Result := GetTickCount;
end;
end.

18
components/virtualtreeview-new/trunk/units/gtk2/virtualdragmanager.pas
View File

@ -291,8 +291,8 @@ type
IDropSource = interface(IUnknown)
['{00000121-0000-0000-C000-000000000046}']
function QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint):HResult;StdCall;
function GiveFeedback(dwEffect: Longint): HResult;StdCall;
grfKeyState: LongWord):HResult;StdCall;
function GiveFeedback(dwEffect: LongWord): HResult;StdCall;
end;
@ -332,10 +332,10 @@ type
IDropTargetHelper = interface(IUnknown)
[SID_IDropTargetHelper]
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function DragLeave: HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Show(fShow: Boolean): HRESULT; stdcall;
end;
@ -434,8 +434,8 @@ type
function DragOver(KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
function Drop(const DataObject: IDataObject; KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
procedure ForceDragLeave; stdcall;
function GiveFeedback(Effect: Integer): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall;
function GiveFeedback(Effect: LongWord): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult; stdcall;
end;
//Ole helper functions
@ -1583,7 +1583,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.GiveFeedback(Effect: Integer): HResult;
function TVTDragManager.GiveFeedback(Effect: LongWord): HResult;
begin
{$ifdef DEBUG_VTV}Logger.SendError([lcOle],'Ole function called in Linux');{$endif}
@ -1593,7 +1593,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult;
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult;
var
RButton,

18
components/virtualtreeview-new/trunk/units/qt/virtualdragmanager.pas
View File

@ -291,8 +291,8 @@ type
IDropSource = interface(IUnknown)
['{00000121-0000-0000-C000-000000000046}']
function QueryContinueDrag(fEscapePressed: BOOL;
grfKeyState: Longint):HResult;StdCall;
function GiveFeedback(dwEffect: Longint): HResult;StdCall;
grfKeyState: LongWord):HResult;StdCall;
function GiveFeedback(dwEffect: LongWord): HResult;StdCall;
end;
@ -332,10 +332,10 @@ type
IDropTargetHelper = interface(IUnknown)
[SID_IDropTargetHelper]
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function DragLeave: HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Show(fShow: Boolean): HRESULT; stdcall;
end;
@ -434,8 +434,8 @@ type
function DragOver(KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
function Drop(const DataObject: IDataObject; KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
procedure ForceDragLeave; stdcall;
function GiveFeedback(Effect: Integer): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall;
function GiveFeedback(Effect: LongWord): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult; stdcall;
end;
//Ole helper functions
@ -1583,7 +1583,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.GiveFeedback(Effect: Integer): HResult;
function TVTDragManager.GiveFeedback(Effect: LongWord): HResult;
begin
{$ifdef DEBUG_VTV}Logger.SendError([lcOle],'Ole function called in Linux');{$endif}
@ -1593,7 +1593,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult;
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult;
var
RButton,

14
components/virtualtreeview-new/trunk/units/win32/virtualdragmanager.pas
View File

@ -71,10 +71,10 @@ type
IDropTargetHelper = interface(IUnknown)
[SID_IDropTargetHelper]
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragEnter(hwndTarget: HWND; pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function DragLeave: HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: Integer): HRESULT; stdcall;
function DragOver(var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Drop(pDataObject: IDataObject; var ppt: TPoint; dwEffect: LongWord): HRESULT; stdcall;
function Show(fShow: Boolean): HRESULT; stdcall;
end;
@ -173,8 +173,8 @@ type
function DragOver(KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
function Drop(const DataObject: IDataObject; KeyState: LongWord; Pt: TPoint; var Effect: LongWord): HResult; stdcall;
procedure ForceDragLeave; stdcall;
function GiveFeedback(Effect: Integer): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult; stdcall;
function GiveFeedback(Effect: LongWord): HResult; stdcall;
function QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult; stdcall;
end;
//Ole helper functions
@ -1100,7 +1100,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.GiveFeedback(Effect: Integer): HResult;
function TVTDragManager.GiveFeedback(Effect: LongWord): HResult;
begin
Result := DRAGDROP_S_USEDEFAULTCURSORS;
@ -1108,7 +1108,7 @@ end;
//----------------------------------------------------------------------------------------------------------------------
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: Integer): HResult;
function TVTDragManager.QueryContinueDrag(EscapePressed: BOOL; KeyState: LongWord): HResult;
var
RButton,

2
components/virtualtreeview-new/trunk/units/win32/virtualpanningwindow.pas
View File

@ -38,7 +38,7 @@ var
begin
if Msg = WM_PAINT then
begin
PanningObject:=TVirtualPanningWindow(GetWindowLong(Window,GWL_USERDATA));
PanningObject:=TVirtualPanningWindow(GetWindowLongPtrW(Window,GWL_USERDATA));
if Assigned(PanningObject) then
PanningObject.HandlePaintMessage;
end

32
components/virtualtreeview-new/trunk/virtualtreeview_package.lpk
View File

@ -1,24 +1,30 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<Package Version="4">
<Name Value="virtualtreeview_package"/>
<Author Value="Mike Lischke (LCL Port: Luiz Americo)"/>
<AddToProjectUsesSection Value="True"/>
<Author Value="Mike Lischke (LCL Port: Luiz Am�rico)"/>
<CompilerOptions>
<Version Value="8"/>
<Version Value="11"/>
<SearchPaths>
<IncludeFiles Value="include/intf/$(LCLWidgetType)/;units/;include/intf/"/>
<OtherUnitFiles Value="units/$(LCLWidgetType)/"/>
<IncludeFiles Value="include/intf/$(LCLWidgetType);units;include/intf"/>
<OtherUnitFiles Value="units/$(LCLWidgetType)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)-$(LCLWidgetType)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<UseAnsiStrings Value="False"/>
</SyntaxOptions>
</Parsing>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Virtual Treeview is an advanced component originally created for Delphi
"/>
<License Value=" Moziall Public License 1.1 (MPL 1.1) or GNU Lesser General Public License
<License Value=" Mozilla Public License 1.1 (MPL 1.1) or GNU Lesser General Public License
"/>
<Version Major="4" Minor="5" Release="1"/>
<Version Major="4" Minor="8" Release="7" Build="3"/>
<Files Count="7">
<Item1>
<Filename Value="virtualtrees.lrs"/>
@ -51,19 +57,17 @@
</Item7>
</Files>
<Type Value="RunAndDesignTime"/>
<RequiredPkgs Count="3">
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="multiloglaz"/>
<PackageName Value="lclextensions_package"/>
<MinVersion Minor="5" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="lclextensions_package"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)/"/>
<UnitPath Value="$(PkgOutDir)"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>

2
components/virtualtreeview-new/trunk/virtualtreeview_package.pas
View File

@ -1,4 +1,4 @@
{ This file was automatically created by Lazarus. do not edit !
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}