jvdocksupportcontrol.pas

East make Tray Icon in delphi

  if FStyle <> Value then
  begin
    if (Value <> tsTabs) and (TabPosition <> tpTop) then
      raise EInvalidOperation.CreateRes(@SInvalidTabStyle);
    FStyle := Value;
    RecreateWnd;
  end;
end;

procedure TJvDockCustomTabControl.SetTabHeight(Value: Smallint);
begin
  if FTabSize.Y <> Value then
  begin
    if Value < 0 then
      raise EInvalidOperation.CreateResFmt(@SPropertyOutOfRange, [Self.Classname]);
    FTabSize.Y := Value;
    UpdateTabSize;
  end;
end;

procedure TJvDockCustomTabControl.SetTabIndex(Value: Integer);
begin
  SendMessage(Handle, TCM_SETCURSEL, Value, 0);
end;

procedure TJvDockCustomTabControl.SetTabPosition(Value: TTabPosition);
begin
  if FTabPosition <> Value then
  begin
    if (Value <> tpTop) and (Style <> tsTabs) then
      raise EInvalidOperation.CreateRes(@SInvalidTabPosition);
    FTabPosition := Value;
    if not MultiLine and ((Value = tpLeft) or (Value = tpRight)) then
      InternalSetMultiLine(True);
    RecreateWnd;
  end;
end;

procedure TJvDockCustomTabControl.SetTabs(Value: TStrings);
begin
  FTabs.Assign(Value);
end;

procedure TJvDockCustomTabControl.SetTabWidth(Value: Smallint);
var
  OldValue: Smallint;
begin
  if FTabSize.X <> Value then
  begin
    if Value < 0 then
      raise EInvalidOperation.CreateResFmt(@SPropertyOutOfRange, [Self.ClassName]);
    OldValue := FTabSize.X;
    FTabSize.X := Value;
    if (OldValue = 0) or (Value = 0) then
      RecreateWnd
    else
      UpdateTabSize;
  end;
end;

function TJvDockCustomTabControl.TabRect(Index: Integer): TRect;
begin
  TabCtrl_GetItemRect(Handle, Index, Result);
end;

procedure TJvDockCustomTabControl.TabsChanged;
begin
  if not FUpdating then
  begin
    if HandleAllocated then
      SendMessage(Handle, WM_SIZE, SIZE_RESTORED,
        Word(Width) or Word(Height) shl 16);
    Realign;
  end;
end;

procedure TJvDockCustomTabControl.TCMAdjustRect(var Msg: TMessage);
begin
  try
    inherited;
    if (TabPosition <> tpTop) and (Msg.WParam = 0) then
      FSavedAdjustRect := PRect(Msg.LParam)^;
  except
    PRect(Msg.LParam)^ := FSavedAdjustRect;
  end;
end;

procedure TJvDockCustomTabControl.UpdateTabImages;
var
  I: Integer;
  TCItem: TTCItem;
begin
  TCItem.mask := TCIF_IMAGE;
  for I := 0 to FTabs.Count - 1 do
  begin
    TCItem.iImage := GetImageIndex(I);
    if SendMessage(Handle, TCM_SETITEM, I,
      Longint(@TCItem)) = 0 then
      TabControlError(Format(sTabFailSet, [FTabs[I], I]));
  end;
  TabsChanged;
end;

procedure TJvDockCustomTabControl.UpdateTabSize;
begin
  SendMessage(Handle, TCM_SETITEMSIZE, 0, Integer(FTabSize));
  TabsChanged;
end;

procedure TJvDockCustomTabControl.WMDestroy(var Msg: TWMDestroy);
var
  FocusHandle: HWND;
begin
  if (FTabs <> nil) and (FTabs.Count > 0) then
  begin
    FSaveTabs := TStringList.Create;
    FSaveTabs.Assign(FTabs);
    FSaveTabIndex := GetTabIndex;
  end;
  FocusHandle := GetFocus;
  if (FocusHandle <> 0) and ((FocusHandle = Handle) or
    IsChild(Handle, FocusHandle)) then
    Windows.SetFocus(0);
  inherited;
  WindowHandle := 0;
end;

procedure TJvDockCustomTabControl.WMNotifyFormat(var Msg: TMessage);
begin
  with Msg do
    Result := DefWindowProc(Handle, Msg, WParam, LParam);
end;

procedure TJvDockCustomTabControl.WMSize(var Msg: TMessage);
begin
  inherited;
  RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE);
end;

//=== { TJvDockDragDockObject } ==============================================

constructor TJvDockDragDockObject.Create(AControl: TControl);
begin
  inherited Create;
  FControl := AControl;
  FBrush := TBrush.Create;
  FBrush.Bitmap := AllocPatternBitmap(clBlack, clWhite);
  FFrameWidth := 4;
  FCtrlDown := False;
end;

destructor TJvDockDragDockObject.Destroy;
begin
  if FBrush <> nil then
  begin
    FBrush.Free;
    FBrush := nil;
  end;
  inherited Destroy;
end;

procedure TJvDockDragDockObject.AdjustDockRect(const ARect: TRect);
var
  DeltaX, DeltaY: Integer;
  R: TRect;

  function AbsMin(Value1, Value2: Integer): Integer;
  begin
    if Abs(Value1) < Abs(Value2) then
      Result := Value1
    else
      Result := Value2;
  end;

begin
  if (ARect.Left > FDragPos.X) or (ARect.Right < FDragPos.X) then
    DeltaX := AbsMin(ARect.Left - FDragPos.X, ARect.Right - FDragPos.X)
  else
    DeltaX := 0;
  if (ARect.Top > FDragPos.Y) or (ARect.Bottom < FDragPos.Y) then
    DeltaY := AbsMin(ARect.Top - FDragPos.Y, ARect.Bottom - FDragPos.Y)
  else
    DeltaY := 0;
  if (DeltaX <> 0) or (DeltaY <> 0) then
  begin
    R := DockRect;
    OffsetRect(R, -DeltaX, -DeltaY);
    DockRect := R;
  end;
end;

function TJvDockDragDockObject.CanLeave(NewTarget: TWinControl): Boolean;
begin
  Result := NewTarget <> TWinControl(FDragTarget);
end;

function TJvDockDragDockObject.Capture: HWND;
begin
  Result := AllocateHWnd(MouseMsg);
  SetCapture(Result);
end;

procedure TJvDockDragDockObject.DefaultDockImage(Erase: Boolean);
var
  DesktopWindow: HWND;
  DC: HDC;
  OldBrush: HBRUSH;
  DrawRect: TRect;
  PenSize: Integer;
  Brush: TBrush;
begin
  GetBrush_PenSize_DrawRect(Brush, PenSize, DrawRect, Erase);

  DesktopWindow := GetDesktopWindow;
  DC := GetDCEx(DesktopWindow, 0, DCX_CACHE or DCX_LOCKWINDOWUPDATE);
  try
    OldBrush := SelectObject(DC, Brush.Handle);
    with DrawRect do
    begin
      PatBlt(DC, Left + PenSize, Top, Right - Left - PenSize, PenSize, PATINVERT);
      PatBlt(DC, Right - PenSize, Top + PenSize, PenSize, Bottom - Top - PenSize, PATINVERT);
      PatBlt(DC, Left, Bottom - PenSize, Right - Left - PenSize, PenSize, PATINVERT);
      PatBlt(DC, Left, Top, PenSize, Bottom - Top - PenSize, PATINVERT);
    end;
    SelectObject(DC, OldBrush);
  finally
    ReleaseDC(DesktopWindow, DC);
  end;
end;

function TJvDockDragDockObject.DragFindWindow(const Pos: TPoint): HWND;
var
  WinControl: TWinControl;
begin
  WinControl := FindVCLWindow(Pos);
  if WinControl <> nil then
    Result := WinControl.Handle
  else
    Result := 0;
end;

procedure TJvDockDragDockObject.DrawDragDockImage;
begin
  DefaultDockImage(False);
end;

procedure TJvDockDragDockObject.DrawDragRect(DoErase: Boolean);
begin
  if not CompareMem(@DockRect, @EraseDockRect, SizeOf(TRect)) then
  begin
    if DoErase then
      EraseDragDockImage;
    DrawDragDockImage;
    FEraseDockRect := DockRect;
  end;
end;

procedure TJvDockDragDockObject.EndDrag(Target: TObject; X, Y: Integer);
begin
  JvGlobalDockManager.DoEndDrag(Target, X, Y);
end;

procedure TJvDockDragDockObject.EraseDragDockImage;
begin
  DefaultDockImage(True);
end;

procedure TJvDockDragDockObject.Finished(Target: TObject; X, Y: Integer;
  Accepted: Boolean);
begin
  if not Accepted then
    Target := nil;
  EndDrag(Target, X, Y);
end;

procedure TJvDockDragDockObject.GetBrush_PenSize_DrawRect(var ABrush: TBrush;
  var PenSize: Integer; var DrawRect: TRect; Erase: Boolean);
begin
  ABrush := Brush;
  PenSize := FrameWidth;
  if Erase then
    DrawRect := EraseDockRect
  else
    DrawRect := DockRect;
end;

function TJvDockDragDockObject.GetDragCursor(Accepted: Boolean;
  X, Y: Integer): TCursor;
begin
  Result := crDefault;
end;

function TJvDockDragDockObject.GetDragImages: TDragImageList;
begin
  Result := nil;
end;

function TJvDockDragDockObject.GetDropCtl: TControl;
var
  NextCtl: TControl;
  TargetCtl: TWinControl;
  CtlIdx: Integer;

  function GetDockClientsIndex: Integer;
  begin
    for Result := 0 to TWinControlAccessProtected(TargetCtl).DockClientCount - 1 do
      if TWinControlAccessProtected(TargetCtl).DockClients[Result] = NextCtl then
        Exit;
    Result := -1;
  end;

begin
  Result := nil;
  TargetCtl := DragTarget;
  if (TargetCtl = nil) or not TWinControlAccessProtected(TargetCtl).UseDockManager or
    (TargetCtl.DockClientCount = 0) or
    ((TargetCtl.DockClientCount = 1) and
    (TWinControlAccessProtected(TargetCtl).DockClients[0] = Control)) then
    Exit;
  NextCtl := FindDragTarget(DragPos, False);
  while (NextCtl <> nil) and (NextCtl <> TargetCtl) do
  begin
    CtlIdx := GetDockClientsIndex;
    if CtlIdx <> -1 then
    begin
      Result := TargetCtl.DockClients[CtlIdx];
      Exit;
    end
    else
      NextCtl := NextCtl.Parent;
  end;
end;

function TJvDockDragDockObject.GetFrameWidth: Integer;
begin
  Result := FFrameWidth;
end;

function TJvDockDragDockObject.GetTargetControl: TWinControl;
begin
  if FDragTarget <> nil then
    Result := TWinControl(FDragTarget)
  else
    Result := nil;
end;

procedure TJvDockDragDockObject.MouseMsg(var Msg: TMessage);
var
  P: TPoint;

  procedure DoDragDone(DropFlag: Boolean); {NEW! Warren added.}
  var
    DS: TJvDockServer;
    DC: TJvDockClient;
    DP: TJvDockPanel;
    DF: TForm;
  begin
    if not Assigned(JvGlobalDockManager) then
      Exit;

    if DropFlag and Assigned(FControl) then
    begin
      // only do this if DropFlag is true and there is a control (usually a form) we are dragging
      if not Assigned(TargetControl) then
      begin
        {$IFDEF JVDOCK_DEBUG}
        OutputDebugString('TJvDockDragDockObject.MouseMsg.DoDragDone: User drag finished, TargetControl=nil, user made form floating.');
        {$ENDIF JVDOCK_DEBUG}

        {In this case, we're dragging something off and making it floating. }
          {if Assigned(FControl) then
            DC := FindDockClient(FControl)
          else
             DC := nil;

          DP := nil;
          DS := nil;
          DF := nil;
          if Assigned(DC) then begin
            if Assigned(DC.OnCheckIsDockable) then begin
                DC.OnCheckIsDockable( DC, DF, DS, DP, DropFlag );
            end;
          end;}
      end
      else
      if TargetControl is TJvDockPanel then
      begin
        { In this case, we're about to dock to a TJvDockPanel }
          {DP := TargetControl as TJvDockPanel;
          DS := DP.DockServer;
          DC := FindDockClient(FControl);
          if FControl is TForm then
            DF := FControl as TForm
          else
            DF := nil;
          if Assigned(DC.OnCheckIsDockable) then begin
              DC.OnCheckIsDockable( DC, DF, DS, DP, DropFlag );
          end;}
      end
      else
      if TargetControl is TForm then
      begin
        { This appears to have something to do with conjoined and tabbed host forms }
        DC := FindDockClient(TargetControl);
        DP := nil;
        DS := nil;
        if FControl is TForm then
          DF := FControl as TForm
        else