You've already forked lazarus-ccr
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@272 8e941d3f-bd1b-0410-a28a-d453659cc2b4
924 lines
25 KiB
ObjectPascal
924 lines
25 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
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.
|
|
|