Browse Source

bug fix in resizing BGRAVirtualScreen,
limit memory usage of BCButton,
mousewheel event for BGRAFlashProgressBar

circular17 10 years ago
parent
commit
5d393466ea
4 changed files with 40 additions and 4 deletions
  1. 7 0
      bcbasectrls.pas
  2. 26 1
      bcbutton.pas
  3. 4 1
      bgraflashprogressbar.pas
  4. 3 2
      bgravirtualscreen.pas

+ 7 - 0
bcbasectrls.pas

@@ -71,6 +71,7 @@ type
   public
   public
     property NeedRender: Boolean read FNeedRender write FNeedRender;
     property NeedRender: Boolean read FNeedRender write FNeedRender;
     property CustomData: PtrInt read FCustomData write FCustomData;
     property CustomData: PtrInt read FCustomData write FCustomData;
+    procedure Discard;
   end;
   end;
 
 
   { TBCGraphicControl
   { TBCGraphicControl
@@ -402,5 +403,11 @@ begin
   FCustomData := 0;
   FCustomData := 0;
 end;
 end;
 
 
+procedure TBGRABitmapEx.Discard;
+begin
+  FNeedRender := true;
+  SetSize(0,0);
+end;
+
 end.
 end.
 
 

+ 26 - 1
bcbutton.pas

@@ -53,7 +53,7 @@ uses
 {off $DEFINE DEBUG}
 {off $DEFINE DEBUG}
 
 
 type
 type
-
+  TBCButtonMemoryUsage = (bmuLow, bmuMedium, bmuHigh);
   TBCButtonState = class;
   TBCButtonState = class;
   TBCButtonStyle = (bbtButton, bbtDropDown);
   TBCButtonStyle = (bbtButton, bbtDropDown);
   TOnAfterRenderBCButton = procedure(Sender: TObject; const ABGRA: TBGRABitmap;
   TOnAfterRenderBCButton = procedure(Sender: TObject; const ABGRA: TBGRABitmap;
@@ -105,6 +105,7 @@ type
     FFlipArrow: boolean;
     FFlipArrow: boolean;
     FActiveButt: TBCButtonStyle;
     FActiveButt: TBCButtonStyle;
     FBGRANormal, FBGRAHover, FBGRAClick: TBGRABitmapEx;
     FBGRANormal, FBGRAHover, FBGRAClick: TBGRABitmapEx;
+    FMemoryUsage: TBCButtonMemoryUsage;
     FRounding: TBCRounding;
     FRounding: TBCRounding;
     FRoundingDropDown: TBCRounding;
     FRoundingDropDown: TBCRounding;
     FStateClicked: TBCButtonState;
     FStateClicked: TBCButtonState;
@@ -157,6 +158,7 @@ type
     procedure SetGlyphMargin(const AValue: integer);
     procedure SetGlyphMargin(const AValue: integer);
     procedure SetImageIndex(AValue: integer);
     procedure SetImageIndex(AValue: integer);
     procedure SetImages(AValue: TCustomImageList);
     procedure SetImages(AValue: TCustomImageList);
+    procedure SetMemoryUsage(AValue: TBCButtonMemoryUsage);
     procedure SetRounding(AValue: TBCRounding);
     procedure SetRounding(AValue: TBCRounding);
     procedure SetRoundingDropDown(AValue: TBCRounding);
     procedure SetRoundingDropDown(AValue: TBCRounding);
     procedure SetShowCaption(AValue: boolean);
     procedure SetShowCaption(AValue: boolean);
@@ -170,6 +172,7 @@ type
     procedure ImageListChange(ASender: TObject);
     procedure ImageListChange(ASender: TObject);
   protected
   protected
     { Protected declarations }
     { Protected declarations }
+    procedure LimitMemoryUsage;
     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
       WithThemeSpace: boolean); override;
       WithThemeSpace: boolean); override;
     class function GetControlClassDefaultSize: TSize; override;
     class function GetControlClassDefaultSize: TSize; override;
@@ -235,6 +238,7 @@ type
     property OnAfterRenderBCButton: TOnAfterRenderBCButton
     property OnAfterRenderBCButton: TOnAfterRenderBCButton
       read FOnAfterRenderBCButton write FOnAfterRenderBCButton;
       read FOnAfterRenderBCButton write FOnAfterRenderBCButton;
     property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
     property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
+    property MemoryUsage: TBCButtonMemoryUsage read FMemoryUsage write SetMemoryUsage;
   public
   public
     { Public declarations }
     { Public declarations }
     constructor Create(AOwner: TComponent); override;
     constructor Create(AOwner: TComponent); override;
@@ -301,6 +305,7 @@ type
     property Images;
     property Images;
     property ImageIndex;
     property ImageIndex;
     property ShowCaption;
     property ShowCaption;
+    property MemoryUsage;
   end;
   end;
 
 
   { TBCButtonActionLink }
   { TBCButtonActionLink }
@@ -796,6 +801,16 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TCustomBCButton.LimitMemoryUsage;
+begin
+  if (FMemoryUsage = bmuLow) and Assigned(FBGRANormal) then FBGRANormal.Discard;
+  if (FMemoryUsage <> bmuHigh) then
+  begin
+    if Assigned(FBGRAHover) then FBGRAHover.Discard;
+    if Assigned(FBGRAClick) then FBGRAClick.Discard;
+  end;
+end;
+
 procedure TCustomBCButton.SeTBCButtonStateClicked(const AValue: TBCButtonState);
 procedure TCustomBCButton.SeTBCButtonStateClicked(const AValue: TBCButtonState);
 begin
 begin
   if FStateClicked = AValue then
   if FStateClicked = AValue then
@@ -942,6 +957,13 @@ begin
   Invalidate;
   Invalidate;
 end;
 end;
 
 
+procedure TCustomBCButton.SetMemoryUsage(AValue: TBCButtonMemoryUsage);
+begin
+  if FMemoryUsage=AValue then Exit;
+  FMemoryUsage:=AValue;
+  LimitMemoryUsage;
+end;
+
 procedure TCustomBCButton.SetRounding(AValue: TBCRounding);
 procedure TCustomBCButton.SetRounding(AValue: TBCRounding);
 begin
 begin
   if FRounding = AValue then
   if FRounding = AValue then
@@ -1505,6 +1527,8 @@ begin
       end;
       end;
     end;
     end;
   end;
   end;
+
+  LimitMemoryUsage;
 end;
 end;
 
 
 procedure TCustomBCButton.RenderControl;
 procedure TCustomBCButton.RenderControl;
@@ -1539,6 +1563,7 @@ begin
   {$IFDEF DEBUG}
   {$IFDEF DEBUG}
   FRenderCount := 0;
   FRenderCount := 0;
   {$ENDIF}
   {$ENDIF}
+  FMemoryUsage := bmuHigh;
   DisableAutoSizing;
   DisableAutoSizing;
   Include(FControlState, csCreating);
   Include(FControlState, csCreating);
   //{$IFDEF WINDOWS}
   //{$IFDEF WINDOWS}

+ 4 - 1
bgraflashprogressbar.pas

@@ -37,7 +37,7 @@ type
     { Streaming }
     { Streaming }
     procedure SaveToFile(AFileName: string);
     procedure SaveToFile(AFileName: string);
     procedure LoadFromFile(AFileName: string);
     procedure LoadFromFile(AFileName: string);
-    procedure OnFindClass(Reader: TReader; const AClassName: string;
+    procedure OnFindClass({%H-}Reader: TReader; const AClassName: string;
       var ComponentClass: TComponentClass);
       var ComponentClass: TComponentClass);
   published
   published
     { Published declarations }
     { Published declarations }
@@ -52,6 +52,9 @@ type
     property OnMouseLeave;
     property OnMouseLeave;
     property OnMouseMove;
     property OnMouseMove;
     property OnMouseUp;
     property OnMouseUp;
+    property OnMouseWheel;
+    property OnMouseWheelUp;
+    property OnMouseWheelDown;
     property Color;
     property Color;
   end;
   end;
 
 

+ 3 - 2
bgravirtualscreen.pas

@@ -180,12 +180,13 @@ end;
 procedure TCustomBGRAVirtualScreen.Resize;
 procedure TCustomBGRAVirtualScreen.Resize;
 begin
 begin
   inherited Resize;
   inherited Resize;
-  DiscardBitmap;
+  if (FBGRA <> nil) and ((Width <> FBGRA.Width) or (Height <> FBGRA.Height)) then
+    DiscardBitmap;
 end;
 end;
 
 
 procedure TCustomBGRAVirtualScreen.BGRASetSize(AWidth, AHeight: integer);
 procedure TCustomBGRAVirtualScreen.BGRASetSize(AWidth, AHeight: integer);
 begin
 begin
-  if (FBGRA <> nil) and (AWidth <> FBGRA.Width) and (AHeight <> FBGRA.Height) then
+  if (FBGRA <> nil) and ((AWidth <> FBGRA.Width) or (AHeight <> FBGRA.Height)) then
   begin
   begin
     FBGRA.SetSize(AWidth, AHeight);
     FBGRA.SetSize(AWidth, AHeight);
     RedrawBitmapContent;
     RedrawBitmapContent;