paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 11:28:49 +02:00
Code Issues Packages Projects Releases Wiki Activity
001301df01
lazarus/lcl/buttons.pp
lazarus 176191f0cf Started taking KeyDown messages in TDesigner 
Shane

git-svn-id: trunk@108 -
2001-01-09 21:06:06 +00:00

496 lines
15 KiB
ObjectPascal
Raw Blame History

{ $Id$}
{
/***************************************************************************
buttons.pp - TButton implementation
-------------------
Component Library Code
Initial Revision : Sun Mar 28 23:15:32 CST 1999
Revised : Sat Jul 3 1999
***************************************************************************/
/***************************************************************************
* *
* This program is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
***************************************************************************/
}
unit Buttons;
{$mode objfpc}
interface
{$ifdef Trace}
{$ASSERTIONS ON}
{$endif}
uses stdctrls, vclglobals, classes, LCLLinux,graphics,sysutils, controls, lMessages,Forms, messages;
type
TButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
TButtonState = (bsUp, bsDisabled, bsDown, bsExclusive);
{TNumGlyphs holds the number of glyphs in an image. We restrict it to 4 to stay compatable
but we don't NEED to.
If we change this the code in SetNumGlyphs for @link(TSpeedButton) needs to be changed}
TNumGlyphs = 1..4;
TButton = class(TButtonControl) //TButtoncontrol is declared in stdctrls.pp
private
FCancel : Boolean;
FDefault : Boolean;
FModalResult : TModalResult;
fOwner: TControl;
FOnPressed: TNotifyEvent;
FOnReleased: TNotifyEvent;
FOnLeave: TNotifyEvent;
FOnEnter: TNotifyEvent;
FOnResize: TNotifyEvent;
Procedure SetDefault(Value : Boolean);
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
procedure Click; override;
//TODO: make this compatible
procedure CreateWnd; override;
property OnMouseEnter : TNotifyEvent read FOnEnter write FOnEnter;
property OnMouseLeave : TNotifyEvent read FOnLeave write FOnLeave;
public
constructor Create(AOwner: TComponent); override;
published
property Default : Boolean read FDefault write SetDefault default false;
property Enabled;
property ModalResult : TModalResult read FModalResult write FModalResult default mrNone;
property Cancel : Boolean read FCancel write FCancel default False;
property Caption;
property Font;
property TabStop default true;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
TButtonGlyph = class
private
FOriginal : TBitmap;
FNumGlyphs : TNumGlyphs;
FOnChange : TNotifyEvent;
Procedure SetGlyph(Value : TBitmap);
Procedure SetNumGlyphs(Value : TNumGlyphs);
protected
public
constructor Create;
destructor Destroy; override;
function Draw(Canvas: TCanvas; const Client: TRect; const Offset: TPoint;
const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
State: TButtonState; Transparent: Boolean; BiDiFlags: Longint): TRect;
property Glyph : TBitmap read FOriginal write SetGlyph;
property NumGlyphs : TNumGlyphs read FNumGlyphs write SetNumGlyphs;
property OnChange : TNotifyEvent read FOnChange write FOnChange;
end;
TBitBtnKind = (bkCustom, bkOK, bkCancel, bkHelp,bkYes, bkNo, bkClose, bkAbort, bkRetry, bkIgnore, bkAll);
TBitBtn = Class(TButton)
private
FCanvas : TCanvas;
FGlyph : TButtonGlyph;
FKind : TBitBtnKind;
FLayout : TButtonLayout;
FSpacing : Integer;
Function GetGlyph : TBitmap;
Function IsCustom : Boolean;
Procedure SetGlyph(Value : TBitmap);
Procedure SetKind(Value : TBitBtnKind);
Procedure SetLayout(Value : TButtonLayout);
Procedure SetSpacing(Value : Integer);
protected
Procedure Click; override;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; Override;
property Glyph : TBitmap read GetGlyph write SetGlyph;
published
property Default stored IsCustom;
property Kind : TBitBtnKind read FKind write SetKind;
property Layout: TButtonLayout read FLayout write SetLayout;
property ModalResult stored IsCustom;
property Spacing : Integer read FSpacing write SetSpacing;
property Visible;
property OnEnter;
property OnExit;
end;
TSpeedButton = class(TGraphicControl)
private
FAllowAllUp : Boolean;
FDragging : Boolean;
FDown : Boolean;
FFlat : Boolean;
FGlyph: TButtonGlyph;
FGroupIndex : Integer;
FLayout: TButtonLayout;
FMargin : Integer;
FMouseInControl : Boolean;
FSpacing : Integer;
FTransparent : Boolean;
Function GetGlyph : TBitmap;
Function GetNumGlyphs : Integer;
Procedure UpdateExclusive;
Procedure UpdateTracking;
Procedure SetAllowAllUp(Value : Boolean);
Procedure SetDown(Value : Boolean);
Procedure SetFlat(Value : Boolean);
Procedure SetGlyph(value : TBitmap);
Procedure SetGroupIndex(value : Integer);
Procedure SetNumGlyphs(value : Integer);
//there should be a procedure called settransparent but it's not used at this point
Procedure CMButtonPressed(var MEssage : TLMessage); message CM_BUTTONPRESSED;
Procedure CMMouseEnter(var Message :TLMessage); message CM_MouseEnter;
Procedure CMMouseLeave(var Message :TLMessage); message CM_MouseLeave;
Procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
protected
FState : TButtonState;
Procedure GlyphChanged(Sender : TObject);
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 Paint; override;
property MouseInControl : Boolean read FMOuseInControl;
public
constructor Create(AOwner : TCOmponent) ; override;
destructor Destroy; override;
procedure Click; override;
published
property AllowAllUp : Boolean read FAllowAllUp write SetAllowAllUp default false;
property Down : Boolean read FDown write SetDown default False;
property Enabled;
property Flat : Boolean read FFlat write SetFlat default False;
property Glyph : TBitmap read GetGlyph write SetGlyph;
property GroupIndex : Integer read FGroupIndex write SetGroupIndex default 0;
property NumGlyphs : Integer read GetNumGlyphs write SetNumGlyphs default 1;
property Transparent : Boolean read FTransparent write FTransparent default false;
property Visible;
property OnClick;
end;
{$I defaultbitbtnimages.inc}
implementation
const
BitBtnModalResults : Array[TBitBtnKind] of TModalResult = (0,mrOK,mrCAncel,0,mryes,mrNo,
0,mrAbort,mrRetry, mrIgnore, mrAll);
BitbtnCaption : Array[TBitBtnKind] of String = ('','OK','Cancel','Help','','','Close','','','','All');
var
BitBtnImages : Array[TBitBtnKind] of PCharArray;
{$I buttons.inc}
{$I bitbtn.inc}
{$I buttonglyph.inc}
{$I speedbutton.inc}
initialization
BitbtnImages[bkOK] := IMGOK_Check;
BitbtnImages[bkCancel] := IMGCancel_X;
BitbtnImages[bkClose] := IMGClose;
BitbtnImages[bkHelp] := IMGHELP;
BitbtnImages[bkAll] := IMGAll_Check;
finalization
end.
{ =============================================================================
$Log$
Revision 1.7 2001/01/09 21:06:06 lazarus
Started taking KeyDown messages in TDesigner
Shane
Revision 1.6 2001/01/03 18:44:54 lazarus
The Speedbutton now has a numglyphs setting.
I started the TStringPropertyEditor
Revision 1.5 2000/12/01 18:12:40 lazarus
Modified Gloabal so TDesignForm isn't included anymore.
Shane
Revision 1.4 2000/12/01 15:50:39 lazarus
changed the TCOmponentInterface SetPropByName. It works for a few properties, but not all.
Shane
Revision 1.3 2000/11/29 21:22:35 lazarus
New Object Inspector code
Shane
Revision 1.2 2000/07/16 12:44:31 lazarus
added OnMouseEnter, OnMouseLeave property (changes by chris, committed by stoppok)
Revision 1.1 2000/07/13 10:28:23 michael
+ Initial import
Revision 1.33 2000/07/03 17:29:18 lazarus
Some cleanups/enhancements to bitbtn by christer.t.johansson@se.abb.com (committed by stoppok)
Revision 1.32 2000/06/13 20:50:42 lazarus
MWE:
- Started to remove obsolete/dead code/messages
HJO:
* Fixed messages in showmodal of 2nd form
* Fixed modal result for button
Revision 1.31 2000/05/14 21:56:11 lazarus
MWE:
+ added local messageloop
+ added PostMessage
* fixed Peekmessage
* fixed ClientToScreen
* fixed Flat style of Speedutton (TODO: Draw)
+ Added TApplicatio.OnIdle
Revision 1.30 2000/05/08 12:54:19 lazarus
Removed some writeln's
Added alignment for the TLabel. Isn't working quite right.
Added the shell code for WindowFromPoint and GetParent.
Added FindLCLWindow
Shane
Revision 1.29 2000/03/23 20:40:03 lazarus
Added some drag code
Shane
Revision 1.28 2000/03/22 17:09:29 lazarus
*** empty log message ***
Revision 1.27 2000/03/21 20:42:54 lazarus
*** empty log message ***
Revision 1.23 2000/03/21 14:40:06 lazarus
Playing with bitbtn's
Shane
Revision 1.22 2000/03/21 14:29:13 lazarus
*** empty log message ***
Revision 1.21 2000/03/15 20:15:31 lazarus
MOdified TBitmap but couldn't get it to work
Shane
Revision 1.20 2000/03/14 21:18:23 lazarus
Added the ability to click on the speedbuttons
Shane
Revision 1.18 2000/03/10 18:31:09 lazarus
Added TSpeedbutton code
Shane
Revision 1.17 2000/03/10 12:55:07 lazarus
*** empty log message ***
Revision 1.16 2000/03/07 19:00:15 lazarus
Minor changes. Added the skeleton for TSpeedbutton
Shane
Revision 1.15 2000/03/07 16:52:58 lazarus
Fixxed a problem with the main.pp unit determining a new files FORM name.
Shane
Revision 1.14 2000/03/03 20:22:02 lazarus
Trying to add TBitBtn
Shane
Revision 1.13 2000/02/28 19:16:03 lazarus
Added code to the FILE CLOSE to check if the file was modified. HAven't gotten the application.messagebox working yet though. It won't stay visible.
Shane
Revision 1.12 2000/01/11 19:12:37 lazarus
Added some test code for ShowCaret
Shane
Revision 1.11 2000/01/10 21:24:12 lazarus
Minor cleanup and changes.
Revision 1.10 1999/12/18 18:27:31 lazarus
MWE:
Rearranged some events to get a LM_SIZE, LM_MOVE and LM_WINDOWPOSCHANGED
Initialized the TextMetricstruct to zeros to clear unset values
Get mwEdit to show more than one line
Fixed some errors in earlier commits
Revision 1.9 1999/12/10 00:47:00 lazarus
MWE:
Fixed some samples
Fixed Dialog parent is no longer needed
Fixed (Win)Control Destruction
Fixed MenuClick
Revision 1.8 1999/11/01 01:28:29 lazarus
MWE: Implemented HandleNeeded/CreateHandle/CreateWND
Now controls are created on demand. A call to CreateComponent shouldn't
be needed. It is now part of CreateWnd
Revision 1.7 1999/10/19 19:16:51 lazarus
renamed stdcontrols.pp stdctrls.pp
Shane
Revision 1.6 1999/08/07 17:59:09 lazarus
buttons.pp the DoLeave and DoEnter were connected to the wrong
event.
The rest were modified to use the new SendMessage function. MAH
Revision 1.5 1999/07/29 14:22:12 peter
* fixed buttons
Revision 1.4 1999/07/29 02:50:51 lazarus
FOnClicked notifications was moved to TControl so it must be removed
from here. This goes for the OnClicked property as well. MAH
Revision 1.3 1999/07/29 02:05:31 lazarus
Added the Assert routine for doing Tracing of the code
Revision 1.2 1999/07/27 19:37:09 lazarus
Added the mousepress event. Seems to be working. The Mouse release button event isn't doing anything though.
Revision 1.1 1999/07/23 05:56:01 lazarus
New Implementation
Revision 1.4 1999/07/22 20:50:41 lazarus
Canvas changes
Revision 1.3 1999/07/19 01:39:41 lazarus
Resize Changes CEB
Revision 1.2 1999/07/19 00:56:08 lazarus
Add SetBounds to TControl - this makes the resize only get fired once
as opposed to each time a position is changed.
Modified TCustomDialog and TOpenFileDialog to be non gtk specific.
Added SendMessage plus some other changes to TControl.
Added several new messages to the LMessages.pp file. MAH
Revision 1.1 1999/07/12 14:30:48 peter
* reinserted to fix file permissions
Revision 1.23 1999/07/11 21:21:40 lazarus
inserted the multiple messages in the class again - MAH
Revision 1.22 1999/07/11 19:34:04 lazarus
modifed AddControl so that any descendent class of TControl only needs
to call AddControl; The routine itself gets information as to the owner
the control is to be added to. MAH
Revision 1.21 1999/07/11 01:56:52 lazarus
cleaned up formatting and removed any references
to InterfaceObject. MAH
Revision 1.20 1999/07/09 13:54:34 lazarus
Changed to use Dispatch instead of DispatchStr for messaging.
You pass it LM_Message which is an integer value and therefore you
can now use Dispatch to send the integer value back to the class.
There is currently a problem with having multiple "message" procedures
in one class so I commented them out for now.
Shane
Revision 1.19 1999/07/04 00:10:52 lazarus
Code Cleanup
Revision 1.18 1999/07/03 23:26:20 lazarus
test update
Revision 1.17 1999/06/27 21:34:32 lazarus
Minor messaging changes.
Changed from TMyNotifyEvent to TNotifyEvent procedures
Revision 1.16 1999/05/24 21:20:10 lazarus
*** empty log message ***
Revision 1.15 1999/05/14 18:44:02 lazarus
*** empty log message ***
Revision 1.14 1999/05/14 14:52:58 michael
+ Removed objpas from uses clause
Revision 1.13 1999/05/07 05:46:07 lazarus
*** empty log message ***
Revision 1.12 1999/05/07 05:38:55 lazarus
*** empty log message ***
Revision 1.8 1999/05/01 04:36:35 lazarus
*** empty log message ***
Revision 1.7 1999/04/23 19:40:21 lazarus
Removed TLabelButton and am using simply TButton now. Can set TButton.Caption at anytime and it goes out and changes the button caption (code in TControl.Settext does that).
PROBLEM: TButton (and possibly everything else) doesn't resize once it's created. When you set the top,left,height,width the top and left are adjusted, but the height and width are not. This
is a major problem and must be figured out.
04/22/1999 2:22PM
Shane Miller
lazarus@miraclec.com
Revision 1.6 1999/04/20 23:38:30 lazarus
*** empty log message ***
Revision 1.4 1999/04/20 05:42:07 lazarus
*** empty log message ***
Revision 1.3 1999/04/19 05:42:07 lazarus
*** empty log message ***
Revision 1.2 1999/04/18 05:42:07 lazarus
*** empty log message ***
Revision 1.1 1999/04/14 07:31:44 michael
+ Initial implementation
}
Reference in New Issue View Git Blame Copy Permalink