fcdbtreeview.pas

一套及时通讯的原码

    property BorderStyle : TBorderStyle read FBorderStyle write SetBorderStyle;
    property DataSourceFirst: TDataSource read GetDataSource write SetDataSource;
    property DataSourceLast: TDataSource read GetLastDataSource write SetLastDataSource;
    property DataSources: String read FDataSourcesMiddle write SetDataSources;
    property Options: TfcDBTreeViewOptions read FOptions write SetOptions default
          [dtvoAutoExpandOnDSScroll,
           dtvoShowButtons, dtvoShowNodeHint, dtvoShowLines, dtvoShowRoot, dtvoShowHorzScrollBar,
           dtvoShowVertScrollBar];
    property DisplayFields: TStrings read FDisplayFields write SetDisplayFields;
    property Images: TCustomImageList read FImages write SetImages;
    property Imager: TfcCustomImager read FImager write SetImager;
    property StateImages: TCustomImageList read FStateImages write SetStateImages;
    property MultiSelectAttributes: TfcDBMultiSelectAttributes
        read FMultiSelectAttributes write FMultiSelectAttributes;
    property OnCalcNodeAttributes: TfcDBTreeEvent read FOnCalcNodeAttributes
             write FOnCalcNodeAttributes;
    property OnCalcSectionAttributes: TfcDBTreeSectionEvent read FOnCalcSectionAttributes
             write FOnCalcSectionAttributes;
    property OnDrawSection: TfcDBTreeDrawSectionEvent read FOnDrawSection
             write FOnDrawSection;
    property OnChange: TfcDBTreeEvent read FOnChange write FOnChange;
    property OnUserCollapse: TfcDBTreeEvent read FOnUserCollapse write FOnUserCollapse;
    property OnUserExpand: TfcDBTreeEvent read FOnUserExpand write FOnUserExpand;
    property OnDblClick: TfcDBTreeMouseEvent read FOnDblClick write FOnDblClick;
    property OnMouseDown: TfcDBTreeMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TfcDBTreeMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TfcDBTreeMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnDrawText: TfcDBTreeDrawTextEvent read FOnDrawText write FOnDrawText;
    property Header: TfcTreeHeader read FHeader write SetHeader;
    property HideUpDownButtons: boolean read FHideUpDownButtons write SetHideUpDownButtons default False;
    property DisableThemes : boolean read FDisableThemes write FDisableThemes default False;
  end;

  TfcDBTreeView = class(TfcDBCustomTreeView)
  published
    property DisableThemes;
    property Align;
    property BorderStyle;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor default False;
    property ParentFont;
    property ParentShowHint;
    property TabStop default True;
    property TabOrder;
    property Visible;
    property Header;

    {$ifdef fcDelphi4Up}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property ParentBiDiMode;
    {$endif}

    property DataSourceFirst;
    property DataSourceLast;
    property DataSources;
    property DisplayFields;
//    {$ifdef fcDelphi4Up}
//    property HideUpDownButtons;
//    {$endif}
    property Imager;
    property InactiveFocusColor;
    property LineColor;
    property Options;

    {$ifdef fcDelphi4Up}
    property OnStartDock;
    property OnEndDock;
    {$endif}
    property LevelIndent;
    property Images;
    property StateImages;
    property MultiSelectAttributes;
    property PopupMenu;
    property HideUpDownButtons;
    property OnCalcNodeAttributes;
    property OnCalcSectionAttributes;
    property OnDrawSection;
    property OnChange;
    property OnUserCollapse;
    property OnUserExpand;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyUp;
    property OnKeyPress;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
    property OnDrawText;
  end;


implementation

{$ifdef fcdelphi6}
uses
 {$ifdef ThemeManager}
   variants, thememgr, themesrv, uxtheme;
 {$else}
   variants;
 {$endif}
{$endif}

{$ifdef fcdelphi7}
uses
variants, themes;
{$endif}



const
  CmpLess = -1;
  CmpEql = 0;
  CmpGtr = 1;
  CmpKeyEql = 2;

type
  CMPBkMkRslt = Integer; { To resolve CmpBkmkRslt type }

constructor TfcTreeDataLink.Create(ATree: TfcDBCustomTreeView);
begin
  inherited Create;
  FTree := ATree;
end;

procedure TfcTreeDataLink.RecordChanged(Field: TField);
begin
  if (Field<>Nil) and (Dataset.State in [dsEdit, dsInsert]) then
  begin
    FTree.invalidateClient;
  end;
end;

procedure TfcDBCustomTreeView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if (FBorderStyle = bsSingle) then
    begin
       Style := Style and not WS_BORDER;
       ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

destructor TfcTreeDataLink.Destroy;
begin
  inherited Destroy;
end;

procedure TfcTreeDataLink.DataSetChanged;
begin
  FTree.DataChanged(self.dataset);
end;

procedure TfcTreeDataLink.DataSetScrolled(Distance: Integer);
begin
  FTree.Scroll(self.dataset, Distance);
end;

type

TfcTreeVertScrollBar = class(TfcScrollBar)
  protected
    procedure Scroll(ScrollCode: integer; Position: integer); override;
end;

TfcTreeHorzScrollBar = class(TfcScrollBar)
  protected
    procedure Scroll(ScrollCode: integer; Position: integer); override;
end;

constructor TfcDBCustomTreeView.Create(AOwner: TComponent);
var i: Integer;
begin
  inherited;
  CacheSize:= 1;
  FDataLinks:= TList.create;
  FFirstDataLink:= TfcTreeDataLink.create(self);
  FLastDataLink:= TfcTreeDataLink.create(self);
  FFirstDataLink.BufferCount := CacheSize;
  FLastDataLink.BufferCount := CacheSize;
  Nodes:= TList.create;
  OldNodes:= TList.create;
  FPaintBitmap:= TBitmap.create;
  FPaintCanvas:= TfcCanvas(FPaintBitmap.Canvas);
  FOptions:=
     [dtvoAutoExpandOnDSScroll, dtvoShowButtons, dtvoShowNodeHint,
      dtvoShowLines, dtvoShowRoot, dtvoShowHorzScrollBar,
      dtvoShowVertScrollBar];
  FBorderStyle:= bsSingle;
  for i:= 0 to 50 do StartOffsets[i]:= 0;
  LevelIndent := 21;
  LevelIndent:= 19; { Seems to be more consistent with TTreeView. Find out when 21
                      is better }
  FixedOffset := 1;
  RowHeight:= 16;
  HintTimer:= TTimer.create(self);

  FMultiSelectAttributes:= TfcDBMultiSelectAttributes.create(self);
  FMultiSelectList:= TList.create;

  HotTrackRow:= -1;
  Width := 121;
  Height := 97;
  Color:= clWindow;
  ParentColor:= False;
  FLineColor:= clBtnShadow;
  FInactiveFocusColor:= clBtnFace;
  FDisplayFields:= TStringList.create;

  VertScrollBar:= TfcTreeVertScrollBar.create(self);
  VertScrollBar.Kind:= sbVertical;
  VertScrollBar.Width:= GetSystemMetrics(SM_CXVSCROLL);

  VertScrollBar.parent:= self;

  HorzScrollBar:= TfcTreeHorzScrollBar.create(self);
  HorzScrollBar.Kind:= sbHorizontal;
  HorzScrollBar.Height:= GetSystemMetrics(SM_CXVSCROLL);
  HorzScrollBar.Max:= 5;
  HorzScrollBar.PageSize:= 10;
  HorzScrollBar.visible:= false;
  HorzScrollBar.parent:= self;
  HorzScrollBar.SmallChange:= 10;
  HorzScrollBar.ContinuousDrag:= True;

  UpTreeButton:= CreateUpTreeButton;
  DownTreeButton:= CreateDownTreeButton;

  FScrollWithinLevel:= True;
  FChangeLink := TfcChangeLink.Create;
  FChangeLink.OnChange := ImagerChange;
  TabStop:= True;

end;

destructor TfcDBCustomTreeView.Destroy;
var i: integer;
begin
   FChangeLink.Free;
   VertScrollBar.Free;
   VertScrollBar:= nil;

   for i:= 0 to Nodes.count-1 do TfcDBTreeNode(Nodes[i]).Free;
   Nodes.Free;
   FreeOldNodes;
   OldNodes.Free;
   for i:= 0 to FDataLinks.count-1 do begin
      if FDataLinks[i]=FFirstDataLink then continue;
      if FDataLinks[i]=FLastDataLink then continue;
      TfcTreeDataLink(FDataLinks[i]).Free;
   end;
   UnselectAll; { 2/14/2000 }
   FMultiSelectList.Free;
   FMultiSelectAttributes.Free;

   FFirstDataLink.Free;
   FLastDataLink.Free;
   FDataLinks.Free;
   HintTimer.Free;
   FreeFirstBookmark;
   FreeLastActiveBookmark;
   FDisplayFields.Free;
   FPaintBitmap.Free;
   FCanvas.Free;

   FreeRootBookmark;
   inherited Destroy;
end;

procedure TfcDBCustomTreeView.FreeRootBookmark;
begin
  {$ifdef fcdelphi4up}
  if RootDataSetBookmark<>Nil then FreeMem(RootDataSetBookmark);
  RootDataSetBookmark:= nil;
  {$else}
  if RootDataSetBookmark<>Nil then StrDispose(RootDataSetBookmark);
  RootDataSetBookmark:= nil;
  {$endif}
end;


procedure TfcTreeDataLink.ActiveChanged;
begin
  if (DataSource=FTree.DataSourceFirst) or (DataSource=FTree.DataSourceLast) then
     FTree.RefreshDataLinks(FTree.DataSourceFirst, FTree.DataSourceLast);
  FTree.LinkActive(Dataset, Active);
end;

function TfcDBCustomTreeView.GetDataSource: TDataSource;
begin
    Result := FFirstDataLink.DataSource
end;

function TfcDBCustomTreeView.GetLastDataSource: TDataSource;
begin
    Result := FLastDataLink.DataSource
end;

{type
  TwwGetWordOption = (wwgwSkipLeadingBlanks, wwgwQuotesAsWords, wwgwStripQuotes,
                      wwgwSpacesInWords);
  TwwGetWordOptions = set of TwwGetWordOption;
  strCharSet = Set of char;

Function wwGetWord(s: string; var APos: integer;
         Options: TwwGetWordOptions; DelimSet: strCharSet): string;
var i: integer;

   Function max(x,y: integer): integer;
   begin
     if x>y then result:= x
     else result:= y;
   end;

   Procedure StripQuotes;
   begin
      if not (wwgwStripQuotes in Options) then exit;
      if (Result[1]='"') or (Result[1]='''') then
         if (Result[length(Result)] = '"') or
            (Result[length(Result)] = '''') then
            Result:= copy(Result, 2, length(Result)-2)
         else
            Result:= copy(Result, 2, length(Result)-1);
   end;

begin
   result:= '';
   if APos<=0 then exit;
   if APos>length(s) then exit;

   i:= APos;
   if (wwgwSkipLeadingBlanks in Options) then
   begin
      while (i<=length(s)) and ((s[i]=' ') or (s[i]=#9)) do inc(i);
      APos:= i;
   end;

   if (wwgwQuotesAsWords in Options) then
   begin
      if s[i]='"' then begin
         inc(i);
         while (i<=length(s)) and (s[i]<>'"') do inc(i);
         if s[i]='"' then begin
            result:= copy(s, APos, i+1-APos);
            APos:= i+1;
         end
         else if (i>length(s)) then begin
            result:= copy(s, APos, length(s));
            APos:= length(s)+1;
         end;
         StripQuotes;
         exit;
      end
   end;

   if wwgwSpacesInWords in Options then
   begin
      while (i<=length(s)) and (s[i] in [#32..#255]) do begin
         if (s[i] in DelimSet) then break
         else inc(i);
      end
   end
   else begin
      while (i<=length(s)) and (s[i] in [#33..#255]) do begin
         if (s[i] in DelimSet) then break
         else inc(i);
      end
   end;

   result:= copy(s, APos, max(i-APos, 1));

   if length(result)>1 then APos:= i
   else APos:= i+1;

end;
}
procedure TfcDBCustomTreeView.RefreshDataLinks(FirstDS, LastDS: TDataSource);
var i:integer;
    FDataLink: TfcTreeDataLink;