1. 技术文章
  2. How to make a TScrollBox with Transparent Background?

How to make a TScrollBox with Transparent Background?

由 孤街醉人 提交于 2019-12-10 11:40:41

问题


I have a TFrame with a TImage as background.

This frame serves as ancestor for other frames that I put on a limited space in the main TForm. So it is just a user interface base for the other frames.

I need to put many controls inside these frames, because they will handle large database forms.

As the main form has limited space, I need to put a TScrollBox in all the TFrame space except for the title bar. But this covers the backgroud image.

How do I make this ScrollBar to be background transparent?

Or is it better to make a new component with that functionality, and how to do it?

I saw some examples in other sites, but they are buggy at the run-time

Thank You!

Edit2:

I found the TElScrollBox from ElPack from LMD Inovative. This is background transparent and allow us to put an image as background. But the same problem occurs: When we scroll it at run-time, it moves the ancestor's background in it's area of effect.

Edit1:

I've tried to make a descendant but the scrollbar only shows when we pass hover the mouse where it should be, and the form's background move inside the scrollbox when we scroll it. And also, the controls inside of it get some paint errors...

interface

uses
  Windows, SysUtils, Messages, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ExtCtrls;

type
  TTransScrollBox = class(TScrollBox)
  private
    { Private declarations }
  protected
    procedure CreateParams(var params: TCreateParams); override;
    procedure WMEraseBkGnd(var msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  public
    { Public declarations }
  published
    { Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Eduardo', [TTransScrollBox]);
end;

procedure TTransScrollBox.CreateParams(var params: TCreateParams);
begin
  inherited CreateParams(params);
  params.ExStyle := params.ExStyle or WS_EX_TRANSPARENT;
end;

procedure TTransScrollBox.WMEraseBkGnd(var Msg: TWMEraseBkGnd); 
begin
  SetBkMode (Msg.DC, TRANSPARENT);
  Msg.Result := 1;
end;

回答1:


f you don't want the image to scroll you will have to roll your own scroller, which is not too difficult (It still raining here in England so I'm bored!)

To test, Create the frame put the image on and alighn to client. Put a scrollbar on the frame set to vertical and align right. enlarge the frame at design time. Put controls on anywhere and then shrink it so some are not visible (below the bottom). On the main form in form show (for testing), or when you create a new frame call Frame.BeforeShow to do the setup.

[LATER] EDIT It's raining & Still Bored So I finished it for ya!

unit ScrollingBaseFrameU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, jpeg, ExtCtrls, StdCtrls, contnrs, Generics.Collections, Grids,
  DBGrids;

const
  MaxLargeSteps = 5; // maximum large scroll clicks to scroll to max
  IgnoreTag = 99;   // Controls with this tag value are igored for scrolling
  TitleHeight = 23; // Height of title bar as we are dealing with the image mouse co-ordinates
  RightMargin = 25; // space after right-most control
  BottomMargin = 25; // space after bottom-most control
  StrControl = 'ControlName';  // prefix for controls with no name

type
  TControlPos = class(Tobject) // Little object to save initial control positions
  public
    Name: string;
    X,
    Y: Integer;
  end;

  TScrollingBaseFrame = class(TFrame)
    BackGroundImage: TImage;
    HorzScrollBar: TScrollBar;
    VertScrollBar: TScrollBar;
    pnlTitle: TPanel;
    procedure VertScrollBarChange(Sender: TObject);
    procedure BackGroundImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FrameResize(Sender: TObject);
    procedure HorzScrollBarChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ShowHScroller,
    ShowVScroller : Boolean;       // scroller needed at all?
    PosList: TList<TControlPos>;   // list of initial positions
    procedure BeforeShow; virtual; // override in descendants for specific behaviour
    procedure BeforeClose; virtual; // override in descendants for specific behaviour
    function IndexOfPos(AName:string): Integer;
  end;

implementation

{$R *.dfm}

procedure TScrollingBaseFrame.BeforeClose;
// Clean up
var
  p: TControlPos;
begin
  for p in PosList do
    p.free;
  PosList.Free;
end;

procedure TScrollingBaseFrame.BeforeShow;
//Setup scroller and save initial control positions
var
  i,XMax,YMax,Idx: Integer;
  AControl: TControl;
begin
  pnlTitle.Height := TitleHeight;
  PosList := TList<TControlpos>.Create;
  XMax := 0;
  YMax := 0;
  for i := 0 to ComponentCount - 1 do
  begin
    if Components[i] is TControl then
    begin
      AControl := TControl(Components[i]);
      if Acontrol.Tag <> IgnoreTag then
      begin
        Idx := PosList.Add(TcontrolPos.Create);
        if AControl.Name = '' then  // deal with empty names
          AControl.Name :=  StrControl + IntToStr(i);
        PosList[Idx].Name := AControl.Name;
        PosList[Idx].X := AControl.Left;
        PosList[Idx].Y := AControl.Top;
        if YMax < AControl.Top + AControl.Height then
         YMax := AControl.Top + AControl.Height;
        if XMax < AControl.Left + AControl.Width then
         XMax := AControl.Left + AControl.Width;
      end; // Ignored
    end; // is control
  end; // count
   VertScrollBar.Max := (YMax + BottomMargin) - Height; // bit of a bottom margin :)
   VertScrollBar.LargeChange := VertScrollBar.Max div MaxLargeSteps;
   ShowVScroller := VertScrollBar.Max > BottomMargin;
   VertScrollBar.Visible := ShowVScroller;
   HorzScrollBar.Max := (XMax + RightMargin) - Width; // bit of a Right margin :)
   HorzScrollBar.LargeChange := HorzScrollBar.Max div MaxLargeSteps;
   ShowHScroller := HorzScrollBar.Max > RightMargin;
   HorzScrollBar.Visible := ShowHScroller;
end;

procedure TScrollingBaseFrame.FrameResize(Sender: TObject);
begin
  BackGroundImage.Width := Width;
  BackGroundImage.Height := Height;
end;

procedure TScrollingBaseFrame.HorzScrollBarChange(Sender: TObject);
// Move the controls left and right relative to thier initail positions
var
  i,j: Integer;
  AControl: TControl;
begin
  for i := 0 to ComponentCount - 1 do
   begin
     if Components[i] is TControl then
     begin
       AControl :=  TControl(Components[i]);
       j := IndexOfPos(AControl.Name);
       if j >= 0 then  // could be ignored or the background image
         Acontrol.Left := PosList[j].X  - HorzScrollBar.Position;
     end;
   end;
end;

procedure TScrollingBaseFrame.BackGroundImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
// Show/Hide the scrollbars using mouse position
var
  ScrollBarWidth: Integer;
begin
  ScrollBarWidth := GetSystemmetrics(SM_CXVSCROLL);  // assume the same for horizontal
  VertScrollBar.Visible := (X > Width - ScrollBarWidth) and ShowVScroller;
  HorzScrollBar.Visible := (Y > (Height - TitleHeight) - ScrollBarWidth) and ShowHScroller;
end;

function TScrollingBaseFrame.IndexOfPos(AName:string): Integer;
// Find a control position in the list by name
var
  Idx: Integer;
begin
  Result := -1;
  Idx := 0;
  while (Result < 0) and (Idx < PosList.Count) do
  begin
    if PosList[idx].Name = AName then
      Result := idx;
    inc(idx);
  end;
end;

procedure TScrollingBaseFrame.VertScrollBarChange(Sender: TObject);
// Move the controls Up and down relative to thier initail positions
var
  i,j: Integer;
  AControl: TControl;
begin
  for i := 0 to ComponentCount - 1 do
   begin
     if Components[i] is TControl then
     begin
       AControl :=  TControl(Components[i]);
       j := IndexOfPos(AControl.Name);
       if j >= 0 then  // could be ignored
         Acontrol.Top := PosList[j].Y  - VertScrollBar.Position;
     end;
   end;
end;

end.

and the DFM for completeness:

object ScrollingBaseFrame: TScrollingBaseFrame
  Left = 0
  Top = 0
  Width = 830
  Height = 634
  DoubleBuffered = True
  ParentDoubleBuffered = False
  TabOrder = 0
  OnResize = FrameResize
  object BackGroundImage: TImage
    Tag = 99
    Left = 0
    Top = 23
    Width = 813
    Height = 594
    Align = alClient
    Picture.Data = { **Removed as it was so big!**}
    Transparent = True
    OnMouseMove = BackGroundImageMouseMove
    ExplicitTop = 0
    ExplicitWidth = 1600
    ExplicitHeight = 1200
  end
  object HorzScrollBar: TScrollBar
    Tag = 99
    Left = 0
    Top = 617
    Width = 830
    Height = 17
    Align = alBottom
    PageSize = 0
    TabOrder = 0
    OnChange = HorzScrollBarChange
    ExplicitLeft = 231
    ExplicitTop = 293
    ExplicitWidth = 121
  end
  object VertScrollBar: TScrollBar
    Tag = 99
    Left = 813
    Top = 23
    Width = 17
    Height = 594
    Align = alRight
    Kind = sbVertical
    PageSize = 0
    TabOrder = 1
    OnChange = VertScrollBarChange
    ExplicitTop = 29
  end
  object pnlTitle: TPanel
    Tag = 99
    Left = 0
    Top = 0
    Width = 830
    Height = 23
    Align = alTop
    Caption = 'pnlTitle'
    TabOrder = 2
    ExplicitLeft = 184
    ExplicitTop = 3
    ExplicitWidth = 185
  end
end

[2ND EDIT] Well, Not wanting my spare time to go to waste, the below should work with Delphi 6 onwards. 

unit ScrollingBaseFrameU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, jpeg, ExtCtrls, StdCtrls, contnrs, Grids,
  DBGrids;

const
  MaxLargeSteps = 5; // maximum large scroll clicks to scroll to max
  IgnoreTag = 99;   // Controls with this tag value are igored for scrolling
  TitleHeight = 23; // Height of title bar as we are dealing with the image mouse co-ordinates
  RightMargin = 25; // space after right-most control
  BottomMargin = 25; // space after bottom-most control
  StrControl = 'ControlName';  // prefix for controls with no name

type
  TControlPos = class(Tobject) // Little object to save initial control positions
  public
    Name: string;
    X,
    Y: Integer;
  end;

  TControlPosList = class(TObject)
  private
    function GetCount: Integer;
    function GetItems(Index: Integer): TControlPos;
    procedure SetItems(Index: Integer; const Value: TControlPos);
  public
   TheList: TObjectList;
   Constructor Create; virtual;
   Destructor Destroy; override;
   function Add(APos: TControlPos): Integer;
   function IndexOfPos(AName: string): Integer;
   property Count: Integer read GetCount;
   property Items[Index: Integer]: TControlPos read GetItems write SetItems; default;
  end;

  TScrollingBaseFrame = class(TFrame)
    BackGroundImage: TImage;
    HorzScrollBar: TScrollBar;
    VertScrollBar: TScrollBar;
    pnlTitle: TPanel;
    procedure VertScrollBarChange(Sender: TObject);
    procedure BackGroundImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FrameResize(Sender: TObject);
    procedure HorzScrollBarChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ShowHScroller,
    ShowVScroller : Boolean;       // scroller needed at all?
    PosList: TControlPosList;   // list of initial positions
    procedure BeforeShow; virtual; // override in descendants for specific behaviour
    procedure BeforeClose; virtual; // override in descendants for specific behaviour
  end;

implementation

{$R *.dfm}

procedure TScrollingBaseFrame.BeforeClose;
// Clean up
begin
  PosList.Free;
end;

procedure TScrollingBaseFrame.BeforeShow;
//Setup scroller and save initial control positions
var
  i,XMax,YMax,Idx: Integer;
  AControl: TControl;
begin
  pnlTitle.Height := TitleHeight;
  PosList := TControlPosList.Create;
  XMax := 0;
  YMax := 0;
  for i := 0 to ComponentCount - 1 do
  begin
    if Components[i] is TControl then
    begin
      AControl := TControl(Components[i]);
      if Acontrol.Tag <> IgnoreTag then
      begin
        Idx := PosList.Add(TcontrolPos.Create);
        if AControl.Name = '' then  // deal with empty names
          AControl.Name :=  StrControl + IntToStr(i);
        PosList[Idx].Name := AControl.Name;
        PosList[Idx].X := AControl.Left;
        PosList[Idx].Y := AControl.Top;
        if YMax < AControl.Top + AControl.Height then
         YMax := AControl.Top + AControl.Height;
        if XMax < AControl.Left + AControl.Width then
         XMax := AControl.Left + AControl.Width;
      end; // Ignored
    end; // is control
  end; // count
   VertScrollBar.Max := (YMax + BottomMargin) - Height; // bit of a bottom margin :)
   VertScrollBar.LargeChange := VertScrollBar.Max div MaxLargeSteps;
   ShowVScroller := VertScrollBar.Max > BottomMargin;
   VertScrollBar.Visible := ShowVScroller;
   HorzScrollBar.Max := (XMax + RightMargin) - Width; // bit of a Right margin :)
   HorzScrollBar.LargeChange := HorzScrollBar.Max div MaxLargeSteps;
   ShowHScroller := HorzScrollBar.Max > RightMargin;
   HorzScrollBar.Visible := ShowHScroller;
end;

procedure TScrollingBaseFrame.FrameResize(Sender: TObject);
begin
  BackGroundImage.Width := Width;
  BackGroundImage.Height := Height;
end;

procedure TScrollingBaseFrame.HorzScrollBarChange(Sender: TObject);
// Move the controls left and right relative to thier initail positions
var
  i,j: Integer;
  AControl: TControl;
begin
  for i := 0 to ComponentCount - 1 do
   begin
     if Components[i] is TControl then
     begin
       AControl :=  TControl(Components[i]);
       j := PosList.IndexOfPos(AControl.Name);
       if j >= 0 then  // could be ignored
         Acontrol.Left := PosList[j].X  - HorzScrollBar.Position;
     end;
   end;
end;

procedure TScrollingBaseFrame.BackGroundImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
// Show/Hide the scrollbars using mouse position
var
  ScrollBarWidth: Integer;
begin
  ScrollBarWidth := GetSystemmetrics(SM_CXVSCROLL);  // assume the same for horizontal
  VertScrollBar.Visible := (X > Width - ScrollBarWidth) and ShowVScroller;
  HorzScrollBar.Visible := (Y > (Height - TitleHeight) - ScrollBarWidth) and ShowHScroller;
end;


procedure TScrollingBaseFrame.VertScrollBarChange(Sender: TObject);
// Move the controls Up and down relative to thier initail positions
var
  i,j: Integer;
  AControl: TControl;
begin
  for i := 0 to ComponentCount - 1 do
   begin
     if Components[i] is TControl then
     begin
       AControl :=  TControl(Components[i]);
       j := PosList.IndexOfPos(AControl.Name);
       if j >= 0 then  // could be ignored
         Acontrol.Top := PosList[j].Y  - VertScrollBar.Position;
     end;
   end;
end;

{ TcontrolPosList }

function TControlPosList.Add(APos: TControlPos): Integer;
begin
  Result := TheList.Add(APos);
end;

constructor TControlPosList.Create;
begin
  TheList := TObjectList.Create;
  TheList.OwnsObjects := True;
end;

destructor TControlPosList.Destroy;
begin
  TheList.Free;
  inherited;
end;

function TControlPosList.GetCount: Integer;
begin
  Result := TheList.Count;
end;

function TControlPosList.GetItems(Index: Integer): TControlPos;
begin
  Result := TControlPos(TheList[Index]);
end;

function TControlPosList.IndexOfPos(AName: string): Integer;
// Find a control position in the list by name
var
  Idx: Integer;
begin
  Result := -1;
  Idx := 0;
  while (Result < 0) and (Idx < TheList.Count) do
  begin
    if Items[idx].Name = AName then
      Result := idx;
    inc(idx);
  end;
end;

procedure TControlPosList.SetItems(Index: Integer; const Value: TControlPos);
begin
  TheList[Index] := Value;
end;

end.



回答2:


Reverse the order on the Base frame :)

Put the ScrollBox on, then put the image on the Scrollbox (align Client) and make it transparent. Then Place controls all over it and it allows scrolling...

I'm sure you will have tried this, so what gives you a problem...



来源：https://stackoverflow.com/questions/11366400/how-to-make-a-tscrollbox-with-transparent-background

标签
Delphi
user-interface
delphi-2006
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!