⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fctreecombo.pas

📁 一套及时通讯的原码
💻 PAS
📖 第 1 页 / 共 4 页
字号:
     LastItemText:= Node.text;
     exit;
  end;

  case Action of
    icaDelete: begin
       if Index <> -1 then FItemsList.Delete(Index);
       LastItemText:= '';
       LastItemIndex:= -1;
    end;

    icaText: begin { 12/5/99 - Optimization }
       if (Index <> -1) and (NewValue <> NULL) then FItemsList[Index] := NewValue + '=' + InttoStr(Node.ImageIndex);
       if NewValue=Null then LastItemText:= ''
       else LastItemText:=  NewValue;
       LastItemIndex:= Index;
    end;

    icaImageIndex: if Index <> -1 then FItemsList[Index] := Node.Text + '=' + InttoStr(NewValue);
  end;
end;

function TfcCustomTreeCombo.CalcImageRect(Rect: TRect): TRect;
var LineHeight, LineOffset: integer;
begin
   if Images=nil then  { RSW }
   begin
      result:= Rect;
      exit;
   end;

  { 4/14/99 - Center icon with respect to the middle of the text's height  - RSW }
  if AlignmentVertical = fcavTop then
  begin
     LineHeight:=
             fcMax(Canvas.Textheight('A')+2, TImageList(Images).Height);
     LineOffset:= (LineHeight-TImageList(Images).Height) div 2;

//     if BorderStyle=bsNone then
//        LineOffset:= LineOffset - 1;
     LineOffset:= fcMax(-1, LineOffset);
     result := Classes.Rect(Rect.Left + 1,  Rect.Top + 1 + LineOffset,
             TImageList(Images).Width,
             Rect.Top + 1 + LineOffset + TImageList(Images).Height);
     if (Frame.isFrameEffective) then begin
        if FFocused and (efLeftBorder in Frame.FocusBorders) then
           result.left:= result.left +  1;
        if FFocused and (efTopBorder in Frame.FocusBorders) then
           result.top:= result.top +  1;
        if not FFocused and (efLeftBorder in Frame.NonFocusBorders) then
           result.left:= result.left +  1;
        if not FFocused and (efTopBorder in Frame.NonFocusBorders) then
           result.top:= result.top +  1;
     end
  end else
  begin
     result := Classes.Rect( Rect.Left + 1, Rect.Top + (Rect.Bottom-Rect.Top - TImageList(Images).Height) div 2 + 1,
                 TImageList(Images).Width,TImageList(Images).Height);
//     if Style = csDropDownList then OffsetRect(result, 1, 0); { 4/27/99 - RSW Remove this code as it makes image move to left unnecessarily}
  end;
end;

procedure TfcCustomTreeCombo.PaintToCanvas(Canvas: TCanvas; Rect: TRect; Highlight,GridPaint: Boolean;
  Text: string);
var ImageIndex,OldBkMode: Integer;
    s: String;
    Flags: UINT;
    TempRect:TRect;
    OldBkColor:TColor;
    SkipPaintImage: boolean;
    TempNode: TfcTreeNode;

    function GetTextRect:TRect;
    begin
       result := Classes.Rect(Rect.Left + GetLeftIndent + 2,
                              Rect.Top + 2,
                              Rect.Right,Rect.Bottom);
       {$ifdef fcDelphi4Up}
       if fcIsInwwObjectView(self) then begin
          result.Top:= result.Top -1;
          result.Left:= result.Left -1; // 1/29/01
       end;
       {$endif}

      if (not fcIsInwwObjectView(self)) and
         Frame.IsFrameEffective then
      begin
         Frame.GetFrameTextPosition(result.Left, result.top, FFocused);
         result.left:= result.Left + GetLeftIndent + 1;
         if AlignmentVertical = fcavCENTER then result.top:= result.Top -1;
      end

    end;

  function DrawHighlight:boolean;
  begin
     result := ((not Editable and Focused) or fcParentGridFocused(Self));
     if (not ShowMatchText) and (Style = csDropDownList) and Focused and not IsDroppedDown then result:= True; { RSW - 3/27/99 }
     if csPaintCopy in ControlState then result:= False;
  end;

  procedure PaintText;
  begin
    // 2/25/99 - Added vertical alignment.
    Flags := 0;
    TempRect := GetTextRect;
    if AlignmentVertical = fcavCENTER then flags := Flags or DT_VCENTER or DT_SINGLELINE
    else flags := Flags or DT_TOP or DT_SINGLELINE;
    if not fcIsInwwGrid(self) and { 4/27/99 - RSW, Adjust left,top in special case }
      ((Style = csDropDownList) and not IsDroppedDown and not showmatchtext) then
    begin
       TempRect.left:= TempRect.left - 1;
       TempRect.Top:= TempRect.Top - 1;
    end
    else if fcIsClass(parent.classtype, 'TwwDBGrid') then
    begin
       if not (dgRowLines in fcGetGridOptions(self)) then TempRect.Top:= TempRect.Top -1;
    end;

    if fcIsInwwObjectViewPaint(self) or
       (IsTransparentEffective and not FFocused) or fcIsInwwGridPaint(self) then
       SetBkMode(Canvas.Handle, TRANSPARENT)
    else
       SetBkMode(Canvas.Handle, OPAQUE);

    if (not FFocused) and IsTransparentEffective and (Frame.NonFocusTransparentFontColor<>clNone) then
        Canvas.Font.Color:= Frame.NonFocusTransparentFontColor;

    // 8/1/02
    if (not IsTransparentEffective) and (not fcIsInwwGridPaint(self)) then
      if (not FFocused) and (Frame.Enabled) and (Frame.NonFocusColor<>clNone) then
         Canvas.Brush.Color:= Frame.NonFocusColor;
    DrawText(Canvas.Handle,PChar(Text),Length(Text),TempRect,Flags);
  end;

  procedure PaintImage;
  var ImageRect: TRect;
  begin
     if Images=nil then exit; { 3/3/99 }

     ImageRect := CalcImageRect(Rect);

     if (Images <> nil) and (ImageIndex >= 0) and (ImageIndex < Images.Count) then
     begin
       fcImageListDraw(Images, ImageIndex, Canvas,
         ImageRect.Left, ImageRect.Top,
           0, Enabled)  // Changed calculation of y pos to ignore self's height.  Made it constant for now.  -ksw (2/24/99)
     end
  end;

  //3/1/2002-Added new function to handle painting in a TDBCtrlGrid
  function PaintCopyOutsideGrid: boolean;
  begin
     result:= not
       ((not fcIsInwwGrid(self)) and (not (csPaintcopy in ControlState)))
  end;

begin
  OldBkColor := GetBkColor(Canvas.Handle);
  OldBkMode := GetBkMode(Canvas.Handle);
  SkipPaintImage:= False;

  Canvas.Font := Font; { 7/8/99 - Fixes problem where font not set for csPaintCopy }

  if (not enabled) and (color<>clGrayText) then { 3/7/00 - Use disablec color }
     Canvas.font.color:= clGrayText;

  try
     ImageIndex:= -1;
//     if (not HandleAllocated) or (not TreeView.HandleAllocated) then
//        if TreeView.Selected=nil then
//           s:= 'abc';

     if ((csPaintCopy in ControlState) and (DataLink.Field<>nil)) or // 12/11/01 - Respect mapped value and check for nil field
        ((Frame.Enabled and not FFocused) and (Datalink.Field<>nil)) then // 3/18/2002 - Respect mapped value when framing enabled.
     begin
       if StoreDataUsing =sdStoreText then
          Text := DataLink.Field.asString
       else begin
          tempNode := TreeView.Items.FindNodeInfo(
             DataLink.Field.Text, False, StoreDataUsing);
          if tempNode<>nil then
             Text:= tempNode.Text
          else Text:=DataLink.Field.asString;
       end;
     end;

     if (not (csPaintCopy in ControlState)) and
        (TreeView.Selected <> nil) and (TreeView.Selected.Text = Text) then
        ImageIndex := TreeView.Selected.ImageIndex
     else begin
        s := FItemsList.Values[Text];
        if s <> '' then ImageIndex := StrtoInt(s)
        else ImageIndex := -1;
     end;

     // Draw Highlight rect with focus rect
     if (csPaintCopy in ControlState) or // 1/31/01
        (fcIsInwwGrid(self) and (not Focused or not Highlight)) or
        ((Style = csDropDownList) and Focused and not IsDroppedDown and not showmatchtext) then
     begin
        if not fcIsInwwGrid(self) then
        begin
           Rect.Right := BtnParent.Left-1; { RSW, just set right and bottom}
        end;

        // Draw Background in the Highlight color and surround it with a focus rect
        if (not fcIsInwwGrid(self)) or (not GridPaint) then
           Canvas.Brush.Color :=
             fcThisThat(Highlight and (DrawHighlight or Not PaintCopyOutsideGrid),
             clHighlight, self.Color); { 7/8/99 - RSW - Use color of control }

        if (not IsTransparentEffective) and not fcIsInwwObjectViewPaint(self) and
           not (fcIsInwwGridPaint(self)) then Canvas.FillRect(Rect);

        if (not GridPaint) and Highlight and (DrawHighlight or Not PaintCopyOutsideGrid) then
        begin
           SetBkColor(Canvas.Handle, ColorToRGB(clHighlightText));
           SetTextColor(Canvas.Handle, ColorToRGB(clHighlight));
           TempRect := Rect;
           if fcIsInwwGrid(self) then begin
              // 9/20/01 - don't subtract from temprect if its already been done
              if TempRect.right > ClientRect.right - GetIconIndent then
                 TempRect.Right := ClientRect.Right - GetIconIndent;
//              if parent.focused then
//                TwwCheatGridCast(Parent).DoCalcCellColors(FFieldLink.Field, [], True, Font, Brush);
           end;

           PaintImage;
           SkipPaintImage:= True;
           Canvas.DrawFocusRect(TempRect);
        end;

        // Draw the text
        if not fcIsInwwGrid(self) or (not GridPaint) then begin
           SetBkMode(Canvas.Handle, TRANSPARENT);
           SetBkColor(Canvas.Handle, ColorToRGB(fcThisThat(Highlight and (DrawHighlight or Not PaintCopyOutsideGrid), clHighlight, clWindow)));
           SetTextColor(Canvas.Handle, ColorToRGB(fcThisThat(Highlight and (DrawHighlight or not PaintCopyOutsideGrid), clWindow, Font.Color)));
        end;

        PaintText;
     end
     else if not fcisinwwGrid(Self) and
       ((csPaintCopy in ControlState) or Frame.IsFrameEffective) and { 12/12/99 }
       (not Focused) then begin { RSW - 3/17/99 }
        PaintText;
     end;

     if not SkipPaintImage then PaintImage;

     if Frame.IsFrameEffective then
     begin
       DrawFrame(Canvas);
     end;

  finally
     SetBkMode(Canvas.Handle,OldBkMode);
     SetBkColor(Canvas.Handle, OldBkColor);
  end;
end;

procedure TfcCustomTreeCombo.ResyncTreeSelected(LookupText: string);
begin
  if ((TreeView.Selected = nil) or
      (TreeView.Selected.Text <> LookupText)) then
  begin
     if (fcNameInList(Text, FItemsList) <> -1) then
     begin
        TreeView.Selected := TreeView.Items.FindNode(LookupText, False);
        invalidate; { RSW - 2/24/99 }
     end
     else TreeView.Selected:= nil { RSW }
  end
end;

procedure TfcCustomTreeCombo.SelectionChange;
begin
  if Assigned(FOnSelectionChange) then FOnSelectionChange(self);
  TreeView.FCheckChange := False;
end;

procedure TfcCustomTreeCombo.SelectionChanging;
begin
  DataLink.Edit;
  TreeView.FCheckChange := True;
end;

function TfcCustomTreeCombo.GetSorted: Boolean;
begin
  result := TreeView.SortType = fcstText;
end;

function TfcCustomTreeCombo.GetCalcNodeAttributes: TfcCalcNodeAttributesEvent;
begin
  result := TreeView.OnCalcNodeAttributes;
end;

function TfcCustomTreeCombo.GetImageList: TCustomImageList;
begin
  result := TreeView.Images;
end;

function TfcCustomTreeCombo.GetStateImageList: TCustomImageList;
begin
  result := TreeView.StateImages;
end;

function TfcCustomTreeCombo.GetItems: TfcTreeNodes;
begin
  result := TreeView.Items;
end;

function TfcCustomTreeCombo.GetTreeOptions: TfcTreeViewOptions;
begin
  result := TreeView.Options;
end;

{procedure TfcCustomTreeCombo.SetAlignmentVertical(Value: TfcAlignVertical);
begin
  if FAlignmentVertical <> Value then FAlignmentVertical := Value;
end;
}
procedure TfcCustomTreeCombo.SetCalcNodeAttributes(Value: TfcCalcNodeAttributesEvent);
begin
  TreeView.OnCalcNodeAttributes := Value;
end;

procedure TfcCustomTreeCombo.SetItems(Value: TfcTreeNodes);
begin
  TreeView.Items := Value;
end;

procedure TfcCustomTreeCombo.SetImageList(Value: TCustomImageList);
begin
  TreeView.Images := Value;
  if Value <> nil then Value.FreeNotification(self);
  SetEditRect;
end;

procedure TfcCustomTreeCombo.SetStateImageList(Value: TCustomImageList);
begin
  TreeView.StateImages := Value;
  if Value <> nil then Value.FreeNotification(self);
  SetEditRect;
end;

procedure TfcCustomTreeCombo.SetSorted(Value: Boolean);
begin
  if Value then TreeView.SortType := fcstText else TreeView.SortType := fcstNone;
end;

procedure TfcCustomTreeCombo.SetTreeOptions(Value: TfcTreeViewOptions);
begin
  TreeView.Options := Value;
end;

function TfcCustomTreeCombo.GetDropDownControl: TWinControl;
begin
  result := TreeView;
end;

function TfcCustomTreeCombo.GetDropDownContainer: TWinControl;
begin
  result := FPanel;
end;

function TfcCustomTreeCombo.GetItemCount: Integer;
begin
  result := Items.Count;
end;

function TfcCustomTreeCombo.GetItemSize: TSize;
  function LargestRect: TSize;
  var Node: TfcTreeNode;
      i: Integer;
  begin
    result := fcSize(0, 0);
    Node := TreeView.Items.GetFirstNode;
    while Node <> nil do
    begin
      with Node.DisplayRect(True) do
      begin
        TreeView.Canvas.Font:= TreeView.Font; { 4/24/99 - RSW }
        i:= Left + TreeView.Canvas.TextWidth(Node.Text) + 6; { 4/5/99 - RSW }
        if (Node.ImageIndex=-2) and (TreeView.Images<>nil) then inc(i, TImageList(TreeView.Images).Width);

        result.cy := Bottom - Top;
      end;
      if i > result.cx then result.cx := i;
      Node := Node.GetNextVisible;
    end;
  end;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -