stabcontrol.pas

AlphaControls是一个Delphi标准控件的集合

    if not Value then FScrollOpposite := False;
  end;
end;

procedure TsCustomTabControl.Loaded;
begin
  inherited Loaded;
  if Images <> nil then UpdateTabImages;
  CommonData.Loaded;
//  FTabs.EndUpdate;
  RebuildTabs;
end;

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

function TsCustomTabControl.PageRect: TRect;
var
  r : TRect;
begin
  Result := Rect(0, 0, Width, Height);
  if Tabs.Count > 0 then begin
    AdjustClientRect(r);
    case TabPosition of
      tpTop : Result.Top := R.Top - TopOffset;
      tpBottom : Result.Bottom := R.Bottom + BottomOffset;
      tpLeft : Result.Left := R.Left - LeftOffset;
      tpRight : Result.Right := R.Right + RightOffset;
    end;
  end;
end;

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

procedure TsCustomTabControl.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 TsCustomTabControl.SetHotTrack(Value: Boolean);
begin
  if FHotTrack <> Value then begin
    FHotTrack := Value;
    RecreateWnd;
  end;
end;

procedure TsCustomTabControl.SetImages(Value: TCustomImageList);
var
  Form : TCustomForm;
begin
  if csDestroying in ComponentState then Exit;
  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);
  Form := GetParentForm(Self);
  if (Form <> nil) and not (csDestroying in Form.ComponentState) and not (csDestroying in Parent.ComponentState) then begin
    FCommonData.Invalidate; // Changed by Serge - exception arises when projects closes in design-time
//    RecreateWnd;
  end;
end;

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

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

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

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

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

procedure TsCustomTabControl.SetStyle(Value: TTabStyle);
begin
  if FStyle <> Value then begin
    if (Value <> tsTabs) and (TabPosition <> tpTop) then raise EInvalidOperation.Create(SInvalidTabStyle);
    FStyle := Value;
    RecreateWnd;
  end;
end;

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

procedure TsCustomTabControl.SetTabIndex(Value: Integer);
var
  NewValue : integer;
begin
  NewValue := Value * integer(ActualIndex(Value) <> -1);
  if FSavedTabIndex = NewValue then Exit;
  FSavedTabIndex := NewValue;
  if OwnCalc then begin
    if not (csLoading in ComponentState) and ((csDesigning in ComponentState) or not (csReading in ComponentState)) then begin
      RebuildTabs;
      FCommonData.BGChanged := True;
      Repaint;
    end;
  end else SendMessage(Handle, TCM_SETCURSEL, Value, 0);
end;

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

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

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

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

procedure TsCustomTabControl.TabsChanged;
begin
  if csDestroying in ComponentState then Exit;
  if not FUpdating and not (csReading in ComponentState) and not (csLoading in ComponentState) then begin
    FillTabs;
//    if not DrawingLock then begin
      if HandleAllocated then SendMessage(Handle, WM_SIZE, SIZE_RESTORED, Word(Width) or Word(Height) shl 16);
      Realign;
//    end;
  end;
end;

function TsCustomTabControl.TabsRect: TRect;
var
  r : TRect;
begin
  Result := Rect(0, 0, Width, Height);
  if Tabs.Count > 0 then begin
    AdjustClientRect(r);
    case TabPosition of
      tpTop : Result.Bottom := R.Top - TopOffset;
      tpBottom : Result.Top := R.Bottom + BottomOffset;
      tpLeft : Result.Right := R.Left - LeftOffset;
      tpRight : Result.Left := R.Right + RightOffset;
    end;
  end;
end;

procedure TsCustomTabControl.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 TsCustomTabControl.UpdateTabSize;
begin
  SendMessage(Handle, TCM_SETITEMSIZE, 0, Integer(FTabSize));
  if not (csReading in ComponentState) then TabsChanged;
end;

procedure TsCustomTabControl.WMDestroy(var Message: 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 TsCustomTabControl.WMNotifyFormat(var Message: TMessage);
begin
  with Message do Result := DefWindowProc(Handle, Msg, WParam, LParam);
end;

procedure TsCustomTabControl.WMPaint(var Message: TWMPaint);
var
  ci : TCacheInfo;
  BorderIndex : integer;
  SaveIndex, DC : hdc;
  PS : TPaintStruct;
  R : TRect;
begin
  if DrawingLock or (csDestroying in ComponentState) or (csLoading in ComponentState) then Exit;
  if IsValidSkinIndex(FCommonData.SkinIndex) then begin
    Message.Result := 1;
    UpdateTabRects;
    ci := GetParentCache(FCommonData);
    FCommonData.InitCacheBmp;
    case TabPosition of
      tpTop : begin ChangedSkinSection := FCommonData.SkinSection; end;
      tpLeft : begin ChangedSkinSection := FCommonData.SkinSection + 'LEFT'; end;
      tpRight : begin ChangedSkinSection := FCommonData.SkinSection + 'RIGHT'; end;
      tpBottom : begin ChangedSkinSection := FCommonData.SkinSection + 'BOTTOM'; end;
    end;
    FCommonData.SkinIndex := GetSkinIndex(ChangedSkinSection);
    BorderIndex := GetMaskIndex(FCommonData.SkinIndex, ChangedSkinSection, BordersMasK);
    if IsValidImgIndex(BorderIndex) and IsValidSkinIndex(FCommonData.SkinIndex) then begin
      DC := Message.DC; if DC = 0 then DC := BeginPaint(Handle, PS);
      SaveIndex := SaveDC(DC);
      try
        if FCommonData.BGChanged then begin
          if Tabs.Count > 0 then DrawSkinTabs(CI);
          R := PageRect;
          PaintItem(FCommonData.SkinIndex, ChangedSkinSection, CI, False, 0, PageRect, Point(Left + R.Left, Top + r.Top), FCommonData.FCacheBmp);
          if Tabs.Count > 0 then DrawSkinTab(ActiveTabIndex, 1);
          FCommonData.BGChanged := False;
        end;
        FCommonData.CopyFromCache(DC, 0, 0, Width, Height);
      finally
        RestoreDC(DC, SaveIndex);
        if Message.DC = 0 then EndPaint(Handle, PS);
      end;
    end else inherited;
  end else inherited;
end;

procedure TsCustomTabControl.WMSize(var Message: TWMSize);
begin
  if Sizing then Exit;
  Sizing := True;
  DrawingLock := True;
  inherited;
  if not (csReading in ComponentState) and not (csLoading in ComponentState) then FillTabs;
  DrawingLock := False;
  Sizing := False;
  if not (csReading in ComponentState) and not (csLoading in ComponentState) then Repaint;
//  RedrawWindow(Handle, nil, 0, RDW_INVALIDATE or RDW_ERASE);
end;

function TsCustomTabControl.GlyphRect: TRect;
begin
  Result := Rect(0,0,0,0);
  if Images <> nil then begin
    Result.Top := (TabHeight + 4 - Images.Height) div 2;
    Result.Bottom := Result.Top + Images.Height;
    Result.Left := Result.Top;
    Result.Right := Result.Left + Images.Width;
  end;
end;

procedure TsCustomTabControl.WMEraseBkGND(var Message: TWMPaint);
begin
  if IsValidSkinIndex(FCommonData.SkinIndex)
    then Message.Result := 1
    else inherited;
end;

procedure TsCustomTabControl.WndProc(var Message: TMessage);
begin
  if Assigned(FCommonData) then begin
    FCommonData.WndProc(Message);
    if FCommonData.Skinned then case Message.Msg of
      SM_REMOVESKIN : begin
        SetLength(TabsArray, 0);
        TabIndex := FSavedTabIndex;
      end;
      SM_REFRESH : begin
        if csDesigning in ComponentState then Perform(WM_SIZE, 0, 0);
      end;
      SM_BGCHANGED : begin
        if not (csReading in ComponentState) then ReBuildTabs;
      end;
     WM_SIZE : begin
        if FCommonData.Skinned and
             not (csReading in ComponentState) and
               not (csLoading in ComponentState) and
                 not (csFreeNotification in ComponentState) and
                   not (csCreating in ControlState) then begin
          if (FCommonData.FCacheBmp = nil) or (FCommonData.FCacheBmp.Width <> Width) or (FCommonData.FCacheBmp.Height <> Height) then begin
            FCommonData.BGChanged := True;
            Repaint;
          end;
        end;
      end;
      CM_VISIBLECHANGED, WM_MOUSEWHEEL : begin
        if FCommonData.Skinned and not (csReading in ComponentState) and not (csLoading in ComponentState) then begin
          FCommonData.BGChanged := True;
          Repaint;
        end;
      end;
      WM_SETFOCUS, CM_ENTER, WM_KILLFOCUS, CM_EXIT: begin
        if FCommonData.Skinned then begin
          FCommonData.FFocused := (Message.Msg = CM_ENTER) or (Message.Msg = WM_SETFOCUS);
          FCommonData.FMouseAbove := False;
          FCommonData.BGChanged := True;
          if not (csReading in ComponentState) and
               not (csLoading in ComponentState) and
                 not (csCreating in ControlState) then begin
            Repaint;
            SendMessage(Handle, WM_NCPAINT, 0, 0);
          end;
        end;
      end;
      CM_MOUSELEAVE, CM_MOUSEENTER : begin
        if not FCommonData.FFocused and not(csDesigning in ComponentState) then begin
          FCommonData.FMouseAbove := Message.Msg = CM_MOUSEENTER;
//          FCommonData.BGChanged := True;
//          SendMessage(Handle, WM_NCPAINT, 0, 0);
//          Repaint;
        end;
      end;
    end;
  end;
  if Message.Result <> 1 then inherited;
  case Message.Msg of
    WM_MOVE : begin
      if FCommonData.Skinned and not (csReading in ComponentState) and not (csLoading in ComponentState) then begin
        FCommonData.BGChanged := True;
        Repaint;
      end;
    end;
  end;
end;