fthtabs.pas

Gestione Cellulari Nokia

  ReleaseCapture;
  Pressed := False;

  if Down then
  begin
    Down := False;
    NewPos := Position;
    case Current of
      sbLeft: Dec(NewPos, Change);
      sbRight: Inc(NewPos, Change);
    end;
    Position := NewPos;
  end;
end;

{ TFourthTabList }

function TFourthTabList.Add(const S: string): Integer;
begin
  Result := inherited Add(S);
  if Tabs <> nil then
    Tabs.Invalidate;
end;

procedure TFourthTabList.Insert(Index: Integer; const S: string);
begin
  inherited Insert(Index, S);
  if Tabs <> nil then
  begin
    if Index <= Tabs.FTabIndex then Inc(Tabs.FTabIndex);
    Tabs.Invalidate;
  end;
end;

procedure TFourthTabList.Delete(Index: Integer);
var
  OldIndex: Integer;
begin
  OldIndex := Tabs.Tabindex;
  inherited Delete(Index);

  if OldIndex < Count then
    Tabs.FTabIndex := OldIndex else
    Tabs.FTabIndex := Count - 1;
  Tabs.Invalidate;
  Tabs.Invalidate;
  if OldIndex = Index then Tabs.Click; { deleted selected tab }
end;

procedure TFourthTabList.Put(Index: Integer; const S: string);
begin
  inherited Put(Index, S);
  if Tabs <> nil then
    Tabs.Invalidate;
end;

procedure TFourthTabList.Clear;
begin
  inherited Clear;
  Tabs.FTabIndex := -1;
  Tabs.Invalidate;
end;

procedure TFourthTabList.AddStrings(Strings: TStrings);
begin
  SendMessage(Tabs.Handle, WM_SETREDRAW, 0, 0);
  inherited AddStrings(Strings);
  SendMessage(Tabs.Handle, WM_SETREDRAW, 1, 0);
  Tabs.Invalidate;
end;

{ TFourthTabSetOptions }

constructor TFourthTabSetOptions.Create;
begin
  FBGColor := clBtnShadow;
  FFlatStyle := fsMiddleFlat;
  FSeparatorColor := clBtnFace;
  FUnSelColor := clBtnHighlight;
  FLightColor := cl3DLight;
  FHighlightColor := clBtnHighlight;
  FShadowColor := clBtnShadow;
  FDarkShadowColor := cl3DDkShadow;
  FFaceColor := clBtnFace;
end;

procedure TFourthTabSetOptions.SetBGColor(Value: TColor);
begin
  if FBGColor <> Value then
  begin
    FBGColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthTabSetOptions.SetFlatStyle(Value: TFourthTabSetFlatStyle);
begin
  if FFlatStyle <> Value then
  begin
    FFlatStyle := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthTabSetOptions.SetSeparatorColor(Value: TColor);
begin
  if FSeparatorColor <> Value then
  begin
    FSeparatorColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthTabSetOptions.SetUnselectedColor(Value: TColor);
begin
  if FUnSelColor <> Value then
  begin
    FUnSelColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthTabSetOptions.SetLightColor(Value: TColor);
begin
  if FLightColor <> Value then
  begin
    FLightColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthTabSetOptions.SetHighlightColor(Value: TColor);
begin
  if FHighlightColor <> Value then
  begin
    FHighlightColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthTabSetOptions.SetShadowColor(Value: TColor);
begin
  if FShadowColor <> Value then
  begin
    FShadowColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthTabSetOptions.SetDarkShadowColor(Value: TColor);
begin
  if FDarkShadowColor <> Value then
  begin
    FDarkShadowColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthTabSetOptions.SetFaceColor(Value: TColor);
begin
  if FFaceColor <> Value then
  begin
    FFaceColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

{ TFourthTabSet }

constructor TFourthTabSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csDoubleClicks, csOpaque];
  Width := 185;
  Height := 21;
  FTopEdge := 2;
  FBottomEdge := 1;

  TabPositions := TList.Create;
  FTabHeight := Height - (FTopEdge + FBottomEdge);

  FTabs := TFourthTabList.Create;
  TFourthTabList(FTabs).Tabs := Self;
  FDisabledTabs := TStringList.create;

  CreateScroller;

  FTabIndex := -1;
  FFirstIndex := 0;
  FVisibleTabs := 0; { set by draw routine }
  FStartMargin := 5;
  FEndMargin := 5;

  { initialize default values }
  FAutoScroll := True;
  FStyle := tsStandard;
  FOwnerDrawHeight := 20;

  ParentFont := False;
{$IFDEF DELPHI3_UP}
  Font.Name := DefFontData.Name;
  Font.Height := DefFontData.Height;
  Font.Style := [];
{$ENDIF}
  FOptions := TFourthTabSetOptions.Create;
  FOptions.OnChange := OptionsChange;
end;

procedure TFourthTabSet.OptionsChange(Sender: TObject);
begin
  Invalidate;
end;

procedure TFourthTabSet.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params.WindowClass do
    Style := Style and not (CS_VREDRAW or CS_HREDRAW);
end;

procedure TFourthTabSet.CreateScroller;
begin
  FScroller := TFourthScroller.Create(Self);
  with FScroller do
  begin
    Parent := Self;
    Top := 5;
    Min := 0;
    Max := 0;
    Position := 0;
    Visible := False;
    OnClick := ScrollClick;
  end;
end;

destructor TFourthTabSet.Destroy;
begin
  FTabs.Free;
  TabPositions.Free;
  inherited Destroy;
end;

procedure TFourthTabSet.ScrollClick(Sender: TObject);
begin
  FirstIndex := TFourthScroller(Sender).Position;
end;

function TFourthTabSet.ItemAtPos(Pos: TPoint): Integer;
var
  TabPos: TTabPos;
  I: Integer;
begin
  Result := -1;
  if (Pos.Y < 0) or (Pos.Y > ClientHeight) then Exit;
  for I := 0 to TabPositions.Count - 1 do
  begin
    Pointer(TabPos) := TabPositions[I];
    if (Pos.X >= TabPos.StartPos) and (Pos.X <= TabPos.StartPos + TabPos.Size) then
    begin
      Result := I;
      Exit;
    end;
  end;
end;

function TFourthTabSet.ItemRect(Item: Integer): TRect;
var
  TabPos: TTabPos;
begin
  if (TabPositions.Count > 0) and (Item >= 0) and (Item < TabPositions.Count) then
  begin
    Pointer(TabPos) := TabPositions[Item];
    Result := Rect(TabPos.StartPos, 0, TabPos.StartPos + TabPos.Size, FTabHeight);
    InflateRect(Result, 1, -2);
  end else
    Result := Rect(0, 0, 0, 0);
end;

procedure TFourthTabSet.Paint;
var
  MemBitmap: TBitmap;
  TabStart, LastTabPos: Integer;
  TabPos: TTabPos;
  Tab: Integer;
  isFirst, isSelected: Boolean;
  R: TRect;
  loop: integer;
begin
  if not HandleAllocated then Exit;

  MemBitmap := TBitmap.Create;
  try
    MemBitmap.Width := ClientWidth;
    if ClientHeight < FTabHeight + 5 then
      MemBitmap.Height := FTabHeight + 5 else
      MemBitmap.Height := ClientHeight;

    MemBitmap.Canvas.Font := Self.Canvas.Font;

    TabStart := StartMargin + EdgeWidth; { where does first text appear? }
    LastTabPos := Width - EndMargin; { tabs draw until this position }
    FScroller.Left := Width - FScroller.Width - 2;

     { do initial calculations for how many tabs are visible }
    FVisibleTabs := CalcTabPositions(TabStart, LastTabPos, MemBitmap.Canvas, FirstIndex);

     { enable the scroller if FAutoScroll = True and not all tabs are visible }
    if AutoScroll and (FVisibleTabs < Tabs.Count) then
    begin
      Dec(LastTabPos, FScroller.Width - 4);
       { recalc the tab positions }
      FVisibleTabs := CalcTabPositions(TabStart, LastTabPos, MemBitmap.Canvas, FirstIndex);

       { set the scroller's range }
      FScroller.Visible := True;
      ShowWindow(FScroller.Handle, SW_SHOW);
      FScroller.Min := 0;
      FScroller.Max := Tabs.Count - VisibleTabs;
      FScroller.Position := FirstIndex;
    end else
    if VisibleTabs >= Tabs.Count then
    begin
      FScroller.Visible := False;
      ShowWindow(FScroller.Handle, SW_HIDE);
    end;

    if FDoFix then
    begin
      FixTabPos;
      FVisibleTabs := CalcTabPositions(TabStart, LastTabPos, MemBitmap.Canvas, FirstIndex);
    end;
    FDoFix := False;

    { draw background of tab area }
    with MemBitmap.Canvas do
    begin
      Brush.Color := FOptions.BackgroundColor;
      FillRect(Rect(0, 0, MemBitmap.Width, MemBitmap.Height));

      Pen.Color := FOptions.FaceColor;
      for loop := 0 to FTopEdge - 1 do
      begin
        MoveTo(0, loop);
        LineTo(MemBitmap.Width + 1, loop);
      end;

      Pen.Color := FOptions.DarkShadowColor;
      MoveTo(0, 2);
      LineTo(MemBitmap.Width + 1, FTopEdge);

      if FOptions.FlatStyle = fsNoFlat then
      begin
        Pen.Color := FOptions.ShadowColor;
        MoveTo(0, 1);
        LineTo(MemBitmap.Width + 1, FTopEdge-1);
      end;
    end;

    for Tab := 0 to TabPositions.Count - 1 do
    begin
      if not TabEnabled(Tab + FirstIndex) then Continue;

      Pointer(TabPos) := TabPositions[Tab];

      isFirst := Tab = 0;
      isSelected := Tab + FirstIndex = TabIndex;

      R := Rect(TabPos.StartPos - (EdgeWidth div 2), FTopEdge-1, (TabPos.StartPos + TabPos.Size) + (EdgeWidth div 2), FTabHeight);

      with MemBitmap.Canvas do
      begin
        if isSelected then
        begin
          Brush.Color := FOptions.FaceColor;
          FillRect(R);

          R := Rect(TabPos.StartPos, FTopEdge, TabPos.StartPos + TabPos.Size, FTabHeight);

          Font.Color := Self.Font.Color{clBtnText};
          Inc(R.Top, 1);
          DrawText(Handle, PChar(Tabs[Tab + FirstIndex]),
            Length(Tabs[Tab + FirstIndex]), R, DT_CENTER);

          Pen.Color := FOptions.HighlightColor; { Draw the left level1 }
          MoveTo(TabPos.StartPos - (EdgeWidth div 2), FTopEdge);
          LineTo(TabPos.StartPos - (EdgeWidth div 2), FTabHeight);

          if FOptions.FlatStyle = fsNoFlat then
          begin
            Pen.Color := FOptions.LightColor; { Draw the left level1 }
            MoveTo(TabPos.StartPos - (EdgeWidth div 2)+1, FTopEdge);
            LineTo(TabPos.StartPos - (EdgeWidth div 2)+1, FTabHeight);
          end;

          Pen.Color := FOptions.DarkShadowColor; { Draw the bottom-right ___| }
          MoveTo(TabPos.StartPos - (EdgeWidth div 2)+1, FTabHeight);
          LineTo(TabPos.StartPos + TabPos.Size + (EdgeWidth div 2), FTabHeight);

          MoveTo(TabPos.StartPos + TabPos.Size + (EdgeWidth div 2), FTopEdge);
          LineTo(TabPos.StartPos + TabPos.Size + (EdgeWidth div 2), FTabHeight);

          Pen.Color := FOptions.ShadowColor;
          if (FOptions.FlatStyle = fsNoFlat) or
            (FOptions.FlatStyle = fsMiddleFlat) then
          begin
            MoveTo(TabPos.StartPos - (EdgeWidth div 2), FTabHeight - 1);
            LineTo(TabPos.StartPos + TabPos.Size + (EdgeWidth div 2), FTabHeight - 1);
          end;

          if (FOptions.FlatStyle = fsNoFlat) then
          begin
            MoveTo(TabPos.StartPos + TabPos.Size + (EdgeWidth div 2)-1, FTopEdge);
            LineTo(TabPos.StartPos + TabPos.Size + (EdgeWidth div 2)-1, FTabHeight);
          end;