lazarus-ccr/components/virtualtreeview-unstable/demos/vtbasic/VTEditors.pas

unit VTEditors;

{$mode delphi}
{$H+}

// Utility unit for the advanced Virtual Treeview demo application which contains the implementation of edit link
// interfaces used in other samples of the demo.

interface

   uses
      LCLIntf,LCLType, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
      StdCtrls, VirtualTrees, ExtDlgs, ImgList, Buttons, ExtCtrls, ComCtrls, MaskEdit, LResources, EditBtn;

   type
      // Describes the type of value a property tree node stores in its data property.
      TValueType = 
      (
         vtNone,
         vtString,
         vtPickString,
         vtNumber,
         vtPickNumber,
         vtMemo,
         vtDate
      );

   type
      // Node data record for the the document properties treeview.
      TPropertyData = 
      record
         ValueType: TValueType;
         Value    : WideString;      // This value can actually be a date or a number too.
         Changed  : Boolean;
      end;
      PPropertyData = ^TPropertyData;

      // Our own edit link to implement several different node editors.
      TPropertyEditLink = 
      class(TInterfacedObject, IVTEditLink)
         private
         FEdit: TWinControl;        // One of the property editor classes.
         FTree: TVirtualStringTree; // A back reference to the tree calling.
         FNode: PVirtualNode;       // The node being edited.
         FColumn: Integer;          // The column of the node being edited.
         FOldEditProc: TWndMethod;  // Used to capture some important messages
                   // regardless of the type of edit control we use.
         FListItems  : TStringList;        // One of the property editor classes.
                   
         protected
         procedure EditWindowProc(var Message: TMessage);
         procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
         
         public
         constructor Create;
         destructor Destroy; override;

         function BeginEdit: Boolean; stdcall;
         function CancelEdit: Boolean; stdcall;
         function EndEdit: Boolean; stdcall;
         function GetBounds: TRect; stdcall;
         function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
         procedure ProcessMessage(var Message: TMessage); stdcall;
         procedure SetBounds(R: TRect); stdcall;
      end;

   type
      TPropertyTextKind = 
      (
         ptkText,
         ptkHint
      );

      TGridData = 
      record
         ValueType: array[0..3] of TValueType; // one for each column
         Value    : array[0..3] of Variant;
         Changed  : Boolean;
      end;
      PGridData = ^TGridData;

      // Our own edit link to implement several different node editors.
      TGridEditLink = 
      class(TPropertyEditLink, IVTEditLink)
         public
         function EndEdit: Boolean; stdcall;
         function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean; stdcall;
      end;

   function ShowForm( afc : TFormClass; iLeft : integer = -1; iTop : integer = -1 ) : TForm;
   function FindAppForm ( afc : TFormClass ) : TForm;
   procedure ConvertToHighColor(ImageList: TImageList);
      
implementation

   uses
      CommCtrl;
   (*
   uses
      PropertiesDemo, GridDemo;
   *)      

   {---------------------------------------------------------------
                     utility functions
   ---------------------------------------------------------------}
   function ShowForm( afc : TFormClass; iLeft : integer = -1; iTop : integer = -1 ) : TForm;
   begin        
      Result := FindAppForm( afc );
      if Result = nil then 
      begin
         Result := afc.Create(Application);
         if (iLeft <> -1) then Result.left  := iLeft;
         if (iTop  <> -1) then Result.top   := iTop ;
      end;   
      Result.Show;
   end;         

   
   function FindAppForm ( afc : TFormClass ) : TForm;
   var
      i : integer;
   begin
      Result := nil;
      for i := Screen.FormCount-1 downto 0 do
      begin
         if (Screen.Forms[i] is afc) then
         begin
            Result := Screen.Forms[i];
            break;
         end;   
      end;   
   end;   
   
   procedure ConvertToHighColor(ImageList: TImageList);
   // To show smooth images we have to convert the image list from 16 colors to high color.
   var
     IL: TImageList;
   begin
     //todo: properly implement
     // Have to create a temporary copy of the given list, because the list is cleared on handle creation.
     {
     IL := TImageList.Create(nil);
     IL.Assign(ImageList);


     //with ImageList do
     //  Handle := ImageList_Create(Width, Height, ILC_COLOR16 or ILC_MASK, Count, AllocBy);
     ImageList.Assign(IL);
     IL.Free;
     }
   end;
   
   (*-------------------------------------------------------------------
                        TPropertyEditLink
   -------------------------------------------------------------------*)
   // This implementation is used in VST3 to make a connection beween the tree
   // and the actual edit window which might be a simple edit, a combobox or a memo etc.
   constructor TPropertyEditLink.Create;
   begin
      inherited;
      FListItems  := TStringList.Create;        // One of the property editor classes.
   end;

   destructor TPropertyEditLink.Destroy;
   begin
      FEdit.Free;
      FListItems.Free;
      inherited;
   end;

   
   function TPropertyEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
   var
     Data: PPropertyData;
   begin
     Result := True;
     FTree := Tree as TVirtualStringTree;
     FNode := Node;
     FColumn := Column;

     // determine what edit type actually is needed
     FEdit.Free;
     FEdit := nil;
     Data := FTree.GetNodeData(Node);
     case Data.ValueType of
       vtString:
         begin
           FEdit := TEdit.Create(nil);
           with FEdit as TEdit do
           begin
             Visible := False;
             Parent := Tree;
             Text := Data.Value;
             BorderStyle := bsNone;
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtPickString:
         begin
           FEdit := TComboBox.Create(nil);
           with FEdit as TComboBox do
           begin
             //BorderStyle := bsNone;
             Visible := False;
             Parent := Tree;
             Text := Data.Value;
             Items.Add(Text);
             Items.Add('Standard');
             Items.Add('Additional');
             Items.Add('Win32');
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtNumber:
         begin
           FEdit := TMaskEdit.Create(nil);
           with FEdit as TMaskEdit do
           begin
             BorderStyle := bsNone;
             Visible := False;
             Parent := Tree;
             EditMask := '9999';
             Text := Data.Value;
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtPickNumber:
         begin
           FEdit := TComboBox.Create(nil);
           with FEdit as TComboBox do
           begin
             //BorderStyle := bsNone;
             Visible := False;
             Parent := Tree;
             Text := Data.Value;
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtMemo:
         begin
           FEdit := TComboBox.Create(nil);
           // In reality this should be a drop down memo but this requires a special control.
           with FEdit as TComboBox do
           begin
             //BorderStyle := bsNone;
             Visible := False;
             Parent := Tree;
             Text := Data.Value;
             Items.Add(Data.Value);
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtDate:
         begin
           FEdit := TDateEdit.Create(nil);
           with FEdit as TDateEdit do
           begin
             //BorderStyle := bsNone;
             Visible := False;
             Parent := Tree;

             {
             CalColors.MonthBackColor := clWindow;
             CalColors.TextColor := clBlack;
             CalColors.TitleBackColor := clBtnShadow;
             CalColors.TitleTextColor := clBlack;
             CalColors.TrailingTextColor := clBtnFace;
             }
             Date := StrToDate(Data.Value);
             OnKeyDown := EditKeyDown;
           end;

         end;
     else
       Result := False;
     end;
   end;

   
   procedure TPropertyEditLink.EditWindowProc(var Message: TMessage);
   // Here we can capture messages for keeping track of focus changes.
   begin
     case Message.Msg of
       WM_KILLFOCUS:
         if FEdit is TDateEdit then
         begin
           //todo
           {
           // When the user clicks on a dropped down calender we also get
           // the kill focus message.
           if not TDateTimePicker(FEdit).DroppedDown then}
             FTree.EndEditNode;
         end
         else
           FTree.EndEditNode;
     else
       FOldEditProc(Message);
     end;
   end;

   function TPropertyEditLink.BeginEdit: Boolean;
   begin
     Result := True;
     FEdit.Show;
     FEdit.SetFocus;
     // Set a window procedure hook (aka subclassing) to get notified about important messages.
     FOldEditProc := FEdit.WindowProc;
     FEdit.WindowProc := EditWindowProc;
   end;

   function TPropertyEditLink.CancelEdit: Boolean;
   begin
     Result := True;
     // Restore the edit's window proc.
     FEdit.WindowProc := FOldEditProc;
     FEdit.Hide;
   end;

   function TPropertyEditLink.EndEdit: Boolean;
   var
     Data: PPropertyData;
     Buffer: array[0..1024] of Char;
     S: WideString;
     P: TPoint;
     Dummy: Integer;
   begin
     // Check if the place the user click on yields another node as the one we
     // are currently editing. If not then do not stop editing.
     GetCursorPos(P);
     P := FTree.ScreenToClient(P);
     Result := FTree.GetNodeAt(P.X, P.Y, True, Dummy) <> FNode;

     if Result then
     begin
       // restore the edit's window proc
       FEdit.WindowProc := FOldEditProc;
       Data := FTree.GetNodeData(FNode);
       //original
       {
       if FEdit is TComboBox then
         S := TComboBox(FEdit).Text
       else
       begin
         GetWindowText(FEdit.Handle, Buffer, 1024);
         S := Buffer;
       end;
       }
       //lcl
       case Data.ValueType of
         vtString: S:= TEdit(FEdit).Text;
         vtPickString, vtMemo: S:= TComboBox(FEdit).Text;
         vtNumber: S:= TMaskEdit(FEdit).Text;
         vtDate: S:= TDateEdit(FEdit).Text;
         else
           S:='BUG - Error getting value';
       end;
       
       if S <> Data.Value then
       begin
         Data.Value := S;
         Data.Changed := True;
         FTree.InvalidateNode(FNode);
       end;
       FEdit.Hide;
     end;
   end;

   
   procedure TPropertyEditLink.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   var
     CanAdvance: Boolean;
   begin
     case Key of
       VK_RETURN,
       VK_UP,
       VK_DOWN:
         begin
           // Consider special cases before finishing edit mode.
           CanAdvance := Shift = [];
           if FEdit is TComboBox then
             CanAdvance := CanAdvance and not TComboBox(FEdit).DroppedDown;
           //todo
           //if FEdit is TDateEdit then
           //  CanAdvance :=  CanAdvance and not TDateEdit(FEdit).DroppedDown;

           if CanAdvance then
           begin
             FTree.EndEditNode;
             with FTree do
             begin
               if Key = VK_UP then
                 FocusedNode := GetPreviousVisible(FocusedNode)
               else
                 FocusedNode := GetNextVisible(FocusedNode);
               Selected[FocusedNode] := True;
             end;
             Key := 0;
           end;
         end;
     end;
   end;

   procedure TPropertyEditLink.ProcessMessage(var Message: TMessage);
   begin
     FEdit.WindowProc(Message);
   end;

   function TPropertyEditLink.GetBounds: TRect;
   begin
     Result := FEdit.BoundsRect;
   end;

   procedure TPropertyEditLink.SetBounds(R: TRect);
   var
     Dummy: Integer;
   begin
     // Since we don't want to activate grid extensions in the tree (this would influence how the selection is drawn)
     // we have to set the edit's width explicitly to the width of the column.
     FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
     FEdit.BoundsRect := R;
   end;

   (*-------------------------------------------------------------------
                           TGridEditLink 
   -------------------------------------------------------------------*)
   function TGridEditLink.EndEdit: Boolean;
   var
     Data: PGridData;
     Buffer: array[0..1024] of Char;
     S: WideString;
     I: Integer;
  
   begin
     Result := True;
     // Restore the edit's window proc.
     FEdit.WindowProc := FOldEditProc;
     Data := FTree.GetNodeData(FNode);
     if FEdit is TComboBox then
     begin
       S := TComboBox(FEdit).Text;
       if S <> Data.Value[FColumn - 1] then
       begin
         Data.Value[FColumn - 1] := S;
         Data.Changed := True;
       end;
     end
     else
       if FEdit is TMaskEdit then
       begin
         I := StrToInt(Trim(TMaskEdit(FEdit).EditText));
         if I <> Data.Value[FColumn - 1] then
         begin
           Data.Value[FColumn - 1] := I;
           Data.Changed := True;
         end;
       end
       else
         if FEdit is TCustomEdit then
         begin
           S := TCustomEdit(FEdit).Text;
           if S <> Data.Value[FColumn - 1] then
           begin
             Data.Value[FColumn - 1] := S;
             Data.Changed := True;
           end;
           {
           GetWindowText(FEdit.Handle, Buffer, 1024);
           S := Buffer;
           if S <> Data.Value[FColumn - 1] then
           begin
             Data.Value[FColumn - 1] := S;
             Data.Changed := True;
           end;
           }
         end;

     if Data.Changed then
       FTree.InvalidateNode(FNode);
     FEdit.Hide;
   end;

   function TGridEditLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex): Boolean;
   var
     Data: PGridData;
     //todo: fpc does not accept variant to TTransLateString
     TempText: String;
   begin
     Result := True;
     FTree := Tree as TVirtualStringTree;
     FNode := Node;
     FColumn := Column;

     // Determine what edit type actually is needed.
     FEdit.Free;
     FEdit := nil;
     Data := FTree.GetNodeData(Node);
     case Data.ValueType[FColumn - 1] of
       vtString:
         begin
           FEdit := TEdit.Create(nil);
           with FEdit as TEdit do
           begin
             Visible := False;
             Parent := Tree;
             TempText:= Data.Value[FColumn - 1];
             Text := TempText;
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtPickString:
         begin
           FEdit := TComboBox.Create(nil);
           with FEdit as TComboBox do
           begin
             Visible := False;
             Parent := Tree;
              TempText:= Data.Value[FColumn - 1];
             Text := TempText;
             // Here you would usually do a lookup somewhere to get
             // values for the combobox. We only add some dummy values.
             case FColumn of
               2:
                 begin
                   Items.Add('John');
                   Items.Add('Mike');
                   Items.Add('Barney');
                   Items.Add('Tim');
                 end;
               3:
                 begin
                   Items.Add('Doe');
                   Items.Add('Lischke');
                   Items.Add('Miller');
                   Items.Add('Smith');
                 end;
             end;
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtNumber:
         begin
           FEdit := TMaskEdit.Create(nil);
           with FEdit as TMaskEdit do
           begin
             Visible := False;
             Parent := Tree;
             EditMask := '9999;0; ';
              TempText:= Data.Value[FColumn - 1];
             Text := TempText;
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtPickNumber:
         begin
           FEdit := TComboBox.Create(nil);
           with FEdit as TComboBox do
           begin
             Visible := False;
             Parent := Tree;
              TempText:= Data.Value[FColumn - 1];
             Text := TempText;
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtMemo:
         begin
           FEdit := TComboBox.Create(nil);
           // In reality this should be a drop down memo but this requires
           // a special control.
           with FEdit as TComboBox do
           begin
             Visible := False;
             Parent := Tree;
              TempText:= Data.Value[FColumn - 1];
             Text := TempText;
             Items.Add(Data.Value[FColumn - 1]);
             OnKeyDown := EditKeyDown;
           end;
         end;
       vtDate:
         begin
           FEdit := TDateEdit.Create(nil);
           with FEdit as TDateEdit do
           begin
             Visible := False;
             Parent := Tree;
             {
             CalColors.MonthBackColor := clWindow;
             CalColors.TextColor := clBlack;
             CalColors.TitleBackColor := clBtnShadow;
             CalColors.TitleTextColor := clBlack;
             CalColors.TrailingTextColor := clBtnFace;
             }
             Date := StrToDate(Data.Value[FColumn - 1]);
             OnKeyDown := EditKeyDown;
           end;

         end;
     else
       Result := False;
     end;
   end;



end.