sframebar.pas

Alpha Controls.v5.46b Source

  FAnimation := True;
  FAllowAllClose := False;
  FAllowAllOpen := False;
end;

function TsFrameBar.CreateDefaultFrame: TFrame;
begin

  Result := TFrame.Create(Self);
  Result.Height := 150;
  with TsFrameAdapter.Create(Result) do begin
    SkinData.SkinManager := Self.SkinData.FSkinManager;
    SkinData.SkinSection := s_BarPanel;
  end;
  with TsLabel.Create(Result) do begin
    Align := alClient;
    Caption := 'Frame creation'#13#10'event has not been defined.';
    Alignment := taCenter;
    Layout := tlCenter;
    WordWrap := True;
    Font.color := clRed;
    Parent := Result;
  end;
end;

destructor TsFrameBar.Destroy;
begin
  FreeAndNil(FItems);
  inherited Destroy;
end;

procedure TsFrameBar.ExpandAll(AllowAnimation : boolean);
var
  i : integer;
begin

  for i := 0 to Items.Count - 1 do if AllowAnimation then Items[i].State := stOpening else Items[i].State := stOpened;
  ArrangeTitles;
end;

procedure TsFrameBar.Loaded;
var
  i : integer;
begin
  inherited;
  for i := 0 to Items.Count - 1 do Items[i].TitleButton.SkinData.SkinManager := SkinData.FSkinManager;
  if Visible then Rearrange
end;

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

function TsFrameBar.Offset: integer;
begin
  if Assigned(ListSW) and (ListSW.sBarVert <> nil) and ListSW.sBarVert.fScrollVisible
    then Result := ListSW.sBarVert.ScrollInfo.nPos else Result := 0
end;

procedure TsFrameBar.OpenItem(Index: integer; AllowAnimation: boolean);
var
  i : integer;
begin

  if AllowAnimation then Items[Index].State := stOpening else Items[Index].State := stOpened;
  if not AllowAllOpen then begin
    for i := 0 to Items.Count - 1 do if Items[i].State = stOpened then Items[i].State := stClosing;
    Items[Index].State := stOpened;
  end;
  DontAnim := not AllowAnimation;
  ArrangeTitles;
  DontAnim := False;
end;

procedure TsFrameBar.Rearrange;
begin
  DontAnim := True;
  ArrangeTitles;
  DontAnim := False;
end;

procedure TsFrameBar.SetAllowAllOpen(const Value: boolean);
begin
  if FAllowAllOpen <> Value then begin
    if Value and FAutoFrameSize then FAutoFrameSize := False;
    FAllowAllOpen := Value;
    if not (csLoading in ComponentState) then Rearrange;
  end;
end;

procedure TsFrameBar.SetAutoFrameSize(const Value: boolean);
begin
  if FAutoFrameSize <> Value then begin
    if Value then begin
      if AllowAllOpen then AllowAllOpen := False;
      AutoScroll := False;
    end;
    FAutoFrameSize := Value;
    if not (csLoading in ComponentState) then Rearrange;
  end;
end;

procedure TsFrameBar.SetBorderWidth(const Value: integer);
begin
  if FBorderWidth <> Value then begin
    FBorderWidth := Value;
    RecreateWnd;
    if not (csLoading in ComponentState) then Rearrange;
  end;
end;

procedure TsFrameBar.SetImages(const Value: TCustomImageList);
var
  i : integer;
begin
  if FImages <> Value then begin
    FImages := Value;
    for i := 0 to Items.Count - 1 do if Items[i].TitleButton.Visible then Items[i].TitleButton.Images := Images;
  end;
end;

procedure TsFrameBar.SetItems(const Value: TsTitles);
begin

  FItems.Assign(Value);
end;

procedure TsFrameBar.SetSpacing(const Value: integer);
begin

  if FSpacing <> Value then begin
    FSpacing := Value;
    if not (csLoading in ComponentState) then Rearrange;
  end;
end;

procedure TsFrameBar.SetTitleHeight(const Value: integer);
begin

  if FTitleHeight <> Value then begin
    FTitleHeight := Value;
    if not (csLoading in ComponentState) then Rearrange;
  end;
end;

function TsFrameBar.UpdateFrame(i, y, h, w : integer) : boolean;
var
  rgn : hrgn;
begin
  Result := False;
  if Items.Count <= i then Exit;
  if (Items[i].Frame = nil) and not (csDesigning in ComponentState) then begin
    if Assigned(Items[i].OnCreateFrame)
      then Items[i].OnCreateFrame(Items[i], Items[i].Frame)
      else Items[i].Frame := CreateDefaultFrame;
  end;
  if (Items[i].Frame <> nil) then begin
    if (Items[i].FrameSize = 0) then Items[i].FrameSize := Items[i].Frame.Height;
    if h = -1 then begin
      h := Items[i].FrameSize; // if frame has not been created
      Items[i].Frame.Height := Items[i].FrameSize;
    end;
    if h = 0 then begin
      rgn := CreateRectRgn(-1, -1, -1, -1);
      SetWindowRgn(Items[i].Frame.Handle, rgn, False);
      Items[i].Frame.Visible := False;
    end
    else if h = Items[i].Frame.Height then begin
      rgn := CreateRectRgn(0, 0, Items[i].Frame.Width, Items[i].Frame.Height);
      SetWindowRgn(Items[i].Frame.Handle, rgn, False);
      Items[i].Frame.Visible := True;
    end
    else begin
      rgn := CreateRectRgn(0, Items[i].Frame.Height - h, w, Items[i].Frame.Height);
      SetWindowRgn(Items[i].Frame.Handle, rgn, False);
      Items[i].Frame.Visible := True;
    end;
    Items[i].Frame.SetBounds(Items[i].TitleButton.Left, y - (Items[i].Frame.Height - h), w, Items[i].Frame.Height);
    Result := True
  end
  else Result := False;
end;

procedure TsFrameBar.UpdateWidths;
var
  i, cWidth : integer;
begin
  Arranging := True;
  cWidth := WidthOf(CalcClientRect);
  for i := 0 to Items.Count - 1 do if Items[i].TitleButton.Visible and Items[i].Visible then begin
    if Items[i].TitleButton.Width <> cWidth then begin
      Items[i].TitleButton.SkinData.BGChanged := True;
      Items[i].TitleButton.Width := cWidth;
    end;
    if (Items[i].Frame <> nil) and (Items[i].Frame.Width <> cWidth) then begin
      Items[i].Frame.Width := cWidth;
    end;
  end;
  Arranging := False;
  if AutoScroll then UpdateScrolls(ListSW);
end;

procedure TsFrameBar.WndProc(var Message: TMessage);
var
  i : integer;
begin
  inherited;          
  case Message.Msg of
    WM_SIZE : if Showing then begin
      if AutoFrameSize then Rearrange else begin
        UpdateWidths;
        SendMessage(Handle, WM_NCPAINT, 0, 0);
      end;
    end;
    CM_VISIBLECHANGED : if Showing then begin
      Rearrange;
    end;
    CM_ENABLEDCHANGED: begin
      for i := 0 to Items.Count - 1 do begin
        Items[i].TitleButton.Enabled := Enabled;
        if Items[i].Frame <> nil then Items[i].Frame.Enabled := Enabled;
      end;
      Repaint
    end;
  end;
  if Message.Msg = cardinal(SM_ALPHACMD) then case Message.WParamHi of
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) and SkinData.Skinned then UpdateWidths
  end;
end;

{ TsTitleItem }

constructor TsTitleItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);

  FOwner := TsTitles(Collection);
  TitleButton := TsTitleButton.InternalCreate(FOwner.FOwner, Index);
  TitleButton.TitleItem := Self;
  TitleButton.OnClick := TitleButtonClick;
  FVisible := True;
  DontAnim := True;
  FOwner.FOwner.ArrangeTitles;
  DontAnim := False;
  FImageIndex := -1;
  State := stClosed;
end;

destructor TsTitleItem.Destroy;
begin
  if not (csDestroying in FOwner.FOwner.ComponentState) and (TitleButton <> nil) then begin
    TitleButton.Visible := False;
    TitleButton.Free;
    TitleButton := nil;
    if Frame <> nil then FreeAndNil(Frame);
  end;
  inherited Destroy;
  if not (csDestroying in FOwner.FOwner.ComponentState) then FOwner.FOwner.ArrangeTitles;
end;

function TsTitleItem.GetMargin: integer;
begin
  Result := TitleButton.Margin; 
end;

function TsTitleItem.GetPopupMenu: TPopupMenu;
begin
  if TitleButton <> nil then Result := TitleButton.PopupMenu else Result := nil
end;

function TsTitleItem.GetSkinSection: string;
begin
  Result := TitleButton.SkinData.SkinSection;
end;

function TsTitleItem.GetSpacing: integer;
begin
  if Result <> TitleButton.Spacing then begin
    Result := TitleButton.Spacing;
    if csDesigning in TitleButton.ComponentState then TitleButton.SkinData.Invalidate;
  end;
end;

procedure TsTitleItem.SetCaption(const Value: string);
begin
  TitleButton.Caption := Value;
  FCaption := Value;
end;

procedure TsTitleItem.SetImageIndex(const Value: integer);
begin
  if FImageIndex <> Value then begin
    FImageIndex := Value;
    TitleButton.ImageIndex := Value;
    if TitleButton.Images <> FOwner.FOwner.Images then TitleButton.Images := FOwner.FOwner.Images
  end;
end;

procedure TsTitleItem.SetMargin(const Value: integer);
begin
  if TitleButton.Margin <> Value then begin
    TitleButton.Margin := Value;
    if csDesigning in TitleButton.ComponentState then TitleButton.SkinData.Invalidate;
  end;
end;

procedure TsTitleItem.SetPopupMenu(const Value: TPopupMenu);
begin
  if TitleButton <> nil then TitleButton.PopupMenu := Value;
end;

procedure TsTitleItem.SetSkinSection(const Value: string);
begin

  TitleButton.SkinData.SkinSection := Value
end;

procedure TsTitleItem.SetSpacing(const Value: integer);
begin
  TitleButton.Spacing := Value;
end;

procedure TsTitleItem.SetVisible(const Value: boolean);
begin
  if FVisible <> Value then begin
    FVisible := Value;
    if Value then begin
      TitleButton.SkinData.UpdateIndexes;
      TitleButton.Parent := FOwner.FOwner;
    end
    else TitleButton.Parent := nil;
    FOwner.FOwner.ArrangeTitles;
  end;
end;

procedure TsTitleItem.TitleButtonClick;
var
  i : integer;
begin
  if (csDesigning in FOwner.FOwner.ComponentState) then Exit;
  if Assigned(TitleButton) and Assigned(FOnClick) then FOnClick(TitleButton);
  case State of
    stClosed : begin
      State := stOpening;
      if not FOwner.FOwner.AllowAllOpen
        then for i := 0 to FOwner.Count - 1 do if FOwner[i].State = stOpened then FOwner[i].State := stClosing;
    end;
    stOpened : if FOwner.FOwner.AllowAllClose then FOwner[Index].State := stClosing;
  end;
  FOwner.FOwner.ArrangeTitles;
end;

{ TsTitleButton }
function TsTitleButton.CurrentState: integer;
begin
  Result := inherited CurrentState;
  if (Result = 0) and Active then Result := 1;
end;

constructor TsTitleButton.InternalCreate(AOwner: TsFrameBar; Index: integer);
var
  i : Integer;
begin
  inherited Create(AOwner);
  SkinData.COC := COC_TsBarTitle;
  i := 0;
  repeat
    inc(i);
    if AOwner.FindComponent('sTitleButton' + IntToStr(i)) = nil then begin
      Name := 'sTitleButton' + IntToStr(i);
      break;
    end;
  until False;
  Alignment := taLeftJustify;
  Spacing := 8;
  Margin := 5;
end;

end.