stabcontrol.pas

Alpha Controls 界面控件包

procedure TsTabStrings.SetUpdateState(Updating: Boolean);
begin
  FTabControl.FUpdating := Updating;
  SendMessage(FTabControl.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  if not Updating then begin
    FTabControl.FCommonData.Invalidate;
    FTabControl.TabsChanged;
  end;
end;

{ TsCustomTabControl }

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

procedure TsCustomTabControl.AfterConstruction;
begin
  inherited Loaded;
//  if Images <> nil then UpdateTabImages;
  SkinData.Loaded;
//  if FCommonData.Skinned then RebuildTabs;
//  inherited;
//  SkinData.Loaded;
end;

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

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

procedure TsCustomTabControl.Change;
var
  Form: TCustomForm;
begin
  if csDestroying in ComponentState then Exit;
  if Assigned(FOnChange) then FOnChange(Self);
  if csDesigning in ComponentState then begin
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.Designer <> nil) then Form.Designer.Modified;
  end;
  UpdateUpDown;
end;

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

procedure TsCustomTabControl.CMFontChanged(var Message);
begin
  inherited;
  if FCommonData.Skinned then begin
    Repaint;
    SendMessage(Handle, WM_NCPAINT, 0, 0);
  end;
end;

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

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

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

procedure TsCustomTabControl.CNNotify(var Message: TWMNotify);
begin
  with Message do
    case NMHdr^.code of
      TCN_SELCHANGE: begin
        Change;
      end;
      TCN_SELCHANGING: begin
        if OwnCalc
          then Result := 1
          else if CanChange then Result := 0;
      end;
    end;
end;

constructor TsCustomTabControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsTabControl;

  Width := 289;
  Height := 100;
  TabStop := True;
  ControlStyle := [csAcceptsControls, csDoubleClicks];
  FTabs := TsTabStrings.Create;
  TsTabStrings(FTabs).FTabControl := Self;
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
end;

procedure TsCustomTabControl.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 TsCustomTabControl.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;

destructor TsCustomTabControl.Destroy;
begin
  FreeAndNil(FCanvas);
  FreeAndNil(FTabs);
  FreeAndNil(FSaveTabs);
  if Images <> nil then Images.UnRegisterChanges(FImageChangeLink);
  FImageChangeLink.OnChange := nil;
  FreeAndNil(FImageChangeLink);
//  if UpDown <> nil then FreeAndNil(UpDown);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  inherited Destroy;
end;

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

procedure TsCustomTabControl.DrawSkinTabs(CI: TCacheInfo);
var
  i : integer;
  aRect: TRect;
  l : integer;
begin
  if (csDestroying in ComponentState) then Exit;

  aRect := TabsRect;
  if not ci.Ready then begin
    inc(aRect.Bottom, 4);
    FCommonData.FCacheBmp.Canvas.Brush.Style := bsSolid;
    FCommonData.FCacheBmp.Canvas.Brush.Color := ColorToRGB(TsHackedControl(Parent).Color);
    FCommonData.FCacheBmp.Canvas.FillRect(aRect);
  end
  else begin
    BitBlt(FCommonData.FCacheBmp.Canvas.Handle,
           aRect.Left, aRect.Top,
           min(WidthOf(aRect), ci.Bmp.Width){.Right},
           min(HeightOf(aRect), ci.Bmp.Height){.Bottom},
           ci.Bmp.Canvas.Handle, ci.X + Left + aRect.Left, ci.Y + Top + aRect.Top, SRCCOPY);
  end;
  // Paint tabs
  l := Length(TabsArray) - 1;
  for i := 0 to l do if CanShowTab(i) and (i <> ActiveTabIndex) then DrawSkinTab(i, 0);
end;

procedure TsCustomTabControl.DrawSkinTab(Index: Integer; State: integer);
var
  rText, aRect : TRect;
  VertFont : TLogFont;
  pFont : PLogFontA;
  i, h, w : integer;
  CI : TCacheInfo;
  TabIndex, TabMask, TabState : integer;
  TabSection : string;
  TempBmp : TBitmap;
  SavedDC : hdc;
  procedure MakeVertFont(Orient : integer);
  begin
    pFont := @VertFont;
    VertFont.lfFaceName := 'Arial';
    GetObject(FCommonData.FCacheBmp.Canvas.Handle, SizeOf(TLogFont), pFont);
    VertFont.lfEscapement := Orient;
    VertFont.lfHeight := Font.Height;
    VertFont.lfStrikeOut := integer(fsStrikeOut in Font.Style);
    VertFont.lfItalic := integer(fsItalic in Font.Style);
    VertFont.lfUnderline := integer(fsUnderline	in Font.Style);
    VertFont.lfWeight := FW_NORMAL;
    VertFont.lfCharSet := Font.Charset;

    VertFont.lfWidth := 0;
    Vertfont.lfOutPrecision := OUT_DEFAULT_PRECIS;
    VertFont.lfClipPrecision := CLIP_DEFAULT_PRECIS;
    VertFont.lfOrientation := VertFont.lfEscapement;
    VertFont.lfPitchAndFamily := Default_Pitch;
    VertFont.lfQuality := Default_Quality;
    FCommonData.FCacheBmp.Canvas.Font.Handle := CreateFontIndirect(VertFont);
    if State <> 0
      then FCommonData.FCacheBmp.Canvas.Font.Color := FCommonData.SkinManager.gd[TabIndex].HotFontColor[1]
      else FCommonData.FCacheBmp.Canvas.Font.Color := FCommonData.SkinManager.gd[TabIndex].FontColor[1];
  end;
  procedure KillVertFont; begin
    FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  end;
begin
  if Index = - 1 then Exit;
  aRect := SkinTabRect(Index);
  if ((State = 1) and (aRect.Left < -2)) then Exit;
  rText := aRect;
  // Tabs drawing
  if (UpDown <> nil) and (aRect.Right > UpDown.Left) then begin
    SavedDC := SaveDC(FCommonData.FCacheBmp.Canvas.Handle);
    case TabPosition of
      tpTop, tpBottom : begin
        ExcludeClipRect(FCommonData.FCacheBmp.Canvas.Handle, UpDown.Left, aRect.Top, Width, aRect.Bottom);
      end;
    end;
  end else SavedDC := 0;
  if FCommonData.SkinManager.ConstData.IndexTabTop > 0 then begin // new style
    if State = 1 then TabState := 2 else TabState := 0;

    case Style of
      tsTabs : case TabPosition of // Init of skin data
        tpTop : begin TabIndex := FCommonData.SkinManager.ConstData.IndexTabTop; TabMask := FCommonData.SkinManager.ConstData.MaskTabTop; TabSection := s_TabTop end;
        tpLeft : begin TabIndex := FCommonData.SkinManager.ConstData.IndexTabLeft; TabMask := FCommonData.SkinManager.ConstData.MaskTabLeft; TabSection := s_TabLeft end;
        tpBottom : begin TabIndex := FCommonData.SkinManager.ConstData.IndexTabBottom; TabMask := FCommonData.SkinManager.ConstData.MaskTabBottom; TabSection := s_TabBottom end
        else begin TabIndex := FCommonData.SkinManager.ConstData.IndexTabRight; TabMask := FCommonData.SkinManager.ConstData.MaskTabRight; TabSection := s_TabRight end;
      end;
      tsButtons : begin
        TabSection := s_Button;
        TabIndex := FCommonData.SkinManager.GetSkinIndex(TabSection);
        TabMask := FCommonData.SkinManager.GetMaskIndex(TabSection, s_BordersMask);
      end
      else begin
        TabSection := s_ToolButton;
        TabIndex := FCommonData.SkinManager.GetSkinIndex(TabSection);
        TabMask := FCommonData.SkinManager.GetMaskIndex(TabSection, s_BordersMask);
      end;
    end;

    if FCommonData.SkinManager.IsValidImgIndex(TabMask) then begin
      TempBmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
      try
        CI := MakeCacheInfo(FCommonData.FCacheBmp);
        PaintItem(TabIndex, TabSection, CI, True, TabState, Rect(0, 0, TempBmp.Width, TempBmp.Height),
          Point(aRect.Left, aRect.Top), TempBmp, FCommonData.SkinManager);
        BitBlt(FCommonData.FCacheBmp.Canvas.Handle, aRect.Left, aRect.Top, TempBmp.Width, TempBmp.Height,
          TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
      finally
        FreeAndNil(TempBmp);
      end;
    end;
  end;
  // End of tabs drawing

  if not OwnerDraw then begin
    FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
    // Drawing of the tab content
    case TabPosition of
      tpTop, tpBottom : begin
        FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
        if (Images <> nil) and (TabsArray[Index].ImageIndex <= Images.Count - 1) then begin
          Images.Draw(FCommonData.FCacheBmp.Canvas,
                rText.Left + (WidthOf(rText) - (FCommonData.FCacheBmp.Canvas.TextWidth(TabsArray[Index].Caption) + Images.Width + 8)) div 2,
                rText.Top + (HeightOf(rText) - Images.Height) div 2,
                TabsArray[Index].ImageIndex,
                True);
          inc(rText.Left, WidthOf(GlyphRect));
          WriteTextEx(FCommonData.FCacheBmp.Canvas, PChar(TabsArray[Index].Caption),
                      Enabled, rText, DT_CENTER or ta_CENTER or DT_SINGLELINE or DT_VCENTER, TabIndex, State <> 0);
        end
        else WriteTextEx(FCommonData.FCacheBmp.Canvas, PChar(TabsArray[Index].Caption), True, rText, DT_CENTER or ta_CENTER or DT_SINGLELINE or DT_VCENTER, TabIndex, State <> 0);
        if Focused and (Index = ActiveTabIndex) then begin
          InflateRect(rText, 1, 0);
          FocusRect(FCommonData.FCacheBmp.Canvas, rText);
        end;
      end;
      tpLeft : begin
        FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
        MakeVertFont(-2700);

        h := FCommonData.FCacheBmp.Canvas.TextWidth(TabsArray[Index].Caption);
        w := FCommonData.FCacheBmp.Canvas.TextHeight(TabsArray[Index].Caption);

        if not Enabled then FCommonData.FCacheBmp.Canvas.Font.Color := clGray;
        if (Images <> nil) and (TabsArray[Index].ImageIndex > -1) and (TabsArray[Index].ImageIndex <= Images.Count - 1) then begin
          if Index = ActiveTabIndex then OffsetRect(rText, 2, 0);
          i := rText.Bottom - (HeightOf(rText) - (Images.Height + 4 + h)) div 2 - Images.Height;
          Images.Draw(FCommonData.FCacheBmp.Canvas,
                rText.Left + (WidthOf(rText) - Images.Width) div 2,
                i,
                TabsArray[Index].ImageIndex,
                Enabled);

          FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
          FCommonData.FCacheBmp.Canvas.TextRect(rText,
                              rText.Left + (WidthOf(rText) - w) div 2,
                              i - 4,
                              PChar(TabsArray[Index].Caption));
          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2 + 2);
          OffsetRect(rText, 0, - (4 + Images.Height) div 2);
        end
        else begin
          FCommonData.FCacheBmp.Canvas.Brush.Style := bsClear;
          FCommonData.FCacheBmp.Canvas.TextRect(rText,
                              rText.Left + (WidthOf(rText) - w) div 2,
                              rText.Bottom - (HeightOf(rText) - h) div 2,
                              PChar(TabsArray[Index].Caption));
          InflateRect(rText, (w - WidthOf(rText)) div 2, (h - HeightOf(rText)) div 2);
        end;