treeflow.pas

TeeChart 7.0 With Source在Delphi 7.0中的安装

var ARow : Integer;
    ACol : Integer;
begin
  if (Column>=0) and (Column<FColumns) then
  begin
    Dec(FColumns);

    for ARow:=0 to Rows-1 do
        FreeAndNil(FCell[ARow,Column]);

    for ACol:=Column to Columns-1 do
        for ARow:=0 to Rows-1 do
        begin
          FCell[ARow,ACol]:=FCell[ARow,ACol+1];
          FCell[ARow,ACol].Column:=ACol;
        end;

    for ARow:=0 to Rows-1 do
        FCell[ARow,Columns]:=nil;
  end;
end;

procedure TGridShape.DeleteRow(Row: Integer);
var ACol : Integer;
    ARow : Integer;
begin
  Dec(FRows);

  for ACol:=0 to Columns-1 do
      FreeAndNil(FCell[Row,ACol]);

  for ARow:=Row to Rows-1 do
      for ACol:=0 to Columns-1 do
      begin
        FCell[ARow,ACol]:=FCell[ARow+1,ACol];
        FCell[ARow,ACol].Row:=ARow;
      end;

  for ACol:=0 to Columns-1 do
      FCell[Rows,ACol]:=nil;
end;

function TGridShape.GetCell(Row, Col: Integer): TGridCellShape;
begin
  if not Assigned(FCell[Row,Col]) then
  begin
    FCell[Row,Col]:=TGridCellShape.Create(Self);
    with FCell[Row,Col] do
    begin
      AutoSize:=False;
      Transparent:=True;
    end;

    FCell[Row,Col].Column:=Col;
    FCell[Row,Col].Row:=Row;

    // Call OnNewCell event:
    if Assigned(FOnNewCell) then FOnNewCell(Self,Row,Col);
  end;
  result:=FCell[Row,Col];
end;

procedure TGridShape.SetColumns(const Value: Integer);
begin
  if FColumns<>Value then
  begin
    While Value<FColumns do DeleteColumn(FColumns-1);
    While Value>FColumns do AddColumn;
    Repaint;
  end;
end;

procedure TGridShape.SetGridLines(const Value: TTreePen);
begin
  FGridLines.Assign(Value);
end;

procedure TGridShape.SetRows(const Value: Integer);
begin
  if FRows<>Value then
  begin
    While Value<FRows do DeleteRow(FRows-1);
    While Value>FRows do AddRow;
    Repaint;
  end;
end;

type TCellAccess=class(TGridCellShape);

procedure TGridShape.DrawShapeCanvas(ACanvas: TCanvas3D; const R: TRect);
var tmpRow : Integer;
    tmpCol : Integer;
    tmpR   : TRect;
    tmpR2  : TRect;
begin
  inherited;
  for tmpRow:=0 to Rows-1 do
   for tmpCol:=0 to Columns-1 do
   begin
     tmpR:=CellRect(R,tmpRow,tmpCol);
     with TCellAccess(Cells[tmpRow,tmpCol]) do
     begin
       SetBounds(tmpR);
       
       FTree:=Self.FTree;
       DrawShapeCanvas(ACanvas,tmpR);
       DrawText(ACanvas,tmpR);

       if Selected and (not Tree.Printing) then
       begin
         tmpR2:=tmpR;
         InflateRect(tmpR2,-2,-2);
         SetBounds(tmpR2);
         DrawHandles;
         SetBounds(tmpR);
       end;
     end;
   end;

   if Assigned(Tree) and Tree.Designing then // draw grid lines
   begin
     if FSelectedCol<>-1 then
     begin
       Tree.Canvas.Brush.Color:=clGray;
       tmpR:=CellRect(R,0,FSelectedCol);
       tmpR.Top:=R.Top;
       tmpR.Bottom:=R.Bottom;
       Tree.Canvas.RectangleWithZ(tmpR,TeeTreeZ);
     end;

     Tree.Canvas.AssignVisiblePen(FGridLines);
     for tmpRow:=1 to Rows-1 do
     begin
       tmpR:=CellRect(R,tmpRow,0);
       Tree.Canvas.HorizLine3D(R.Left,R.Right,tmpR.Top,TeeTreeZ);
     end;

     for tmpCol:=1 to Columns-1 do
     begin
       tmpR:=CellRect(R,0,tmpCol);
       Tree.Canvas.VertLine3D(tmpR.Left,R.Top,R.Bottom,TeeTreeZ);
     end;
   end;
end;

function TGridShape.CellRect(Const R:TRect; Row, Col: Integer): TRect;
var t    : Integer;
    tmpW : Integer;
    tmpH : Integer;
begin
  if AutoSize then
  begin
    result.Left:=R.Left;
    for t:=0 to Col-1 do Inc(result.Left,Cells[Row,t].Width);

    result.Top:=R.Top;
    for t:=0 to Row-1 do Inc(result.Top,Cells[t,Col].Height);

    result.Right:=result.Left+Cells[Row,Col].Width;
    result.Bottom:=result.Top+Cells[Row,Col].Height;
  end
  else
  begin
    tmpW:=Width div Columns;
    result.Left:=R.Left+Col*tmpW;
    if Col=Columns-1 then result.Right:=R.Right
                     else result.Right:=result.Left+tmpW;

    tmpH:=Height div Rows;
    result.Top:=R.Top+Row*tmpH;
    if Row=Rows-1 then result.Bottom:=R.Bottom
                  else result.Bottom:=result.Top+tmpH;
  end;
end;

function TGridShape.GetHandleCursor(x, y: Integer): TCursor;
var tmpR : TRect;
    tmp  : TTreeNodeShape;
begin
  result:=inherited GetHandleCursor(x,y);
  if result=crDefault then
  begin
    tmpR:=Bounds;
    if ((y>=tmpR.Top) and (y<=tmpR.Bottom)) and
       (Abs(x-tmpR.Left)<3) then result:=crArrowRight
    else
    if ((x>=tmpR.Left) and (x<=tmpR.Right)) and
       (Abs(y-tmpR.Top)<3) then result:=crArrowDown
    else
    begin
      tmp:=CellAt(x,y);
      if Assigned(tmp) then result:=tmp.Cursor;
    end;
  end;
end;

function TGridShape.CellAt(x, y: Integer): TGridCellShape;
var tmpRow : Integer;
    tmpCol : Integer;
begin
  result:=nil;
  for tmpRow:=0 to Rows-1 do
    for tmpCol:=0 to Columns-1 do
       if PointInRect(CellRect(Bounds,tmpRow,tmpCol),x,y) then
       begin
         result:=Cells[tmpRow,tmpCol];
         exit;
       end;
end;

procedure TGridShape.RecalcSize;
var tmpCol    : Integer;
    tmpRow    : Integer;
    tmpW      : Integer;
    tmpH      : Integer;
    tmpTotalW : Integer;
    tmpTotalH : Integer;
begin
  tmpTotalW:=0;
  tmpTotalH:=0;

  // Calculate each Columns Width
  for tmpCol:=0 to Columns-1 do
  begin
    if Rows=1 then  // special case for single-row grid:
    begin
      with Cells[0,tmpCol] do
      begin
        RecalcSize(Self.Tree.Canvas);
        Inc(tmpTotalW,Width);
        if Height>tmpTotalH then tmpTotalH:=Height;
      end;
    end
    else
    begin
      tmpW:=0;

      // Find maximum width of this column:
      for tmpRow:=0 to Rows-1 do
      begin
        with Cells[tmpRow,tmpCol] do
        begin
          RecalcSize(Self.Tree.Canvas);
          if Width>tmpW then tmpW:=Width;
        end;
      end;

      // Set max Width to all rows of this column:
      for tmpRow:=0 to Rows-1 do
      with Cells[tmpRow,tmpCol] do
           if Width<tmpW then Width:=tmpW;

      Inc(tmpTotalW,tmpW);
    end;
  end;

  if Rows>1 then
  begin
    // Calculate total Height of all rows:
    tmpTotalH:=0;

    for tmpRow:=0 to Rows-1 do
    begin
      // Find maximum Height of this row:
      tmpH:=0;
      for tmpCol:=0 to Columns-1 do
          with Cells[tmpRow,tmpCol] do
               if Height>tmpH then tmpH:=Height;

      // Set max Height to all cells of this row:
      for tmpCol:=0 to Columns-1 do
          with Cells[tmpRow,tmpCol] do
               if Height<tmpH then Height:=tmpH;

      Inc(tmpTotalH,tmpH);
    end;
  end;

  // Set total grid size:
  Width:=tmpTotalW;
  Height:=tmpTotalH;

  // Reset AutoSize and IAutoSized to True:
  AutoSize:=True;
  IAutoSized:=True;
end;

procedure TGridShape.Loaded;
begin
  inherited;
  SimpleText:='';
end;

procedure TGridShape.ClearSelection;
var Row : Integer;
    Col : Integer;
begin
  for Row:=0 to Rows-1 do
      for Col:=0 to Columns-1 do
          if Assigned(FCell[Row,Col]) then
             FCell[Row,Col].Selected:=False;
end;

// Returns the selected grid cell:
function TGridShape.GetEditedShape: TTreeNodeShape;
var Row : Integer;
    Col : Integer;
begin
  for Row:=0 to Rows-1 do
      for Col:=0 to Columns-1 do
          if Assigned(FCell[Row,Col]) and
             FCell[Row,Col].Selected then
          begin
            result:=FCell[Row,Col];
            exit;
          end;
  result:=Self;
end;

Procedure TGridShape.DoClick( Button:TMouseButton; Shift:TShiftState;
                              x,y:Integer);
var tmp : TGridCellShape;
begin
  // When clicking the Grid, try to select the individual grid cell
  // under mouse XY:

  if Selected and Assigned(Tree) and Tree.Designing then
  begin
    ClearSelection;
    tmp:=CellAt(x,y);
    if Assigned(tmp) then
       tmp.Selected:=True;  // select the individual cell
  end;
end;

procedure TGridShape.SetSelected(Value: Boolean);
begin
  inherited;
  if not Selected then ClearSelection;
end;

{ TGridCellShape }

procedure TGridCellShape.CanvasChanged(Sender: TObject);
begin
  if Owner is TTreeNodeShape then
     TCellAccess(Owner).CanvasChanged(Sender)
  else
     inherited;
end;

procedure TGridCellShape.SetSelected(Value: Boolean);
begin
  SetBooleanProperty(FSelected,Value);
end;

{ TBeveledShape }

constructor TBeveledShape.Create(AOwner: TComponent);
begin
  inherited;
  FBevel:=bvRaised;
  FBevelSize:=1;
  //Color:=clBtnFace //gives an weird effect at Shadow and Transparent properities of teeInspector...
  Color:=clSilver; //tom:20/10/2002
end;

procedure TBeveledShape.DrawShapeCanvas(ACanvas: TCanvas3D; const R: TRect);

  procedure Frame3D(Var Rect: TRect; TopColor, BottomColor: TColor;
    Width: Integer);

    procedure DoRect;
    begin
      with ACanvas, Rect do
      begin
        Pen.Color := TopColor;
        DoVertLine(Left,Top,Bottom);
        DoHorizLine(Left,Right,Top);
        Pen.Color := BottomColor;
        DoVertLine(Right,Top,Bottom);
        DoHorizLine(Left-1,Right+1,Bottom);
      end;
    end;

  begin
    ACanvas.Pen.Width := 1;
    Dec(Rect.Bottom);
    Dec(Rect.Right);
    while Width > 0 do
    begin
      Dec(Width);
      DoRect;
      InflateRect(Rect, -1, -1);
    end;
    Inc(Rect.Bottom); Inc(Rect.Right);
  end;

Const Colors:Array[Boolean] of TColor=(clBtnHighlight,clBtnShadow);
var Rect : TRect;
begin
  inherited;
  if FBevel<>bvNone then
  begin
    With ACanvas.Pen do
    begin
      Style:=psSolid;
      Width:=1;
      Mode:=pmCopy;
    end;
    ACanvas.Brush.Style:=bsClear;

    Rect:=RectTo3DCanvas(ACanvas,R);
    Frame3D(Rect,Colors[FBevel=bvLowered],Colors[FBevel=bvRaised],FBevelSize);
  end;
end;

procedure TBeveledShape.SetBevel(const Value: TPanelBevel);
begin
  if FBevel<>Value then
  begin
    FBevel:=Value;
    Repaint;
  end;
end;

procedure TBeveledShape.SetBevelSize(const Value: Integer);
begin
  SetIntegerProperty(FBevelSize,Value);
end;

initialization
  // alias classes:
  RegisterClass(TConditionShape);
  RegisterClass(TTitleShape);
  RegisterClass(TCardShape);
  RegisterClass(TManualShape);
  RegisterClass(TDataShape);
  RegisterClass(TTapeShape);

  // shapes:
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Decision', TDecisionShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Process', TProcessShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Predefined Process', TPredefinedProcessShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Terminal', TTerminalShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Connector', TConnectorShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Input/Output',     TInputOutputShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Manual Operation',   TManualOperationShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Select',    TSelectShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Document',  TDocumentShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Punched Card', TPunchCardShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Punched Tape', TPunchTapeShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Delay',     TDelayShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Manual Input',    TManualInputShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'And',       TAndShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Or',        TOrShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Online Storage', TOnlineStorageShape);
  RegisterCustomTreeShape(TeeTree_tabFlow, 'Magnetic Tape', TMagneticTapeShape);

  RegisterCustomTreeShape(TeeTree_tabOther, 'Pentagon', TPentagonShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Hexagon',  THexagonShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Octagon',  TOctagonShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Cross',    TCrossShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Triangle Rect. Right', TTriangleRectRightShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Triangle Rect. Left',  TTriangleRectLeftShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'House',  THouseShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Envelope',  TEnvelopeShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Ring',  TRingShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'ArrowUp',  TArrowUpShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'ArrowDown',  TArrowDownShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'ArrowLeft',  TArrowLeftShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'ArrowRight',  TArrowRightShape);

  RegisterCustomTreeShape(TeeTree_tabOther, 'CallOut',  TCallOutShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Start',  TStarShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Grid',  TGridShape);
  RegisterCustomTreeShape(TeeTree_tabOther, 'Bevel',  TBeveledShape);
finalization
  UnRegisterCustomTreeShapes([TDecisionShape,TInputOutputShape,TProcessShape,
                              TPredefinedProcessShape, TConnectorShape, TTerminalShape,
                              TSelectShape,TDocumentShape,TPunchCardShape,
                              TPunchTapeShape,TDelayShape, TManualInputShape,
                              TAndShape,TOrShape, TOnlineStorageShape, TMagneticTapeShape]);

  UnRegisterCustomTreeShapes([TPentagonShape,THexagonShape,TOctagonShape,
                              TCrossShape,TTriangleRectRightShape,
                              TTriangleRectLeftShape,THouseShape,TEnvelopeShape,
                              TRingShape,TArrowUpShape,TArrowDownShape,
                              TArrowLeftShape,TArrowRightShape,
                              TCallOutShape,TStarShape,TGridShape,
                              TBeveledShape]);
end.