1
0
mirror of synced 2024-06-16 11:07:40 +00:00

Added: start of colour editor in button function form

This commit is contained in:
Mark van Renswoude 2013-02-17 10:39:25 +00:00
parent 32f411c1b8
commit 59fc110814
5 changed files with 335 additions and 22 deletions

View File

@ -72,10 +72,13 @@ object ButtonFunctionForm: TButtonFunctionForm
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
TabOrder = 1
TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoSort, toAutoTristateTracking, toAutoDeleteMovedNodes]
TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toInitOnSave, toWheelPanning, toEditOnClick]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowTreeLines, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toFullRowSelect]
OnFocusChanged = vstFunctionsFocusChanged
OnGetText = vstFunctionsGetText
OnPaintText = vstFunctionsPaintText
ExplicitTop = 5
Columns = <
item
Position = 0
@ -98,9 +101,9 @@ object ButtonFunctionForm: TButtonFunctionForm
TabOrder = 2
object vstStates: TVirtualStringTree
Left = 0
Top = 113
Top = 81
Width = 411
Height = 239
Height = 271
Align = alClient
Header.AutoSizeIndex = 0
Header.Font.Charset = DEFAULT_CHARSET
@ -108,8 +111,16 @@ object ButtonFunctionForm: TButtonFunctionForm
Header.Font.Height = -11
Header.Font.Name = 'Tahoma'
Header.Font.Style = []
Header.MainColumn = 1
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible]
TabOrder = 0
TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning]
TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect]
OnChange = vstStatesChange
OnCreateEditor = vstStatesCreateEditor
OnEditing = vstStatesEditing
OnGetText = vstStatesGetText
Columns = <
item
Position = 0
@ -119,20 +130,20 @@ object ButtonFunctionForm: TButtonFunctionForm
item
Position = 1
Width = 200
WideText = 'Color'
WideText = 'Colour'
end>
end
object pnlName: TPanel
Left = 0
Top = 0
Width = 411
Height = 113
Height = 81
Align = alTop
BevelOuter = bvNone
TabOrder = 1
DesignSize = (
411
113)
81)
object lblFunctionName: TLabel
Left = 0
Top = 19
@ -157,11 +168,17 @@ object ButtonFunctionForm: TButtonFunctionForm
Anchors = [akLeft, akTop, akRight]
AutoSize = False
Caption = 'runtime: category'
Font.Charset = DEFAULT_CHARSET
Font.Color = clGrayText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
ExplicitWidth = 401
end
object lblHasStates: TLabel
Left = 0
Top = 74
Top = 47
Width = 401
Height = 31
AutoSize = False
@ -173,7 +190,7 @@ object ButtonFunctionForm: TButtonFunctionForm
end
object lblNoStates: TLabel
Left = 0
Top = 55
Top = 47
Width = 195
Height = 13
Caption = 'This function has no configurable states.'

View File

@ -8,12 +8,18 @@ uses
Vcl.Forms,
Vcl.Graphics,
Vcl.StdCtrls,
Winapi.Messages,
VirtualTrees,
LEDFunctionIntf,
Profile;
const
WM_STARTEDITING = WM_USER + 1;
type
TButtonFunctionForm = class(TForm)
pnlButtons: TPanel;
@ -32,11 +38,22 @@ type
procedure FormDestroy(Sender: TObject);
procedure vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vstFunctionsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
procedure vstFunctionsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
procedure vstStatesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
procedure vstStatesChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure vstStatesCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure vstStatesEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
private
FButtonIndex: Integer;
FProfile: TProfile;
protected
procedure WMStartEditing(var Msg: TMessage); message WM_STARTEDITING;
protected
procedure LoadFunctions;
procedure SetFunction(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction);
procedure LoadStates(AFunction: ILEDMultiStateFunction);
property ButtonIndex: Integer read FButtonIndex write FButtonIndex;
property Profile: TProfile read FProfile write FProfile;
@ -47,22 +64,36 @@ type
implementation
uses
System.SysUtils,
Generics.Collections,
System.SysUtils,
Winapi.Windows,
LEDFunctionIntf,
LEDFunctionRegistry;
ColourEditor,
LEDFunctionRegistry,
LEDStateIntf;
type
TNodeType = (ntCategory, ntFunction);
TNodeData = record
NodeType: TNodeType;
TFunctionNodeType = (ntCategory, ntFunction);
TFunctionNodeData = record
NodeType: TFunctionNodeType;
Provider: ILEDFunctionProvider;
LEDFunction: ILEDFunction;
end;
PNodeData = ^TNodeData;
PFunctionNodeData = ^TFunctionNodeData;
TStateNodeData = record
State: ILEDState;
end;
PStateNodeData = ^TStateNodeData;
const
ColumnState = 0;
ColumnColour = 1;
{$R *.dfm}
@ -84,9 +115,8 @@ end;
procedure TButtonFunctionForm.FormCreate(Sender: TObject);
begin
vstFunctions.NodeDataSize := SizeOf(TNodeData);
lblNoStates.Top := lblHasStates.Top;
vstFunctions.NodeDataSize := SizeOf(TFunctionNodeData);
vstStates.NodeDataSize := SizeOf(TStateNodeData);
lblCategoryName.Caption := '';
lblFunctionName.Caption := '';
@ -108,7 +138,7 @@ var
function GetCategoryNode(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction): PVirtualNode;
var
category: string;
nodeData: PNodeData;
nodeData: PFunctionNodeData;
begin
category := AFunction.GetCategoryName;
@ -130,7 +160,7 @@ var
var
node: PVirtualNode;
nodeData: PNodeData;
nodeData: PFunctionNodeData;
provider: ILEDFunctionProvider;
ledFunction: ILEDFunction;
@ -162,10 +192,88 @@ begin
end;
procedure TButtonFunctionForm.SetFunction(AProvider: ILEDFunctionProvider; AFunction: ILEDFunction);
var
multiStateFunction: ILEDMultiStateFunction;
begin
lblCategoryName.Caption := AFunction.GetCategoryName;
lblFunctionName.Caption := AFunction.GetDisplayName;
if Supports(AFunction, ILEDMultiStateFunction, multiStateFunction) then
begin
lblNoStates.Visible := False;
lblHasStates.Visible := True;
LoadStates(multiStateFunction);
vstStates.Visible := True;
end else
begin
lblNoStates.Visible := True;
lblHasStates.Visible := False;
vstStates.Visible := False;
vstStates.Clear;
end;
end;
procedure TButtonFunctionForm.LoadStates(AFunction: ILEDMultiStateFunction);
var
node: PVirtualNode;
nodeData: PStateNodeData;
state: ILEDState;
begin
vstStates.BeginUpdate;
try
vstStates.Clear;
for state in AFunction do
begin
node := vstStates.AddChild(nil);
nodeData := vstStates.GetNodeData(node);
nodeData^.State := state;
end;
finally
vstStates.EndUpdate;
end;
end;
procedure TButtonFunctionForm.vstFunctionsFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex);
var
nodeData: PFunctionNodeData;
functionNode: PVirtualNode;
begin
if Assigned(Node) then
begin
nodeData := Sender.GetNodeData(Node);
case nodeData^.NodeType of
ntCategory:
begin
{ Select first child (function) node instead }
functionNode := Sender.GetFirstChild(Node);
if not Assigned(functionNode) then
exit;
Sender.FocusedNode := functionNode;
Sender.Selected[functionNode] := True;
end;
ntFunction:
SetFunction(nodeData^.Provider, nodeData^.LEDFunction);
end;
end;
end;
procedure TButtonFunctionForm.vstFunctionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
var
nodeData: PNodeData;
nodeData: PFunctionNodeData;
begin
nodeData := Sender.GetNodeData(Node);
@ -180,7 +288,7 @@ end;
procedure TButtonFunctionForm.vstFunctionsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType);
var
nodeData: PNodeData;
nodeData: PFunctionNodeData;
begin
nodeData := Sender.GetNodeData(Node);
@ -191,4 +299,49 @@ begin
TargetCanvas.Font.Style := [];
end;
procedure TButtonFunctionForm.vstStatesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
TextType: TVSTTextType; var CellText: string);
var
nodeData: PStateNodeData;
begin
nodeData := Sender.GetNodeData(Node);
case Column of
ColumnState: CellText := nodeData^.State.GetDisplayName;
ColumnColour: CellText := 'Red';
end;
end;
procedure TButtonFunctionForm.vstStatesChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
if Assigned(Node) and not (tsIncrementalSearching in Sender.TreeStates) then
PostMessage(Self.Handle, WM_STARTEDITING, WPARAM(Node), 0);
end;
procedure TButtonFunctionForm.vstStatesCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; out EditLink: IVTEditLink);
begin
EditLink := TVTColourEditor.Create;
end;
procedure TButtonFunctionForm.vstStatesEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
Allowed := True;
end;
procedure TButtonFunctionForm.WMStartEditing(var Msg: TMessage);
var
node: PVirtualNode;
begin
node := Pointer(Msg.WParam);
vstStates.EditNode(Node, 1);
end;
end.

View File

@ -29,7 +29,8 @@ uses
FSXLEDFunction in 'Units\FSXLEDFunction.pas',
StaticResources in 'Units\StaticResources.pas',
FSXResources in 'Units\FSXResources.pas',
FSXSimConnectClient in 'Units\FSXSimConnectClient.pas';
FSXSimConnectClient in 'Units\FSXSimConnectClient.pas',
ColourEditor in 'Units\ColourEditor.pas';
{$R *.res}

View File

@ -195,6 +195,7 @@
<DCCReference Include="Units\StaticResources.pas"/>
<DCCReference Include="Units\FSXResources.pas"/>
<DCCReference Include="Units\FSXSimConnectClient.pas"/>
<DCCReference Include="Units\ColourEditor.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>

View File

@ -0,0 +1,141 @@
unit ColourEditor;
interface
uses
System.Types,
System.Classes,
Vcl.StdCtrls,
Winapi.Messages,
VirtualTrees;
type
TVTColourEditor = class(TInterfacedObject, IVTEditLink)
private
FEdit: TComboBox;
FTree: TBaseVirtualTree;
FColumn: TColumnIndex;
protected
procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
protected
{ IVTEditLink }
function BeginEdit: Boolean; stdcall;
function CancelEdit: Boolean; stdcall;
function EndEdit: Boolean; stdcall;
function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
procedure ProcessMessage(var Message: TMessage); stdcall;
function GetBounds: TRect; stdcall;
procedure SetBounds(R: TRect); stdcall;
public
destructor Destroy; override;
end;
implementation
uses
System.SysUtils,
Winapi.Windows;
{ TVTColourEditor }
destructor TVTColourEditor.Destroy;
begin
FreeAndNil(FEdit);
inherited;
end;
function TVTColourEditor.BeginEdit: Boolean;
begin
Result := True;
FEdit.Show;
FEdit.SetFocus;
end;
function TVTColourEditor.CancelEdit: Boolean;
begin
Result := True;
FEdit.Hide;
end;
function TVTColourEditor.EndEdit: Boolean;
begin
Result := True;
// TODO update node data
end;
function TVTColourEditor.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
begin
Result := True;
FTree := Tree;
// FNode := Node;
FColumn := Column;
FreeAndNil(FEdit);
FEdit := TComboBox.Create(nil);
FEdit.Visible := False;
FEdit.Parent := Tree;
// FEdit.Text := Data.Value;
// FEdit.Items.Add();
FEdit.OnKeyDown := EditKeyDown;
end;
procedure TVTColourEditor.ProcessMessage(var Message: TMessage);
begin
FEdit.WindowProc(Message);
end;
function TVTColourEditor.GetBounds: TRect;
begin
Result := FEdit.BoundsRect;
end;
procedure TVTColourEditor.SetBounds(R: TRect);
var
dummy: Integer;
begin
(FTree as TVirtualStringTree).Header.Columns.GetColumnBounds(FColumn, dummy, R.Right);
FEdit.BoundsRect := R;
end;
procedure TVTColourEditor.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
case Key of
VK_ESCAPE:
begin
FTree.CancelEditNode;
Key := 0;
end;
VK_RETURN:
begin
FTree.EndEditNode;
Key := 0;
end;
VK_UP,
VK_DOWN:
if (Shift = []) and (not FEdit.DroppedDown) then
begin
PostMessage(FTree.Handle, WM_KEYDOWN, Key, 0);
Key := 0;
end;
end;
end;
end.