sscrollbox.pas

Alpha Controls.v5.46b Source

unit sScrollBox;
{$I sDefs.inc}
{.$DEFINE LOGGED}

interface

uses
  sLabel, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, sCommonData, StdCtrls, acSBUtils;

type
  TsPaintEvent = procedure (ControlBmp : TBitmap) of object;

  TsScrollBox = class(TScrollingWinControl)
  private
{$IFNDEF NOTFORHELP}
    FCommonData : TsCommonData;
    FOnPaint: TsPaintEvent;
    FOnBeforeScroll: TNotifyEvent;
    FOnAfterScroll: TNotifyEvent;
    FCanvas : TControlCanvas;
    FOnMouseLeave: TNotifyEvent;
    FOnMouseEnter: TNotifyEvent;
    function GetCanvas: TCanvas;
    procedure SetBorderStyle(const Value: TBorderStyle);
  protected
    FBorderStyle: TBorderStyle;
    FAutoFrameSize: boolean;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMNCPaint(var Message: TWMPaint); message WM_NCPAINT;
    procedure WMPrint(var Message: TWMPaint); message WM_PRINT;
    procedure SetParent(AParent: TWinControl); override;
    procedure WMNCHitTest(var Message: TMessage); message WM_NCHITTEST;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  public
    ListSW : TacScrollWnd;
    constructor Create(AOwner: TComponent); override;
    procedure CreateParams(var Params: TCreateParams); override;
    destructor Destroy; override;
    procedure AfterConstruction; override;
    procedure Loaded; override;

    procedure ScrollBy(DeltaX, DeltaY: Integer);

    procedure PrepareCache; virtual;
    procedure Paint(aDC : hdc = 0; SendUpdated : boolean = True); virtual;
    procedure WndProc(var Message: TMessage); override;
{$ENDIF} // NOTFORHELP
  published
    {:@event}
    property OnPaint : TsPaintEvent read FOnPaint write FOnPaint;
{$IFNDEF NOTFORHELP}
    {:@event}
    property OnAfterScroll : TNotifyEvent read FOnAfterScroll write FOnAfterScroll;
    {:@event}
    property OnBeforeScroll : TNotifyEvent read FOnBeforeScroll write FOnBeforeScroll;
    property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property Align;
    property Anchors;
    property AutoScroll default True;
    property BiDiMode;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Canvas : TCanvas read GetCanvas;
    property Constraints;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Color;
    property Ctl3D;
    property Font;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDblClick;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
{$ENDIF} // NOTFORHELP
    property SkinData : TsCommonData read FCommonData write FCommonData;
  end;

{$IFNDEF NOTFORHELP}
procedure SkinScrollInView(AControl: TControl; ScrollBox : TsScrollBox); // For compatibility
{$ENDIF} // NOTFORHELP

implementation

uses sGraphUtils{$IFDEF CHECKXP}, UxTheme, Themes{$ENDIF}, sConst, sMaskData, sVCLUtils, acntUtils, sStyleSimply, math,
  sMessages{$IFDEF LOGGED}, sDebugMsgs{$ENDIF}, sAlphaGraph, sSkinManager, FlatSB;

procedure SkinScrollInView(AControl: TControl; ScrollBox : TsScrollBox);
begin
  ScrollBox.ScrollInView(AControl);
end;

{ TsScrollBox }

procedure TsScrollBox.AfterConstruction;
begin
  inherited AfterConstruction;
  FCommonData.Loaded;
end;

procedure TsScrollBox.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
  inherited;
end;

constructor TsScrollBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FAutoFrameSize := False;
  FCommonData := TsCommonData.Create(Self, True);
  FCommonData.COC := COC_TsScrollBox;
  ControlStyle := ControlStyle + [csAcceptsControls];
  FCanvas := TControlCanvas.Create;
  FCanvas.Control := Self;
  Width := 185;
  Height := 41;
  AutoScroll := True;

  FBorderStyle := bsSingle;
end;

procedure TsScrollBox.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do begin
    Style := Style or BorderStyles[FBorderStyle];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then  begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

destructor TsScrollBox.Destroy;
begin
  if ListSW <> nil then FreeAndNil(ListSW);
  if Assigned(FCommonData) then FreeAndNil(FCommonData);
  if Assigned(FCanvas) then FreeAndNil(FCanvas);
  inherited Destroy;
end;

function TsScrollBox.GetCanvas: TCanvas;
begin
  Result := FCanvas;
end;

procedure TsScrollBox.Loaded;
begin
  inherited Loaded;
  FCommonData.Loaded;
  if not FCommonData.Skinned then Exit;
end;

procedure TsScrollBox.Paint(aDC : hdc = 0; SendUpdated : boolean = True);
var
  DC : hdc;
  bWidth : integer;
begin
  FCommonData.Updating := FCommonData.Updating;
  if FCommonData.Updating then Exit; // !!!
  if aDC = 0 then DC := Canvas.Handle else DC := aDC;
  if FCommonData.BGChanged and not FCommonData.UrgentPainting then begin
    PrepareCache;
    if Assigned(OnPaint) then OnPaint(FCommonData.FCacheBmp);
    FCommonData.BGChanged := False;
  end;
  bWidth := 2 * integer(BorderStyle = bsSingle);
  CopyWinControlCache(Self, FCommonData, Rect(bWidth, bWidth, 0, 0), Rect(0, 0, Width - bWidth * 2, Height - bWidth * 2), DC, True);
  sVCLUtils.PaintControls(DC, Self, True, Point(0, 0));
  if SendUpdated then SetParentUpdated(Self);
end;

procedure TsScrollBox.PrepareCache;
begin
  FCommonData.InitCacheBmp;
  PaintItem(FCommonData, GetParentCache(FCommonData),
                 False, 0, Rect(0, 0, Width, Height),
                 Point(Left, Top),
                 FCommonData.FCacheBmp, False);
  SkinData.BGChanged := False;
end;

procedure TsScrollBox.ScrollBy(DeltaX, DeltaY: Integer);
begin
  SendAMessage(Handle, AC_BEFORESCROLL);
  inherited ScrollBy(DeltaX, DeltaY);
  SendAMessage(Handle, AC_AFTERSCROLL);
end;

procedure TsScrollBox.SetBorderStyle(const Value: TBorderStyle);
begin
  if Value <> FBorderStyle then begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TsScrollBox.SetParent(AParent: TWinControl);
begin
  inherited;
  if (Parent = nil) then Exit;
  FCommonData.Loaded;
end;

procedure TsScrollBox.WMNCHitTest(var Message: TMessage);
begin
  DefaultHandler(Message);
end;

procedure TsScrollBox.WMNCPaint(var Message: TWMPaint);
var
  DC, SavedDC : hdc;
  bWidth : integer;
begin
  if FCommonData.Skinned or (BorderStyle = bsNone) or not Visible then begin
    if csDesigning in ComponentState then inherited;
    FCommonData.Updating := FCommonData.Updating; // v4.44
    if ControlIsReady(Self) and not FCommonData.Updating then begin
      if SkinData.BGChanged then begin
        PrepareCache;
        if Assigned(OnPaint) then OnPaint(FCommonData.FCacheBmp);
      end;
      UpdateCorners(FCommonData, 0);

      bWidth := 2 * integer(BorderStyle = bsSingle) + BorderWidth;
      DC := GetWindowDC(Handle);
      SavedDC := SaveDC(DC);

      BitBltBorder(DC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, bWidth);
      if Assigned(ListSW) and Assigned(ListSW.sBarVert) then Ac_NCPaint(ListSW, Handle, 1, 0, -1, DC);
      RestoreDC(DC, SavedDC);
      ReleaseDC(Handle, DC);
    end;
  end else inherited;
end;

procedure TsScrollBox.WMPaint(var Message: TWMPaint);
var
  DC, SavedDC : hdc;
  PS : TPaintStruct;
begin
  if FCommonData.Skinned and (Visible or (csDesigning in ComponentState)) then begin
    BeginPaint(Handle, PS);
    DC := GetDC(Handle);
    try
      FCommonData.Updating := FCommonData.Updating;
      if ControlIsReady(Self) and not FCommonData.Updating then begin
        SavedDC := SaveDC(DC);
        Canvas.Lock;
        Canvas.Handle := DC;
        try
          Paint;
        finally
          Canvas.Handle := 0;
          Canvas.UnLock;
          RestoreDC(DC, SavedDC);
        end;
      end;
    finally
      ReleaseDC(Handle, DC);
      EndPaint(Handle, PS);
    end;
  end
  else inherited;
end;

procedure TsScrollBox.WMPrint;
var
  DC : hdc;
  bWidth : integer;
  cR : TRect;
begin
  if FCommonData.Skinned then begin
    FCommonData.Updating := False;
    if ControlIsReady(Self) then begin
      DC := Message.DC;
      if SkinData.BGChanged then begin
        PrepareCache;
        if Assigned(OnPaint) then OnPaint(FCommonData.FCacheBmp);
      end;
      UpdateCorners(FCommonData, 0);
      bWidth := BorderWidth + 2 * integer(BorderStyle = bsSingle);
      BitBltBorder(DC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, bWidth);
      Ac_NCPaint(ListSW, Handle, longint(Message.DC), 0, -1, DC);

      MoveWindowOrg(DC, bWidth, bWidth);
      cR := GetClientRect;
      IntersectClipRect(DC, 0, 0, WidthOf(cR), HeightOf(cR));

      Paint(DC, False);
      if Message.DC = 0 then ReleaseDC(Handle, DC);
    end;
  end
  else inherited;
end;

procedure TsScrollBox.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  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_SETNEWSKIN : begin
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        AlphaBroadCast(Self, Message);
        CommonWndProc(Message, FCommonData);
      end
      else AlphaBroadCast(Self, Message);
      exit
    end;
    AC_REFRESH : begin
      if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
        CommonWndProc(Message, FCommonData);
        SkinData.Updating := SkinData.Updating;
        if not SkinData.Updating then begin
          PrepareCache;
          RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_UPDATENOW);
        end;
        RefreshScrolls(SkinData, ListSW);
      end;
      AlphaBroadCast(Self, Message);
      exit
    end;
    AC_REMOVESKIN : begin
      AlphaBroadCast(Self, Message);
      if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
        if ListSW <> nil then begin
          FreeAndNil(ListSW);
          InitializeFlatSB(Handle);
        end;
        CommonWndProc(Message, FCommonData);
        if not (csDestroying in ComponentState) then begin
          FCommonData.BorderIndex := -1;
          FCommonData.SkinIndex := -1;
{$IFDEF CHECKXP}
          if UseThemes then begin
            ControlStyle := ControlStyle - [csParentBackground];
            SetWindowTheme(Handle, nil, nil);
          end;
{$ENDIF}
          RedrawWindow(Handle, nil, 0, RDW_ERASE or RDW_UPDATENOW or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_FRAME);
        end;
      end;
      exit
    end;
    AC_INVALIDATE : begin
      SendMessage(Handle, WM_PAINT, 0, 0);
      SendMessage(Handle, WM_NCPAINT, 0, 0);
    end;
    AC_BEFORESCROLL : begin
      if Assigned(FOnBeforeScroll) then FOnBeforeScroll(Self);
//      if GetBoolMsg(Self, AC_CHILDCHANGED) or FCommonData.RepaintIfMoved then begin
        SendMessage(Handle, WM_SETREDRAW, 0, 0);
//      end;
    end;
    AC_AFTERSCROLL : begin
//      if GetBoolMsg(Self, AC_CHILDCHANGED) or FCommonData.RepaintIfMoved then begin
        SendMessage(Handle, WM_SETREDRAW, 1, 0);
        RedrawWindow(Handle, nil, 0, RDW_NOERASE or RDW_UPDATENOW or RDW_INVALIDATE or RDW_ALLCHILDREN or RDW_FRAME);
//      end;
      if Assigned(FOnAfterScroll) then FOnAfterScroll(Self);
    end;
    AC_ENDPARENTUPDATE : if FCommonData.Updating {IsNT or (not IsNT and FCommonData.Updating)} {v4.83 for Win9x} then begin
      FCommonData.Updating := False;
      RedrawWindow(Handle, nil, 0, RDW_FRAME or RDW_INTERNALPAINT or RDW_INVALIDATE or RDW_UPDATENOW);
      Exit;
    end else Exit;
    AC_URGENTPAINT : begin // v4.24
      CommonWndProc(Message, FCommonData);
      if FCommonData.UrgentPainting then begin
        FCommonData.InitCacheBmp;
        PaintItem(FCommonData, GetParentCache(FCommonData), False, 0, Rect(0, 0, width, Height), Point(Left, Top), FCommonData.FCacheBMP, True);
        FCommonData.BGChanged := False;
      end;
      Exit
    end;
  end;
  case Message.Msg of
    CM_MOUSEENTER : begin
      if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
    end;
    CM_MOUSELEAVE : begin
      if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
    end;
  end;
  if not ControlIsReady(Self) then inherited else begin
    if FCommonData.Skinned then begin
      if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
        AC_PREPARING : begin
          Message.LParam := integer(FCommonData.Updating);//FCommonData.BGChanged or FCommonData.Updating);    v5.40
          Message.Result := Message.LParam;
          Exit;
        end;
        AC_GETCACHE : begin
          GlobalCacheInfo := MakeCacheInfo(FCommonData.FCacheBmp, 2 * integer(BorderStyle = bsSingle) + BorderWidth,  2 * integer(BorderStyle = bsSingle) + BorderWidth);
          Exit;
        end;
      end
      else case Message.Msg of
        CM_VISIBLECHANGED : FCommonData.BGChanged := True;
        CM_ENTER, CM_EXIT : begin
          FCommonData.BeginUpdate;
          inherited;
          FCommonData.EndUpdate;
          Exit;
        end;
        WM_ERASEBKGND : begin
          FCommonData.Updating := FCommonData.Updating;
          Exit;
        end;
      end;
    end;
    CommonWndProc(Message, FCommonData);
    inherited;
    if FCommonData.Skinned then case Message.Msg of
      CM_FOCUSCHANGED : UpdateScrolls(ListSW, True);
      CM_SHOWINGCHANGED : RefreshScrolls(SkinData, ListSW);
      WM_PARENTNOTIFY: if (Message.WParam and $FFFF = WM_CREATE) or (Message.WParam and $FFFF = WM_DESTROY) then begin
        if AutoScroll then UpdateScrolls(ListSW, True);
      end;
      WM_WINDOWPOSCHANGING, WM_MOUSEWHEEL, CM_CONTROLLISTCHANGE, CM_CONTROLCHANGE : if not SkinData.Updating then begin
        if AutoScroll then UpdateScrolls(ListSW, True);
      end;
    end;
  end;
end;

end.