jvdocksupportcontrol.pas

East make Tray Icon in delphi

    if Assigned(FOnMoved) then
      FOnMoved(Self);
    FOldSize := FNewSize;

  end;
end;

procedure TJvDockCustomPanelSplitter.UpdateSize(X, Y: Integer);
begin
  CalcSplitSize(X, Y, FNewSize, FSplit);
end;

//=== { TJvDockCustomTabControl } ============================================

constructor TJvDockCustomTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 289;
  Height := 193;
  TabStop := True;
  ControlStyle := [csAcceptsControls, csDoubleClicks];
  FTabs := TJvDockTabStrings.Create;
  FTabs.FTabControl := Self;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
end;

destructor TJvDockCustomTabControl.Destroy;
begin
  FreeAndNil(FTabs);
  FreeAndNil(FSaveTabs);
  FreeAndNil(FImageChangeLink);
  inherited Destroy;
end;

procedure TJvDockCustomTabControl.AdjustClientRect(var Rect: TRect);
begin
  Rect := DisplayRect;
  inherited AdjustClientRect(Rect);
end;

function TJvDockCustomTabControl.CanChange: Boolean;
begin
  Result := True;
  if Assigned(FOnChanging) then
    FOnChanging(Self, Result);
end;

function TJvDockCustomTabControl.CanShowTab(TabIndex: Integer): Boolean;
begin
  Result := True;
end;

procedure TJvDockCustomTabControl.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TJvDockCustomTabControl.CMDialogChar(var Msg: TCMDialogChar);
var
  I: Integer;
begin
  for I := 0 to FTabs.Count - 1 do
    if IsAccel(Msg.CharCode, FTabs[I]) and CanShowTab(I) and CanFocus then
    begin
      Msg.Result := 1;
      if CanChange then
      begin
        TabIndex := I;
        Change;
      end;
      Exit;
    end;
  inherited;
end;

procedure TJvDockCustomTabControl.CMFontChanged(var Msg);
begin
  inherited;
  if HandleAllocated then
    Perform(WM_SIZE, 0, 0);
end;

procedure TJvDockCustomTabControl.CMSysColorChange(var Msg: TMessage);
begin
  inherited;
  if not (csLoading in ComponentState) then
  begin
    Msg.Msg := WM_SYSCOLORCHANGE;
    DefaultHandler(Msg);
  end;
end;

procedure TJvDockCustomTabControl.CMTabStopChanged(var Msg: TMessage);
begin
  if not (csDesigning in ComponentState) then
    RecreateWnd;
end;

procedure TJvDockCustomTabControl.CNDrawItem(var Msg: TWMDrawItem);
var
  SaveIndex: Integer;
begin
  with Msg.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    Canvas.Lock;
    try
      Canvas.Handle := hDC;
      Canvas.Font := Font;
      Canvas.Brush := Brush;
      DrawTab(itemID, rcItem, itemState and ODS_SELECTED <> 0);
    finally
      Canvas.Handle := 0;
      Canvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;
  end;
  Msg.Result := 1;
end;

procedure TJvDockCustomTabControl.CNNotify(var Msg: TWMNotify);
begin
  with Msg do
    case NMHdr^.code of
      TCN_SELCHANGE:
        Change;
      TCN_SELCHANGING:
        Result := Ord(not CanChange);
    end;
end;

procedure TJvDockCustomTabControl.CreateParams(var Params: TCreateParams);
const
  AlignStyles: array [Boolean, TTabPosition] of DWORD =
   ((0, TCS_BOTTOM, TCS_VERTICAL, TCS_VERTICAL or TCS_RIGHT),
    (0, TCS_BOTTOM, TCS_VERTICAL or TCS_RIGHT, TCS_VERTICAL));
  TabStyles: array [TTabStyle] of DWORD =
    (TCS_TABS, TCS_BUTTONS, TCS_BUTTONS or TCS_FLATBUTTONS);
  RRStyles: array [Boolean] of DWORD =
    (0, TCS_RAGGEDRIGHT);
begin
  InitCommonControl(ICC_TAB_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, WC_TABCONTROL);
  with Params do
  begin
    Style := Style or WS_CLIPCHILDREN or
      AlignStyles[UseRightToLeftAlignment, FTabPosition] or
      TabStyles[FStyle] or RRStyles[FRaggedRight];
    if not TabStop then
      Style := Style or TCS_FOCUSNEVER;
    if FMultiLine then
      Style := Style or TCS_MULTILINE;
    if FMultiSelect then
      Style := Style or TCS_MULTISELECT;
    if FOwnerDraw then
      Style := Style or TCS_OWNERDRAWFIXED;
    if FTabSize.X <> 0 then
      Style := Style or TCS_FIXEDWIDTH;
    if FHotTrack and (not (csDesigning in ComponentState)) then
      Style := Style or TCS_HOTTRACK;
    if FScrollOpposite then
      Style := Style or TCS_SCROLLOPPOSITE;
    WindowClass.style := WindowClass.style and
      not (CS_HREDRAW or CS_VREDRAW) or CS_DBLCLKS;
  end;
end;

procedure TJvDockCustomTabControl.CreateWnd;
begin
  inherited CreateWnd;
  if (Images <> nil) and Images.HandleAllocated then
    Perform(TCM_SETIMAGELIST, 0, Images.Handle);
  if Integer(FTabSize) <> 0 then
    UpdateTabSize;
  if FSaveTabs <> nil then
  begin
    FTabs.Assign(FSaveTabs);
    SetTabIndex(FSaveTabIndex);
    FSaveTabs.Free;
    FSaveTabs := nil;
  end;
end;

procedure TJvDockCustomTabControl.DrawTab(TabIndex: Integer; const Rect: TRect;
  Active: Boolean);
begin
  if Assigned(FOnDrawTab) then
    FOnDrawTab(Self, TabIndex, Rect, Active)
  else
    Canvas.FillRect(Rect);
end;

function TJvDockCustomTabControl.GetDisplayRect: TRect;
begin
  Result := ClientRect;
  SendMessage(Handle, TCM_ADJUSTRECT, 0, Integer(@Result));
  if TabPosition = tpTop then
    Inc(Result.Top, 2);
end;

function TJvDockCustomTabControl.GetHitTestInfoAt(X, Y: Integer): THitTests;
var
  HitTest: TTCHitTestInfo;
begin
  Result := [];
  if PtInRect(ClientRect, Point(X, Y)) then
    with HitTest do
    begin
      pt.X := X;
      pt.Y := Y;
      if TabCtrl_HitTest(Handle, @HitTest) <> -1 then
      begin
        if (flags and TCHT_NOWHERE) <> 0 then
          Include(Result, htNowhere);
        if (flags and TCHT_ONITEM) = TCHT_ONITEM then
          Include(Result, htOnItem)
        else
        begin
          if (flags and TCHT_ONITEM) <> 0 then
            Include(Result, htOnItem);
          if (flags and TCHT_ONITEMICON) <> 0 then
            Include(Result, htOnIcon);
          if (flags and TCHT_ONITEMLABEL) <> 0 then
            Include(Result, htOnLabel);
        end;
      end
      else
        Result := [htNowhere];
    end;
end;

function TJvDockCustomTabControl.GetImageIndex(TabIndex: Integer): Integer;
begin
  Result := TabIndex;
  if Assigned(FOnGetImageIndex) then
    FOnGetImageIndex(Self, TabIndex, Result);
end;

function TJvDockCustomTabControl.GetTabIndex: Integer;
begin
  Result := SendMessage(Handle, TCM_GETCURSEL, 0, 0);
end;

function TJvDockCustomTabControl.GetTabs: TStrings;
begin
  Result := FTabs;
end;

procedure TJvDockCustomTabControl.ImageListChange(Sender: TObject);
begin
  Perform(TCM_SETIMAGELIST, 0, TCustomImageList(Sender).Handle);
end;

function TJvDockCustomTabControl.IndexOfTabAt(X, Y: Integer): Integer;
var
  HitTest: TTCHitTestInfo;
begin
  Result := -1;
  if PtInRect(ClientRect, Point(X, Y)) then
    with HitTest do
    begin
      pt.X := X;
      pt.Y := Y;
      Result := TabCtrl_HitTest(Handle, @HitTest);
    end;
end;

function TJvDockCustomTabControl.InternalSetMultiLine(Value: Boolean): Boolean;
begin
  Result := FMultiLine <> Value;
  if Result then
  begin
    if not Value and ((TabPosition = tpLeft) or (TabPosition = tpRight)) then
      TabControlError(sTabMustBeMultiLine);
    FMultiLine := Value;
    if not Value then
      FScrollOpposite := False;
  end;
end;

procedure TJvDockCustomTabControl.Loaded;
begin
  inherited Loaded;
  if Images <> nil then
    UpdateTabImages;
end;

procedure TJvDockCustomTabControl.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = Images) then
    Images := nil;
end;

procedure TJvDockCustomTabControl.PaintWindow(DC: HDC);
var
  Msg: TMessage;
begin
  if not OwnerDraw then
  begin
    Msg.Msg := WM_PAINT;
    Msg.WParam := DC;
    Msg.LParam := 0;
    Msg.Result := 0;
    DefaultHandler(Msg);
  end;
  inherited PaintWindow(DC);
end;

function TJvDockCustomTabControl.RowCount: Integer;
begin
  Result := TabCtrl_GetRowCount(Handle);
end;

procedure TJvDockCustomTabControl.ScrollTabs(Delta: Integer);
var
  Wnd: HWND;
  P: TPoint;
  Rect: TRect;
  I: Integer;
begin
  Wnd := FindWindowEx(Handle, 0, 'msctls_updown32', nil);
  if Wnd <> 0 then
  begin
    Windows.GetClientRect(Wnd, Rect);
    if Delta < 0 then
      P.X := Rect.Left + 2
    else
      P.X := Rect.Right - 2;
    P.Y := Rect.Top + 2;
    for I := 0 to Abs(Delta) - 1 do
    begin
      SendMessage(Wnd, WM_LBUTTONDOWN, 0, MakeLParam(P.X, P.Y));
      SendMessage(Wnd, WM_LBUTTONUP, 0, MakeLParam(P.X, P.Y));
    end;
  end;
end;

procedure TJvDockCustomTabControl.SetHotTrack(Value: Boolean);
begin
  if FHotTrack <> Value then
  begin
    FHotTrack := Value;
    RecreateWnd;
  end;
end;

procedure TJvDockCustomTabControl.SetImages(Value: TCustomImageList);
begin
  if Images <> nil then
    Images.UnRegisterChanges(FImageChangeLink);
  FImages := Value;
  if Images <> nil then
  begin
    Images.RegisterChanges(FImageChangeLink);
    Images.FreeNotification(Self);
    Perform(TCM_SETIMAGELIST, 0, Images.Handle);
  end
  else
    Perform(TCM_SETIMAGELIST, 0, 0);
end;

procedure TJvDockCustomTabControl.SetMultiLine(Value: Boolean);
begin
  if InternalSetMultiLine(Value) then
    RecreateWnd;
end;

procedure TJvDockCustomTabControl.SetMultiSelect(Value: Boolean);
begin
  if FMultiSelect <> Value then
  begin
    FMultiSelect := Value;
    RecreateWnd;
  end;
end;

procedure TJvDockCustomTabControl.SetOwnerDraw(Value: Boolean);
begin
  if FOwnerDraw <> Value then
  begin
    FOwnerDraw := Value;
    RecreateWnd;
  end;
end;

procedure TJvDockCustomTabControl.SetRaggedRight(Value: Boolean);
begin
  if FRaggedRight <> Value then
  begin
    FRaggedRight := Value;
    SetComCtlStyle(Self, TCS_RAGGEDRIGHT, Value);
  end;
end;

procedure TJvDockCustomTabControl.SetScrollOpposite(Value: Boolean);
begin
  if FScrollOpposite <> Value then
  begin
    FScrollOpposite := Value;
    if Value then
      FMultiLine := Value;
    RecreateWnd;
  end;
end;

procedure TJvDockCustomTabControl.SetStyle(Value: TTabStyle);
begin