tb97tlbr.pas

详细的ERP设计资料

    S, S1: TPoint;
    S2: TSmallPoint;
  begin
    with PToolbar97SizeData(SizeData)^ do begin
      SaveFloatingRightX := FFloatingRightX;
      try
        FFloatingRightX := 0;
        S := OrderControls(False, dtNotDocked, nil);
        S1 := S;
        AddFloatingNCAreaToSize (S1, Resizable);
        S2 := PointToSmallPoint(S1);
        NewSizes.Add (Pointer(S2));
        LastY := S.Y;
        Max := S.X;
        SkipTo := High(SkipTo);
        for X := Max-1 downto LeftMarginNotDocked+CurBarSize+RightMarginNotDocked do begin
          if X > SkipTo then Continue;
          FFloatingRightX := X;
          S := OrderControls(False, dtNotDocked, nil);
          if X = S.X then begin
            if S.Y = LastY then
              NewSizes.Delete (NewSizes.Count-1);
            S1 := S;
            AddFloatingNCAreaToSize (S1, Resizable);
            S2 := PointToSmallPoint(S1);
            if NewSizes.IndexOf(Pointer(S2)) = -1 then
              NewSizes.Add (Pointer(S2));
            LastY := S.Y;
          end
          else
            SkipTo := S.X;
        end;
      finally
        FFloatingRightX := SaveFloatingRightX;
      end;
      ListSortEx (NewSizes, CompareNewSizes, Pointer(Longint(YOrdering)));
    end;
  end;
const
  MaxSizeSens = 12;
var
  I, NewSize: Integer;
  S, N: TSmallPoint;
begin
  inherited;

  SizeData := AllocMem(SizeOf(TToolbar97SizeData));

  with PToolbar97SizeData(SizeData)^ do begin
    HitTest := HitTestValue;
    CurRightX := FFloatingRightX;
    DisableSensCheck := False;
    OpSide := False;
    GetBarSize (CurBarSize, dtNotDocked);
    NewSizes := TList.Create;

    BuildNewSizes (HitTestValue in [HTTOP, HTBOTTOM]);

    SizeSens := MaxSizeSens;
    { Adjust sensitivity if it's too high }
    for I := 0 to NewSizes.Count-1 do begin
      Pointer(S) := NewSizes[I];
      if (S.X = Width) and (S.Y = Height) then begin
        if I > 0 then begin
          Pointer(N) := NewSizes[I-1];
          if HitTestValue in [HTLEFT, HTRIGHT] then
            NewSize := N.X - S.X - 1
          else
            NewSize := N.Y - S.Y - 1;
          if NewSize < SizeSens then SizeSens := NewSize;
        end;
        if I < NewSizes.Count-1 then begin
          Pointer(N) := NewSizes[I+1];
          if HitTestValue in [HTLEFT, HTRIGHT] then
            NewSize := S.X - N.X - 1
          else
            NewSize := S.Y - N.Y - 1;
          if NewSize < SizeSens then SizeSens := NewSize;
        end;
        Break;
      end;
    end;
    if SizeSens < 0 then SizeSens := 0;
  end;
end;

procedure TCustomToolbar97.ResizeTrack (var Rect: TRect; const OrigRect: TRect);
var
  Pos: TPoint;
  NCXDiff: Integer;
  NewOpSide: Boolean;
  Reverse: Boolean;
  I: Integer;
  P: TSmallPoint;
begin
  inherited;

  with PToolbar97SizeData(SizeData)^ do begin
    GetCursorPos (Pos);

    NCXDiff := ClientToScreen(Point(0, 0)).X - Left;
    Dec (Pos.X, Left);  Dec (Pos.Y, Top);
    if HitTest = HTLEFT then
      Pos.X := Width-Pos.X
    else
    if HitTest = HTTOP then
      Pos.Y := Height-Pos.Y;

    { Adjust Pos to make up for the "sizing sensitivity", as seen in Office 97 }
    if HitTest in [HTLEFT, HTRIGHT] then
      NewOpSide := Pos.X < Width
    else
      NewOpSide := Pos.Y < Height;
    if (not DisableSensCheck) or (OpSide <> NewOpSide) then begin
      DisableSensCheck := False;
      OpSide := NewOpSide;
      if HitTest in [HTLEFT, HTRIGHT] then begin
        if (Pos.X >= Width-SizeSens) and (Pos.X < Width+SizeSens) then
          Pos.X := Width;
      end
      else begin
        if (Pos.Y >= Height-SizeSens) and (Pos.Y < Height+SizeSens) then
          Pos.Y := Height;
      end;
    end;

    Rect := OrigRect;

    if HitTest in [HTLEFT, HTRIGHT] then
      Reverse := Pos.X > Width
    else
      Reverse := Pos.Y > Height;
    if not Reverse then
      I := NewSizes.Count-1
    else
      I := 0;
    while True do begin
      if (not Reverse and (I < 0)) or
         (Reverse and (I >= NewSizes.Count)) then
        Break;
      Pointer(P) := NewSizes[I];
      if HitTest in [HTLEFT, HTRIGHT] then begin
        if (not Reverse and ((I = NewSizes.Count-1) or (Pos.X >= P.X))) or
           (Reverse and ((I = 0) or (Pos.X < P.X))) then begin
          if I = 0 then
            CurRightX := 0
          else
            CurRightX := P.X - NCXDiff*2;
          if HitTest = HTRIGHT then
            Rect.Right := Rect.Left + P.X
          else
            Rect.Left := Rect.Right - P.X;
          Rect.Bottom := Rect.Top + P.Y;
          DisableSensCheck := not EqualRect(Rect, OrigRect);
        end;
      end
      else begin
        if (not Reverse and ((I = NewSizes.Count-1) or (Pos.Y >= P.Y))) or
           (Reverse and ((I = 0) or (Pos.Y < P.Y))) then begin
          if I = NewSizes.Count-1 then
            CurRightX := 0
          else
            CurRightX := P.X - NCXDiff*2;
          if HitTest = HTBOTTOM then
            Rect.Bottom := Rect.Top + P.Y
          else
            Rect.Top := Rect.Bottom - P.Y;
          Rect.Right := Rect.Left + P.X;
          DisableSensCheck := not EqualRect(Rect, OrigRect);
        end;
      end;
      if not Reverse then
        Dec (I)
      else
        Inc (I);
    end;
  end;
end;

procedure TCustomToolbar97.ResizeEnd (Accept: Boolean);
begin
  inherited;
  if Assigned(SizeData) then begin
    with PToolbar97SizeData(SizeData)^ do begin
      if Accept then
        FFloatingRightX := CurRightX;
      NewSizes.Free;
    end;
    FreeMem (SizeData);
  end;
end;

function TCustomToolbar97.GetOrderIndex (Control: TControl): Integer;
begin
  Result := OrderList.IndexOf(Control);
  if Result = -1 then
    raise EInvalidOperation.CreateFmt(STB97ToolbarControlNotChildOfToolbar,
      [Control.Name]);
end;

procedure TCustomToolbar97.SetOrderIndex (Control: TControl; Value: Integer);
var
  OldIndex: Integer;
begin
  with OrderList do begin
    OldIndex := IndexOf(Control);
    if OldIndex = -1 then
      raise EInvalidOperation.CreateFmt(STB97ToolbarControlNotChildOfToolbar,
        [Control.Name]);
    if Value < 0 then Value := 0;
    if Value >= Count then Value := Count-1;
    if Value <> OldIndex then begin
      Delete (OldIndex);
      Insert (Value, Control);
      ArrangeControls;
    end;
  end;
end;

procedure TCustomToolbar97.SetFloatingWidth (Value: Integer);
begin
  if FFloatingRightX <> Value then begin
    FFloatingRightX := Value;
    ArrangeControls;
  end;
end;

procedure TCustomToolbar97.SetSlaveControl (const ATopBottom, ALeftRight: TControl);
var
  NewVersion: PSlaveInfo;
begin
  GetMem (NewVersion, SizeOf(TSlaveInfo));
  with NewVersion^ do begin
    TopBottom := ATopBottom;
    LeftRight := ALeftRight;
  end;
  SlaveInfo.Add (NewVersion);
  ArrangeControls;
end;

function TCustomToolbar97.ChildControlTransparent (Ctl: TControl): Boolean;
begin
  Result := Ctl is TToolbarSep97;
end;


{ TToolbarSep97 }

constructor TToolbarSep97.Create (AOwner: TComponent);
begin
  inherited;
  FSizeHorz := 6;
  FSizeVert := 6;
  ControlStyle := ControlStyle - [csOpaque, csCaptureMouse];
end;

procedure TToolbarSep97.SetParent (AParent: TWinControl);
begin
  if (AParent <> nil) and not(AParent is TCustomToolbar97) then
    raise EInvalidOperation.Create(STB97SepParentNotAllowed);
  inherited;
end;

procedure TToolbarSep97.SetBlank (Value: Boolean);
begin
  if FBlank <> Value then begin
    FBlank := Value;
    Invalidate;
  end;
end;

procedure TToolbarSep97.SetSizeHorz (Value: TToolbarSepSize);
begin
  if FSizeHorz <> Value then begin
    FSizeHorz := Value;
    if Parent is TCustomToolbar97 then
      TCustomToolbar97(Parent).ArrangeControls;
  end;
end;

procedure TToolbarSep97.SetSizeVert (Value: TToolbarSepSize);
begin
  if FSizeVert <> Value then begin
    FSizeVert := Value;
    if Parent is TCustomToolbar97 then
      TCustomToolbar97(Parent).ArrangeControls;
  end;
end;

procedure TToolbarSep97.Paint;
var
  R: TRect;
  Z: Integer;
begin
  inherited;
  if not(Parent is TCustomToolbar97) then Exit;

  with Canvas do begin
    { Draw dotted border in design mode }
    if csDesigning in ComponentState then begin
      Pen.Style := psDot;
      Pen.Color := clBtnShadow;
      Brush.Style := bsClear;
      R := ClientRect;
      Rectangle (R.Left, R.Top, R.Right, R.Bottom);
      Pen.Style := psSolid;
    end;

    if not FBlank then
      if GetDockTypeOf(TCustomToolbar97(Parent).DockedTo) <> dtLeftRight then begin
        Z := Width div 2;
        Pen.Color := clBtnShadow;
        MoveTo (Z-1, 0);  LineTo (Z-1, Height);
        Pen.Color := clBtnHighlight;
        MoveTo (Z, 0);  LineTo (Z, Height);
      end
      else begin
        Z := Height div 2;
        Pen.Color := clBtnShadow;
        MoveTo (0, Z-1);  LineTo (Width, Z-1);
        Pen.Color := clBtnHighlight;
        MoveTo (0, Z);  LineTo (Width, Z);
      end;
  end;
end;

procedure TToolbarSep97.MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  inherited;
  if not(Parent is TCustomToolbar97) then Exit;

  { Relay the message to the parent toolbar }
  P := Parent.ScreenToClient(ClientToScreen(Point(X, Y)));
  TCustomToolbar97(Parent).MouseDown (Button, Shift, P.X, P.Y);
end;

end.