fctreeheader.pas

一套及时通讯的原码

     if I<> Sections.Count-1 then
        s:=s+'#9';
  end;

  OldDisplayFieldCount:= TfcDBTreeView(Tree).displayfields.count;
  TfcDBTreeView(Tree).DisplayFields.Clear;
  for i:= 0 to OldDisplayFieldCount-1 do
     TfcDBTreeView(Tree).displayfields.Add(s);
  Tree.invalidate;
end;

procedure TfcTreeHeaderControl.CNNotify(var Message: TWMNotify);
const HDN_BEGINDRAG = HDN_FIRST - 10;
      HDN_BEGINTRACK = HDN_FIRST - 6;
      HDN_ENDDRAG = HDN_FIRST - 11;
      HDM_ORDERTOINDEX = HDM_FIRST + 15;
      HDM_GETORDERARRAY = HDM_FIRST + 17;
      HDI_ORDER = $0080;
type
  TfcHDItem = packed record
    Mask: Cardinal;
    cxy: Integer;
    pszText: PAnsiChar;
    hbm: HBITMAP;
    cchTextMax: Integer;
    fmt: Integer;
    lParam: LPARAM;
    iImage: integer;
    iOrder: integer;
  end;
  PwwHDItem = ^TfcHDItem;
var
  Section: TfcTreeHeaderSection;
  TrackState: TSectionTrackState;
//  OrderArray: array[0..40] of integer;
  dragFrom, dragto: integer;
  AllowMove: boolean;
  MsgPos: Longint;
  hdhti: THDHitTestInfo;
  hdi: THDItem;
//  FFromIndex, FToIndex: integer;
begin
  with PHDNotify(Message.NMHdr)^ do
    case Hdr.code of
      HDN_BEGINDRAG: begin
         end;
      HDN_ENDDRAG: begin
          if (PwwHDItem(PItem)^.mask and HDI_ORDER)<>0 then  {Checks if ComCtrl supports this}
          begin
             Message.Result := 0;
             MsgPos := GetMessagePos;
             hdhti.Point.X := MsgPos and $FFFF;
             Windows.ScreenToClient(Handle, hdhti.Point);
             hdhti.Point.Y := ClientHeight div 2;
             SendMessage(Handle, HDM_HITTEST, 0, Integer(@hdhti));
             hdi.Mask := HDI_ORDER;
             DragTo:= 0;
             if hdhti.Item < 0 then
               if (HHT_TOLEFT and hdhti.Flags) <> 0 then
                 DragTo := 0
               else begin
                 if ((HHT_TORIGHT and hdhti.Flags) <> 0)
                 or ((HHT_NOWHERE and hdhti.Flags) <> 0) then
                   DragTo := Sections.Count - 1
               end
             else begin
               Header_GetItem(Handle, hdhti.Item, hdi);
               DragTo := hdi.iOrder;
             end;
             if DragTo<0 then exit;
             AllowMove:= True;

             Header_GetItem(Handle, Item, hdi);
             DragFrom := hdi.iOrder;

             Header.SectionMove(Sections[Item], DragFrom, DragTo, AllowMove);
             FSectionDragged:= AllowMove;
             if AllowMove then
             begin
//                Header_GetItem(Handle, Item, hdi);
//                DragFrom := hdi.iOrder;
                Sections[DragFrom].index:= DragTo;
//                FSectionDragged :=
                   DoSectionDrag(Sections[DragFrom], Sections[DragTo]);
                if Tree<>Nil then
                begin
                   RearrangeTreeColumns;
                   Tree.invalidate; { W2W - Invalidate TreeView when header is moved }
                end
             end;
          end;
          Message.result:= 1; { Don't do default processing }
       end;
      HDN_ITEMCLICK:
        Header.SectionClick(Sections[Item]);
      HDN_ITEMCHANGED:
        if PItem^.mask and HDI_WIDTH <> 0 then
        begin
          Section := Sections[Item];
          if Section.FWidth <> PItem^.cxy then
          begin
            Section.FWidth := PItem^.cxy;
            Header.SectionResize(Section);
          end;
        end;
      HDN_BEGINTRACK, HDN_TRACK, HDN_ENDTRACK:
        begin
          Section := Sections[Item];
          case Hdr.code of
            HDN_BEGINTRACK: TrackState := tsTrackBegin;
            HDN_ENDTRACK: TrackState := tsTrackEnd;
          else
            TrackState := tsTrackMove;
          end;
          with PItem^ do
          begin
            if cxy < Section.MinWidth then cxy := Section.MinWidth;
            if cxy > Section.MaxWidth then cxy := Section.MaxWidth;
            Header.SectionTrack(Sections[Item], cxy, TrackState);
          end;
        end;
    end;

end;

procedure TfcTreeHeaderControl.WMLButtonDown(var Message: TWMLButtonDown);
var
  Index: Integer;
  Info: THDHitTestInfo;
begin
  Info.Point.X := Message.Pos.X;
  Info.Point.Y := Message.Pos.Y;
  Index := SendMessage(Handle, HDM_HITTEST, 0, Integer(@Info));
  if (Index < 0) or (Info.Flags and HHT_ONHEADER = 0) or
    Sections[Index].AllowClick then inherited;
end;

procedure TfcTreeHeader.WMSize(var Message: TWMSize);
begin
  inherited;
  if not (csLoading in ComponentState) then Resize;
  HeaderControl.Width:= Width -HeaderControl.Left;
  HeaderControl.Height:= Height;
end;

procedure TfcTreeHeaderControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  inherited;
  Invalidate;
end;

{ Support design time sizing of the header sections }
procedure TfcTreeHeaderControl.WndProc(var Message: TMessage);
var hti: THDHitTestInfo;
    pt: TPoint;
    i: integer;
begin
  if csDesigning in ComponentState then begin
     case Message.Msg of
       WM_LBUTTONDOWN: begin
            hti.Point.x:= TWMMouse(Message).xpos;
            hti.Point.y:= TWMMouse(Message).ypos;
            SendMessage(Handle, HDM_HITTEST, 0, longint(@hti));
            if (hti.flags and HHT_ONDIVIDER)<>0 then begin
               GetParentForm(self).Designer.modified;
               Dispatch(Message);
               exit;
            end
         end;

       WM_LBUTTONUP:
         begin
            Dispatch(Message);
            exit;
         end;

       WM_MOUSEMOVE:
         begin
            Dispatch(Message);
            exit;
         end;
     end;
     inherited;
  end

  else begin
     case Message.Msg of
       WM_MOUSEMOVE:
         begin
           if HotTrack or fcUseThemes(self) then begin //ThemeServices.ThemesEnabled then begin
              GetCursorPos(pt);
              pt:=  ScreenToClient(pt);
              begin
                for i:= 0 to Sections.count-1 do begin
                   if Sections[i].PtInSection(pt) then
                   begin
                      if HotTrackSection<>i then
                      begin
                         HotTrackSection:= i;
                         invalidate;
                      end
                   end
                 end;
              end;
           end;
       end
     end;
     inherited;
  end;
end;

procedure TfcTreeHeaderControl.SetOptions(val: TfcTreeHeaderOptions);
begin
   if FOptions<>val then
   begin
      FOptions:= val;
      RecreateWnd;
   end;
end;

procedure TfcTreeHeaderControl.SetImageList(val: TImageList);
begin
   FImageList:= Val;
   Invalidate;
end;

procedure TfcTreeHeaderControl.WMPaint(var Message: TWMPaint);
begin
   inherited;

   if thcoRightBorder in Options then
   begin
      Canvas.MoveTo(ClientRect.Right-1, 0);
      Canvas.LineTo(ClientRect.Right-1, ClientRect.Bottom);
   end;
end;

function TfcTreeHeaderControl.DoSectionDrag(FromSection, ToSection: TfcTreeHeaderSection): Boolean;
begin
  Result := True;
  Header.SectionDrag(FromSection, ToSection);
end;


procedure TfcTreeHeader.SectionDrag(FromSection, ToSection: TfcTreeHeaderSection);
begin
  if Assigned(FOnSectionDrag) then FOnSectionDrag(Self, FromSection, ToSection)
end;

constructor TfcTreeHeader.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   HeaderControl:= TfcTreeHeaderControl.create(self);
   HeaderControl.Header:= self;
   Align:= alTop;
   HeaderControl.Left:= 0;
   HeaderControl.Top:= 0;
   HeaderControl.Width:= Width;
   HeaderControl.Height:= Height;
end;

procedure TfcTreeHeader.CreateWnd;
begin
   inherited CreateWnd;
   HeaderControl.parent:= self;
   HeaderControl.align:= alNone;
end;

destructor TfcTreeHeader.Destroy;
begin
  HeaderControl.Free;
  inherited Destroy;
end;

procedure TfcTreeHeader.SetSections(Value: TfcTreeHeaderSections);
begin
   HeaderControl.Sections.Assign(Value);
end;

function TfcTreeHeader.GetSections: TfcTreeHeaderSections;
begin
   result:= HeaderControl.Sections;
end;

function TfcTreeHeader.GetHotTrack: boolean;
begin
  result:= HeaderControl.HotTrack;
end;

procedure TfcTreeHeader.SetHotTrack(Value: Boolean);
begin
   HeaderControl.HotTrack:= value;
end;

function TfcTreeHeader.GetImageList: TImageList;
begin
   result:= HeaderControl.Images;
end;

procedure TfcTreeHeader.SetImageList(Value: TImageList);
begin
   HeaderControl.Images:= Value;
end;

procedure TfcTreeHeader.SetOptions(val: TfcTreeHeaderOptions);
begin
   HeaderControl.Options:= val;
end;

function TfcTreeHeader.GetOptions: TfcTreeHeaderOptions;
begin
   result:= HeaderControl.Options;
end;

function TfcTreeHeader.GetCanvas: TCanvas;
begin
  result:= HeaderControl.Canvas;
end;

function TfcTreeHeader.GetTree: TWinControl;
begin
   result:= HeaderControl.Tree;
end;

procedure TfcTreeHeaderControl.CMMouseEnter(var Message: TMessage);
begin
  inherited;
end;

procedure TfcTreeHeaderControl.CMMouseLeave(var Message: TMessage);
var r:TRect;
    pt:TPoint;
begin
  GetCursorPos(pt);
  pt := ScreenToClient(pt);
  r := ClientRect;
  if (PtInRect(r,pt)) then exit;

  if HotTrack or fcUseThemes(self) then begin//ThemeServices.ThemesEnabled then begin
     HotTrackSection:=-1;
     invalidate;
  end;

  inherited;
end;


Function TfcTreeHeader.GetMouseDown: TMouseEvent;
begin
   result:= HeaderControl.OnMouseDown;
end;

procedure  TfcTreeHeader.SetMouseDown(Value: TMouseEvent);
begin
   HeaderControl.OnMouseDown:= Value;
end;

Function TfcTreeHeader.GetMouseUp: TMouseEvent;
begin
   result:= HeaderControl.OnMouseUp;
end;

procedure  TfcTreeHeader.SetMouseUp(Value: TMouseEvent);
begin
   HeaderControl.OnMouseUp:= Value;
end;

Function TfcTreeHeader.GetMouseMove :TMouseMoveEvent;
begin
   result:= HeaderControl.OnMouseMove;
end;

procedure  TfcTreeHeader.SetMouseMove(Value: TMouseMoveEvent);
begin
   HeaderControl.OnMouseMove:= Value;
end;

procedure TfcTreeHeader.WMEraseBkgnd(var Message: TWMEraseBkgnd);
//var
//  Details: TThemedElementDetails;
begin
{  if ThemeServices.ThemesEnabled then
  begin
    Details := ThemeServices.GetElementDetails(thHeaderRoot);
    ThemeServices.DrawElement(Message.DC, Details, ClientRect, nil);
    Message.Result := 1;
  end
  else}
    inherited;
end;

end.