fthtabs.pas

Gestione Cellulari Nokia

        end else
        begin
          R := Rect(TabPos.StartPos, FTopEdge, TabPos.StartPos + TabPos.Size, FTabHeight);
          Brush.Style := bsClear;

          if TabEnabled(Tab + FirstIndex) then
             Font.Color := FOptions.UnselectedColor else
             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.SeparatorColor;
          if isFirst then
          begin
            MoveTo(TabPos.StartPos - (EdgeWidth div 2), FTopEdge + 3);
            LineTo(TabPos.StartPos - (EdgeWidth div 2), (fTopEdge + FTabHeight) - 3);
          end;

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

          Pen.Color := FOptions.DarkShadowColor;
          MoveTo(TabPos.StartPos, FTopEdge);
          LineTo(TabPos.StartPos + TabPos.Size, FTopEdge);

        end;
      end;
    end;

     { draw onto the screen }
    Canvas.Draw(0, 0, MemBitmap);
  finally
    MemBitmap.Free;
  end;
end;

procedure TFourthTabSet.FixTabPos;
var
  FLastVisibleTab: Integer;

  function GetRightSide: Integer;
  begin
    Result := Width - EndMargin;
    if AutoScroll and (FVisibleTabs < Tabs.Count - 1) then
      Dec(Result, FScroller.Width + 4);
  end;

  function ReverseCalcNumTabs(Start, Stop: Integer; Canvas: TCanvas;
    Last: Integer): Integer;
  var
    W: Integer;
  begin
    if HandleAllocated then
    begin
      Result := Last;
      while (Start >= Stop) and (Result >= 0) do
        with Canvas do
        begin
          W := TextWidth(Tabs[Result]);
          if (FStyle = tsOwnerDraw) then MeasureTab(Result, W);
          Dec(Start, W + EdgeWidth); { next usable position }
          if Start >= Stop then Dec(Result);
        end;
      if (Start < Stop) or (Result < 0) then Inc(Result);
    end
    else
      Result := FFirstIndex;
  end;

begin
  if Tabs.Count > 0 then
  begin
    FLastVisibleTab := FFirstIndex + FVisibleTabs - 1;
    if FTabIndex > FLastVisibleTab then
      FFirstIndex := ReverseCalcNumTabs(GetRightSide, StartMargin + EdgeWidth,
        Canvas, FTabIndex)
    else if (FTabIndex >= 0) and (FTabIndex < FFirstIndex) then
      FFirstIndex := FTabIndex;
  end;
end;

procedure TFourthTabSet.SetAutoScroll(Value: Boolean);
begin
  if Value <> FAutoScroll then
  begin
    FAutoScroll := Value;
    FScroller.Visible := False;
    ShowWindow(FScroller.Handle, SW_HIDE);
    Invalidate;
  end;
end;

procedure TFourthTabSet.SetStartMargin(Value: Integer);
begin
  if Value <> FStartMargin then
  begin
    FStartMargin := Value;
    Invalidate;
  end;
end;

procedure TFourthTabSet.SetEndMargin(Value: Integer);
begin
  if Value <> FEndMargin then
  begin
    FEndMargin := Value;
    Invalidate;
  end;
end;

function TFourthTabSet.CanChange(NewIndex: Integer): Boolean;
begin
  if TabEnabled(NewIndex) then
  begin
     Result := true;
     if Assigned(FOnChange) then
       FOnChange(Self, NewIndex, Result);
  end
  else
  result := false;
end;

procedure TFourthTabSet.SetTabIndex(Value: Integer);
var
   newValue:integer;
   found : boolean;
begin
  if Value <> FTabIndex then
  begin
    if (Value < -1) or (Value >= Tabs.Count) then
{$IFDEF DELPHI3_UP}
      raise Exception.Create(SInvalidTabIndex);
{$ELSE}
      raise Exception.Create(LoadStr(SInvalidTabIndex));
{$ENDIF}

    if CanChange(Value) then
    begin
      FTabIndex := Value;
      FixTabPos;
      Click;
      Invalidate;
    end
    else
    begin
       found := false;
       newValue := Value+1;
       while newValue <> Value do
       begin
          if newValue >= fTabs.count then
             newValue := 0;
          if (newValue < fTabs.count) and (not TabEnabled(newValue)) then
             inc(newValue)
          else
          begin
             found := true;
             break;
          end
       end;
       if found and CanChange(newValue) then
       begin
         FTabIndex := newValue;
         FixTabPos;
         Click;
         Invalidate;
       end;
    end;
  end;
end;

procedure TFourthTabSet.SelectNext(Direction: Boolean);
var
  NewIndex: Integer;
begin
  if Tabs.Count > 1 then
  begin
    NewIndex := TabIndex;
    if Direction then
      Inc(NewIndex) else
      Dec(NewIndex);
    if NewIndex = Tabs.Count then
      NewIndex := 0 else
      if NewIndex < 0 then
        NewIndex := Tabs.Count - 1;
    SetTabIndex(NewIndex);
  end;
end;

procedure TFourthTabSet.SetFirstIndex(Value: Integer);
begin
  if (Value >= 0) and (Value < Tabs.Count) then
  begin
    FFirstIndex := Value;
    Invalidate;
  end;
end;

procedure TFourthTabSet.SetTabList(Value: TStrings);
begin
  FTabs.Assign(Value);
  FTabIndex := -1;
  if FTabs.Count > 0 then
    TabIndex := 0
  else
    Invalidate;
end;

procedure TFourthTabSet.SetTabStyle(Value: TTabStyle);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

procedure TFourthTabSet.SetTabHeight(Value: Integer);
var
  SaveHeight: Integer;
begin
  if Value <> FOwnerDrawHeight then
  begin
    SaveHeight := FOwnerDrawHeight;
    try
      FOwnerDrawHeight := Value;
      FTabHeight := value;
      Invalidate;
    except
      FOwnerDrawHeight := SaveHeight;
      fTabHeight := SaveHeight;
      raise;
    end;
  end;
end;

procedure TFourthTabSet.DrawTab(TabCanvas: TCanvas; R: TRect; Index: Integer;
  Selected: Boolean);
begin
  if Assigned(FOnDrawTab) then
    FOnDrawTab(Self, TabCanvas, R, Index, Selected);
end;

procedure TFourthTabSet.GetChildren(Proc: TGetChildProc{$IFDEF DELPHI3_UP}; Root: TComponent{$ENDIF});
begin
  //
end;

procedure TFourthTabSet.MeasureTab(Index: Integer; var TabWidth: Integer);
begin
  if Assigned(FOnMeasureTab) then
    FOnMeasureTab(Self, Index, TabWidth);
end;

procedure TFourthTabSet.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  TabPos: TTabPos;
  I: Integer;
  Extra: Integer;
  MinLeft: Integer;
  MaxRight: Integer;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and (Y <= FTabHeight) then
  begin
    if Y < FTabHeight div 2 then
      Extra := EdgeWidth div 3
    else
      Extra := EdgeWidth div 2;

    for I := 0 to TabPositions.Count - 1 do
    begin
      Pointer(TabPos) := TabPositions[I];
      MinLeft := TabPos.StartPos - Extra;
      MaxRight := TabPos.StartPos + TabPos.Size + Extra;
      if (X >= MinLeft) and (X <= MaxRight) and TabEnabled(FirstIndex + I) then
      begin
        SetTabIndex(FirstIndex + I);
        Break;
      end;
    end;
  end;
end;

procedure TFourthTabSet.WMSize(var Message: TWMSize);
var
  NumVisTabs, LastTabPos: Integer;

  function CalcNumTabs(Start, Stop: Integer; Canvas: TCanvas;
    First: Integer): Integer;
  var
    W: Integer;
  begin
    Result := First;
    while (Start < Stop) and (Result < Tabs.Count) do
      with Canvas do
      begin
        W := TextWidth(Tabs[Result]);
        if (FStyle = tsOwnerDraw) then MeasureTab(Result, W);
        Inc(Start, W + EdgeWidth); { next usable position }
        if Start <= Stop then Inc(Result);
      end;
  end;

begin
  inherited;
  if Tabs.Count > 1 then
  begin
    LastTabPos := Width - EndMargin;
    NumVisTabs := CalcNumTabs(StartMargin + EdgeWidth, LastTabPos, Canvas, 0);
    if (FTabIndex = Tabs.Count) or (NumVisTabs > FVisibleTabs) or
      (NumVisTabs = Tabs.Count) then FirstIndex := Tabs.Count - NumVisTabs;
    FDoFix := True;
  end;
  Invalidate;
end;

procedure TFourthTabSet.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Canvas.Font := Font;
  Invalidate;
end;

procedure TFourthTabSet.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTALLKEYS;
end;

procedure TFourthTabSet.CMDialogChar(var Message: TCMDialogChar);
var
  I: Integer;
begin
  for I := 0 to FTabs.Count - 1 do
  begin
    if IsAccel(Message.CharCode, FTabs[I]) then
    begin
      Message.Result := 1;
      if FTabIndex <> I then
        SetTabIndex(I);
      Exit;
    end;
  end;
  inherited;
end;

procedure TFourthTabSet.DefineProperties(Filer: TFiler);
begin
  { Can be removed after version 1.0 }
  if Filer is TReader then inherited DefineProperties(Filer);
  Filer.DefineProperty('TabOrder', ReadIntData, nil, False);
  Filer.DefineProperty('TabStop', ReadBoolData, nil, False);
end;

procedure TFourthTabSet.ReadIntData(Reader: TReader);
begin
  Reader.ReadInteger;
end;

procedure TFourthTabSet.ReadBoolData(Reader: TReader);
begin
  Reader.ReadBoolean;
end;

procedure TFourthTabSet.SetDisabledTabList(const Value: TStrings);
begin
  FDisabledTabs.Assign(Value);
  Invalidate;
end;

function TFourthTabSet.TabEnabled(index: integer): boolean;
begin
   result := FDisabledTabs.IndexOf(fTabs[index]) = -1;
end;

function TFourthTabSet.CalcTabPositions(Start, Stop: Integer;
  Canvas: TCanvas; First: Integer): Integer;
var
  Index: Integer;
  TabPos: TTabPos;
  W: Integer;
begin
  TabPositions.Count := 0; { erase all previously cached data }
  Index := First;
  while (Start < Stop) and (Index < Tabs.Count) do
  begin
    with Canvas do
    begin
      if TabEnabled(index) then
      begin
         TabPos.StartPos := Start;
         W := TextWidth(Tabs[Index]);

         { Owner }
         if (FStyle = tsOwnerDraw) then MeasureTab(Index, W);

         TabPos.Size := W;
         Inc(Start, TabPos.Size + EdgeWidth); { next usable position }
      end;

      if Start <= Stop then
      begin
        TabPositions.Add(Pointer(TabPos)); { add to list }
        Inc(Index);
      end;
    end;
  end;
  Result := Index - First;
end;

end.