Context Navigation

SPIN.PAS

Last change on this file was 7, checked in by RBRi, 19 years ago
+ sibyl staff
Property svn:eol-style set to `native`
File size: 12.3 KB

Rev	Line
[7]	1	Unit Spin;
	2
	3	Interface
	4
	5	Uses SysUtils,Classes,Forms,Graphics,StdCtrls,Buttons,ComCtrls;
	6
	7	Type
	8	TSpinButton=Class(TUpDown)
	9	Private
	10	FUpButton:TSpeedButton;
	11	FDownButton:TSpeedButton;
	12	Private
	13	Procedure ButtonOnPaint(Sender:TObject;Const rec:TRect);
	14	Function GetDownGlyph:TBitmap;
	15	Procedure SetDownGlyph(NewValue:TBitmap);
	16	Function GetDownNumGlyphs:TNumGlyphs;
	17	Procedure SetDownNumGlyphs(NewValue:TNumGlyphs);
	18	Function GetUpGlyph:TBitmap;
	19	Procedure SetUpGlyph(NewValue:TBitmap);
	20	Function GetUpNumGlyphs:TNumGlyphs;
	21	Procedure SetUpNumGlyphs(NewValue:TNumGlyphs);
	22	Public
	23	Procedure SetupComponent;Override;
	24	Published
	25	Property DownGlyph:TBitmap read GetDownGlyph write SetDownGlyph;
	26	Property DownNumGlyphs:TNumGlyphs read GetDownNumGlyphs write SetDownNumGlyphs;
	27	Property UpGlyph:TBitmap read GetUpGlyph write SetUpGlyph;
	28	Property UpNumGlyphs:TNumGlyphs read GetUpNumGlyphs write SetUpNumGlyphs;
	29	End;
	30
	31
	32	TSpinMode=(spSpinNumbers,spSpinList);
	33
	34	TSpinEdit=Class(TControl)
	35	Private
	36	FEditorEnabled:Boolean;
	37	FButton:TSpinButton;
	38	FEdit:TEdit;
	39	FMinValue,FMaxValue:LongInt;
	40	FIncrement:LongInt;
	41	FItems:TStrings;
	42	FSpinMode:TSpinMode;
	43	FValue:LongInt;
	44	Private
	45	Procedure SetMaxValue(NewValue:LongInt);
	46	Procedure SetMinValue(NewValue:LongInt);
	47	Procedure SetValue(NewValue:LongInt);
	48	Procedure SetEditorEnabled(NewValue:Boolean);
	49	Procedure SetItems(NewValue:TStrings);
	50	Procedure SetSpinMode(NewValue:TSpinMode);
	51	Procedure ButtonClick(Sender:TObject);
	52	Procedure EditResize(Sender:TObject);
	53	Procedure EditChange(Sender:TObject);
	54	Public
	55	Procedure SetupComponent;Override;
	56	Procedure SetupShow;Override;
	57	Destructor Destroy;Override;
	58	Procedure Resize;Override;
	59	Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
	60	Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
	61	Public
	62	Property Button:TSpinButton read FButton;
	63	Property Edit:TEdit read FEdit;
	64	Published
	65	Property Increment:LongInt read FIncrement write FIncrement;
	66	Property MaxValue:LongInt read FMaxValue write SetMaxValue;
	67	Property MinValue:LongInt read FMinValue write SetMinValue;
	68	Property Value:LongInt read FValue write SetValue;
	69	Property EditorEnabled:Boolean read FEditorEnabled write SetEditorEnabled;
	70	Property Items:TStrings read FItems write SetItems;
	71	Property SpinMode:TSpinMode read FSpinMode write SetSpinMode;
	72	Property Align;
	73	Property ClientHeight;
	74	Property ClientWidth;
	75	Property Enabled;
	76	Property OnBeforePaint;
	77	Property OnAfterPaint;
	78	Property TabOrder;
	79	Property TabStop;
	80	Property PopUpMenu;
	81	Property OnSetupShow;
	82	Property OnShow;
	83	Property Visible;
	84	Property Font;
	85	Property ParentFont;
	86	Property Color;
	87	Property ParentColor;
	88	Property PenColor;
	89	Property ParentPenColor;
	90	End;
	91
	92	Implementation
	93
	94	{$R Spin}
	95
	96	{
	97	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
	98	º º
	99	º Speed-Pascal/2 Version 2.0 º
	100	º º
	101	º Speed-Pascal Component Classes (SPCC) º
	102	º º
	103	º This section: TSpinButton Class Implementation º
	104	º º
	105	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
	106	º º
	107	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
	108	}
	109
	110
	111	Type TSpdBtn=Class(TBitBtn)
	112	Procedure DoRedraw(Const rec:TRect);
	113	End;
	114
	115
	116	Procedure TSpdBtn.DoRedraw(Const rec:TRect);
	117	Begin
	118	TBitBtn.Redraw(rec);
	119	End;
	120
	121	Procedure TSpinButton.ButtonOnPaint(Sender:TObject;Const rec:TRect);
	122	Begin
	123	TSpdBtn(Sender).DoRedraw(rec);
	124	End;
	125
	126	Procedure TSpinButton.SetupComponent;
	127	Var Up,Down:TSpeedButton;
	128	Bitmap:TBitmap;
	129	Begin
	130	Inherited SetupComponent;
	131
	132	Name:='SpinButton';
	133	Width:=20;
	134	Height:=25;
	135
	136	//Get the buttons
	137	//because they are declared as private, we have to use ASM :-(
	138	Asm
	139	PUSH DWORD PTR SELF
	140	CALLN32 ComCtrls.GetUpRightButton
	141	MOV Up,EAX
	142
	143	PUSH DWORD PTR SELF
	144	CALLN32 ComCtrls.GetDownLeftButton
	145	MOV Down,EAX
	146	End;
	147
	148	Up.OnPaint:=ButtonOnPaint;
	149	Bitmap.Create;
	150	Bitmap.LoadFromResourceName('SpUp');
	151	Up.NumGlyphs:=1;
	152	Up.Glyph:=Bitmap;
	153	Bitmap.Destroy;
	154	Down.OnPaint:=ButtonOnPaint;
	155	Bitmap.Create;
	156	Bitmap.LoadFromResourceName('SpDown');
	157	Down.NumGlyphs:=1;
	158	Down.Glyph:=Bitmap;
	159	Bitmap.Destroy;
	160
	161	FUpButton:=Up;
	162	FDownButton:=Down;
	163	End;
	164
	165	Function TSpinButton.GetDownGlyph:TBitmap;
	166	Begin
	167	Result:=FDownButton.Glyph;
	168	End;
	169
	170	Procedure TSpinButton.SetDownGlyph(NewValue:TBitmap);
	171	Begin
	172	FDownButton.Glyph:=NewValue;
	173	End;
	174
	175	Function TSpinButton.GetDownNumGlyphs:TNumGlyphs;
	176	Begin
	177	Result:=FDownButton.NumGlyphs;
	178	End;
	179
	180	Procedure TSpinButton.SetDownNumGlyphs(NewValue:TNumGlyphs);
	181	Begin
	182	FDownButton.NumGlyphs:=NewValue;
	183	End;
	184
	185	Function TSpinButton.GetUpGlyph:TBitmap;
	186	Begin
	187	result:=FUpButton.Glyph;
	188	End;
	189
	190	Procedure TSpinButton.SetUpGlyph(NewValue:TBitmap);
	191	Begin
	192	FUpButton.Glyph:=NewValue;
	193	End;
	194
	195	Function TSpinButton.GetUpNumGlyphs:TNumGlyphs;
	196	Begin
	197	Result:=FUpButton.NumGlyphs;
	198	End;
	199
	200	Procedure TSpinButton.SetUpNumGlyphs(NewValue:TNumGlyphs);
	201	Begin
	202	FUpButton.NumGlyphs:=NewValue;
	203	End;
	204
	205	{
	206	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
	207	º º
	208	º Speed-Pascal/2 Version 2.0 º
	209	º º
	210	º Speed-Pascal Component Classes (SPCC) º
	211	º º
	212	º This section: TSpinEdit Class Implementation º
	213	º º
	214	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
	215	º º
	216	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
	217	}
	218
	219
	220	Procedure TSpinEdit.SetupComponent;
	221	Begin
	222	Inherited SetupComponent;
	223
	224	Name:='SpinEdit';
	225	Width:=100;
	226
	227	FMinValue:=0;
	228	FMaxValue:=100;
	229	FIncrement:=1;
	230	FSpinMode:=spSpinNumbers;
	231	FEditorEnabled:=True;
	232
	233	FItems:=TStringList.Create;
	234
	235	FEdit:=TEdit.Create(Self);
	236	Include(FEdit.ComponentState,csDetail);
	237	FEdit.Width:=100-12;
	238	FEdit.NumbersOnly:=True;
	239	FEdit.OnResize:=EditResize;
	240	FEdit.OnChange:=EditChange;
	241	FEdit.ParentFont:=True;
	242	FEdit.ParentColor:=True;
	243	FEdit.ParentPenColor:=True;
	244	FEdit.Parent:=Self;
	245	Height:=FEdit.Height;
	246
	247	FButton.Create(Self);
	248	Include(FButton.ComponentState,csDetail);
	249	FButton.SetWindowPos(80,0,12,Height);
	250	FButton.FUpButton.OnClick:=ButtonClick;
	251	FButton.FDownButton.OnClick:=ButtonClick;
	252	FButton.ParentColor:=False;
	253	FButton.ParentPenColor:=False;
	254	FButton.Parent:=Self;
	255	End;
	256
	257	Procedure TSpinEdit.EditChange(Sender:TObject);
	258	Var i:LongInt;
	259	c:Integer;
	260	Begin
	261	If SpinMode<>spSpinNumbers Then exit;
	262
	263	Val(FEdit.Text,i,c);
	264	If ((c<>0)Or(i<MinValue)Or(i>MaxValue)) Then
	265	Begin
	266	If ((c=0)And(i<MinValue)) Then Value:=MinValue
	267	Else If ((c=0)And(i>MaxValue)) Then Value:=MaxValue;
	268	End
	269	Else
	270	Begin
	271	FValue:=i;
	272	If FEdit.Text<>tostr(FValue) Then FEdit.Text:=tostr(FValue);
	273	End;
	274	End;
	275
	276	Procedure TSpinEdit.ButtonClick(Sender:TObject);
	277	Begin
	278	If Sender=FButton.FUpButton Then
	279	Begin
	280	If SpinMode=spSpinNumbers Then
	281	Begin
	282	If Value<MaxValue Then Value:=Value+1;
	283	End
	284	Else
	285	Begin
	286	If Value<FItems.Count-1 Then Value:=Value+1;
	287	End;
	288	End
	289	Else
	290	Begin
	291	If SpinMode=spSpinNumbers Then
	292	Begin
	293	If Value>MinValue Then Value:=Value-1;
	294	End
	295	Else
	296	Begin
	297	If Value>0 Then Value:=Value-1;
	298	End;
	299	End;
	300	End;
	301
	302	Procedure TSpinEdit.EditResize(Sender:TObject);
	303	Begin
	304	If Height<>FEdit.Height Then Height:=FEdit.Height;
	305	End;
	306
	307	Procedure TSpinEdit.SetupShow;
	308	Begin
	309	Inherited SetupShow;
	310
	311	FEdit.Width:=Width-12;
	312	FButton.Left:=Width-12;
	313	Height:=FEdit.Height;
	314	FButton.Height:=FEdit.Height;
	315	If SpinMode=spSpinNumbers Then FEdit.Text:=tostr(Value)
	316	Else If Value<FItems.Count Then FEdit.Text:=FItems[Value];
	317	End;
	318
	319	Destructor TSpinEdit.Destroy;
	320	Begin
	321	FItems.Destroy;
	322	FItems:=Nil;
	323	Inherited Destroy;
	324	End;
	325
	326	Procedure TSpinEdit.Resize;
	327	Begin
	328	Inherited Resize;
	329
	330	If FEdit.Height<>Height Then FEdit.Height:=Height;
	331	FEdit.Width:=Width-12;
	332	FButton.Left:=Width-12;
	333	FButton.Height:=Height;
	334	End;
	335
	336	Procedure TSpinEdit.SetMaxValue(NewValue:LongInt);
	337	Begin
	338	FMaxValue:=NewValue;
	339	If Value>FMaxValue Then Value:=FMaxValue;
	340	End;
	341
	342	Procedure TSpinEdit.SetMinValue(NewValue:LongInt);
	343	Begin
	344	FMinValue:=NewValue;
	345	If Value<FMinValue Then Value:=FMinValue;
	346	End;
	347
	348	Procedure TSpinEdit.SetValue(NewValue:LongInt);
	349	Begin
	350	If SpinMode=spSpinNumbers Then
	351	Begin
	352	If ((NewValue<FMinValue)Or(NewValue>FMaxValue)) Then exit;
	353	End
	354	Else
	355	Begin
	356	If ((NewValue<0)Or(NewValue>FItems.Count-1)) Then exit;
	357	End;
	358	FValue:=NewValue;
	359	If SpinMode=spSpinNumbers Then FEdit.Text:=tostr(FValue)
	360	Else If FValue<FItems.Count Then FEdit.Text:=FItems[FValue];
	361	End;
	362
	363	Procedure TSpinEdit.SetEditorEnabled(NewValue:Boolean);
	364	Begin
	365	FEditorEnabled:=NewValue;
	366	FEdit.ReadOnly:=not NewValue;
	367	End;
	368
	369	Procedure TSpinEdit.SetItems(NewValue:TStrings);
	370	Begin
	371	If NewValue <> FItems Then FItems.Assign(NewValue);
	372	If SpinMode=spSpinList Then
	373	Begin
	374	If Value<0 Then Value:=0
	375	Else If Value>FItems.Count-1 Then Value:=FItems.Count-1
	376	Else FEdit.Text:=FItems[Value];
	377	End;
	378	End;
	379
	380	Procedure TSpinEdit.SetSpinMode(NewValue:TSpinMode);
	381	Begin
	382	FSpinMode:=NewValue;
	383	If SpinMode=spSpinNumbers Then
	384	Begin
	385	If Value<MinValue Then Value:=MinValue
	386	Else If Value>MaxValue Then Value:=MaxValue
	387	Else FEdit.Text:=tostr(Value);
	388	FEdit.ReadOnly:=not EditorEnabled;
	389	End
	390	Else
	391	Begin
	392	If Value<0 Then Value:=0
	393	Else If Value>FItems.Count-1 Then Value:=FItems.Count-1
	394	Else If Value<FItems.Count Then FEdit.Text:=FItems[Value];
	395	FEdit.ReadOnly:=True;
	396	End;
	397	End;
	398
	399	Const rnSpinEditItems='rnSpinEditItems';
	400
	401	Procedure TSpinEdit.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
	402	Var aText:PChar;
	403	Begin
	404	If ResName = rnSpinEditItems Then
	405	Begin
	406	aText := @Data;
	407	Items.SetText(aText);
	408	End
	409	Else Inherited ReadSCUResource(ResName,Data,DataLen);
	410	End;
	411
	412	Function TSpinEdit.WriteSCUResource(Stream:TResourceStream):Boolean;
	413	Var aText:PChar;
	414	Begin
	415	Result:=Inherited WriteSCUResource(Stream);
	416	If not Result Then exit;
	417
	418	aText := Items.GetText;
	419	If aText <> Nil Then
	420	Begin
	421	Result := Stream.NewResourceEntry(rnSpinEditItems,aText^,Length(aText^)+1);
	422	StrDispose(aText);
	423	End;
	424	End;
	425
	426	Begin
	427	RegisterClasses([TSpinButton,TSpinEdit]);
	428	End.

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format