sscrollmax.pas

Alpha Controls.v5.46b Source

  Result := TsScrollMaxBand(FPnlEdit.Controls[Index]);
end;

function TsScrollMax.GetBandCount: Integer;
begin
  if FPnlEdit <> nil
    then Result := FPnlEdit.ControlCount
    else Result := 0
end;

procedure TsScrollMax.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
  FPnlEdit.GetChildren(Proc, Root);
end;

function TsScrollMax.GetChildParent: TComponent;
begin
  Result := FPnlEdit;
end;

procedure TsScrollMax.SetScrollPos(const Value: Integer);
begin
  if FScrollPos <> Value then begin
    FScrollPos := Value;
    if not (csLoading in ComponentState) then begin
      Perform(WM_SETREDRAW, 0, 0);
      if FScrollPos > FScrollBar.Max - FScrollBar.Page then FScrollPos := FScrollBar.Max - FScrollBar.Page;
      if FScrollPos < 0 then FScrollPos := 0;
      FPnlEdit.Realign;
      Perform(WM_SETREDRAW, 1, 0);
      RedrawWindow(Handle, nil, 0, RDW_UPDATENOW or RDW_ALLCHILDREN or RDW_INVALIDATE);
    end;
  end;
end;

procedure TsScrollMax.ScrollBarScroll(Sender: TObject);
begin
  ScrollPos := FScrollBar.Pos;
  if Assigned(FOnScroll) then FOnScroll(Self);
end;

procedure TsScrollMax.ScrollInView(AControl: TControl);
var
  I: Integer;
  Band: TsScrollMaxBand;
  Rect: TRect;
begin
  Band := nil;
  for I := 0 to FPnlEdit.ControlCount - 1 do
    if (FPnlEdit.Controls[I] as TsScrollMaxBand).ContainsControl(AControl) then begin
      Band := FPnlEdit.Controls[I] as TsScrollMaxBand;
      Break;
    end;
  if Band = nil then raise Exception.Create('Band is empty'); 
  Band.Expanded := True;
  Rect := AControl.ClientRect;
  Dec(Rect.Top, BevelWidth + BorderWidth + 4);
  Inc(Rect.Bottom, BevelWidth + BorderWidth + 4);
  Rect.TopLeft := ScreenToClient(AControl.ClientToScreen(Rect.TopLeft));
  Rect.BottomRight := ScreenToClient(AControl.ClientToScreen(Rect.BottomRight));
  if Rect.Top < 0 then ScrollPos := ScrollPos + Rect.Top else if Rect.Bottom > ClientHeight then begin
    if Rect.Bottom - Rect.Top > ClientHeight then Rect.Bottom := Rect.Top + ClientHeight;
    ScrollPos := ScrollPos + Rect.Bottom - ClientHeight;
  end;
end;

procedure TsScrollMax.SetAutoHeight(const Value: Boolean);
begin
  if FAutoHeight <> Value then begin
    FAutoHeight := Value;
    if FAutoHeight then CorrectHeight;
  end;
end;

procedure TsScrollMax.SetExpandedHeight(const Value: Integer);
begin
  if FExpandedHeight <> Value then begin
    FExpandedHeight := Value;
    if FAutoHeight then CorrectHeight;
  end;
end;

procedure TsScrollMax.Resize;
begin
  inherited Resize;
  if FAutoHeight and (BandCount > 0) and not AllCollapsed and (FExpandedHeight > -1) then FExpandedHeight := Height;
  if FAutoHeight then CorrectHeight;
end;

procedure TsScrollMax.CorrectHeight;
var
  I, H: Integer;
  Band: TsScrollMaxBand;
begin
  if not FAutoHeight or (BandCount = 0) then Exit;
  if AllCollapsed then begin
    H := 0;
    for I := 0 to BandCount - 1 do Inc(H, Bands[I].Height);
    ClientHeight := H + 2 * PanelBorder(Self);
  end
  else if FExpandedHeight <> -1 then Height := FExpandedHeight else begin
    H := 0;
    Band := nil;
    for I := 0 to BandCount - 1 do if Bands[I].Height > H then begin
      Band := Bands[I];
      H := Band.Height;
    end;
    H := 0;
    for I := 0 to BandCount - 1 do if Bands[I] = Band then Inc(H, Bands[I].Height) else Inc(H, Bands[I].CollapsedHeight);
    ClientHeight := H + 2 * PanelBorder(Self);
  end;
end;

function TsScrollMax.AllCollapsed: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to BandCount - 1 do if Bands[I].Expanded then Exit;
  Result := True;
end;

function TsScrollMax.AllExpanded: Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := 0 to BandCount - 1 do if not Bands[I].Expanded then Exit;
  Result := True;
end;

procedure TsScrollMax.AddBand(Band: TsScrollMaxBand);
begin
  Band.Parent := GetChildParent as TWinControl;
end;

function TsScrollMax.GetScrollBarWidth: Cardinal;
begin
  Result := FScrollBar.Width;
end;

procedure TsScrollMax.SetScrollBarWidth(const Value: Cardinal);
begin
  if Value >= 4 then
    FScrollBar.Width := Value;
end;

function TsScrollMax.GetScrollBarVisible: Boolean;
begin
  Result := FScrollBar.Visible;
end;

procedure TsScrollMax.SetScrollBarVisible(const Value: Boolean);
begin
  FScrollBar.Visible := Value;
  if csDesigning in ComponentState then
    if not Value then FScrollBar.Parent := nil else FScrollBar.Parent := Self;
end;

procedure TsScrollMax.SetOneExpanded(const Value: Boolean);
begin
  if FOneExpanded <> Value then begin
    FOneExpanded := Value;
  end;
end;

constructor TsScroller.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SkinData.SkinSection := s_ProgressV;
end;

procedure TsScrollMaxBand.PrepareCache;
var
  CI : TCacheInfo;
  h : integer;
begin
  SkinData.InitCacheBmp;
  CI := GetParentCacheHwnd(Handle);

  if ButtonVisible then begin
    h := FButton.Height + 1;
    if CI.Ready then begin
      BitBlt(SkinData.FCacheBMP.Canvas.Handle, 0, 0, Width, h, CI.Bmp.Canvas.Handle, Left, Top, SrcCopy);
    end
    else FillRect(SkinData.FCacheBMP.Canvas.Handle, Rect(0, 0, Width, h), Color);
    if Expanded then PaintItem(SkinData, CI, False, 0, Rect(0, FButton.Height, Width, Height), Point(Left, Top + h), SkinData.FCacheBMP, True);
  end
  else PaintItem(SkinData, CI, True, 0, Rect(0, 0, width, Height), Point(Left, Top), SkinData.FCacheBMP, True);
  SkinData.BGChanged := False;
end;

destructor TsScrollMaxBand.Destroy;
begin
  if Assigned(FSkinData) then FreeAndNil(FSkinData);
  inherited;
end;

procedure TsScrollMaxBand.AfterConstruction;
begin
  inherited;
  SkinData.Loaded;
  TextChanged;
end;

procedure TsScrollMaxBand.OurPaint(DC: HDC; SendUpdated: boolean);
var
  b : boolean;
  NewDC : HDC;
  R : TRect;
begin
  if (csDestroying in ComponentState) or
       (csCreating in Parent.ControlState) or
         not Assigned(SkinData) or not SkinData.Skinned then Exit;

  SkinData.Updating := SkinData.Updating;
  if not SkinData.Updating then begin
    b := SkinData.HalfVisible or SkinData.BGChanged;

    if DC <> 0 then NewDC := DC else NewDC := Canvas.Handle;
    if SkinData.RepaintIfMoved then begin
      GetClipBox(NewDC, R);
      SkinData.HalfVisible := (WidthOf(R) <> Width) or (HeightOf(R) <> Height)
    end
    else SkinData.HalfVisible := False;

    if b and not SkinData.UrgentPainting then PrepareCache;
    CopyWinControlCache(Self, SkinData, Rect(0, 0, 0, 0), Rect(0, 0, Width, Height), NewDC, True);

    sVCLUtils.PaintControls(NewDC, Self, b and SkinData.RepaintIfMoved, Point(0, 0)); 
    if SendUpdated then SetParentUpdated(Self);
  end;
end;

procedure TsScrollMaxBand.PaintWindow(DC: HDC);
begin
  inherited;
  OurPaint(DC);
end;

procedure TsScrollMaxBand.WndProc(var Message: TMessage);
var
  SaveIndex: Integer;
  DC: HDC;
  PS: TPaintStruct;
begin
  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 : begin
      ControlStyle := ControlStyle - [csOpaque];
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, SkinData);
        Invalidate;
      end;
      AlphaBroadCast(Self, Message);
      exit
    end;
    AC_SETNEWSKIN : begin
      ControlStyle := ControlStyle + [csOpaque];
      AlphaBroadCast(Self, Message);
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, SkinData);
      end;
      exit
    end;
    AC_REFRESH : begin
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, SkinData);
        AlphaBroadCast(Self, Message);
        Repaint;
      end
      else AlphaBroadCast(Self, Message);
      exit
    end;
  end;
  if not ControlIsReady(Self) or not SkinData.Skinned then inherited else begin
    if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
      AC_ENDPARENTUPDATE : if {IsNT or (not IsNT and }(SkinData.Updating) {v4.83 for win9x} then {????} begin
        SkinData.Updating := False;
        RedrawWindow(Handle, nil, 0, RDW_ALLCHILDREN or RDW_INVALIDATE or RDW_ERASE or RDW_FRAME or RDW_UPDATENOW);
        Exit;
      end else Exit;
      AC_PREPARING : begin
        Message.LParam := integer(SkinData.BGChanged or SkinData.Updating);
      end;
      AC_URGENTPAINT : begin // v4.08
        CommonWndProc(Message, SkinData);
        if SkinData.UrgentPainting then PrepareCache;
      end
      else CommonMessage(Message, SkinData);
    end
    else begin
      case Message.Msg of
        WM_PRINT : begin
          SkinData.Updating := False;
          if ControlIsReady(Self) then begin
            DC := TWMPaint(Message).DC;
            if SkinData.BGChanged then begin
              PrepareCache;
            end;
            OurPaint(DC, False);
          end;
          Exit;
        end;
        WM_PAINT : begin
          if (not Visible and not (csDesigning in ComponentState)) then begin inherited; exit end;
          ControlState := ControlState + [csCustomPaint];
          BeginPaint(Handle, PS); // v4.31
          if TWMPAINT(Message).DC = 0 then DC := GetDC(Handle) else DC := TWMPAINT(Message).DC;
          try
            SaveIndex := SaveDC(DC);
            Canvas.Lock;
            try
              Canvas.Handle := DC;
              try
                TControlCanvas(Canvas).UpdateTextFlags;
                OurPaint(DC);
              finally
                Canvas.Handle := 0;
              end;
            finally
              Canvas.Unlock;
            end;
            RestoreDC(DC, SaveIndex);
          finally
            if TWMPaint(Message).DC = 0 then ReleaseDC(Handle, DC);
            EndPaint(Handle, PS);
          end;
          ControlState := ControlState - [csCustomPaint];
          Exit;
        end;
        WM_ERASEBKGND : Exit;
        WM_MOVE : SkinData.BGChanged := True;
        CM_VISIBLECHANGED : begin
          SkinData.BGChanged := True;
          SkinData.Updating := False;
          inherited;
          Exit;
        end;
        WM_KILLFOCUS, WM_SETFOCUS: begin inherited; exit end;
      end;
      CommonWndProc(Message, SkinData);
      inherited;
      case Message.Msg of
        CM_TEXTCHANGED : begin
          if Parent <> nil then SkinData.Invalidate;
          TextChanged;
          Exit;
        end;
        CM_ENABLEDCHANGED : SkinData.Invalidate;
        WM_SETFONT : begin
          if Caption <> '' then begin
            SkinData.BGChanged := True;
            Repaint;
          end;
        end;
      end;
    end;
  end;
end;

procedure TsScrollMax.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  inherited;
end;

constructor TsScrollMaxBands.Create(AOwner: TComponent);
begin
  inherited;
  BevelOuter := bvNone;
  BevelInner := bvNone;
  SkinData.SkinSection := s_CheckBox
end;

procedure TsScrollMaxBand.CreateWnd;
begin
  inherited;
  TextChanged;
end;

procedure TsScrollMaxBands.WndProc(var Message: TMessage);
var
  R: TRect;
  DC : hdc;
begin
  inherited;
  case Message.Msg of
    WM_PAINT : if (csDesigning in ComponentState) and (ControlCount = 0) then begin
      DC := GetDC(Handle);
      try
        SetBkMode(DC, TRANSPARENT);
        R := ClientRect;
        DrawText(DC, PChar('Right click and choose "Add band"'), -1, R, DT_WORDBREAK);
      finally
        ReleaseDC(Handle, DC);
      end
    end;
  end;
end;

procedure TsScrollMaxBand.SetImageIndex(const Value: integer);
begin
  Button.ImageIndex := Value;
end;

procedure TsScrollMaxBand.SetImages(const Value: TCustomImageList);
begin
  Button.Images := Value;
end;

function TsScrollMaxBand.GetImageIndex: integer;
begin
  Result := Button.ImageIndex;
end;

function TsScrollMaxBand.GetImages: TCustomImageList;
begin
  Result := Button.Images;
end;

procedure TsBandBtn.Invalidate;
begin
  Spacing := SpeedSpacing;
  if (Parent <> nil) and (Width <> Parent.Width) then Width := Parent.Width;
  inherited;
end;

function TsScrollMaxBand.GetTitleHeight: integer;
begin
  Result := Button.Height;
end;

procedure TsScrollMaxBand.SetTitleHeight(const Value: integer);
begin
  Button.Height := Value;
end;

procedure TsBandBtn.PrepareCache;
var
  CI : TCacheInfo;
  si, mi, w : integer;
  Mode, x, y : integer;
  R : TRect;
begin
inherited;exit;
  SkinData.InitCacheBmp;
  SkinData.FCacheBmp.Canvas.Font.Assign(Font);

  CI := GetParentCache(TsScrollMaxBand(Parent).SkinData);
  if CI.Ready and (CI.Bmp.Width = 0) then Exit;

  if not CI.Ready then ParentCenterColor := TsHackedControl(Parent).Color else ParentCenterColor := clFuchsia;

  PaintItem(SkinData, CI, True, CurrentState, Rect(0, 0, Width - ArrowWidth, Height), Point(Left, Top), SkinData.FCacheBMP, False, integer(Down), integer(Down));
  UpdateCorners(SkinData, CurrentState);
  DrawCaption;
  DrawGlyph;

  CtrlParentColor := clFuchsia;
  if not Enabled then begin
    CI := GetParentCache(SkinData);
    if CI.Ready and not SkinData.RepaintIfMoved and not SkinData.UrgentPainting then begin
      ParentCenterColor := CI.Bmp.Canvas.Pixels[CI.Bmp.Width div 2, CI.Bmp.Height div 2];
    end;
    BmpDisabledKind(SkinData.FCacheBmp, DisabledKind, Parent, CI, Point(Left, Top));
    ParentCenterColor := clFuchsia;
  end;

  SkinData.BGChanged := False;
end;

end.