stabcontrol.pas

Alpha Controls 界面控件包

  if (FTabs <> nil) and (FTabs.Count > 0) and (FSaveTabs = nil) 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
  SaveIndex, DC : hdc;
  PS : TPaintStruct;
  ci : TCacheInfo;
  R : TRect;
begin
  if (csDestroying in Parent.ComponentState) or (csLoading in ComponentState) or not FCommonData.Skinned then begin inherited; Exit end;
  // If transparent and form resizing processed
  FCommonData.BGChanged := FCommonData.BGChanged or FCommonData.HalfVisible or GetBoolMsg(Parent, AC_GETHALFVISIBLE);
  FCommonData.HalfVisible := not (PtInRect(Parent.ClientRect, Point(Left, Top)) and
                           PtInRect(Parent.ClientRect, Point(Left + Width, Top + Height)));
  SkinData.Updating := False;
  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 := FCommonData.SkinManager.GetSkinIndex(ChangedSkinSection);

  if FCommonData.Skinned then begin
    UpdateTabRects;
    CI := GetParentCache(FCommonData);
    BeginPaint(Handle, PS);
    if Message.Unused <> 0 then DC := Message.DC else DC := GetDC(Handle);
    SaveIndex := SaveDC(DC);
    try
      if not FCommonData.Updating and not DrawingLock then begin
        FillTabs;
        UpdateTabRects;
        FCommonData.InitCacheBmp;
        if FCommonData.BGChanged then begin
          if Tabs.Count > 0 then DrawSkinTabs(CI);
          R := PageRect;
          CtrlParentColor := ColorToRGB(TsHackedControl(Parent).Color);
          PaintItem(FCommonData.SkinIndex, ChangedSkinSection, CI, False, 0, PageRect, Point(Left + R.Left, Top + r.Top), FCommonData.FCacheBmp, FCommonData.SkinManager);
          CtrlParentColor := clFuchsia;
          if Tabs.Count > 0 then DrawSkinTab(ActiveTabIndex, 1);
        end;
        FCommonData.BGChanged := False;

        CopyWinControlCache(Self, FCommonData,  Rect(0, 0, 0, 0), Rect(0, 0, Width, Height), DC, True);
        sVCLUtils.PaintControls(DC, Self, True, Point(0, 0)); // Painting of the skinned TGraphControls
        SetParentUpdated(Self);
      end else FCommonData.Updating := True;
    finally
      RestoreDC(DC, SaveIndex);
      if Message.Unused = 0 then ReleaseDC(Handle, DC);
      EndPaint(Handle, PS);
    end;
  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 FCommonData.Skinned and
       not (csReading in ComponentState) and
         not (csLoading 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;
    end;
  end; //!!!
  if not (csCreating in ControlState) and (ActiveTabIndex > -1) then CheckUpDown;
  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 not FCommonData.Skinned then inherited;
end;

procedure TsCustomTabControl.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      CommonWndProc(Message, FCommonData);
      SetLength(TabsArray, 0);
      CheckUpDown;
      RecreateWnd;
      AlphaBroadcast(Self, Message);
      Exit;
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      CommonWndProc(Message, FCommonData);
      Repaint;
      SendMessage(Handle, WM_NCPAINT, 0, 0);
      CheckUpDown;
      if UpDown <> nil then UpDown.Repaint;
      AlphaBroadcast(Self, Message);
      exit
    end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      AlphaBroadcast(Self, Message);
      CommonWndProc(Message, FCommonData);
      exit
    end
  end;
  if Assigned(FCommonData) then begin
    if CommonWndProc(Message, FCommonData) and (Message.Msg = SM_ALPHACMD) then Exit;
    if FCommonData.Skinned then if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
      AC_ENDPARENTUPDATE : if FCommonData.Updating then begin
        FCommonData.Updating := False;
        RedrawWindow(Handle, nil, 0, RDW_INVALIDATE + RDW_ALLCHILDREN); // v408
        Exit
      end
    end
    else case Message.Msg of
      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) and
          ((FCommonData.FCacheBmp = nil) or (FCommonData.FCacheBmp.Width <> Width) or (FCommonData.FCacheBmp.Height <> Height)) then begin
            FCommonData.BGChanged := True;
            Repaint
        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 and TabStop 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;
        end;
      end;
      WM_PRINT : begin
        CheckUpDown;
        SendMessage(Handle, WM_PAINT, longint(TWMPaint(Message).DC), 1);
        Exit;
      end;
    end;
  end;
  inherited;
  case Message.Msg of
    WM_MOVE : begin
      if FCommonData.Skinned and not (csReading in ComponentState) and not (csLoading in ComponentState) then begin
        Repaint;
      end;
    end;
  end;
end;

procedure TsCustomTabControl.WMLButtonDown(var Message: TWMLButtonDown);
var
  i : integer;
  m : TWMLButtonDown;
begin
  m := Message;
  if OwnCalc then begin
    if Assigned(OnMouseDown) then OnMouseDown(Self, mbLeft, [], m.XPos, m.YPos);
    i := IndexOfSkinTab(m.XPos, m.YPos);
    if (i > -1) and (TabIndex <> i) and CanChange then begin
      TabIndex := i;
    end;
    if not Focused and TabStop then SetFocus;
  end
  else inherited;
end;

function TsCustomTabControl.OwnCalc: boolean;
begin
  Result := FCommonData.Skinned;
end;

procedure TsCustomTabControl.FillTabs;
const
  m = 0;
var
  i, l : integer;
begin
  if (csReading in ComponentState) then Exit;
  if (csDestroying in ComponentState) or ((Parent <> nil) and (csDestroying in Parent.ComponentState)) then Exit;
  SetLength(TabsArray, 0);
  if Tabs.Count = 0 then Exit;
  l := 0;
  for i := 0 to Tabs.Count - 1 do begin
    inc(l);
    SetLength(TabsArray, l);
    TabsArray[l - 1].Caption := Tabs[i];
    TabsArray[l - 1].Index := i;
    TabsArray[l - 1].ImageIndex := GetImageIndex(i);
  end;
  RebuildTabs;
end;

function TsCustomTabControl.IndexOfSkinTab(X, Y: integer) : integer;
var
  i, l : integer;
begin
  Result := -1;
  l := Length(TabsArray);
  try
    for i := 0 to l - 1 do begin
      if PtInRect(TabsArray[i].R, Point(X, Y)) then begin
        Result := TabsArray[i].Index;// + InvisibleTabs(TabsArray[i].Index);
        Break;
      end;
    end;
  except
  end;
end;

function TsCustomTabControl.ActiveTabIndex: integer;
var
  i, l : integer;
begin
  Result := -1;
  l := Length(TabsArray);
  if l = 0 then begin
    Exit;
  end;
  for i := 0 to l - 1 do if i = FSavedTabIndex then begin
    Result := ActualIndex(i);
    Exit;
  end;
  Result := 0;
end;

procedure TsCustomTabControl.UpdateTabRects;
var
  i, l, j : integer;
  Row, Offset, ItemSize : integer;
begin
  if (csReading in ComponentState) then Exit;
  Row := RowCount + 1;
  l := Length(TabsArray);

  for j := 0 to l - 1 do begin
    TabCtrl_GetItemRect(Handle, TabsArray[j].Index, TabsArray[j].R);
    TabsArray[j].Size.cx := WidthOf(TabsArray[j].R);
    TabsArray[j].Size.cy := HeightOf(TabsArray[j].R);
    TabsArray[j].Processed := False;
  end;

  // Different rules for rects calcs
  case TabPosition of
    tpTop : begin
      for j := 0 to l - 1 do begin
        if not TabsArray[j].Processed and (TabsArray[j].R.Left < 4) then begin
          dec(Row);
          ItemSize := HeightOf(TabsArray[j].R);
          Offset := (RowCount - Row) * ItemSize + 1;

          TabsArray[j].Row := Row;
          TabsArray[j].Processed := True;

          for i := 0 to l - 1 do begin
            if not TabsArray[i].Processed and Between(TabsArray[i].R.Top, TabsArray[j].R.Top - 2, TabsArray[j].R.Top + 2) then begin
              TabsArray[i].R.Top := Offset;
              TabsArray[i].R.Bottom := Offset + ItemSize;
              TabsArray[i].Row := Row;
              TabsArray[i].Processed := True;
            end;
          end;
          TabsArray[j].R.Top := Offset;
          TabsArray[j].R.Bottom := Offset + ItemSize;
        end;
      end;
    end;
    tpLeft : begin
      for j := 0 to l - 1 do begin
        if not TabsArray[j].Processed and (TabsArray[j].R.Top < 4) then begin
          dec(Row);
          ItemSize := WidthOf(TabsArray[j].R);
          Offset := (RowCount - Row) * ItemSize + 1;

          TabsArray[j].Row := Row;
          TabsArray[j].Processed := True;

          for i := 0 to l - 1 do begin
            if not TabsArray[i].Processed and Between(TabsArray[i].R.Left, TabsArray[j].R.Left - 2, TabsArray[j].R.Left + 2) then begin
              TabsArray[i].R.Left := Offset;
              TabsArray[i].R.Right := Offset + ItemSize;
              TabsArray[i].Row := Row;
              TabsArray[i].Processed := True;
            end;
          end;
          TabsArray[j].R.Left := Offset;
          TabsArray[j].R.Right := Offset + ItemSize;
        end;
      end;
    end;
    tpBottom : begin
      for j := 0 to l - 1 do begin
        if not TabsArray[j].Processed and (TabsArray[j].R.Left < 4) then begin
          dec(Row);
          ItemSize := HeightOf(TabsArray[j].R);
          Offset := Height - ((RowCount - Row) * ItemSize + 1);

          TabsArray[j].Row := Row;
          TabsArray[j].Processed := True;

          for i := 0 to l - 1 do begin
            if not TabsArray[i].Processed and Between(TabsArray[i].R.Top, TabsArray[j].R.Top - 2, TabsArray[j].R.Top + 2) then begin
              TabsArray[i].R.Bottom := Offset;
              TabsArray[i].R.Top := Offset - ItemSize;
              TabsArray[i].Row := Row;
              TabsArray[i].Processed := True;
            end;
          end;
          TabsArray[j].R.Bottom := Offset;
          TabsArray[j].R.Top := Offset - ItemSize;
        end;
      end;
    end;
    tpRight : begin
      for j := 0 to l - 1 do begin
        if not TabsArray[j].Processed and (TabsArray[j].R.Top < 4) then begin
          dec(Row);
          ItemSize := WidthOf(TabsArray[j].R);