paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-24 17:19:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

AJ: Initial TUpDown, minor property additions to improve reading Delphi created forms.

Browse Source 
git-svn-id: trunk@3442 -
This commit is contained in:
lazarus 2002-10-01 18:00:04 +00:00
parent 03abba6294
commit 690a7f150a
7 changed files with 179 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
ide/idecomp.pp
View File

@ -325,7 +325,7 @@ begin
RegisterComponents('Additional','ExtCtrls',[TNoteBook,TPaintBox,
TBevel,TImage]);
RegisterComponents('Additional','ComCtrls',[TStatusBar,TListView,TTreeView,
TProgressBar,TToolBar,TTrackbar,TScrollBox]);
TProgressBar,TToolBar,TTrackbar,TScrollBox,TUpDown]);
RegisterComponents('Additional','ImgList',[TImageList]);
RegisterComponents('Misc','Calendar',[TCalendar]);

106
lcl/comctrls.pp
View File

@ -461,7 +461,107 @@ type
{ property BarTextFormat : string read FBarTextFormat write SetBarTextFormat; }
end;
{ TUpDown }
TUDAlignButton = (udLeft, udRight);
TUDOrientation = (udHorizontal, udVertical);
TUDBtnType = (btNext, btPrev);
TUDClickEvent = procedure (Sender: TObject; Button: TUDBtnType) of object;
TUDChangingEvent = procedure (Sender: TObject; var AllowChange: Boolean) of object;
TCustomUpDown = class(TCustomControl)
private
MinBtn,
MaxBtn : TControl;//TSpeedButton's
BTimer : TTimer;
BTimerProc : Procedure of Object;
BTimerBounds : TRect;
InheritedChangeBounds,
FArrowKeys: Boolean;
FAssociate: TWinControl;
FMin: SmallInt;
FMax: SmallInt;
FIncrement: Integer;
FPosition: SmallInt;
FThousands: Boolean;
FWrap: Boolean;
FOnClick: TUDClickEvent;
FAlignButton: TUDAlignButton;
FOrientation: TUDOrientation;
FOnChanging: TUDChangingEvent;
procedure SetAssociate(Value: TWinControl);
function GetPosition: SmallInt;
procedure SetMin(Value: SmallInt);
procedure SetMax(Value: SmallInt);
procedure SetIncrement(Value: Integer);
procedure SetPosition(Value: SmallInt);
procedure SetAlignButton(Value: TUDAlignButton);
procedure SetOrientation(Value: TUDOrientation);
procedure SetArrowKeys(Value: Boolean);
procedure SetThousands(Value: Boolean);
procedure SetWrap(Value: Boolean);
Procedure MinBtnClick;
Procedure MaxBtnClick;
Procedure MinBtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure MaxBtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure BtnMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure BTimerExec(Sender : TObject);
protected
OldKeyDown : TKeyEvent;
Procedure AssociateKeyDown(Sender: TObject; var Key: Word; ShiftState : TShiftState);
procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: Integer); Override;
function CanChange: Boolean; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Click(Button: TUDBtnType); dynamic;
property AlignButton: TUDAlignButton read FAlignButton write SetAlignButton default udRight;
property ArrowKeys: Boolean read FArrowKeys write SetArrowKeys default True;
property Associate: TWinControl read FAssociate write SetAssociate;
property Min: SmallInt read FMin write SetMin;
property Max: SmallInt read FMax write SetMax default 100;
property Increment: Integer read FIncrement write SetIncrement default 1;
property Orientation: TUDOrientation read FOrientation write SetOrientation default udVertical;
property Position: SmallInt read GetPosition write SetPosition;
property Thousands: Boolean read FThousands write SetThousands default True;
property Wrap: Boolean read FWrap write SetWrap;
property OnChanging: TUDChangingEvent read FOnChanging write FOnChanging;
property OnClick: TUDClickEvent read FOnClick write FOnClick;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; Override;
end;
TUpDown = class(TCustomUpDown)
published
property AlignButton;
property Anchors;
property Associate;
property ArrowKeys;
property Enabled;
property Hint;
property Min;
property Max;
property Increment;
property Constraints;
property Orientation;
property ParentShowHint;
property PopupMenu;
property Position;
property ShowHint;
property TabOrder;
property TabStop;
property Thousands;
property Visible;
property Wrap;
property OnChanging;
property OnClick;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
{ TToolBar }
@ -1549,7 +1649,7 @@ procedure CheckCommonControl(CC: Integer);
Implementation
uses Forms,Interfaces;
uses Forms, Interfaces, Buttons;
const
ButtonStates: array[TToolButtonState] of Word = (TBSTATE_CHECKED,
@ -1595,6 +1695,7 @@ end;
{$I listitems.inc}
{$I customlistview.inc}
{$I progressbar.inc}
{$I customupdown.inc}
{$I toolbutton.inc}
{$I toolbar.inc}
{$I trackbar.inc}
@ -1605,6 +1706,9 @@ end.
{ =============================================================================
$Log$
Revision 1.49 2002/10/01 18:00:02 lazarus
AJ: Initial TUpDown, minor property additions to improve reading Delphi created forms.
Revision 1.48 2002/09/14 14:47:41 lazarus
MG: fixed icons

13
lcl/forms.pp
View File

@ -224,6 +224,7 @@ type
FOnCloseQuery : TCloseQueryEvent;
FPosition : TPosition;
FWindowState : TWindowState;
FDummyTextHeight : Longint;
procedure ClientWndProc(var Message: TLMessage);
procedure CloseModal;
procedure DoCreate;
@ -270,6 +271,7 @@ type
procedure ValidateRename(AComponent: TComponent;
const CurName, NewName: string);override;
procedure WndProc(var TheMessage : TLMessage); override;
property TextHeight : Longint read FDummyTextHeight write FDummyTextHeight stored False;
{events}
property ActiveControl : TWinControl read FActiveControl write SetActiveControl;
property Icon: TIcon read FIcon write SetIcon stored IsIconStored;
@ -316,11 +318,13 @@ type
TForm = class(TCustomForm)
private
FClientHandle: HWND;
FDummyPPI : longint;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property ClientHandle: HWND read FClientHandle;
published
property PixelsPerInch : Longint read FDummyPPI write FDummyPPI stored False;
property ActiveCOntrol;
property Align;
property AutoSize;
@ -331,12 +335,15 @@ type
property ClientWidth;
property Constraints;
property Enabled;
property Font;
property FormStyle;
property Icon;
property Menu;
property ParentFont;
property PopupMenu;
property Position;
property ShowHint;
property TextHeight;
property Visible;
property WindowState;
property OnActivate;
@ -345,6 +352,12 @@ type
property OnCloseQuery;
property OnDeactivate;
property OnDestroy;
property OnKeyPress;
property OnKeyUp;
property OnKeyDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseDown;
property OnShow;
property OnHide;
property OnPaint;

23
lcl/include/customedit.inc
View File

@ -18,6 +18,26 @@
*****************************************************************************
}
Procedure TCustomEdit.DoAutoSize;
var
TM : TTextMetric;
DC : HDC;
OldFont : hFont;
begin
//TCustomEdit.AutoSize only affects Height!!
If AutoSize and Not AutoSizing then begin
AutoSizing := True;
DC := GetDC(0);
OldFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, TM);
SelectObject(DC, OldFont);
ReleaseDC(0, DC);
//TextHeight + 5 top space/border + 5 bottom space/border
Height := TM.tmHeight + 10;
AutoSizing := False;
end;
end;
{------------------------------------------------------------------------------
Method: TCustomEdit.Create
Params: none
@ -254,6 +274,9 @@ end;
{ =============================================================================
$Log$
Revision 1.11 2002/10/01 18:00:04 lazarus
AJ: Initial TUpDown, minor property additions to improve reading Delphi created forms.
Revision 1.10 2002/09/07 12:14:50 lazarus
EchoMode for TCustomEdit. emNone not implemented for GTK+, falls back to emPassword
behaviour.

6
lcl/include/font.inc
View File

@ -18,7 +18,7 @@
}
const
FontCharsets: array[0..17] of TIdentMapEntry = (
FontCharsets: array[0..18] of TIdentMapEntry = (
(Value: ANSI_CHARSET; Name: 'ANSI_CHARSET'),
(Value: DEFAULT_CHARSET; Name: 'DEFAULT_CHARSET'),
(Value: SYMBOL_CHARSET; Name: 'SYMBOL_CHARSET'),
@ -30,6 +30,7 @@ const
(Value: CHINESEBIG5_CHARSET; Name: 'CHINESEBIG5_CHARSET'),
(Value: GREEK_CHARSET; Name: 'GREEK_CHARSET'),
(Value: TURKISH_CHARSET; Name: 'TURKISH_CHARSET'),
(Value: VIETNAMESE_CHARSET; Name: 'VIETNAMESE_CHARSET'),
(Value: HEBREW_CHARSET; Name: 'HEBREW_CHARSET'),
(Value: ARABIC_CHARSET; Name: 'ARABIC_CHARSET'),
(Value: BALTIC_CHARSET; Name: 'BALTIC_CHARSET'),
@ -854,6 +855,9 @@ end;
{ =============================================================================
$Log$
Revision 1.9 2002/10/01 18:00:04 lazarus
AJ: Initial TUpDown, minor property additions to improve reading Delphi created forms.
Revision 1.8 2002/09/05 12:11:43 lazarus
MG: TNotebook is now streamable

3
lcl/include/statusbar.inc
View File

@ -146,8 +146,9 @@ Begin
SingleLine := True;
Clipping := True;
ShowPrefix := False;
Opaque := False;
Opaque := True;
end;
Canvas.Color := Color;
R := Rect(Left, Top, Left + ClientWidth, Top + ClientHeight);
if SimplePanel = False then
Begin

37
lcl/stdctrls.pp
View File

@ -244,9 +244,17 @@ type
property ItemIndex;
published
property Anchors;
property Ctl3D;
property DropDownCount;
property Enabled;
property Font;
property ItemHeight;
property Items;
property MaxLength;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property ShowHint;
property Sorted;
property Style;
property TabOrder;
@ -272,12 +280,14 @@ type
FBorderStyle : TBorderStyle;
FExtendedSelect, FMultiSelect : boolean;
FItems : TStrings;
FItemHeight: Integer;
FSorted : boolean;
FStyle : TListBoxStyle;
procedure UpdateSelectionMode;
protected
procedure CreateHandle; override;
procedure DestroyHandle; override;
function GetItemHeight: Integer;
function GetItemIndex : integer; virtual;
function GetSelCount : integer;
function GetSelected(Index : integer) : boolean;
@ -285,6 +295,7 @@ type
procedure SetExtendedSelect(Val : boolean); virtual;
procedure SetItemIndex(Val : integer); virtual;
procedure SetItems(Value : TStrings); virtual;
procedure SetItemHeight(Value: Integer);
procedure SetMultiSelect(Val : boolean); virtual;
procedure SetSelected(Index : integer; Val : boolean);
procedure SetSorted(Val : boolean); virtual;
@ -293,6 +304,7 @@ type
property ExtendedSelect : boolean read FExtendedSelect write SetExtendedSelect;
property Sorted : boolean read FSorted write SetSorted;
property Style : TListBoxStyle read FStyle write SetStyle;
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
@ -313,7 +325,15 @@ type
property BorderStyle;
property ExtendedSelect;
property Items;
property ItemHeight;
property MultiSelect;
property ParentShowHint;
property ShowHint;
property Sorted;
property Style;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnEnter;
@ -325,12 +345,7 @@ type
property OnMouseDown;
property OnMouseUp;
property OnResize;
property Sorted;
property Style;
property TabOrder;
property TabStop;
property Visible;
end;
end;
TEditCharCase = (ecNormal, ecUppercase, ecLowerCase);
TEchoMode = (emNormal, emNone, emPassword);
@ -350,7 +365,9 @@ type
procedure SetMaxLength(Value : Integer);
procedure SetModified(Value : Boolean);
procedure SetReadOnly(Value : Boolean);
protected
Protected
Procedure DoAutoSize; Override;
procedure CMTextChanged(Var Message : TLMessage); message CM_TextChanged;
procedure Change; dynamic;
function GetSelLength : integer; virtual;
@ -403,13 +420,16 @@ type
TEdit = class(TCustomEdit)
published
property AutoSize;
property Anchors;
property CharCase;
property DragMode;
property EchoMode;
property MaxLength;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property ShowHint;
property Text;
property Visible;
property OnChange;
@ -1248,6 +1268,9 @@ end.
{ =============================================================================
$Log$
Revision 1.47 2002/10/01 18:00:03 lazarus
AJ: Initial TUpDown, minor property additions to improve reading Delphi created forms.
Revision 1.46 2002/09/27 20:52:22 lazarus
MWE: Applied patch from "Andrew Johnson" <aj_genius@hotmail.com>