Files
lazarus-ccr/components/jvcllaz/run/JvButton.pas

924 lines
25 KiB
ObjectPascal
Raw Normal View History

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvButton.PAS, released on 2001-02-28.
The Initial Developer of the Original Code is S�bastien Buysse [sbuysse att buypin dott com]
Portions created by S�bastien Buysse are Copyright (C) 2001 S�bastien Buysse.
All Rights Reserved.
Contributor(s): Michael Beck [mbeck att bigfoot dott com].
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net
Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvButton.pas 11400 2007-06-28 21:24:06Z ahuser $
// Initial port to Lazarus by Sergio Samayoa - september 2007.
// Conversion is done in incremental way: as types / classes / routines
// are needed they are converted.
{$mode objfpc}{$H+}
unit JvButton;
interface
uses
Classes, Controls, Graphics, JvComponent, JvConsts, JvTypes, LMessages, Menus;
type
TJvButtonMouseState = (bsMouseInside, bsMouseDown);
TJvButtonMouseStates = set of TJvButtonMouseState;
TJvCustomGraphicButton = class(TJvGraphicControl)
private
FStates: TJvButtonMouseStates;
FBuffer: TBitmap;
FFlat: Boolean;
FDropDownMenu: TPopupMenu;
FDown: Boolean;
FForceSameSize: Boolean;
FAllowAllUp: Boolean;
FGroupIndex: Integer;
FHotTrack: Boolean;
FHotFont: TFont;
FHotTrackFontOptions: TJvTrackFontOptions;
FOnDropDownMenu: TContextPopupEvent;
FDropArrow: Boolean;
FOnDropDownClose: TNotifyEvent;
function GetPattern: TBitmap;
procedure SetFlat(const Value: Boolean);
procedure SetDown(Value: Boolean);
procedure CMButtonPressed(var Msg: TCMButtonPressed); message CM_JVBUTTONPRESSED;
procedure CMForceSize(var Msg: TCMForceSize); message CM_FORCESIZE;
procedure CMSysColorChange(var Msg: TLMessage); message CM_SYSCOLORCHANGE;
procedure SetForceSameSize(const Value: Boolean);
procedure SetAllowAllUp(const Value: Boolean);
procedure SetGroupIndex(const Value: Integer);
procedure SetHotFont(const Value: TFont);
procedure SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
procedure SetDropArrow(const Value: Boolean);
procedure SetDropDownMenu(const Value: TPopupMenu);
protected
procedure ButtonPressed(Sender: TJvCustomGraphicButton; AGroupIndex: Integer); virtual;
procedure ForceSize(Sender: TControl; AWidth, AHeight: Integer);
function DoDropDownMenu(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean; virtual;
procedure DropDownClose;
procedure UpdateExclusive;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseEnter(Control: TControl); override;
procedure MouseLeave(Control: TControl); override;
procedure Paint; override;
procedure PaintButton(ACanvas: TCanvas); virtual;
procedure PaintFrame(ACanvas: TCanvas); virtual;
function InsideBtn(X, Y: Integer): Boolean; virtual;
function WantKey(Key: Integer; Shift: TShiftState;
const KeyText: WideString): Boolean; override;
procedure EnabledChanged; override;
procedure FontChanged; override;
procedure RepaintBackground; virtual;
procedure TextChanged; override;
property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
property MouseStates: TJvButtonMouseStates read FStates write FStates default [];
property ForceSameSize: Boolean read FForceSameSize write SetForceSameSize default False;
property Pattern: TBitmap read GetPattern;
property Flat: Boolean read FFlat write SetFlat default False;
property HotTrack: Boolean read FHotTrack write FHotTrack default False;
property HotTrackFont: TFont read FHotFont write SetHotFont;
property HotTrackFontOptions: TJvTrackFontOptions read FHotTrackFontOptions write SetHotTrackFontOptions default
DefaultTrackFontOptions;
property Down: Boolean read FDown write SetDown default False;
property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
property DropArrow: Boolean read FDropArrow write SetDropArrow default False;
property OnDropDownMenu: TContextPopupEvent read FOnDropDownMenu write FOnDropDownMenu;
property OnDropDownClose: TNotifyEvent read FOnDropDownClose write FOnDropDownClose;
public
procedure Click; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawDropArrow(ACanvas: TCanvas; ArrowRect: TRect); virtual;
end;
(******************** NOT CONVERTED
TJvCustomButton = class(TJvExButton)
private
FDropDownMenu: TPopupMenu;
FHotTrack: Boolean;
FHotFont: TFont;
FFontSave: TFont;
FWordWrap: Boolean;
FForceSameSize: Boolean;
FHotTrackFontOptions: TJvTrackFontOptions;
FOnDropDownMenu: TContextPopupEvent;
FDropArrow: Boolean;
procedure SetHotFont(const Value: TFont);
procedure SetWordWrap(const Value: Boolean);
procedure SetForceSameSize(const Value: Boolean);
procedure CMForceSize(var Msg: TCMForceSize); message CM_FORCESIZE;
procedure SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
procedure SetDropArrow(const Value: Boolean);
procedure SetDropDownMenu(const Value: TPopupMenu);
protected
function DoDropDownMenu(X, Y: Integer): Boolean; virtual;
procedure ForceSize(Sender: TControl; AWidth, AHeight: Integer);
procedure MouseEnter(Control: TControl); override;
procedure MouseLeave(Control: TControl); override;
procedure FontChanged; override;
procedure CreateParams(var Params: TCreateParams); override;
function GetRealCaption: string; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
property ForceSameSize: Boolean read FForceSameSize write SetForceSameSize default False;
property DropArrow: Boolean read FDropArrow write SetDropArrow default False;
property DropDownMenu: TPopupMenu read FDropDownMenu write SetDropDownMenu;
property HotTrack: Boolean read FHotTrack write FHotTrack default False;
property HotTrackFont: TFont read FHotFont write SetHotFont;
property HotTrackFontOptions: TJvTrackFontOptions read FHotTrackFontOptions write SetHotTrackFontOptions default
DefaultTrackFontOptions;
property HintColor;
property OnParentColorChange;
property OnDropDownMenu: TContextPopupEvent read FOnDropDownMenu write FOnDropDownMenu;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Click;override;
procedure DrawDropArrow(Canvas: TCanvas; ArrowRect: TRect); virtual;
procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;
end;
// TJvDropDownButton draws a DropDown button with the DropDown glyph
// (also themed). It ignores the properties Glyph and Flat
TJvDropDownButton = class(TSpeedButton)
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
end;
******************** NOT CONVERTED *)
implementation
uses
Forms, JvJVCLUtils, LCLIntf, LCLType, SysUtils;
(******************** NOT CONVERTED
const
JvBtnLineSeparator = '|';
******************** NOT CONVERTED *)
var
GlobalPattern: TBitmap = nil;
function CreateBrushPattern: TBitmap;
var
X, Y: Integer;
begin
if GlobalPattern = nil then
begin
GlobalPattern := TBitmap.Create;
try
GlobalPattern.Width := 8; { must have this size }
GlobalPattern.Height := 8;
with GlobalPattern.Canvas do
begin
Brush.Style := bsSolid;
Brush.Color := clBtnFace;
FillRect(Rect(0, 0, GlobalPattern.Width, GlobalPattern.Height));
for Y := 0 to 7 do
for X := 0 to 7 do
if (Y mod 2) = (X mod 2) then { toggles between even/odd pixels }
Pixels[X, Y] := clWhite; { on even/odd rows }
end;
except
FreeAndNil(GlobalPattern);
end;
end;
Result := GlobalPattern;
end;
//=== { TJvCustomGraphicButton } =============================================
constructor TJvCustomGraphicButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle -
[csOpaque, csDoubleClicks ];
FStates := [];
SetBounds(0, 0, 40, 40);
FBuffer := TBitmap.Create;
FFlat := False;
FDropArrow := False;
FForceSameSize := False;
FHotFont := TFont.Create;
FHotTrackFontOptions := DefaultTrackFontOptions;
end;
destructor TJvCustomGraphicButton.Destroy;
begin
FBuffer.Free;
FHotFont.Free;
inherited Destroy;
end;
procedure TJvCustomGraphicButton.DrawDropArrow(ACanvas: TCanvas; ArrowRect: TRect);
var
I: Integer;
begin
if not Enabled then
ACanvas.Pen.Color := clInactiveCaption
else
ACanvas.Pen.Color := clWindowText;
for I := 0 to 3 do
begin
if ArrowRect.Left + I <= ArrowRect.Right - I then
begin
ACanvas.MoveTo(ArrowRect.Left + I, ArrowRect.Top + I);
ACanvas.LineTo(ArrowRect.Right - I, ArrowRect.Top + I);
end;
end;
end;
{ Handle speedkeys (Alt + key) }
function TJvCustomGraphicButton.WantKey(Key: Integer; Shift: TShiftState;
const KeyText: WideString): Boolean;
begin
Result := IsAccel(Key, Caption) and Enabled and (Shift * KeyboardShiftStates = [ssAlt]);
if Result then
Click
else
Result := inherited WantKey(Key, Shift, KeyText);
end;
procedure TJvCustomGraphicButton.EnabledChanged;
begin
inherited EnabledChanged;
if not Enabled then
FStates := [];
RepaintBackground;
end;
procedure TJvCustomGraphicButton.MouseEnter(Control: TControl);
begin
if csDesigning in ComponentState then
Exit;
if Enabled and not MouseOver then
begin
Include(FStates, bsMouseInside);
inherited MouseEnter(Control);
if Flat then
RepaintBackground;
if HotTrack then
Repaint;
end;
end;
procedure TJvCustomGraphicButton.MouseLeave(Control: TControl);
begin
if Enabled and MouseOver then
begin
Exclude(FStates, bsMouseInside);
inherited MouseLeave(Control);
if Flat then
RepaintBackground;
if HotTrack then
Repaint;
end;
end;
procedure TJvCustomGraphicButton.Paint;
var
ArrowRect: TRect;
begin
// FBuffer.Width := Width;
// FBuffer.Height := Height;
PaintFrame(Canvas);
PaintButton(Canvas);
if DropArrow and Assigned(DropDownMenu) then
begin
ArrowRect := Rect(Width - 16, Height div 2, Width - 9, Height div 2 + 9);
if bsMouseDown in FStates then
OffsetRect(ArrowRect, 1, 1);
DrawDropArrow(Canvas, ArrowRect);
end;
// BitBlt(Canvas.Handle, 0, 0, Width,Height, FBuffer.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TJvCustomGraphicButton.PaintFrame(ACanvas: TCanvas);
begin
// do nothing
end;
procedure TJvCustomGraphicButton.PaintButton(ACanvas: TCanvas);
begin
if (bsMouseInside in FStates) and HotTrack then
ACanvas.Font := FHotFont
else
ACanvas.Font := Font;
end;
function TJvCustomGraphicButton.InsideBtn(X, Y: Integer): Boolean;
begin
Result := PtInRect(Rect(0, 0, Width, Height), Point(X, Y));
end;
procedure TJvCustomGraphicButton.MouseDown(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
Tmp: TPoint;
begin
if not Enabled then
Exit;
inherited MouseDown(Button, Shift, X, Y);
if InsideBtn(X, Y) then
begin
FStates := [bsMouseDown, bsMouseInside];
RepaintBackground;
end;
SetCaptureControl(Self);
Tmp := ClientToScreen(Point(0, Height));
DoDropDownMenu(Button, Shift, Tmp.X, Tmp.Y);
end;
procedure TJvCustomGraphicButton.MouseMove(Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseMove(Shift, X, Y);
if MouseCapture then
begin
if not InsideBtn(X, Y) then
begin
if bsMouseInside in FStates then
begin
Exclude(FStates, bsMouseInside);
RepaintBackground;
end;
end
else
begin
if not (bsMouseInside in FStates) then
begin
Include(FStates, bsMouseInside);
RepaintBackground;
end;
end;
end;
end;
procedure TJvCustomGraphicButton.MouseUp(Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if GetCaptureControl = Self then
ReleaseCapture;
if not Enabled then
Exit;
inherited MouseUp(Button, Shift, X, Y);
Exclude(FStates, bsMouseDown);
// 26.09.2007 - SESS:
// Update bsMouseInside flag also.
if not InsideBtn(X, Y) and (bsMouseInside in FStates) then
Exclude(FStates, bsMouseInside);
RepaintBackground;
end;
function TJvCustomGraphicButton.DoDropDownMenu(Button: TMouseButton; Shift: TShiftState; X, Y: Integer): Boolean;
var
Msg: TMsg;
Handled: Boolean;
begin
Result := (Button = mbLeft) and (DropDownMenu <> nil);
if Result then
begin
DropDownMenu.PopupComponent := Self;
Handled := False;
if Assigned(FOnDropDownMenu) then
FOnDropDownMenu(Self, Point(X, Y), Handled);
if not Handled then
DropDownMenu.Popup(X, Y)
else
Exit;
{ wait 'til menu is done }
while PeekMessage(Msg, 0, LM_MOUSEFIRST, LM_MOUSELAST, PM_REMOVE) do
{nothing};
{ release button }
MouseUp(Button, Shift, X, Y);
DropDownClose;
end;
end;
procedure TJvCustomGraphicButton.SetFlat(const Value: Boolean);
begin
if FFlat <> Value then
begin
FFlat := Value;
if FFlat then
ControlStyle := ControlStyle - [csOpaque]
else
ControlStyle := ControlStyle + [csOpaque];
RepaintBackground;
end;
end;
procedure TJvCustomGraphicButton.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = DropDownMenu) then
DropDownMenu := nil;
end;
procedure TJvCustomGraphicButton.SetDown(Value: Boolean);
begin
if GroupIndex = 0 then
Value := False;
if FDown <> Value then
begin
if FDown and not AllowAllUp then
Exit;
FDown := Value;
UpdateExclusive;
Invalidate;
end;
end;
procedure TJvCustomGraphicButton.SetForceSameSize(const Value: Boolean);
begin
if FForceSameSize <> Value then
begin
FForceSameSize := Value;
if FForceSameSize then
SetBounds(Left, Top, Width, Height);
end;
end;
procedure TJvCustomGraphicButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
Form: TCustomForm;
Msg: TCMForceSize;
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if ForceSameSize then
begin
Form := GetParentForm(Self);
if Assigned(Form) then
begin
Msg.Msg := CM_FORCESIZE;
Msg.Sender := Self;
Msg.NewSize.X := AWidth;
Msg.NewSize.Y := AHeight;
Form.Broadcast(Msg);
end;
end;
end;
procedure TJvCustomGraphicButton.CMForceSize(var Msg: TCMForceSize);
begin
with Msg do
ForceSize(Sender, NewSize.x, NewSize.y);
end;
function TJvCustomGraphicButton.GetPattern: TBitmap;
begin
Result := CreateBrushPattern;
end;
procedure TJvCustomGraphicButton.SetAllowAllUp(const Value: Boolean);
begin
if FAllowAllUp <> Value then
begin
FAllowAllUp := Value;
UpdateExclusive;
end;
end;
procedure TJvCustomGraphicButton.SetGroupIndex(const Value: Integer);
begin
if FGroupIndex <> Value then
begin
FGroupIndex := Value;
UpdateExclusive;
end;
end;
procedure TJvCustomGraphicButton.UpdateExclusive;
var
Msg: TCMButtonPressed;
begin
if (GroupIndex <> 0) and (Parent <> nil) then
begin
Msg.Msg := CM_JVBUTTONPRESSED;
Msg.Index := GroupIndex;
Msg.Control := Self;
Msg.Result := 0;
Parent.Broadcast(Msg);
end;
end;
procedure TJvCustomGraphicButton.CMButtonPressed(var Msg: TCMButtonPressed);
begin
ButtonPressed(TJvCustomGraphicButton(Msg.Control), Msg.Index);
end;
procedure TJvCustomGraphicButton.SetHotFont(const Value: TFont);
begin
FHotFont.Assign(Value);
end;
procedure TJvCustomGraphicButton.SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
begin
if FHotTrackFontOptions <> Value then
begin
FHotTrackFontOptions := Value;
UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
end;
end;
procedure TJvCustomGraphicButton.SetDropArrow(const Value: Boolean);
begin
if FDropArrow <> Value then
begin
FDropArrow := Value;
Invalidate;
end;
end;
procedure TJvCustomGraphicButton.SetDropDownMenu(const Value: TPopupMenu);
begin
if FDropDownMenu <> Value then
begin
FDropDownMenu := Value;
if DropArrow then
Invalidate;
end;
end;
procedure TJvCustomGraphicButton.CMSysColorChange(var Msg: TLMessage);
begin
inherited;
RepaintBackground;
end;
procedure TJvCustomGraphicButton.FontChanged;
begin
inherited FontChanged;
UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
end;
procedure TJvCustomGraphicButton.TextChanged;
begin
inherited TextChanged;
RepaintBackground;
end;
procedure TJvCustomGraphicButton.Click;
begin
if GroupIndex <> 0 then
begin
if AllowAllUp then
Down := not Down
else
Down := True;
end;
try
inherited Click;
except
// Mantis 3097: In case there is an exception, we ensure here that the
// button is not left "down", and we reraise the exception as we can't
// handle it and don't want to ignore it.
Exclude(FStates, bsMouseDown);
RepaintBackground;
raise;
end;
end;
procedure TJvCustomGraphicButton.ButtonPressed(Sender: TJvCustomGraphicButton;
AGroupIndex: Integer);
begin
if AGroupIndex = GroupIndex then
if Sender <> Self then
begin
if Sender.Down and Down then
begin
FDown := False;
Exclude(FStates, bsMouseDown);
RepaintBackground;
end;
FAllowAllUp := Sender.AllowAllUp;
end;
end;
procedure TJvCustomGraphicButton.ForceSize(Sender: TControl; AWidth, AHeight: Integer);
begin
if Sender <> Self then
inherited SetBounds(Left, Top, AWidth, AHeight);
end;
(******************** NOT CONVERTED
//=== { TJvCustomButton } ====================================================
constructor TJvCustomButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FDropArrow := False;
FHotTrack := False;
FHotFont := TFont.Create;
FFontSave := TFont.Create;
// ControlStyle := ControlStyle + [csAcceptsControls];
FWordWrap := True;
FForceSameSize := False;
FHotTrackFontOptions := DefaultTrackFontOptions;
end;
destructor TJvCustomButton.Destroy;
begin
FHotFont.Free;
FFontSave.Free;
inherited Destroy;
end;
procedure TJvCustomButton.Click;
var
Tmp: TPoint;
begin
// Call ClientToScreen before the inherited Click as the OnClick handler might
// reset the parent, which is needed by ClientToScreen.
Tmp := ClientToScreen(Point(0, Height));
inherited Click;
DoDropDownMenu(Tmp.X, Tmp.Y);
end;
procedure TJvCustomButton.DrawDropArrow(Canvas: TCanvas; ArrowRect: TRect);
var
I: Integer;
begin
if not Enabled then
Canvas.Pen.Color := clInactiveCaption
else
Canvas.Pen.Color := clWindowText;
for I := 0 to (ArrowRect.Bottom - ArrowRect.Top) do
begin
if ArrowRect.Left + I <= ArrowRect.Right - I then
begin
Canvas.MoveTo(ArrowRect.Left + I, ArrowRect.Top + I);
Canvas.LineTo(ArrowRect.Right - I, ArrowRect.Top + I);
end;
end;
end;
procedure TJvCustomButton.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := Params.Style or BS_MULTILINE;
end;
procedure TJvCustomButton.SetHotTrackFontOptions(const Value: TJvTrackFontOptions);
begin
if FHotTrackFontOptions <> Value then
begin
FHotTrackFontOptions := Value;
UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
end;
end;
procedure TJvCustomButton.SetDropArrow(const Value: Boolean);
begin
if FDropArrow <> Value then
begin
FDropArrow := Value;
Invalidate;
end;
end;
procedure TJvCustomButton.SetHotFont(const Value: TFont);
begin
FHotFont.Assign(Value);
end;
procedure TJvCustomButton.SetDropDownMenu(const Value: TPopupMenu);
begin
if FDropDownMenu <> Value then
begin
FDropDownMenu := Value;
if DropArrow then
Invalidate;
end;
end;
procedure TJvCustomButton.MouseEnter(Control: TControl);
begin
if not MouseOver then
begin
if FHotTrack then
begin
FFontSave.Assign(Font);
Font.Assign(FHotFont);
end;
inherited MouseEnter(Control);
end;
end;
procedure TJvCustomButton.MouseLeave(Control: TControl);
begin
if MouseOver then
begin
if FHotTrack then
Font.Assign(FFontSave);
inherited MouseLeave(Control);
end;
end;
procedure TJvCustomButton.FontChanged;
begin
inherited FontChanged;
UpdateTrackFont(HotTrackFont, Font, HotTrackFontOptions);
end;
function TJvCustomButton.GetRealCaption: string;
begin
if WordWrap then
Result := StringReplace(Caption, JvBtnLineSeparator, Lf, [rfReplaceAll])
else
Result := Caption;
end;
procedure TJvCustomButton.SetWordWrap(const Value: Boolean);
begin
if FWordWrap <> Value then
begin
FWordWrap := Value;
Invalidate;
end;
end;
procedure TJvCustomButton.SetForceSameSize(const Value: Boolean);
begin
if FForceSameSize <> Value then
begin
FForceSameSize := Value;
if FForceSameSize then
SetBounds(Left, Top, Width, Height);
end;
end;
procedure TJvCustomButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
Form: TCustomForm;
Msg: TCMForceSize;
begin
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
if ForceSameSize then
begin
Form := GetParentForm(Self);
if Assigned(Form) then
begin
Msg.Msg := CM_FORCESIZE;
Msg.Sender := Self;
Msg.NewSize.X := AWidth;
Msg.NewSize.Y := AHeight;
Form.Broadcast(Msg);
end;
end;
end;
procedure TJvCustomButton.CMForceSize(var Msg: TCMForceSize);
begin
with Msg do
ForceSize(Sender, NewSize.x, NewSize.y);
end;
procedure TJvCustomButton.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FDropDownMenu) then
DropDownMenu := nil;
end;
******************** NOT CONVERTED *)
procedure TJvCustomGraphicButton.RepaintBackground;
var
R: TRect;
begin
if (Parent <> nil) and Parent.HandleAllocated then
begin
R := BoundsRect;
InvalidateRect(Parent.Handle, @R, True);
end;
Repaint;
end;
(******************** NOT CONVERTED
procedure TJvCustomButton.ForceSize(Sender: TControl; AWidth, AHeight: Integer);
begin
if Sender <> Self then
inherited SetBounds(Left, Top, AWidth, AHeight);
end;
function TJvCustomButton.DoDropDownMenu(X, Y: Integer): Boolean;
var
Msg: TMsg;
Handled: Boolean;
begin
Result := (DropDownMenu <> nil);
if Result then
begin
DropDownMenu.PopupComponent := Self;
case DropDownMenu.Alignment of
paRight:
Inc(X, Width);
paCenter:
Inc(X, Width div 2);
end;
Handled := False;
if Assigned(FOnDropDownMenu) then
FOnDropDownMenu(Self, Point(X, Y), Handled);
if not Handled then
DropDownMenu.Popup(X, Y)
else
Exit;
{ wait 'til menu is done }
while PeekMessage(Msg, 0, WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
{nothing};
end;
end;
//=== { TJvDropDownButton } ==================================================
constructor TJvDropDownButton.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 16;
Height := 16;
end;
procedure TJvDropDownButton.Paint;
var
PaintRect: TRect;
DrawFlags: Integer;
DC: HDC;
Bmp: TBitmap;
begin
// adjust FState and FDragging
DC := Canvas.Handle;
Bmp := TBitmap.Create;
try
Bmp.Width := 1;
Bmp.Height := 1;
Canvas.Handle := Bmp.Canvas.Handle;
try
inherited Paint;
finally
Canvas.Handle := DC;
end;
finally
Bmp.Free;
end;
PaintRect := Rect(0, 0, Width, Height);
DrawFlags := DFCS_SCROLLCOMBOBOX or DFCS_ADJUSTRECT;
if FState in [bsDown, bsExclusive] then
DrawFlags := DrawFlags or DFCS_PUSHED;
{$IFDEF JVCLThemesEnabled}
if ThemeServices.ThemesEnabled then
DrawThemedFrameControl(Self, Canvas.Handle, PaintRect, DFC_SCROLL, DrawFlags)
else
{$ENDIF JVCLThemesEnabled}
begin
DrawFrameControl(Canvas.Handle, PaintRect, DFC_SCROLL, DrawFlags);
end;
end;
******************** NOT CONVERTED *)
procedure TJvCustomGraphicButton.DropDownClose;
begin
if Assigned(FOnDropDownClose) then
FOnDropDownClose(Self);
end;
finalization
FreeAndNil(GlobalPattern);
end.