You've already forked lazarus-ccr
jvcllaz: Fix ChangeBounds loop error of TJvXPCustomToolButton. Minor improvements of JvXPCtrls demo.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6331 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
@ -31,7 +31,7 @@ unit JvXPButtons;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, TypInfo, LCLIntf, LCLType, LCLProc, LMessages, Graphics,
|
||||
Classes, TypInfo, LCLIntf, LCLType, LCLProc, LMessages, Types, Graphics,
|
||||
Controls, Forms, ActnList, ImgList, Menus,
|
||||
JvXPCore, JvXPCoreUtils;
|
||||
|
||||
@ -202,13 +202,13 @@ type
|
||||
procedure SetDropDownMenu(const Value: TPopupMenu);
|
||||
procedure DoImagesChange(Sender: TObject);
|
||||
protected
|
||||
class function GetControlClassDefaultSize: TSize; override;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
||||
X: Integer; Y: Integer); override;
|
||||
procedure SetToolType(Value: TJvXPToolType); virtual;
|
||||
procedure Paint; override;
|
||||
procedure HookResized; override;
|
||||
|
||||
property ToolType: TJvXPToolType read FToolType write SetToolType default ttClose;
|
||||
property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
|
||||
property Images: TCustomImageList read FImages write SetImages;
|
||||
@ -286,7 +286,6 @@ type
|
||||
|
||||
implementation
|
||||
|
||||
//{$R ../resource/JvXPCore.res}
|
||||
|
||||
//=== { TJvXPCustomButtonActionLink } ========================================
|
||||
|
||||
@ -593,13 +592,6 @@ begin
|
||||
}
|
||||
end;
|
||||
|
||||
{
|
||||
procedure TJvXPCustomButton.HookResized;
|
||||
begin
|
||||
UpdateBitmaps;
|
||||
inherited;
|
||||
end;
|
||||
}
|
||||
|
||||
procedure TJvXPCustomButton.SetBounds(ALeft, ATop, AWidth, AHeight: integer);
|
||||
begin
|
||||
@ -787,7 +779,8 @@ begin
|
||||
FToolType := ttClose;
|
||||
FChangeLink := TChangeLink.Create;
|
||||
FChangeLink.OnChange := DoImagesChange;
|
||||
HookResized;
|
||||
Width := 15;
|
||||
Height := 15;
|
||||
end;
|
||||
|
||||
destructor TJvXPCustomToolButton.Destroy;
|
||||
@ -796,13 +789,24 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
class function TJvXPCustomToolButton.GetControlClassDefaultSize: TSize;
|
||||
begin
|
||||
Result.CX := 15;
|
||||
Result.CY := 15;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.HookResized;
|
||||
begin
|
||||
// Don't change the size here - it will cause an infinite ChangeBoundsLoop
|
||||
// And: why must the size stay at 15 x 15 pixels?
|
||||
{
|
||||
inherited;
|
||||
if ToolType <> ttImage then
|
||||
begin
|
||||
Height := 15;
|
||||
Width := 15;
|
||||
end;
|
||||
}
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomToolButton.SetToolType(Value: TJvXPToolType);
|
||||
|
@ -56,7 +56,7 @@ type
|
||||
FLayout: TTextLayout;
|
||||
FShowBoundLines: Boolean;
|
||||
FShowCaption: Boolean;
|
||||
FSpacing: Byte;
|
||||
FSpacing: Integer;
|
||||
FWordWrap: Boolean;
|
||||
FOnEnabledChanged: TNotifyEvent;
|
||||
FOnPaint: TJvXPPaintEvent;
|
||||
@ -70,15 +70,18 @@ type
|
||||
procedure SetLayout(Value: TTextLayout);
|
||||
procedure SetShowBoundLines(Value: Boolean);
|
||||
procedure SetShowCaption(Value: Boolean);
|
||||
procedure SetSpacing(Value: Byte);
|
||||
procedure SetSpacing(Value: Integer);
|
||||
procedure SetWordWrap(Value: Boolean);
|
||||
protected
|
||||
procedure CreateParams(var Params: TCreateParams); override;
|
||||
procedure AdjustClientRect(var Rect: TRect); override;
|
||||
procedure GetPreferredSize(var PreferredWidth, PreferredHeight: integer;
|
||||
Raw: boolean = false; WithThemeSpace: boolean = true); override;
|
||||
procedure HookEnabledChanged; override;
|
||||
procedure HookMouseDown; override;
|
||||
procedure HookPosChanged; override;
|
||||
procedure Paint; override;
|
||||
procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
|
||||
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
|
||||
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
|
||||
property BoundColor: TColor read FBoundColor write SetBoundColor default clGray;
|
||||
@ -94,7 +97,7 @@ type
|
||||
default True;
|
||||
property ShowCaption: Boolean read FShowCaption write SetShowCaption
|
||||
default False;
|
||||
property Spacing: Byte read FSpacing write SetSpacing default 5;
|
||||
property Spacing: Integer read FSpacing write SetSpacing default 5;
|
||||
property Width default 185;
|
||||
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
|
||||
property OnEnabledChanged: TNotifyEvent read FOnEnabledChanged write FOnEnabledChanged;
|
||||
@ -190,8 +193,9 @@ constructor TJvXPCustomContainer.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
ControlStyle := ControlStyle + [csAcceptsControls];
|
||||
Height := 41;
|
||||
Width := 185;
|
||||
SetInitialBounds(0, 0, 41, 185);
|
||||
// Height := 41;
|
||||
// Width := 185;
|
||||
FAlignment := taCenter;
|
||||
FBoundColor := clGray;
|
||||
FBoundLines := [];
|
||||
@ -222,6 +226,18 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure TJvXPCustomContainer.GetPreferredSize(
|
||||
var PreferredWidth, PreferredHeight: integer;
|
||||
Raw: boolean = false; WithThemeSpace: boolean = true);
|
||||
begin
|
||||
inherited;
|
||||
if FShowCaption and (Caption <> '') and HandleAllocated then begin
|
||||
Canvas.Font.Assign(Font);
|
||||
PreferredHeight := Canvas.TextHeight('Tg') + 2;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TJvXPCustomContainer.HookEnabledChanged;
|
||||
var
|
||||
I: Integer;
|
||||
@ -268,6 +284,16 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetBorderWidth(Value: TBorderWidth);
|
||||
begin
|
||||
if Value <> FBorderWidth then
|
||||
begin
|
||||
FBorderWidth := Value;
|
||||
Realign;
|
||||
InternalRedraw;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetBoundColor(Value: TColor);
|
||||
begin
|
||||
if Value <> FBoundColor then
|
||||
@ -287,14 +313,13 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetBorderWidth(Value: TBorderWidth);
|
||||
procedure TJvXPCustomContainer.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
|
||||
begin
|
||||
if Value <> FBorderWidth then
|
||||
begin
|
||||
FBorderWidth := Value;
|
||||
Realign;
|
||||
InternalRedraw;
|
||||
end;
|
||||
if (ALeft = Left) and (ATop = Top) and (AWidth = Width) and (AHeight = Height) then
|
||||
exit;
|
||||
if AutoSize and WordWrap then
|
||||
InvalidatePreferredSize;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetEnabledMode(Value: TJvXPEnabledMode);
|
||||
@ -353,7 +378,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TJvXPCustomContainer.SetSpacing(Value: Byte);
|
||||
procedure TJvXPCustomContainer.SetSpacing(Value: Integer);
|
||||
begin
|
||||
if Value <> FSpacing then
|
||||
begin
|
||||
@ -390,6 +415,7 @@ var
|
||||
begin
|
||||
with AParent, Canvas do
|
||||
begin
|
||||
Canvas.Font.Assign(AFont);
|
||||
DrawStyle := Alignments[AAlignment];
|
||||
if (DrawStyle <> DT_LEFT) and (ARect.Right - ARect.Left < TextWidth(ACaption)) then
|
||||
DrawStyle := DT_LEFT;
|
||||
@ -437,7 +463,6 @@ begin
|
||||
end;
|
||||
if FShowCaption then
|
||||
begin
|
||||
Font.Assign(Self.Font);
|
||||
InflateRect(Rect, -FSpacing, -1);
|
||||
if csDesigning in ComponentState then
|
||||
begin
|
||||
|
@ -395,10 +395,15 @@ begin
|
||||
Rect := Bounds(0, 0, ABitmap.Width, ABitmap.Height);
|
||||
ColorMap := TBitmap.Create;
|
||||
try
|
||||
// Just the create the handle
|
||||
ColorMap.Canvas.Brush.Color := clWhite;
|
||||
ColorMap.Canvas.FillRect(0, 0, 1, 1);
|
||||
// Assign the source bitmap
|
||||
ColorMap.Assign(ABitmap);
|
||||
ABitmap.FreeImage;
|
||||
with ColorMap.Canvas do
|
||||
begin
|
||||
// Replace color clBlack by AColor
|
||||
Brush.Color := AColor;
|
||||
BrushCopy(Rect, ABitmap, Rect, clBlack);
|
||||
end;
|
||||
|
Reference in New Issue
Block a user