fcdbtreeview.pas

一套及时通讯的原码

      FOnCalcSectionAttributes(Self, Node, Section, DisplayText);
end;

procedure TfcDBCustomTreeView.DoDrawSection(Node: TfcDBTreeNode;
  Section: TfcTreeHeaderSection;
  ARect: TRect;
  s: string;
  var DoDefault: boolean);
begin
   if Assigned(FOnDrawSection) then
      FOnDrawSection(Self, Node, Section, ARect, S, DoDefault);
end;


Function fcGetWord(s: string; var APos: integer; var IsFieldName: boolean): string;
var i: integer;

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

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

   i:= APos;
   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+1, i-APos-1);
         IsFieldName:= True;
         APos:= i+1;
      end
   end
   else begin
      while (i<=length(s)) and (not (s[i] in ['"'])) do inc(i);
      result:= copy(s, APos, max(i-APos, 1));
      APos:= i;
   end;
end;


Function TfcDBCustomTreeView.GetNodeText(
   DisplayFieldLine: string;
   DataSet: TDataSet;
   var Field: TField): string;
var line, word: string;
    APos: integer;
    isFieldName: boolean;
    curField: TField;
    i: integer;
    tempStr: string;
begin
  line:= '';
  APos:= 1;

  if Header<>nil then with Header do begin
     for i:= 0 to Sections.count-1 do begin
        curField:= DataSet.FindField(Sections[i].FieldName);
//        Sections[i].Field:= curField;

        if curField<>nil then begin
           if curField.datatype=ftMemo then
              tempStr:= curField.asString
           else
              tempStr:= curField.DisplayText;
           tempStr:= fcStrRemoveChar(tempStr, #9);
        end
        else tempStr:= '';
        if Field=nil then Field:= curField;

        if i>0 then line:= line + #9 + tempstr
        else line:= tempstr;
     end;
     result:= line;
     exit;
  end;

  Field:= nil;
  repeat
      word:= fcGetWord(DisplayFieldLine, APos, isFieldName);
      if (word<>'') then begin
         if IsFieldName then
         begin
            curField:= dataset.findfield(word);
            if curField<>nil then
            begin
               if curField.datatype=ftMemo then
                 line:= line + curField.asString
               else
                 line:= line + curField.DisplayText;
               if Field=nil then Field:= curField;
            end
            else
               line:= line + '<Field not found ' + word + '>'
         end
         else begin
            if pos('"', DisplayFieldLine)>0 then
               line:= line + word
            else begin
               curField:= dataset.findfield(word);
               if curField=nil then
                  line:= line + ' <Field not found ' + word + '> '
               else begin
                  if curField.datatype=ftMemo then
                    line:= line + dataset.fieldbyname(word).asString
                  else line:= line + dataset.fieldbyname(word).DisplayText;

                  if Field=nil then Field:= curField;
               end
            end
         end
      end
  until (word='');
  result:= line;
end;

procedure TfcDBCustomTreeView.WMPaint(var Message: TWMPaint);
var
    Node: TfcDBTreeNode;
    NextDataLink: TfcTreeDataLink;
//    Flags: integer;
    FocusRect, R: TRect;
    i: Integer;
    ActiveNode: boolean;
    PrevActiveRecord: integer;
    sp: TPoint;
    NewMaxTextWidth : integer;
    UpdateRect: TRect;
    FActiveBookmark: TBookmark;
    res: CmpBkmkRslt;
    NewNode: boolean;
    DefaultDrawing: boolean;
    MousePos: TPoint;
    OrigCheckMaxWidth: boolean;
    ParentForm:TCustomForm;

     procedure ScanDataLink(ParentNode: TfcDBTreeNode; DataLinkIndex: integer);
     var DataLink: TfcTreeDataLink;
         RecIndex: integer;
         PrevActiveRecord: integer;
         curBookmark: TBookmark;
         res: CmpBkmkRslt;
     begin
        if DataLinkIndex>=FDataLinks.count then exit;

        DataLink:= TfcTreeDataLink(FDataLinks[DataLinkIndex]);

        PrevActiveRecord:= DataLink.ActiveRecord;

        for RecIndex:= 0 to DataLink.RecordCount-1 do
        begin
           DataLink.ActiveRecord:= RecIndex;
           Node:= TfcDBTreeNode.create;
           if DataLinkIndex<=DisplayFields.count-1 then
             Node.Text:= GetNodeText(DisplayFields[DataLinkIndex], DataLink.DataSet, Node.Field)
           else
             Node.Text:= GetNodeText(DataLink.DataSet.Fields[0].FieldName, DataLink.DataSet, Node.Field);
           Node.Level:= DataLinkIndex;
           Node.DataLink:= DataLink;
           Node.DataSet:= DataLink.DataSet;
           Node.ActiveRecord:= RecIndex;
           Node.Expanded:= False;
           Node.HasChildren:= (DataLinkIndex < FDataLinks.count-1);
           Node.Parent:= ParentNode;
           Node.Selected:= False;
           Node.ImageIndex:= 0;
           Node.StateIndex:= -1;
           Node.HasPrevSibling:= (not DataLink.DataSet.Bof) or (DataLink.ActiveRecord>0);
           if Node.HasPrevSibling and (DataLinkIndex=0) then
           begin
              curBookmark:= DataLink.dataset.GetBookmark;
              try { 2/8/99 - Move try block before test for firstbookmark to fix potential leak }
                 if (curBookmark<>nil) and (FirstBookmark<>nil) then
                 begin
                   res:= DataLink.DataSet.CompareBookmarks(FirstBookmark, curBookmark);
                   if (res=CMPKeyEql) or (res=CMPEql) then
                   begin
                      if DataLink.ActiveRecord=0 then
                         Node.HasPrevSibling:= False
                      else
                         FreeFirstBookmark; { First Record inserted by another application }
                   end;
                 end
              finally
                 DataLink.dataset.FreeBookmark(curBookmark);
              end;
           end;
           if (not Node.HasPrevSibling) and (dsInsert = DataLink.DataSet.state) then
              Node.HasPrevSibling:= True;

           Node.HasNextSibling:=
             not ((RecIndex = DataLink.RecordCount-1) and
                  ((DataLink.RecordCount < DataLink.BufferCount) or DataLink.DataSet.eof));
           if (not Node.HasNextSibling) and (dsInsert = DataLink.DataSet.state) then
              Node.HasNextSibling:= True;
           Nodes.Add(Node);

           if (PrevActiveRecord=RecIndex) then
           begin
              if (DataLink.DataSet=ActiveDataSet) then
              begin
                 ActiveNodeIndex:= Nodes.count-1;
                 Node.Selected:= True;
              end;

              if (DataLink.DataSet=LastVisibleDataSet) or
                 (LastVisibleDataSet=nil) and not (csDesigning in ComponentState) then
              begin
                 NextDataLink:= GetChildDataLink(DataLink.DataSet);
                 if (NextDataLink<>nil) and
                    NextDataLink.DataSet.eof and NextDataLink.DataSet.bof then
                 begin
                    Node.HasChildren:= False;
                 end;
              end
              else begin
                 Node.Expanded:= True;
                 ScanDataLink(Node, DataLinkIndex + 1);
              end
           end
        end;
        DataLink.ActiveRecord:= PrevActiveRecord;
     end;

   { Fill with background color }
   Procedure BeginPainting;
   var PaintRect: TRect;
   begin
      InPaint:= True;
      if VertScrollBar.visible then
         FPaintBitmap.Width := fcMax(0, Width + HorzScrollBar.position - VertScrollBar.Width)
      else
         FPaintBitmap.Width := Width + HorzScrollBar.position;

      // otherwise horz Scrollbar getting painted over by data when themes enabled
      if HorzScrollBar.visible and fcUseThemes(self) then
        FPaintBitmap.Height := HorzScrollBar.Top-1
      else
        FPaintBitmap.Height := Height;
      FPaintCanvas.Brush.Color := Color;
      if (FImager <> nil){ and (FImager.visible) }then
      begin
         if FImager.WorkBitmap.Empty then FImager.UpdateWorkBitmap;
         if FImager.DrawStyle=dsTile then
         begin
            PaintRect:= Rect(0,0,FPaintBitmap.Width, FPaintBitmap.Height);
            FImager.WorkBitmap.TileDraw(Canvas, PaintRect);
         end
         else begin
            PaintRect:= Rect(horzscrollbar.position + 0, 0, horzscrollbar.position + ClientRect.Right, ClientRect.Bottom);
            Canvas.StretchDraw(PaintRect, FImager.WorkBitmap);
         end
      end
      else
        FPaintCanvas.FillRect(Rect(0, 0, FPaintBitmap.Width, FPaintBitmap.Height));
   end;

   procedure EndPainting;
   var r, sourceRect: TRect;
       scrollpos: integer;
       PaintClipRect: TRect;
       MyPrintCanvas: TCanvas;
   begin
     r := ClientRect;
     OffsetRect(r, 1, 0);

     // 11/17/99 - Support form.print
     if (csPaintCopy in ControlState) and (Message.DC<>0) then
     begin
        MyPrintCanvas:= TCanvas.Create;
        MyPrintCanvas.Handle:= Message.DC;
     end
     else MyPrintCanvas:= FCanvas;

     MyPrintCanvas.CopyMode:= cmSrcCopy;

     scrollpos:= HorzScrollBar.position;

     PaintClipRect:= FPaintCanvas.ClipRect;
     if PaintClipRect.Right>ClientRect.Right then
     begin
        PaintClipRect.Right:= ClientRect.Right;
     end;
     if UpdateRect.Bottom>ClientRect.Bottom then
     begin
        UpdateRect.Bottom:= ClientRect.Bottom;
     end;

     if (UpdateRect.Top=0) and (UpdateRect.Bottom=0) and
        (UpdateRect.Left=0) and (UpdateRect.Right=0) then
        UpdateRect:= PaintClipRect;
     SourceRect:= Rect(Scrollpos, UpdateRect.Top,
        ScrollPos+PaintClipRect.Right, UpdateRect.Bottom );


     MyPrintCanvas.CopyRect(
        Rect(0,UpdateRect.Top, PaintClipRect.Right, UpdateRect.Bottom),
        FPaintCanvas, SourceRect);

     if (csPaintCopy in ControlState) and (Message.DC<>0) then
     begin
        MyPrintCanvas.Handle:= 0;
        MyPrintCanvas.Free;
     end;

     InPaint:= False;
   end;

begin
   GetUpdateRect(Handle, UpdateRect, False);

   SkipErase:= True;
   inherited;
   SkipErase:= False;

   if FCanvas = nil then
   begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
   end;

   if (HaveBadLink) then begin { Fix data module problem }
      BeginPainting;
      EndPainting;
      RefreshDataLinks(nil, nil);
      HaveBadLink:= False;  { Just do first for first paint so clear flag }
      exit;
   end;

   if not HaveValidDataLinks then begin
      BeginPainting;
      EndPainting;
      exit;
   end;

   if (Images<>nil) and (StateImages<>nil) then
   begin
     FixedOffset := 2;
   end
   else begin
     FixedOffset := 2;
   end;


   BeginPainting;

   r:= Rect(0,0,0,0);

   try
      if FDataLinks.count<=0 then begin
         RefreshDataLinks(DataSourceFirst, DataSourceLast);
         if FDataLinks.count<=0 then begin
            exit;
         end;
      end;

     if (ActiveDataSet=nil) then
       ActiveDataSet:= TfcTreeDataLink(FDataLinks[0]).DataSet;
     if (ActiveDataSet=nil) or (not ActiveDataSet.Active) then exit;

     if dtvoHotTracking in Options then
     begin
        GetCursorPos(MousePos);
        sp:= ScreenToClient(MousePos);
        if (sp.x>0) and (sp.x<Width) and (sp.y>0) and (sp.y<height) then
           MouseToRow(sp.x, sp.y, HotTrackRow)
        else HotTrackRow:= -1;
     end;

     //11/17/99 - Don't HotTrack if this form is not active.
     ParentForm := GetParentForm(self);
     if (ParentForm<>nil) and (ParentForm.handle<>GetActiveWindow) then
        HotTrackRow:= -1;

     if not SkipReload then
     begin
        NodesCleared:= True;

        for i:= 0 to Nodes.count-1 do begin
          if SkipFreeNodes then OldNodes.Add(Nodes[i])
          else TfcDBTreeNode(Nodes[i]).Free;
        end;

        Nodes.Clear;

        ActiveNodeIndex:= TfcTreeDataLink(FDataLinks[0]).ActiveRecord;;
        ScanDataLink(nil, 0);