Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

STDCTRLS.PAS@ 201

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

Line
1
2	{ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3	º º
4	º Sibyl Portable Component Classes º
5	º º
6	º Copyright (C) 1995,97 SpeedSoft Germany, All rights reserved. º
7	º º
8	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ}
9
10	Unit StdCtrls;
11
12
13	Interface
14
15	{$IFDEF OS2}
16	Uses Os2Def,BseDos,PmWin,PmGpi,PmDev,PmStdDlg;
17	{$ENDIF}
18
19	{$IFDEF Win95}
20	Uses WinDef,WinBase,WinNt,WinUser,WinGDI,CommCtrl;
21	{$ENDIF}
22
23	Uses Dos,SysUtils,Classes,Forms,Graphics,Buttons;
24
25
26	Type
27	TGroupBox=Class(TControl)
28	Private
29	Procedure CMTextChanged(Var Msg:TMessage);Message CM_TEXTCHANGED;
30	Protected
31	Procedure SetupComponent;Override;
32	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
33	Function EvaluateShortCut(KeyCode:TKeyCode):Boolean;Override;
34	Public
35	Procedure Redraw(Const rec:TRect);Override;
36	Property XAlign;
37	Property XStretch;
38	Property YAlign;
39	Property YStretch;
40	Published
41	Property Align;
42	Property Caption;
43	Property Color;
44	Property DragCursor;
45	Property DragMode;
46	Property Enabled;
47	Property Font;
48	Property ParentColor;
49	Property ParentPenColor;
50	Property ParentFont;
51	Property ParentShowHint;
52	Property PenColor;
53	Property PopupMenu;
54	Property ShowHint;
55	Property TabOrder;
56	Property TabStop;
57	Property Visible;
58	Property ZOrder;
59
60	Property OnCanDrag;
61	Property OnClick;
62	Property OnCommand;
63	Property OnDblClick;
64	Property OnDragDrop;
65	Property OnDragOver;
66	Property OnEndDrag;
67	Property OnEnter;
68	Property OnExit;
69	Property OnFontChange;
70	Property OnMouseClick;
71	Property OnMouseDblClick;
72	Property OnMouseDown;
73	Property OnMouseMove;
74	Property OnMouseUp;
75	Property OnResize;
76	Property OnSetupShow;
77	Property OnStartDrag;
78	End;
79
80
81	TLabel=Class(TControl)
82	Private
83	RemoveAccel:Boolean;
84	FAutoSize:Boolean;
85	FAlignment:TAlignment;
86	FWordWrap:Boolean;
87	FRows:Integer;
88	FFocusControl:TControl;
89	FShowAccelChar:Boolean;
90	Procedure CMTextChanged(Var Msg:TMessage);Message CM_TEXTCHANGED;
91	Procedure SetAutoSize(Value:Boolean);
92	Procedure SetAlignment(Value:TAlignment);
93	Procedure SetWordWrap(Value:Boolean);
94	Procedure SetAccelChar(Value:Boolean);
95	Procedure SetFocusControl(Value:TControl);
96	Function GetRows:Integer;
97	Procedure DoDrawLine(Const S:String; Var Row:Integer);
98	Protected
99	Procedure SetupComponent;Override;
100	Procedure SetupShow;Override;
101	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
102	Procedure Notification(AComponent:TComponent;Operation:TOperation);Override;
103	Function EvaluateShortCut(KeyCode:TKeyCode):Boolean;Override;
104	Public
105	Procedure Redraw(Const rec:TRect);Override;
106	Property Rows:Integer Read GetRows;
107	Property XAlign;
108	Property XStretch;
109	Property YAlign;
110	Property YStretch;
111	Published
112	Property Align;
113	Property Alignment:TAlignment Read FAlignment Write SetAlignment;
114	Property AutoSize:Boolean Read FAutoSize Write SetAutoSize;
115	Property Caption;
116	Property Color;
117	Property DragCursor;
118	Property DragMode;
119	Property Enabled;
120	Property FocusControl:TControl Read FFocusControl Write SetFocusControl;
121	Property Font;
122	Property ParentColor;
123	Property ParentPenColor;
124	Property ParentFont;
125	Property ParentShowHint;
126	Property PenColor;
127	Property PopupMenu;
128	Property ShowAccelChar:Boolean Read FShowAccelChar Write SetAccelChar;
129	Property ShowHint;
130	Property Visible;
131	Property WordWrap:Boolean Read FWordWrap Write SetWordWrap;
132	Property ZOrder;
133
134	Property OnCanDrag;
135	Property OnClick;
136	Property OnCommand;
137	Property OnDblClick;
138	Property OnDragDrop;
139	Property OnDragOver;
140	Property OnEndDrag;
141	Property OnEnter;
142	Property OnExit;
143	Property OnFontChange;
144	Property OnMouseClick;
145	Property OnMouseDblClick;
146	Property OnMouseDown;
147	Property OnMouseMove;
148	Property OnMouseUp;
149	Property OnResize;
150	Property OnSetupShow;
151	Property OnStartDrag;
152	End;
153
154
155	EMemoIndexError=Class(Exception);
156
157	TMemo=Class(TControl)
158	Private
159	FLines:TStrings;
160	FInitLines:TStringList;
161	FScrollBars:TScrollStyle;
162	FBorderStyle:TBorderStyle;
163	FWordWrap:Boolean;
164	FReadOnly:Boolean;
165	FWantTabs:Boolean;
166	FModified:Boolean;
167	FOnChange:TNotifyEvent;
168	FUpdateCount:LongInt;
169	FEnableWindowUpdate:Boolean;
170	Private
171	Function GetLines:TStrings;
172	Procedure SetLines(AStrings:TStrings);
173	Procedure SetScrollBars(NewValue:TScrollStyle);
174	Procedure SetBorderStyle(NewBorder:TBorderStyle);
175	Procedure SetWordWrap(Value:Boolean);
176	Procedure SetReadOnly(Value:Boolean);
177	Procedure SetWantTabs(Value:Boolean);
178	{$IFDEF Win95}
179	Procedure WMGetDlgCode(Var Msg:TMessage); Message WM_GETDLGCODE;
180	{$ENDIF}
181	Protected
182	Procedure CreateParams(Var Params:TCreateParams);Override;
183	Procedure GetClassData(Var ClassData:TClassData);Override;
184	Procedure SetupComponent;Override;
185	Procedure SetupShow;Override;
186	Procedure DestroyWnd;Override;
187	Procedure ParentNotification(Var Msg:TMessage);Override;
188	Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
189	Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
190	Procedure Resize;Override;
191	Procedure Changed;Virtual;
192	Public
193	Destructor Destroy;Override;
194	Procedure Clear;
195	Procedure ClearSelection;
196	Procedure CutToClipBoard;
197	Procedure CopyToClipboard;
198	Procedure PasteFromClipBoard;
199	Procedure SelectAll;
200	Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
201	Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
202	Procedure BeginUpdate;
203	Procedure EndUpdate;
204	Public
205	Property Modified:Boolean Read FModified Write FModified;
206	Property XAlign;
207	Property XStretch;
208	Property YAlign;
209	Property YStretch;
210	Published
211	Property Align;
212	Property BorderStyle:TBorderStyle Read FBorderStyle Write SetBorderStyle;
213	Property Color;
214	Property DragCursor;
215	Property DragMode;
216	Property Enabled;
217	Property Font;
218	Property Lines:TStrings Read GetLines Write SetLines;
219	Property ParentColor;
220	Property ParentPenColor;
221	Property ParentFont;
222	Property ParentShowHint;
223	Property PenColor;
224	Property PopupMenu;
225	Property ReadOnly:Boolean Read FReadOnly Write SetReadOnly;
226	Property ScrollBars:TScrollStyle Read FScrollBars Write SetScrollBars;
227	Property ShowHint;
228	Property TabOrder;
229	Property TabStop;
230	Property Visible;
231	Property WantTabs:Boolean Read FWantTabs Write SetWantTabs;
232	Property WordWrap:Boolean Read FWordWrap Write SetWordWrap;
233	Property ZOrder;
234
235	Property OnCanDrag;
236	Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
237	Property OnClick;
238	Property OnDblClick;
239	Property OnDragDrop;
240	Property OnDragOver;
241	Property OnEndDrag;
242	Property OnEnter;
243	Property OnExit;
244	Property OnFontChange;
245	Property OnKeyPress;
246	Property OnMouseClick;
247	Property OnMouseDblClick;
248	Property OnMouseDown;
249	Property OnMouseMove;
250	Property OnMouseUp;
251	Property OnScan;
252	Property OnSetupShow;
253	Property OnStartDrag;
254	End;
255
256
257	{$M+}
258	TEditCharCase = (ecNormal,ecUpperCase,ecLowerCase);
259	{$M-}
260
261	TEdit=Class(TControl)
262	Private
263	FMaxLength:LongInt;
264	FAlignment:TAlignment;
265	FUnreadable:Boolean;
266	FModified:Boolean;
267	FAutoSize:Boolean;
268	FAutoScroll:Boolean;
269	FAutoSelect:Boolean;
270	FExtension:PString;
271	FBorderStyle:TBorderStyle;
272	FInsertMode:Boolean;
273	FReadOnly:Boolean;
274	FCharCase:TEditCharCase;
275	FSelStart:LongInt;
276	FSelLen:LongInt;
277	FTempCaption:PString;
278	FNumbersOnly:Boolean;
279	FOnChange:TNotifyEvent;
280	Procedure SetMaxLength(Value:LongInt);
281	Procedure SetUnreadable(Value:Boolean);
282	Procedure SetBorderStyle(Value:TBorderStyle);
283	Procedure SetAutoSize(Value:Boolean);
284	Procedure SetAlignment(Value:TAlignment);
285	Procedure SetAutoScroll(Value:Boolean);
286	Procedure SetSelStart(X:LongInt);
287	Function GetSelStart:LongInt;
288	Procedure SetSelLength(X:LongInt);
289	Function GetSelLength:LongInt;
290	Function GetSelText:String;
291	Procedure SetSelText(Const Value:String);
292	Procedure SetExtension(Const Value:String);
293	Function GetExtension:String;
294	Procedure SetReadOnly(Value:Boolean);
295	Procedure SetInsertMode(Value:Boolean);
296	Procedure SetCharCase(Value:TEditCharCase);
297	Procedure AdjustHeight;Virtual;
298	Procedure SetSelection(Start,len:LongInt);
299	Protected
300	Procedure SetupComponent;Override;
301	Procedure GetClassData(Var ClassData:TClassData);Override;
302	Procedure CreateParams(Var Params:TCreateParams);Override;
303	Procedure UpdateWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);Override;
304	Procedure CreateWnd;Override;
305	Procedure SetupShow;Override;
306	Procedure DestroyWnd;Override;
307	Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
308	Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
309	Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
310	Procedure ParentNotification(Var Msg:TMessage);Override;
311	Procedure FontChange;Override;
312	Procedure Change;Virtual;
313	Public
314	Destructor Destroy;Override;
315	Procedure Clear;
316	Procedure ClearSelection;
317	Procedure CutToClipBoard;
318	Procedure CopyToClipboard;
319	Procedure PasteFromClipBoard;
320	Procedure SelectAll;
321	Property Modified:Boolean Read FModified Write FModified;
322	Property SelStart:LongInt Read GetSelStart Write SetSelStart;
323	Property SelLength:LongInt Read GetSelLength Write SetSelLength;
324	Property SelText:String Read GetSelText Write SetSelText;
325	Property XAlign;
326	Property XStretch;
327	Property YAlign;
328	Property YStretch;
329	Published
330	Property Align;
331	Property Alignment:TAlignment Read FAlignment Write SetAlignment;
332	Property AutoScroll:Boolean Read FAutoScroll Write SetAutoScroll;
333	Property AutoSelect:Boolean Read FAutoSelect Write FAutoSelect;
334	Property AutoSize:Boolean Read FAutoSize Write SetAutoSize;
335	Property BorderStyle:TBorderStyle Read FBorderStyle Write SetBorderStyle;
336	Property CharCase:TEditCharCase Read FCharCase Write SetCharCase;
337	Property Color;
338	Property DragCursor;
339	Property DragMode;
340	Property Enabled;
341	Property Font;
342	Property InsertMode:Boolean Read FInsertMode Write SetInsertMode;
343	Property MaxLength:LongInt Read FMaxLength Write SetMaxLength;
344	Property NumbersOnly:Boolean Read FNumbersOnly Write FNumbersOnly;
345	Property ParentColor;
346	Property ParentPenColor;
347	Property ParentFont;
348	Property ParentShowHint;
349	Property PenColor;
350	Property PopupMenu;
351	Property ReadOnly:Boolean Read FReadOnly Write SetReadOnly;
352	Property ShowHint;
353	Property TabOrder;
354	Property TabStop;
355	Property Text;
356	Property TextExtension:String Read GetExtension Write SetExtension;
357	Property Unreadable:Boolean Read FUnreadable Write SetUnreadable;
358	Property Visible;
359	Property ZOrder;
360
361	Property OnCanDrag;
362	Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
363	Property OnClick;
364	Property OnDblClick;
365	Property OnDragDrop;
366	Property OnDragOver;
367	Property OnEndDrag;
368	Property OnEnter;
369	Property OnExit;
370	Property OnFontChange;
371	Property OnKeyPress;
372	Property OnMouseClick;
373	Property OnMouseDblClick;
374	Property OnMouseDown;
375	Property OnMouseMove;
376	Property OnMouseUp;
377	Property OnResize;
378	Property OnScan;
379	Property OnSetupShow;
380	Property OnStartDrag;
381	End;
382
383
384	TComboBox=Class;
385
386	EListBoxIndexError=Class(Exception);
387
388	{$M+}
389	TListBoxStyle=(lbStandard,lbOwnerdrawFixed);
390
391	TOwnerDrawState=Set Of (odSelected,odGrayed,odDisabled,odChecked,odFocused);
392
393	TItemFocusEvent=Procedure(Sender:TObject;Index:LongInt) Of Object;
394	TItemSelectEvent=Procedure(Sender:TObject;Index:LongInt) Of Object;
395	TListBoxMeasureItemEvent=Procedure(Sender:TObject;Index:LongInt;
396	Var Width,Height:LongInt) Of Object;
397	TListBoxDrawItemEvent=Procedure(Sender:TObject;Index:LongInt;
398	rec:TRect;State:TOwnerDrawState) Of Object;
399	{$M-}
400
401	TListBox=Class(TControl)
402	Private
403	FDragging:Boolean;
404	FComboBox:TComboBox;
405	FItems:TStrings;
406	FInitItems:TStringList;
407	FInitItemIndex:LongInt;
408	FInitTopIndex:LongInt;
409	FStyle:TListBoxStyle;
410	FIntegralHeight:Boolean;
411	FHorzScroll:Boolean;
412	FMultiSelect:Boolean;
413	FExtendedSelect:Boolean;
414	FSorted:Boolean;
415	FItemHeight:LongInt;
416	FDuplicates:Boolean; {only For Add}
417	FUpdateCount:LongInt;
418	FDragSelected:LongInt;
419	FDragRectValid:Boolean;
420	FDragRect:TRect;
421	FShowDragRects:Boolean;
422	FEnableWindowUpdate:Boolean;
423	FOnItemFocus:TItemFocusEvent;
424	FOnItemSelect:TItemSelectEvent;
425	FOnMeasureItem:TListBoxMeasureItemEvent;
426	FOnDrawItem:TListBoxDrawItemEvent;
427	Procedure SetIntegralHeight(Value:Boolean);
428	Procedure SetHorzScroll(Value:Boolean);
429	Procedure SetMultiSelect(Value:Boolean);
430	Procedure SetExtendedSelect(Value:Boolean);
431	Procedure SetSorted(Value:Boolean);
432	Procedure SetStyle(NewStyle:TListBoxStyle);
433	Function GetItems:TStrings;
434	Procedure SetItems(AStrings:TStrings);
435	Function GetItemIndex:LongInt;
436	Procedure SetItemIndex(Value:LongInt);
437	Function GetSelCount:LongInt;
438	Function GetSelect(Index:LongInt):Boolean;
439	Procedure SetSelect(Index:LongInt;Value:Boolean);
440	Function GetTopIndex:LongInt;
441	Procedure SetTopIndex(Index:LongInt);
442	Function GetItemHeight:LongInt;
443	Procedure SetItemHeight(Value:LongInt);
444	Procedure DrawDragRect;
445	Protected
446	Procedure CreateParams(Var Params:TCreateParams);Override;
447	Procedure GetClassData(Var ClassData:TClassData);Override;
448	Procedure SetupComponent;Override;
449	Procedure SetupShow;Override;
450	Procedure DestroyWnd;Override;
451	Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
452	Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
453	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
454	Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
455	Procedure ParentNotification(Var Msg:TMessage);Override;
456	Procedure ItemFocus(Index:LongInt);Virtual;
457	Procedure ItemSelect(Index:LongInt);Virtual;
458	Procedure MeasureItem(Index:LongInt;Var Width,Height:LongInt);Virtual;
459	Procedure DrawItem(Index:LongInt;rec:TRect;State:TOwnerDrawState);Virtual;
460	Procedure DragOver(Source:TObject;X,Y:LongInt;State:TDragState;
461	Var Accept:Boolean);Override;
462	Procedure DragDrop(Source:TObject;X,Y:LongInt);Override;
463	Procedure KillFocus;Override;
464	Public
465	Destructor Destroy;Override;
466	Procedure Show;Override;
467	Procedure Clear;Virtual;
468	Procedure BeginUpdate;
469	Procedure EndUpdate;
470	Function ItemAtPos(Pos:TPoint;existing:Boolean):LongInt;
471	Function ItemRect(Index:LongInt):TRect;
472	Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
473	Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
474	Property ItemIndex:LongInt Read GetItemIndex Write SetItemIndex;
475	Property SelCount:LongInt Read GetSelCount;
476	Property Selected[Index:LongInt]:Boolean Read GetSelect Write SetSelect;
477	Property TopIndex:LongInt Read GetTopIndex Write SetTopIndex;
478	Property XAlign;
479	Property XStretch;
480	Property YAlign;
481	Property YStretch;
482	Published
483	Property Align;
484	Property Color;
485	Property DragCursor;
486	Property DragMode;
487	Property Duplicates:Boolean Read FDuplicates Write FDuplicates;
488	Property Enabled;
489	Property ExtendedSelect:Boolean Read FExtendedSelect Write SetExtendedSelect;
490	Property Font;
491	Property HorzScroll:Boolean Read FHorzScroll Write SetHorzScroll;
492	Property IntegralHeight:Boolean Read FIntegralHeight Write SetIntegralHeight;
493	Property ItemHeight:LongInt Read GetItemHeight Write SetItemHeight;
494	Property Items:TStrings Read GetItems Write SetItems;
495	Property MultiSelect:Boolean Read FMultiSelect Write SetMultiSelect;
496	Property ParentColor;
497	Property ParentPenColor;
498	Property ParentFont;
499	Property ParentShowHint;
500	Property PenColor;
501	Property PopupMenu;
502	Property ShowDragRects:Boolean Read FShowDragRects Write FShowDragRects;
503	Property ShowHint;
504	Property Sorted:Boolean Read FSorted Write SetSorted;
505	Property Style:TListBoxStyle Read FStyle Write SetStyle;
506	Property TabOrder;
507	Property TabStop;
508	Property Visible;
509	Property ZOrder;
510
511	Property OnCanDrag;
512	Property OnClick;
513	Property OnDblClick;
514	Property OnDragDrop;
515	Property OnDragOver;
516	Property OnDrawItem:TListBoxDrawItemEvent Read FOnDrawItem Write FOnDrawItem;
517	Property OnEndDrag;
518	Property OnEnter;
519	Property OnExit;
520	Property OnFontChange;
521	Property OnItemFocus:TItemFocusEvent Read FOnItemFocus Write FOnItemFocus;
522	Property OnItemSelect:TItemSelectEvent Read FOnItemSelect Write FOnItemSelect;
523	Property OnKeyPress;
524	Property OnMeasureItem:TListBoxMeasureItemEvent Read FOnMeasureItem Write FOnMeasureItem;
525	Property OnMouseClick;
526	Property OnMouseDblClick;
527	Property OnMouseDown;
528	Property OnMouseMove;
529	Property OnMouseUp;
530	Property OnScan;
531	Property OnSetupShow;
532	Property OnStartDrag;
533	End;
534
535
536	{$M+}
537	TComboBoxStyle=(csDropDown,csSimple,csDropDownList);
538	{$M-}
539
540	// Event for drawing an owner draw combobox.
541	// S indicates the text to be drawn
542	// Data is the object data
543	TComboBoxDrawItemEvent=procedure( Canvas: TCanvas;
544	S: string;
545	Data: TObject;
546	Rect: TRect;
547	State: TOwnerDrawState ) of object;
548	TStandardComboEdit=Class;
549	TOwnerDrawComboEdit=Class;
550
551	{$HINTS OFF}
552	TComboBox=Class(TControl)
553	Private
554	FListBoxHeight:LongInt;
555	FStyle:TComboBoxStyle;
556	FEdit:TControl; // either a standard or owner draw comboedit
557	FEditHeight:LongInt;
558	FShowButton:TControl;
559	FListBox:TListBox;
560	FDropped:Boolean;
561	FSelectedObject:TObject; // selected object
562	FAlternate:Boolean;
563	FDropDownCount:LongInt;
564	FPopupMenu:TPopupMenu;
565	FBorderStyle:TBorderStyle;
566
567	FOnItemFocus:TItemFocusEvent;
568	FOnItemSelect:TItemSelectEvent;
569	FOnDrawItem:TComboBoxDrawItemEvent;
570	FOnDropDown:TNotifyEvent;
571	FOnChange:TNotifyEvent;
572	Procedure CMTextChanged(Var Msg:TMessage);Message CM_TEXTCHANGED;
573	Procedure EvEditChanged(Sender:TObject);
574	Procedure EvEditEnter(Sender:TObject);
575	Procedure EvEditExit(Sender:TObject);
576	Procedure EvKillFocus(Sender:TObject);
577	Function GetListBoxHeight:LongInt;
578	Procedure SetupShowButton;
579	Procedure DestroyShowButton;
580	Procedure SetStyle(NewStyle:TComboBoxStyle);
581	Function GetItems:TStrings;
582	Procedure SetItems(AStrings:TStrings);
583	Function GetItemIndex:LongInt;
584	Procedure SetItemIndex(Value:LongInt);
585	Function GetSorted:Boolean;
586	Procedure SetSorted(Value:Boolean);
587	Function GetDuplicates:Boolean;
588	Procedure SetDuplicates(Value:Boolean);
589	Procedure SetExtension(Const Value:String);
590	Function GetExtension:String;
591	Function GetMaxLength:Integer;
592	Procedure SetMaxLength(tl:Integer);
593	Procedure SetSelStart(X:Integer);
594	Function GetSelStart:Integer;
595	Procedure SetSelLength(X:Integer);
596	Function GetSelLength:Integer;
597	Function GetSelText:String;
598	Procedure SetSelText(Const Value:String);
599	Procedure SetAlternate(Value:Boolean);
600	Procedure SetDroppedDown(Value:Boolean);
601	Procedure AdjustDropDown;
602	Procedure SetPopupMenu(NewMenu:TPopupMenu);
603	Procedure SetBorderStyle(NewValue:TBorderStyle);
604	Procedure SetOwnerDraw(NewValue:Boolean);
605	Function StandardEdit: TStandardComboEdit;
606	Function UsesStandardEdit: boolean;
607	Function GetListItemIndexAtCursor: longint;
608	Protected
609	Procedure SetupComponent;Override;
610	Procedure CreateWnd;Override;
611	Procedure DestroyWnd;Override;
612	Procedure Move;Override;
613	Procedure Resize;Override;
614	Procedure EditChange;Virtual;
615	Procedure FontChange;Override;
616	Procedure SetFocus;Override;
617	Procedure KillFocus;Override;
618	Procedure ItemFocus(Index:LongInt);Virtual;
619	Procedure ItemSelect(Index:LongInt);Virtual;
620	Procedure ListBoxMouseUp;
621	Procedure UpdateListBoxPos(Var aLeft,aBottom,aWidth,aHeight:LongInt);Virtual;
622	Property AlternateButton:Boolean Read FAlternate Write SetAlternate;
623	Procedure DrawListBoxItem( Sender:TObject;
624	Index:LongInt;
625	rec:TRect;
626	State:TOwnerDrawState);
627	Procedure CreateEdit;
628	Public
629	Destructor Destroy;Override;
630	Procedure SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);Override;
631	Procedure Invalidate;Override;
632	Procedure Update;Override;
633	Procedure Hide;Override;
634	Procedure SelectAll;
635	Procedure Clear;
636	Procedure BeginUpdate;
637	Procedure EndUpdate;
638	Function WriteSCUResource(Stream:TResourceStream):Boolean;Override;
639	Procedure ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);Override;
640	Property ItemIndex:LongInt Read GetItemIndex Write SetItemIndex;
641	Property SelectedObject: TObject read FSelectedObject;
642	Property DroppedDown:Boolean Read FDropped Write SetDroppedDown;
643	Property XAlign;
644	Property XStretch;
645	Property YAlign;
646	Property YStretch;
647	Published
648	Property Align;
649	Property BorderStyle:TBorderStyle read FBorderStyle write SetBorderStyle;
650	Property Color;
651	Property DragCursor;
652	Property DragMode;
653	Property DropDownCount:LongInt Read FDropDownCount Write FDropDownCount;
654	Property Duplicates:Boolean Read GetDuplicates Write SetDuplicates;
655	Property Enabled;
656	Property Font;
657	Property Items:TStrings Read GetItems Write SetItems;
658	Property MaxLength:Integer Read GetMaxLength Write SetMaxLength;
659	Property OwnerDraw:Boolean Read FOwnerDraw Write SetOwnerDraw;
660	Property ParentColor;
661	Property ParentPenColor;
662	Property ParentFont;
663	Property ParentShowHint;
664	Property PenColor;
665	Property PopupMenu:TPopupMenu Read FPopupMenu Write SetPopupMenu;
666	Property SelLength:Integer Read GetSelLength Write SetSelLength;
667	Property SelStart:Integer Read GetSelStart Write SetSelStart;
668	Property SelText:String Read GetSelText Write SetSelText;
669	Property ShowHint;
670	Property Sorted:Boolean Read GetSorted Write SetSorted;
671	Property Style:TComboBoxStyle Read FStyle Write SetStyle;
672	Property TabOrder;
673	Property TabStop;
674	Property Text;
675	Property TextExtension:String Read GetExtension Write SetExtension;
676	Property Visible;
677	Property ZOrder;
678
679	Property OnCanDrag;
680	Property OnChange:TNotifyEvent Read FOnChange Write FOnChange;
681	Property OnClick;
682	Property OnDblClick;
683	Property OnDragDrop;
684	Property OnDragOver;
685	Property OnDrawItem:TComboBoxDrawItemEvent Read FOnDrawItem Write FOnDrawItem;
686	Property OnDropDown:TNotifyEvent Read FOnDropDown Write FOnDropDown;
687	Property OnEndDrag;
688	Property OnEnter;
689	Property OnExit;
690	Property OnFontChange;
691	Property OnItemFocus:TItemFocusEvent Read FOnItemFocus Write FOnItemFocus;
692	Property OnItemSelect:TItemSelectEvent Read FOnItemSelect Write FOnItemSelect;
693	Property OnKeyPress;
694	Property OnScan;
695	Property OnSetupShow;
696	Property OnStartDrag;
697	End;
698	{$HINTS ON}
699
700
701	{$M+}
702	TValueSetContentStyle=(vscBitmap,vscText,vscRGBColor);
703	{$M-}
704
705	TValueSet=Class(TScrollingWinControl)
706	Private
707	FMemory:Pointer;
708	FRows:LongInt;
709	FColumns:LongInt;
710	FCount:LongInt;
711	FSelection:LongInt;
712	FCtl3D:Boolean;
713	FBorderStyle:TBorderStyle;
714	FItemBorder:TBorderStyle;
715	FScaleBitmap:Boolean;
716	FContentStyle:TValueSetContentStyle;
717	FAutoSize:Boolean;
718	FMargin,FSpacing:LongInt;
719	FItemWidth,FItemHeight:LongInt;
720	FUpdateCount:LongInt;
721	FOnItemFocus:TItemFocusEvent;
722	FOnItemSelect:TItemSelectEvent;
723	Procedure SetCtl3D(Value:Boolean);
724	Procedure SetBorderStyle(Value:TBorderStyle);
725	Procedure SetItemBorder(Value:TBorderStyle);
726	Procedure SetScaleBitmap(Value:Boolean);
727	Procedure SetContentStyle(NewStyle:TValueSetContentStyle);
728	Procedure SetRows(Value:LongInt);
729	Procedure SetColumns(Value:LongInt);
730	Function GetData(Index:LongInt):Pointer;
731	Procedure FreeData(Index:LongInt);
732	Procedure SetRGB(Index:LongInt;NewValue:TColor);
733	Function GetRGB(Index:LongInt):TColor;
734	Procedure SetBitmap(Index:LongInt;NewValue:TBitmap);
735	Function GetBitmap(Index:LongInt):TBitmap;
736	Procedure SetText(Index:LongInt;NewValue:String);
737	Function GetText(Index:LongInt):String;
738	Procedure SetAutoSize(NewValue:Boolean);
739	Procedure SetItemWidth(NewValue:LongInt);
740	Procedure SetItemHeight(NewValue:LongInt);
741	Procedure SetSelection(Value:LongInt);
742	Procedure SetupScrollBars;
743	Procedure GetXYVisible(Var xVisible,yVisible:LongInt);
744	Protected
745	Function RectFromIndex(Index:LongInt):TRect;
746	Function IndexFromPoint(X,Y:LongInt):LongInt;
747	Procedure SetupComponent;Override;
748	Procedure DrawSelection(Index:LongInt);Virtual;
749	Procedure DrawInterior(Index:LongInt);Virtual;
750	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
751	Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
752	Procedure ItemFocus(Index:LongInt);Virtual;
753	Procedure ItemSelect(Index:LongInt);Virtual;
754	Procedure SetFocus;Override;
755	Procedure KillFocus;Override;
756	Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
757	Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
758	Procedure Resize;Override;
759	Procedure SetupShow;Override;
760	Procedure Scroll(Sender:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);Override;
761	Property Margin:LongInt Read FMargin Write FMargin;
762	Property Spacing:LongInt Read FSpacing Write FSpacing;
763	Property Scrollbars;
764	Public
765	Destructor Destroy;Override;
766	Procedure Redraw(Const rec:TRect);Override;
767	Function IndexFromColumnRow(Column,Row:LongInt):LongInt;
768	Procedure ColumnRowFromIndex(Index:LongInt;Var Column,Row:LongInt);
769	Procedure SetDimension(Column,Row:LongInt);
770	Procedure SetColorArray(Index:LongInt;Const Data:Array Of TColor);
771	Procedure SetBitmapArray(Index:LongInt;Const Data:Array Of TBitmap);
772	Procedure SetStringArray(Index:LongInt;Const Data:Array Of String);
773	Procedure BeginUpdate;
774	Procedure EndUpdate;
775	Property Count:LongInt Read FCount;
776	Property Colors[Index:LongInt]:TColor Read GetRGB Write SetRGB;
777	Property Bitmaps[Index:LongInt]:TBitmap Read GetBitmap Write SetBitmap;
778	Property Strings[Index:LongInt]:String Read GetText Write SetText;
779	Property XAlign;
780	Property XStretch;
781	Property YAlign;
782	Property YStretch;
783	Published
784	Property Align;
785	Property AutoSize:Boolean Read FAutoSize Write SetAutoSize;
786	Property BorderStyle:TBorderStyle Read FBorderStyle Write SetBorderStyle;
787	Property Color;
788	Property Ctl3D:Boolean Read FCtl3D Write SetCtl3D;
789	Property ColCount:LongInt Read FColumns Write SetColumns;
790	Property ContentStyle:TValueSetContentStyle Read FContentStyle Write SetContentStyle;
791	Property DragCursor;
792	Property DragMode;
793	Property Enabled;
794	Property Font;
795	Property ItemBorder:TBorderStyle Read FItemBorder Write SetItemBorder;
796	Property ItemHeight:LongInt Read FItemHeight Write SetItemHeight;
797	Property ItemWidth:LongInt Read FItemWidth Write SetItemWidth;
798	Property ParentColor;
799	Property ParentPenColor;
800	Property ParentFont;
801	Property ParentShowHint;
802	Property PenColor;
803	Property PopupMenu;
804	Property RowCount:LongInt Read FRows Write SetRows;
805	Property ScaleBitmap:Boolean Read FScaleBitmap Write SetScaleBitmap;
806	Property Selection:LongInt Read FSelection Write SetSelection;
807	Property ShowHint;
808	Property TabOrder;
809	Property TabStop;
810	Property Visible;
811	Property ZOrder;
812
813	Property OnCanDrag;
814	Property OnDblClick;
815	Property OnDragDrop;
816	Property OnDragOver;
817	Property OnEndDrag;
818	Property OnEnter;
819	Property OnExit;
820	Property OnFontChange;
821	Property OnItemFocus:TItemFocusEvent Read FOnItemFocus Write FOnItemFocus;
822	Property OnItemSelect:TItemSelectEvent Read FOnItemSelect Write FOnItemSelect;
823	Property OnMouseClick;
824	Property OnMouseDblClick;
825	Property OnMouseDown;
826	Property OnMouseMove;
827	Property OnMouseUp;
828	Property OnScan;
829	Property OnSetupShow;
830	Property OnStartDrag;
831	End;
832
833
834	Function InsertLabel(parent:TControl;Left,Bottom,Width,Height:LongInt;
835	Caption:String):TLabel;
836	Function InsertComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt;
837	Style:TComboBoxStyle):TComboBox;
838	Function InsertValueSet(parent:TControl;Left,Bottom,Width,Height:LongInt;
839	Columns,Rows:LongInt;ContentStyle:TValueSetContentStyle):TValueSet;
840	Function InsertGroupBox(parent:TControl;Left,Bottom,Width,Height:LongInt;
841	Caption:String):TGroupBox;
842	Function InsertEdit(parent:TControl;Left,Bottom,Width,Height:LongInt;
843	Text,Hint:String):TEdit;
844	Function InsertListBox(parent:TControl;Left,Bottom,Width,Height:LongInt;
845	Hint:String):TListBox;
846	Function InsertMemo(parent:TControl;Left,Bottom,Width,Height:LongInt;
847	Hint:String):TMemo;
848	Function InsertScrollBar(parent:TControl;Left,Bottom,Width,Height:LongInt;
849	Kind:TScrollBarKind):TScrollBar;
850
851
852	Implementation
853
854
855	Function InsertListBox(parent:TControl;Left,Bottom,Width,Height:LongInt;
856	Hint:String):TListBox;
857	Begin
858	Result.Create(parent);
859	Result.SetWindowPos(Left,Bottom,Width,Height);
860	Result.Hint:=Hint;
861	Result.parent := parent;
862	End;
863
864
865	Function InsertEdit(parent:TControl;Left,Bottom,Width,Height:LongInt;
866	Text,Hint:String):TEdit;
867	Begin
868	Result.Create(parent);
869	Result.SetWindowPos(Left,Bottom,Width,Height);
870	Result.Text:=Text;
871	Result.Hint:=Hint;
872	Result.AutoSize:=True;
873	Result.parent := parent;
874	End;
875
876
877	Function InsertLabel(parent:TControl;Left,Bottom,Width,Height:LongInt;
878	Caption:String):TLabel;
879	Begin
880	Result.Create(parent);
881	Result.SetWindowPos(Left,Bottom,Width,Height);
882	Result.Caption := Caption;
883	Result.AutoSize := False; {!}
884	Result.parent := parent;
885	End;
886
887
888	Function InsertGroupBox(parent:TControl;Left,Bottom,Width,Height:LongInt;
889	Caption:String):TGroupBox;
890	Begin
891	Result.Create(parent);
892	Result.SetWindowPos(Left,Bottom,Width,Height);
893	Result.Caption := Caption;
894	Result.parent := parent;
895	End;
896
897
898	Function InsertComboBox(parent:TControl;Left,Bottom,Width,Height:LongInt;
899	Style:TComboBoxStyle):TComboBox;
900	Begin
901	Result.Create(parent);
902	Result.SetWindowPos(Left,Bottom,Width,Height);
903	Result.Style := Style;
904	Result.parent := parent;
905	End;
906
907
908	Function InsertValueSet(parent:TControl;Left,Bottom,Width,Height:LongInt;
909	Columns,Rows:LongInt;ContentStyle:TValueSetContentStyle):TValueSet;
910	Begin
911	Result.Create(parent);
912	Result.SetWindowPos(Left,Bottom,Width,Height);
913	Result.ColCount := Columns;
914	Result.RowCount := Rows;
915	Result.ContentStyle := ContentStyle;
916	Result.parent := parent;
917	End;
918
919
920	Function InsertMemo(parent:TControl;Left,Bottom,Width,Height:LongInt;
921	Hint:String):TMemo;
922	Begin
923	Result.Create(parent);
924	Result.SetWindowPos(Left,Bottom,Width,Height);
925	Result.Hint := Hint;
926	Result.parent := parent;
927	End;
928
929
930	Function InsertScrollBar(parent:TControl;Left,Bottom,Width,Height:LongInt;
931	Kind:TScrollBarKind):TScrollBar;
932	Begin
933	Result.Create(parent);
934	Result.Kind := Kind;
935	Result.SetWindowPos(Left,Bottom,Width,Height);
936	Result.parent := parent;
937	End;
938
939
940	{
941	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
942	º º
943	º Speed-Pascal/2 Version 2.0 º
944	º º
945	º Speed-Pascal Component Classes (SPCC) º
946	º º
947	º This section: TComboBox Class Implementation º
948	º º
949	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
950	º º
951	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
952	}
953
954	Type
955	TComboListShowButton=Class(TControl)
956	Private
957	FCombo:TComboBox;
958	FDown:Boolean;
959	FDroppingDown:Boolean;
960	Procedure SetDown(Value:Boolean);
961	Protected
962	Procedure SetupComponent;Override;
963	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
964	Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
965	Procedure MouseMove(ShiftState:TShiftState;X,Y:LongInt);Override;
966	Procedure MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
967	Public
968	Procedure Redraw(Const rec:TRect);Override;
969	Procedure SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);Override;
970	Property Down:Boolean Read FDown Write SetDown;
971	End;
972
973
974	Procedure TComboListShowButton.SetupComponent;
975	Begin
976	Inherited SetupComponent;
977
978	color := clBtnFace;
979	FDroppingDown := false;
980	End;
981
982
983	Procedure TComboListShowButton.SetDown(Value:Boolean);
984	Begin
985	If Value <> FDown Then
986	Begin
987	FDown := Value;
988	Refresh;
989	End;
990	End;
991
992
993	Procedure TComboListShowButton.SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);
994	Begin
995	{$IFDEF Win32}
996	If FCombo.FEdit.FBorderStyle = bsSingle Then
997	Begin
998	// decrease size to be inside edit border
999	Dec(NewLeft,4);
1000	Inc(NewBottom,4);
1001	Dec(NewHeight,2);
1002	End;
1003	{$ENDIF}
1004	Inherited SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight);
1005	End;
1006
1007
1008	Procedure TComboListShowButton.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1009	Begin
1010	Inherited MouseDown(Button,ShiftState,X,Y);
1011
1012	If Button = mbLeft Then
1013	Begin
1014	If Designed Then Exit;
1015
1016	LastMsg.Handled := True;
1017	LastMsg.Result := 0;
1018
1019	MouseCapture := true;
1020
1021	if not FCombo.DroppedDown then
1022	begin
1023	FCombo.DroppedDown := True; {aufklappen}
1024	FDroppingDown := true;
1025	end;
1026	End;
1027	End;
1028
1029
1030	Procedure TComboListShowButton.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1031	Begin
1032	Inherited MouseDblClick(Button,ShiftState,X,Y);
1033
1034	If Button = mbLeft Then
1035	Begin
1036	If Designed Then Exit;
1037	MouseDown(Button,ShiftState,X,Y);
1038	{$IFDEF OS2}
1039	MouseUp(Button,ShiftState,X,Y); {Win95 sends it Self}
1040	{$ENDIF}
1041	End;
1042	End;
1043
1044	Procedure TComboListShowButton.MouseMove(ShiftState:TShiftState;X,Y:LongInt);
1045	var
1046	Index:longint;
1047	ThePoints: POINTS;
1048	Begin
1049	if not MouseCapture then Exit;
1050	Index := FCombo.GetListItemIndexAtCursor;
1051	if Index <> -1 then
1052	Begin
1053	// focus the item in the listbox.
1054	FCombo.FListBox.ItemIndex := Index;
1055	End;
1056	End;
1057
1058	Procedure TComboListShowButton.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1059	Begin
1060	Inherited MouseUp(Button,ShiftState,X,Y);
1061
1062	If Button = mbLeft Then
1063	Begin
1064	If Designed Then Exit;
1065
1066	If not MouseCapture Then Exit;
1067
1068	MouseCapture := false;
1069
1070	if FDroppingDown Then
1071	Begin
1072	// Mouse up after initial click.
1073	FDroppingDown := false;
1074	if FCombo.GetListItemIndexAtCursor <> -1 then
1075	begin
1076	// release over list box; select item
1077	FCombo.ItemSelect( FCombo.FListBox.ItemIndex );
1078	FCombo.DroppedDown := False; {einklappen}
1079	end
1080	else if not PointInRect(Point(X,Y),ClientRect) then
1081	begin
1082	// outside of the button/listbox, so cancel
1083	FCombo.DroppedDown := False; {einklappen}
1084	end;
1085	End
1086	else
1087	Begin
1088	// click while combo is already dropped down
1089	if PointInRect(Point(X,Y),ClientRect) then
1090	Begin
1091	// second click to close.
1092	FCombo.DroppedDown := False;
1093	// select the item
1094	FCombo.ItemSelect( FCombo.FListBox.ItemIndex );
1095	End;
1096	End;
1097
1098	LastMsg.Handled := True;
1099	LastMsg.Result := 0;
1100	End;
1101	End;
1102
1103
1104	Procedure TComboListShowButton.Redraw(Const rec:TRect);
1105	Var pt:TPoint;
1106	arrow:Array[0..2] Of TPoint;
1107	rc1,rec1:TRect;
1108	Alternate:Boolean;
1109	Begin
1110	If Canvas = Nil Then Exit;
1111
1112	Inherited Redraw(rec);
1113
1114	rc1 := ClientRect;
1115
1116	Canvas.Pen.color := clBtnShadow;
1117	Canvas.Line(rc1.Left,rc1.Bottom,rc1.Left,rc1.Top);
1118	Inc(rc1.Left);
1119	{$IFDEF OS2}
1120	If Down Then
1121	Begin
1122	Canvas.ShadowedBorder(rc1,clBtnShadow,clBtnHighlight);
1123	InflateRect(rc1,-1,-1);
1124	Canvas.ShadowedBorder(rc1,clBtnShadow,clBtnHighlight);
1125	Inc(rc1.Left);
1126	Dec(rc1.Bottom);
1127	Inc(rc1.Right);
1128	Dec(rc1.Top);
1129	End Else
1130	Begin
1131	Canvas.ShadowedBorder(rc1,clBtnHighlight,clBtnShadow);
1132	InflateRect(rc1,-1,-1);
1133	Canvas.ShadowedBorder(rc1,clBtnHighlight,clBtnShadow);
1134	End;
1135	{$ENDIF}
1136
1137	{$IFDEF Win32}
1138	If Down Then
1139	Begin
1140	Canvas.Pen.color := clBtnShadow;
1141	Canvas.Rectangle(rc1);
1142	End
1143	Else
1144	Begin
1145	Canvas.ShadowedBorder(rc1,clBtnHighlight,cl3DDkShadow);
1146	InflateRect(rc1,-1,-1);
1147	Canvas.ShadowedBorder(rc1,cl3DLight,clBtnShadow);
1148	End;
1149	{$ENDIF}
1150
1151	InflateRect(rc1,-1,-1);
1152
1153	If FCombo <> Nil Then Alternate := FCombo.AlternateButton
1154	Else Alternate := False;
1155
1156	Canvas.Pen.color := clBtnText;
1157	If Alternate Then
1158	Begin
1159	pt.X := (rc1.Left + rc1.Right) Div 2;
1160	pt.Y := (rc1.Bottom + rc1.Top) Div 2;
1161
1162	rec1.Left := pt.X-4;
1163	rec1.Bottom := pt.Y;
1164	rec1.Right := rec1.Left+1;
1165	rec1.Top := rec1.Bottom+1;
1166	Canvas.Box(rec1);
1167	rec1.Left := pt.X;
1168	rec1.Bottom := pt.Y;
1169	rec1.Right := rec1.Left+1;
1170	rec1.Top := rec1.Bottom+1;
1171	Canvas.Box(rec1);
1172	rec1.Left := pt.X+4;
1173	rec1.Bottom := pt.Y;
1174	rec1.Right := rec1.Left+1;
1175	rec1.Top := rec1.Bottom+1;
1176	Canvas.Box(rec1);
1177	End
1178	Else
1179	Begin
1180	pt.X := (rc1.Left + rc1.Right) Div 2;
1181	pt.Y := (rc1.Bottom+rc1.Top) Div 2 + 2;
1182
1183	arrow[0].X := pt.X - 3;
1184	arrow[0].Y := pt.Y;
1185	arrow[1].X := pt.X + 3;
1186	arrow[1].Y := pt.Y;
1187	arrow[2].X := pt.X;
1188	arrow[2].Y := pt.Y - 3;
1189	Canvas.Polygon(arrow);
1190	End;
1191	End;
1192
1193
1194	{
1195	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1196	º º
1197	º Speed-Pascal/2 Version 2.0 º
1198	º º
1199	º Speed-Pascal Component Classes (SPCC) º
1200	º º
1201	º This section: TOwnerDrawComboEdit Class º
1202	º This is a completely custom drawn control, not based on an edit box. º
1203	º As well as handling some keys and doing autoheight, it has a paint º
1204	º method and handles various events to redraw itself. It's paint method º
1205	º only normally draws the border, passing the remainder to the combo box º
1206	º drawitem event. º
1207	º º
1208	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1209	º º
1210	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1211	}
1212
1213	Type
1214	TOwnerDrawComboEdit=Class(TControl)
1215	Private
1216	FComboBox:TComboBox;
1217	FBorderStyle:TBorderStyle;
1218	Procedure EvKeyPress(Sender:TObject;Var Key:Char);
1219	Procedure EvScan(Sender:TObject;Var KeyCode:TKeyCode);
1220	Protected
1221	Procedure CMTextChanged(Var Msg:TMessage);Message CM_TEXTCHANGED;
1222
1223	// Adjust size automatically...
1224	Procedure SetupShow;Override;
1225	Procedure SetBorderStyle(Value:TBorderStyle);
1226	Procedure AdjustHeight;
1227	Procedure FontChange;Override;
1228
1229	Procedure SetupComponent;Override;
1230	Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
1231	Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
1232	Procedure Resize;Override;
1233	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
1234	Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
1235	Procedure SetFocus;Override;
1236	Procedure KillFocus;Override;
1237
1238	Procedure Paint(const rec:TRect);Override;
1239	Public
1240	Property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
1241	End;
1242
1243	Procedure TOwnerDrawComboEdit.SetupComponent;
1244	Begin
1245	inherited SetupComponent;
1246
1247	Name := 'OwnerDrawComboEdit';
1248	Caption := '';
1249	Width := 100;
1250	Height := 20;
1251	Color := clEntryField;
1252	ParentPenColor := False;
1253	ParentColor := False;
1254	Ownerdraw := True;
1255
1256	FBorderStyle := bsSingle;
1257	FTabOrder := 0;
1258	end;
1259
1260	Procedure TOwnerDrawComboEdit.SetupShow;
1261	begin
1262	inherited SetupShow;
1263	AdjustHeight;
1264	end;
1265
1266	Procedure TOwnerDrawComboEdit.CMTextChanged(Var Msg:TMessage);
1267	begin
1268	if FComboBox <> nil then
1269	FComboBox.EvEditChanged( self ); // tell the combo about it.
1270	// Our text has changed, repaint!
1271	Invalidate;
1272	end;
1273
1274	Procedure TOwnerDrawComboEdit.Paint(const rec:TRect);
1275	var
1276	Rect: TRect;
1277	State: TOwnerDrawState;
1278	Begin
1279	Canvas.ClipRect := rec;
1280	Rect := ClientRect;
1281
1282	// Draw border if one is needed.
1283	DrawSystemBorder( self, Rect, FBorderStyle );
1284
1285	dec( Rect.Right, FComboBox.FShowButton.Width );
1286
1287	// leave 1 pixel blank as per standard controls
1288	Canvas.Pen.Color := Color;
1289	Canvas.Pen.Style := psSolid;
1290	Canvas.Rectangle( Rect );
1291	InflateRect( Rect, -1, -1 );
1292
1293	// prevent user from overwriting stuff
1294	Canvas.ClipRect := IntersectRect( rec, Rect );
1295
1296	// Work out the state of drawing
1297	State := [];
1298	if HasFocus then
1299	begin
1300	Include( State, odFocused );
1301	Include( State, odSelected ); // always for an owner draw edit
1302	end;
1303	if not FComboBox.Enabled then
1304	Include( State, odDisabled );
1305
1306	// Draw the selected combo item, if there is one,
1307	// otherwise draw blank box.
1308	if FComboBox.FOnDrawItem <> nil then
1309	begin
1310	FComboBox.FOnDrawItem( Canvas, Text, FComboBox.SelectedObject, Rect, State )
1311	end
1312	else
1313	begin
1314	if odSelected in State then
1315	Canvas.FillRect( Rect, clHighlight )
1316	else
1317	Canvas.FillRect( Rect, Color );
1318	end;
1319	end;
1320
1321	Procedure TOwnerDrawComboEdit.SetBorderStyle(Value:TBorderStyle);
1322	Begin
1323	If FBorderStyle <> Value Then
1324	Begin
1325	FBorderStyle := Value;
1326	AdjustHeight;
1327	Refresh;
1328	End;
1329	End;
1330
1331	// Adjust the control height to match the height of
1332	// the font being used, taking border into account
1333	Procedure TOwnerDrawComboEdit.AdjustHeight;
1334	Var
1335	NewHeight:LongInt;
1336	Begin
1337	NewHeight := Font.Height + 2;
1338	If FBorderStyle = bsSingle Then Inc( NewHeight,4 );
1339	Height := NewHeight;
1340	If FComboBox <> Nil Then FComboBox.Resize;
1341	End;
1342
1343
1344	Procedure TOwnerDrawComboEdit.FontChange;
1345	Begin
1346	// Font has changed, so adjust height to match
1347	AdjustHeight;
1348
1349	Inherited FontChange;
1350	End;
1351
1352	Procedure TOwnerDrawComboEdit.SetFocus;
1353	Begin
1354	Inherited SetFocus;
1355	Refresh;
1356	End;
1357
1358	Procedure TOwnerDrawComboEdit.KillFocus;
1359	Begin
1360	Inherited KillFocus;
1361	Refresh;
1362	End;
1363
1364	// The remaining methods of TOwnerDrawComboEdit are basically copies
1365	// of TStandardComboEdit. I couldn't see any clean way to share them.
1366	// Multiple inheritance would have been nice :)
1367	Procedure TOwnerDrawComboEdit.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1368	Begin
1369	Inherited MouseDown(Button,ShiftState,X,Y);
1370
1371	If Button=mbLeft Then If FComboBox.Enabled Then
1372	Begin
1373	// If combo text is not editable:
1374	If FComboBox.FStyle=csDropDownList Then
1375	Begin
1376	// Drop down when the edit is clicked.
1377	MouseCapture:=False;
1378	FComboBox.DroppedDown:=not FComboBox.DroppedDown;
1379	End;
1380	End;
1381	End;
1382
1383	Procedure TOwnerDrawComboEdit.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1384	Begin
1385	Inherited MouseDblClick(Button,ShiftState,X,Y);
1386
1387	If Button = mbLeft Then
1388	Begin
1389	If Designed Then Exit;
1390	MouseDown(Button,ShiftState,X,Y);
1391	MouseDown(Button,ShiftState,X,Y);
1392	End;
1393	End;
1394
1395	Procedure TOwnerDrawComboEdit.CharEvent(Var key:Char;RepeatCount:Byte);
1396	Begin
1397	If FComboBox<>Nil Then
1398	If FComboBox.Style=csDropDownList Then
1399	begin
1400	// send the keypress to the listbox
1401	SendMsg( FComboBox.FListBox.Handle,
1402	WM_CHAR,
1403	KC_CHAR,
1404	MPARAM( key ) );
1405	FComboBox.ItemSelect(FComboBox.FListBox.ItemIndex);
1406	FComboBox.SelectAll;
1407	key:=#0;
1408	end;
1409
1410	Inherited CharEvent(key,RepeatCount);
1411	End;
1412
1413
1414	Procedure TOwnerDrawComboEdit.EvKeyPress(Sender:TObject;Var Key:Char);
1415	Begin
1416	If FComboBox <> Nil Then
1417	If FComboBox.OnKeyPress <> Nil Then FComboBox.OnKeyPress(FComboBox, Key);
1418	End;
1419
1420
1421	Procedure TOwnerDrawComboEdit.EvScan(Sender:TObject;Var KeyCode:TKeyCode);
1422	Begin
1423	If FComboBox <> Nil Then
1424	If FComboBox.OnScan <> Nil Then FComboBox.OnScan(FComboBox, KeyCode);
1425	End;
1426
1427
1428	Procedure TOwnerDrawComboEdit.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
1429	Begin
1430	If FComboBox <> Nil Then
1431	Begin
1432	Case KeyCode Of
1433	kbAltCDown:
1434	Begin
1435	FComboBox.DroppedDown := True;
1436	KeyCode := kbNull;
1437	End;
1438	kbAltCUp:
1439	Begin
1440	FComboBox.DroppedDown := False;
1441	KeyCode := kbNull;
1442	End;
1443	kbCDown:
1444	Begin
1445	If FComboBox.ItemIndex < FComboBox.Items.Count - 1 Then
1446	Begin
1447	FComboBox.ItemIndex := FComboBox.ItemIndex + 1;
1448	FComboBox.ItemSelect(FComboBox.ItemIndex);
1449	FComboBox.SelectAll;
1450	End;
1451	KeyCode := kbNull;
1452	End;
1453	kbCUp:
1454	Begin
1455	If FComboBox.ItemIndex > 0 Then
1456	Begin
1457	FComboBox.ItemIndex := FComboBox.ItemIndex - 1;
1458	FComboBox.ItemSelect(FComboBox.ItemIndex);
1459	FComboBox.SelectAll;
1460	End;
1461	KeyCode := kbNull;
1462	End;
1463	else
1464	Inherited ScanEvent(KeyCode,RepeatCount);
1465	End;
1466	End
1467	Else Inherited ScanEvent(KeyCode,RepeatCount);
1468	End;
1469
1470
1471	Procedure TOwnerDrawComboEdit.Resize;
1472	Var rec:TRect;
1473	Button:TControl;
1474	Begin
1475	Inherited Resize;
1476
1477	rec := ClientRect;
1478	If FBorderStyle = bsSingle Then InflateRect(rec, -2, -2);
1479
1480	If FComboBox <> Nil Then
1481	If FComboBox.FShowButton <> Nil Then
1482	Begin
1483	Button := FComboBox.FShowButton;
1484	Button.SetWindowPos(rec.Right-Button.Width+1,rec.Bottom,
1485	Button.Width,rec.Top-rec.Bottom);
1486	End;
1487	End;
1488
1489	{
1490	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1491	º º
1492	º Speed-Pascal/2 Version 2.0 º
1493	º º
1494	º Speed-Pascal Component Classes (SPCC) º
1495	º º
1496	º This section: TStandardComboEdit Class º
1497	º This is a standard edit box, modified to pass some key strokes to the º
1498	º list part of the combo. It has hard-coded autoheight (so the edit height º
1499	º exactly fits the font and border (if any). This edit is used for cases º
1500	º where the combo edit can be modified, or the combo is not owner drawn. º
1501	º º
1502	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1503	º º
1504	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1505	}
1506	type
1507	TStandardComboEdit=Class(TEdit)
1508	Private
1509	FComboBox:TComboBox;
1510	Procedure AdjustHeight;Override;
1511	Procedure EvKeyPress(Sender:TObject;Var Key:Char);
1512	Procedure EvScan(Sender:TObject;Var KeyCode:TKeyCode);
1513	Protected
1514	Procedure SetupComponent;Override;
1515	Procedure CreateParams(Var Params:TCreateParams);Override;
1516	Procedure ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);Override;
1517	Procedure CharEvent(Var key:Char;RepeatCount:Byte);Override;
1518	Procedure Resize;Override;
1519	Procedure MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
1520	Procedure MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);Override;
1521	End;
1522
1523	Procedure TStandardComboEdit.SetupComponent;
1524	Begin
1525	Inherited SetupComponent;
1526	If Not Designed Then Include(ComponentState, csAcceptsControls);
1527	OnKeyPress := EvKeyPress;
1528	OnScan := EvScan;
1529	FTabOrder := 0;
1530	End;
1531
1532	Procedure TStandardComboEdit.CreateParams(Var Params:TCreateParams);
1533	Begin
1534	Inherited CreateParams(Params);
1535	Params.Style := Params.Style Or WS_CLIPCHILDREN; {clip ShowButton}
1536	End;
1537
1538	Procedure TStandardComboEdit.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1539	Begin
1540	Inherited MouseDown(Button,ShiftState,X,Y);
1541
1542	If Button=mbLeft Then If FComboBox.Enabled Then
1543	Begin
1544	// If combo text is not editable:
1545	If FComboBox.FStyle=csDropDownList Then
1546	Begin
1547	// Drop down when the edit is clicked.
1548	MouseCapture:=False;
1549	FComboBox.DroppedDown:=not FComboBox.DroppedDown;
1550	End;
1551	End;
1552	End;
1553
1554	Procedure TStandardComboEdit.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
1555	Begin
1556	Inherited MouseDblClick(Button,ShiftState,X,Y);
1557
1558	If Button = mbLeft Then
1559	Begin
1560	If Designed Then Exit;
1561	MouseDown(Button,ShiftState,X,Y);
1562	MouseDown(Button,ShiftState,X,Y);
1563	End;
1564	End;
1565
1566
1567	Procedure TStandardComboEdit.AdjustHeight;
1568	Begin
1569	Inherited AdjustHeight;
1570	If FComboBox <> Nil Then FComboBox.Resize; // tell the combo to resize to match
1571	End;
1572
1573
1574	Procedure TStandardComboEdit.CharEvent(Var key:Char;RepeatCount:Byte);
1575	Begin
1576	If FComboBox<>Nil Then
1577	If FComboBox.Style=csDropDownList Then
1578	begin
1579	// send the keypress to the listbox
1580	SendMsg( FComboBox.FListBox.Handle,
1581	WM_CHAR,
1582	KC_CHAR,
1583	MPARAM( key ) );
1584	FComboBox.ItemSelect(FComboBox.FListBox.ItemIndex);
1585	FComboBox.SelectAll;
1586	key:=#0;
1587	end;
1588
1589	Inherited CharEvent(key,RepeatCount);
1590	End;
1591
1592
1593	Procedure TStandardComboEdit.EvKeyPress(Sender:TObject;Var Key:Char);
1594	Begin
1595	If FComboBox <> Nil Then
1596	If FComboBox.OnKeyPress <> Nil Then FComboBox.OnKeyPress(FComboBox, Key);
1597	End;
1598
1599
1600	Procedure TStandardComboEdit.EvScan(Sender:TObject;Var KeyCode:TKeyCode);
1601	Begin
1602	If FComboBox <> Nil Then
1603	If FComboBox.OnScan <> Nil Then FComboBox.OnScan(FComboBox, KeyCode);
1604	End;
1605
1606
1607	Procedure TStandardComboEdit.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
1608	Begin
1609	If FComboBox <> Nil Then
1610	Begin
1611	Case KeyCode Of
1612	kbAltCDown:
1613	Begin
1614	FComboBox.DroppedDown := True;
1615	KeyCode := kbNull;
1616	End;
1617	kbAltCUp:
1618	Begin
1619	FComboBox.DroppedDown := False;
1620	KeyCode := kbNull;
1621	End;
1622	kbCDown:
1623	Begin
1624	If FComboBox.ItemIndex < FComboBox.Items.Count - 1 Then
1625	Begin
1626	FComboBox.ItemIndex := FComboBox.ItemIndex + 1;
1627	FComboBox.ItemSelect(FComboBox.ItemIndex);
1628	FComboBox.SelectAll;
1629	End;
1630	KeyCode := kbNull;
1631	End;
1632	kbCUp:
1633	Begin
1634	If FComboBox.ItemIndex > 0 Then
1635	Begin
1636	FComboBox.ItemIndex := FComboBox.ItemIndex - 1;
1637	FComboBox.ItemSelect(FComboBox.ItemIndex);
1638	FComboBox.SelectAll;
1639	End;
1640	KeyCode := kbNull;
1641	End;
1642	else
1643	Inherited ScanEvent(KeyCode,RepeatCount);
1644
1645
1646	// kbTab,
1647	{$IFDEF OS2}
1648	// kbBackTab,
1649	// kbEnter,
1650	{$ENDIF}
1651	// kbCR:Inherited ScanEvent(KeyCode,RepeatCount);
1652	// Else
1653	// Begin // WTF? Why!!!
1654	// If FComboBox.Style=csDropDownList Then KeyCode:=kbNull
1655	// Else Inherited ScanEvent(KeyCode,RepeatCount);
1656	// End;
1657	End;
1658	End
1659	Else Inherited ScanEvent(KeyCode,RepeatCount);
1660	End;
1661
1662
1663	Procedure TStandardComboEdit.Resize;
1664	Var rec:TRect;
1665	Button:TControl;
1666	Begin
1667	Inherited Resize;
1668
1669	// Adjust the dropdown button size to fit.
1670	rec := ClientRect;
1671	If FBorderStyle = bsSingle Then InflateRect(rec, -2, -2);
1672
1673	If FComboBox <> Nil Then
1674	If FComboBox.FShowButton <> Nil Then
1675	Begin
1676	Button := FComboBox.FShowButton;
1677	Button.SetWindowPos(rec.Right-Button.Width+1,rec.Bottom,
1678	Button.Width,rec.Top-rec.Bottom);
1679	End;
1680	End;
1681
1682	/////////////////////////////////////////////////////////////////////////////
1683
1684
1685	Procedure TComboBox.SetupComponent;
1686	Begin
1687	Inherited SetupComponent;
1688
1689	Name := 'ComboBox';
1690	Height := 120;
1691	Width := 100;
1692	{Include(WindowStyle, wsChild);????????}
1693
1694	FOwnerDraw := false;
1695	Color := clEntryField;
1696	ParentPenColor := False;
1697	ParentColor := False;
1698
1699	FListBoxHeight := 100;
1700	FDropDownCount := 8;
1701	FStyle := csDropDown;
1702	FDropped := False;
1703	FBorderStyle := bsSingle;
1704
1705	FEdit := nil;
1706
1707	FListBox.Create(Self);
1708	FListBox.Visible := False;
1709	FListBox.TabStop := False;
1710	FListBox.FComboBox := Self;
1711	FListBox.ParentPenColor := True;
1712	FListBox.ParentColor := True;
1713	FListBox.SetDesigning(Designed);
1714	FListBox.OnExit := EvKillFocus;
1715	FListBox.OnDrawItem := DrawListBoxItem;
1716	Include(FListBox.ComponentState, csDetail);
1717
1718	// don't insert it into our controls (set parent).
1719	// We'll do that later when we set the style.
1720
1721	CreateEdit;
1722
1723	FTabStop := false; // the edit is the tabstop
1724
1725	End;
1726
1727	// Returns the comboedit as a standard combo edit.
1728	// Will fail with exception if it isn't one.
1729	Function TComboBox.StandardEdit: TStandardComboEdit;
1730	begin
1731	Result := FEdit as TStandardComboEdit;
1732	end;
1733
1734	Function TComboBox.UsesStandardEdit: boolean;
1735	Begin
1736	Result := ( not FOwnerDraw )
1737	or ( Style <> csDropDownList );
1738	End;
1739
1740	// Create the combo edit: a standard one if
1741	// the combo is not owner draw, or the text is editable.
1742	// A owner draw edit if the text is not editable (dropdown list) and
1743	// the combo is owner draw.
1744	// Note: If a combo has editable text (simple,dropdown) then the list
1745	// items will be owner drawn but the edit will not.
1746	Procedure TComboBox.CreateEdit;
1747	var
1748	OwnerDrawEdit: TOwnerDrawComboEdit;
1749	StandardEdit: TStandardComboEdit;
1750	begin
1751	if FEdit <> nil then
1752	begin
1753	FEdit.Destroy;
1754	FShowButton := nil;
1755	end;
1756
1757	if UsesStandardEdit then
1758	begin
1759	StandardEdit := TStandardComboEdit.Create(Self);
1760	StandardEdit.FComboBox := Self;
1761	StandardEdit.OnChange := EvEditChanged;
1762	StandardEdit.BorderStyle:= BorderStyle;
1763	FEdit := StandardEdit;
1764	end
1765	else
1766	begin
1767	OwnerDrawEdit := TOwnerDrawComboEdit.Create(Self);
1768	OwnerDrawEdit.FComboBox := Self;
1769	OwnerDrawEdit.BorderStyle:= BorderStyle;
1770	FEdit := OwnerDrawEdit;
1771	end;
1772
1773	FEdit.Text := Text;
1774	FEdit.TabStop := True; // yes, this is tabbable!
1775	FEdit.ParentPenColor := True;
1776	FEdit.ParentColor := True;
1777	FEdit.Align := alTop;
1778	FEdit.OnEnter := EvEditEnter;
1779	FEdit.OnExit := EvEditExit;
1780	Include(FEdit.ComponentState, csDetail);
1781
1782	InsertControl(FEdit);
1783	end;
1784
1785	Function TComboBox.GetListItemIndexAtCursor: longint;
1786	var
1787	P:TPoint;
1788	Begin
1789	P := FListBox.ScreenToClient(Screen.MousePos);
1790	Result := FListBox.ItemAtPos(P,true);
1791	End;
1792
1793	Procedure TComboBox.SetOwnerDraw(NewValue:boolean);
1794	begin
1795	if FOwnerDraw = NewValue then
1796	exit;
1797
1798	FOwnerDraw := NewValue;
1799
1800	// set listbox style to match
1801	if NewValue then
1802	FListBox.Style := lbOwnerDrawFixed
1803	else
1804	FListBox.Style := lbStandard;
1805
1806	SetStyle( FStyle );
1807	end;
1808
1809	Procedure TComboBox.DrawListBoxItem( Sender:TObject;
1810	Index:LongInt;
1811	rec:TRect;
1812	State:TOwnerDrawState);
1813	begin
1814	if FOnDrawItem <> nil then
1815	begin
1816	// correct slight problem from listbox rectangle
1817	inc( rec.Left );
1818	dec( rec.top );
1819	FOnDrawItem( FListBox.Canvas,
1820	FListBox.Items[Index], // text
1821	FListBox.Items.Objects[Index], // data
1822	rec,
1823	State )
1824	end
1825	else
1826	FListBox.DrawItem( Index, rec , State );
1827	end;
1828
1829	Procedure TComboBox.SetBorderStyle(NewValue:TBorderStyle);
1830	Begin
1831	If FBorderStyle <> NewValue Then
1832	Begin
1833	FBorderStyle:=NewValue;
1834	RecreateWnd;
1835	End;
1836	End;
1837
1838
1839	Procedure TComboBox.SetPopupMenu(NewMenu:TPopupMenu);
1840	Begin
1841	If NewMenu=FPopupMenu Then Exit;
1842
1843	If FEdit<>Nil Then FEdit.PopupMenu:=NewMenu;
1844	If FListBox<>Nil Then FListBox.PopupMenu:=NewMenu;
1845	End;
1846
1847
1848	Procedure TComboBox.SetStyle(NewStyle:TComboBoxStyle);
1849	Var ComboHeight:LongInt;
1850	AParent:TControl;
1851	Begin
1852	FStyle := NewStyle;
1853	CreateEdit;
1854
1855	If FStyle = csSimple Then
1856	Begin
1857	FListBox.parent := Nil;
1858
1859	ComboHeight := FEdit.Height + GetListBoxHeight;
1860	SetBounds(Left,Top,Width,ComboHeight);
1861	FListBox.SetWindowPos(0,0,Width,GetListBoxHeight);
1862
1863	FListBox.SetDesigning(True); //Error At CheckMenuPopup
1864	FListBox.Visible := True;
1865	FListBox.SetDesigning(Designed);
1866	FListBox.Hint := Hint;
1867	FEdit.Hint := Hint;
1868
1869	FListBox.parent := Self;
1870	FDropped := True;
1871	End
1872	Else
1873	Begin
1874	SetupShowButton;
1875
1876	FListBox.SetDesigning(False); //Error At CheckMenuPopup
1877	FListBox.Visible := False;
1878	FListBox.SetDesigning(Designed);
1879	FListBox.Hint := Hint;
1880	FEdit.Hint := Hint;
1881	ComboHeight := FEdit.Height;
1882	SetBounds(Left,Top,Width,ComboHeight);
1883
1884	if csDesigning in ComponentState then
1885	begin
1886	FListBox.parent := nil;
1887	end
1888	else
1889	begin
1890	AParent := parent;
1891	If Form <> Nil Then
1892	If Form.Frame <> Nil Then AParent := Form.Frame; {!}
1893	FListBox.parent := AParent;
1894	end;
1895	FDropped := False;
1896	End;
1897
1898	if UsesStandardEdit then
1899	StandardEdit.ReadOnly := FStyle = csDropDownList;
1900	// else - ownerdraw edit is always readonly
1901
1902	End;
1903
1904
1905	Function TComboBox.GetListBoxHeight:LongInt;
1906	Var ItemCount:LongInt;
1907	Begin
1908	If FStyle <> csSimple Then
1909	Begin
1910	ItemCount := Items.Count;
1911	If ItemCount > FDropDownCount Then ItemCount := FDropDownCount;
1912	If ItemCount < 1 Then ItemCount := 1;
1913	Result := ItemCount * FListBox.ItemHeight + 6;
1914	End
1915	Else Result := FListBoxHeight;
1916	End;
1917
1918
1919	Procedure TComboBox.SetupShowButton;
1920	Var T,fw:LongInt;
1921	ComboButton:TComboListShowButton;
1922	X,Y,W,H:LongInt;
1923	Begin
1924	If FShowButton = Nil Then
1925	Begin
1926	ComboButton.Create(self);
1927	ComboButton.TabStop := False;
1928	ComboButton.FCombo := Self;
1929	ComboButton.SetDesigning(Designed);
1930	ComboButton.Hint := Hint;
1931	Include(ComboButton.ComponentState, csDetail);
1932	FShowButton := ComboButton;
1933	FEdit.InsertControl(FShowButton);
1934	End;
1935	T := Screen.SystemMetrics(smCxVScroll);
1936	If BorderStyle = bsNone Then fw := 0
1937	Else fw := 2;
1938	X:=FEdit.Width-T-fw;
1939	Y:=fw;
1940	W:=T;
1941	H:=FEdit.Height-2*fw;
1942	If ((FShowButton.Left<>X)Or(FShowButton.Bottom<>Y)Or(FShowButton.Width<>W)Or
1943	(FShowButton.Height<>H)) Then FShowButton.SetWindowPos(X,Y,W,H);
1944	End;
1945
1946
1947	Procedure TComboBox.DestroyShowButton;
1948	Begin
1949	If FShowButton <> Nil Then
1950	Begin
1951	FShowButton.Destroy;
1952	FShowButton := Nil;
1953	If FEdit <> Nil Then FEdit.Resize; {call Arrange}
1954	End;
1955	End;
1956
1957
1958	Procedure TComboBox.CreateWnd;
1959	Begin
1960	Inherited CreateWnd;
1961
1962	SetStyle(FStyle); {Set it again, To determine the Right Listbox parent}
1963	End;
1964
1965
1966	Procedure TComboBox.DestroyWnd;
1967	Begin
1968	Inherited DestroyWnd;
1969
1970	If FStyle <> csSimple Then
1971	If FListBox <> Nil Then
1972	Begin
1973	If DroppedDown Then DroppedDown := False;
1974	FListBox.DestroyWnd;
1975	End;
1976	End;
1977
1978
1979	Procedure TComboBox.Move;
1980	Begin
1981	Inherited Move;
1982
1983	If FStyle <> csSimple Then
1984	If DroppedDown Then DroppedDown := False;
1985	End;
1986
1987
1988	Procedure TComboBox.Resize;
1989	Begin
1990	Inherited Resize;
1991
1992	If FStyle = csSimple Then
1993	Begin
1994	FListBoxHeight := Height - FEdit.Height;
1995	If FListBox <> Nil
1996	Then FListBox.SetWindowPos(0,0,Width,FListBoxHeight);
1997	End
1998	Else
1999	Begin
2000	If Height<>FEdit.Height Then
2001	SetBounds(Left,Top,Width,FEdit.Height);
2002	SetupShowButton; {Realign}
2003	If DroppedDown Then DroppedDown := False;
2004	End;
2005	End;
2006
2007
2008	Procedure TComboBox.SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);
2009	Begin
2010	Inherited SetWindowPos(NewLeft,NewBottom,NewWidth,NewHeight);
2011
2012	If FStyle = csSimple Then FListBoxHeight := Height - FEdit.Height;
2013	End;
2014
2015
2016	Destructor TComboBox.Destroy;
2017	Begin
2018	If FStyle <> csSimple Then
2019	If FListBox <> Nil Then
2020	Begin
2021	FListBox.Destroy;
2022	FListBox := Nil;
2023	End;
2024
2025	Inherited Destroy;
2026	End;
2027
2028
2029	Procedure TComboBox.SetFocus;
2030	Var OldEvent:TNotifyEvent;
2031	Begin
2032	OldEvent := OnEnter;
2033	OnEnter := Nil;
2034
2035	Inherited SetFocus;
2036
2037	OnEnter := OldEvent;
2038
2039	If Not Designed Then
2040	If FEdit <> Nil Then FEdit.CaptureFocus;
2041	End;
2042
2043
2044	Procedure TComboBox.KillFocus;
2045	Var OldEvent:TNotifyEvent;
2046	Begin
2047	OldEvent := OnExit;
2048	OnExit := Nil;
2049
2050	Inherited KillFocus;
2051
2052	OnExit := OldEvent;
2053	End;
2054
2055
2056	{$HINTS OFF}
2057	Procedure TComboBox.EvKillFocus(Sender:TObject); //ListBox
2058	Begin
2059	If FStyle <> csSimple Then
2060	If DroppedDown Then DroppedDown := False;
2061	End;
2062	{$HINTS ON}
2063
2064
2065	Procedure TComboBox.SetDroppedDown(Value:Boolean);
2066	Begin
2067	If Handle = 0 Then Exit;
2068	If FStyle = csSimple Then Exit;
2069
2070	If FDropped <> Value Then
2071	Begin
2072	FDropped := Value;
2073	TComboListShowButton(FShowButton).Down := FDropped;
2074
2075	If FDropped Then
2076	Begin
2077	{Update Colors manually, because lb Is Not In the Comp List}
2078	FListBox.PenColor := PenColor;
2079	FListBox.color := color;
2080	FListBox.Font := Font;
2081
2082	If FOnDropDown <> Nil Then FOnDropDown(Self);
2083	If Not FDropped Then Exit; {DropDown already Handled}
2084
2085	AdjustDropDown;
2086	End
2087	Else
2088	Begin
2089	FListBox.Hide;
2090	If Not Designed Then
2091	Begin
2092	FEdit.CaptureFocus; {!}
2093	if UsesStandardEdit then
2094	StandardEdit.SelectAll;
2095	// else - owner draw edit is always all selected
2096	End;
2097	End;
2098	End;
2099	End;
2100
2101
2102	{$HINTS OFF}
2103	{Koordinaten sind relativ zum parent der ComboBox anzugeben;
2104	phys. parent der Listbox ist TFrameControl}
2105	Procedure TComboBox.UpdateListBoxPos(Var aLeft,aBottom,aWidth,aHeight:LongInt);
2106	Var ListOrigin:TPoint;
2107	ListParentOrigin:TPoint;
2108	ListOffsetY:LongInt;
2109	FormHeight:LongInt;
2110	AForm:TForm;
2111	Begin
2112	If Handle = 0 Then Exit;
2113	If parent = Nil Then Exit;
2114	If FListBox.parent = Nil Then Exit;
2115
2116	{Rechnen mit Screen Koordinaten}
2117	ListOrigin := parent.ClientToScreen(Point(aLeft,aBottom));
2118	ListParentOrigin := FListBox.parent.ClientToScreen(Point(0,0)); {Frame}
2119	ListOffsetY := ListOrigin.Y - ListParentOrigin.Y;
2120
2121	If ListOffsetY < 0 Then {unterhalb der Form}
2122	Begin
2123	If Form Is TForm Then
2124	Begin
2125	FormHeight := Form.ClientHeight;
2126	AForm:=TForm(Form);
2127	Asm
2128	PUSH DWord Ptr AForm
2129	CALLN32 Forms.GetTopBottomHeight
2130	MOV EBX,FormHeight
2131	ADD EBX,EAX
2132	MOV FormHeight,EBX
2133	End;
2134	End
2135	Else FormHeight := 0; {?}
2136
2137	If ListOffsetY + aHeight + Height + aHeight < FormHeight
2138	Then aBottom := Bottom + Height; {nach oben aufklappen}
2139	End;
2140	End;
2141	{$HINTS ON}
2142
2143
2144	Procedure TComboBox.AdjustDropDown;
2145	Var X,Y,W,H,I:LongInt;
2146	ListOrigin:TPoint;
2147	ListParentOrigin:TPoint;
2148	Begin
2149	W := Width;
2150	H := GetListBoxHeight;
2151	X := Left;
2152	Y := Bottom - H;
2153	{Koordinaten wie Die Combo}
2154	UpdateListBoxPos(X,Y,W,H);
2155
2156	{umrechnen auf FormFrame Koordinaten}
2157	If parent Is TControl
2158	Then ListOrigin := parent.ClientToScreen(Point(X,Y))
2159	Else ListOrigin := Point(X,Y);
2160	If FListBox.parent Is TControl
2161	Then ListParentOrigin := FListBox.parent.ClientToScreen(Point(0,0)) {Frame}
2162	Else ListParentOrigin := Point(0,0);
2163	{Offset zum parent der Listbox}
2164	X := ListOrigin.X - ListParentOrigin.X;
2165	Y := ListOrigin.Y - ListParentOrigin.Y;
2166
2167	{Select the Item called like Text}
2168	I := FListBox.Items.IndexOf(Text);
2169	If I >= 0 Then
2170	Begin
2171	FListBox.FInitItemIndex := I;
2172	FListBox.FInitTopIndex := I;
2173	End;
2174
2175	FListBox.SetWindowPos(X,Y,W,H);
2176	FListBox.Show;
2177	If Not Designed Then FListBox.CaptureFocus; {!}
2178	End;
2179
2180
2181	Procedure TComboBox.FontChange;
2182	Begin
2183	Inherited FontChange;
2184
2185	If FEdit <> Nil Then FEdit.Font := Font; {auto Size}
2186	If FListBox <> Nil Then FListBox.Font := Font;
2187	End;
2188
2189
2190	{$HINTS OFF}
2191	Procedure TComboBox.CMTextChanged(Var Msg:TMessage);
2192	Begin
2193	If FEdit <> Nil Then FEdit.Text := Text;
2194	End;
2195	{$HINTS ON}
2196
2197
2198	{$HINTS OFF}
2199	Procedure TComboBox.EvEditEnter(Sender:TObject);
2200	Begin
2201	If OnEnter <> Nil Then OnEnter(Self);
2202	End;
2203
2204
2205	Procedure TComboBox.EvEditExit(Sender:TObject);
2206	Begin
2207	If OnExit <> Nil Then OnExit(Self);
2208	End;
2209
2210
2211	Procedure TComboBox.EvEditChanged(Sender:TObject);
2212	Var OldEdit:TControl;
2213	Begin
2214	OldEdit := FEdit;
2215	FEdit := Nil; {prevent recursion}
2216	Text := OldEdit.Text;
2217	if Style in [ csSimple, csDropDown ] then
2218	// select the matching item in the list, if any.
2219	FListBox.ItemIndex := FListBox.Items.IndexOf( Text );
2220	FEdit := OldEdit;
2221	EditChange;
2222	End;
2223	{$HINTS ON}
2224
2225
2226	Procedure TComboBox.EditChange;
2227	Begin
2228	If FOnChange<>Nil Then FOnChange(Self);
2229	End;
2230
2231
2232	Function TComboBox.GetItems:TStrings;
2233	Begin
2234	If FListBox <> Nil Then Result := FListBox.Items
2235	Else Result := Nil;
2236	End;
2237
2238
2239	Procedure TComboBox.SetItems(AStrings:TStrings);
2240	Begin
2241	If FListBox <> Nil Then FListBox.Items := AStrings;
2242	End;
2243
2244
2245	Function TComboBox.GetItemIndex:LongInt;
2246	Begin
2247	If FListBox <> Nil Then Result := FListBox.ItemIndex
2248	Else Result := -1;
2249	End;
2250
2251
2252	Procedure TComboBox.SetItemIndex(Value:LongInt);
2253	Begin
2254	If FListBox <> Nil Then
2255	Begin
2256	FListBox.ItemIndex := Value;
2257	ItemSelect(Value);
2258	End;
2259	End;
2260
2261
2262	Function TComboBox.GetSorted:Boolean;
2263	Begin
2264	If FListBox <> Nil Then Result := FListBox.sorted
2265	Else Result := False;
2266	End;
2267
2268
2269	Procedure TComboBox.SetSorted(Value:Boolean);
2270	Begin
2271	If FListBox <> Nil Then FListBox.sorted := Value;
2272	End;
2273
2274
2275	Function TComboBox.GetDuplicates:Boolean;
2276	Begin
2277	If FListBox <> Nil Then Result := FListBox.Duplicates
2278	Else Result := False;
2279	End;
2280
2281
2282	Procedure TComboBox.SetDuplicates(Value:Boolean);
2283	Begin
2284	If FListBox <> Nil Then FListBox.Duplicates := Value;
2285	End;
2286
2287
2288	Procedure TComboBox.SetExtension(Const Value:String);
2289	Begin
2290	End;
2291
2292
2293	Function TComboBox.GetExtension:String;
2294	Begin
2295	Result := ''; // no longer supported
2296	End;
2297
2298
2299	Function TComboBox.GetMaxLength:Integer;
2300	Begin
2301	if not UsesStandardEdit then
2302	begin
2303	Result := 255;
2304	exit;
2305	end;
2306
2307	If FEdit <> Nil Then Result := StandardEdit.MaxLength
2308	Else Result := 0;
2309	End;
2310
2311
2312	Procedure TComboBox.SetMaxLength(tl:Integer);
2313	Begin
2314	if not UsesStandardEdit then
2315	exit;
2316	If FEdit <> Nil Then StandardEdit.MaxLength := tl;
2317	End;
2318
2319
2320	Function TComboBox.GetSelStart:Integer;
2321	Begin
2322	if not UsesStandardEdit then
2323	begin
2324	Result := 0;
2325	exit;
2326	end;
2327	If FEdit <> Nil Then Result := StandardEdit.SelStart
2328	Else Result := 0;
2329	End;
2330
2331
2332	Procedure TComboBox.SetSelStart(X:Integer);
2333	Begin
2334	if not UsesStandardEdit then
2335	exit;
2336	If FEdit <> Nil Then StandardEdit.SelStart := X;
2337	End;
2338
2339
2340	Function TComboBox.GetSelLength:Integer;
2341	Begin
2342	if not UsesStandardEdit then
2343	begin
2344	Result := Length( FEdit.Text );
2345	exit;
2346	end;
2347	If FEdit <> Nil Then Result := StandardEdit.SelLength
2348	Else Result := 0;
2349	End;
2350
2351
2352	Procedure TComboBox.SetSelLength(X:Integer);
2353	Begin
2354	if not UsesStandardEdit then
2355	exit;
2356	If FEdit <> Nil Then StandardEdit.SelLength := X;
2357	End;
2358
2359
2360	Function TComboBox.GetSelText:String;
2361	Begin
2362	if not UsesStandardEdit then
2363	begin
2364	Result := FEdit.Text;
2365	exit;
2366	end;
2367
2368	If FEdit <> Nil Then Result := StandardEdit.SelText
2369	Else Result := ''
2370	End;
2371
2372
2373	Procedure TComboBox.SetSelText(Const Value:String);
2374	Begin
2375	if not UsesStandardEdit then
2376	exit;
2377	If FEdit <> Nil Then StandardEdit.SelText := Value;
2378	End;
2379
2380
2381	Procedure TComboBox.SetAlternate(Value:Boolean);
2382	Begin
2383	FAlternate := Value;
2384	If FShowButton <> Nil Then FShowButton.Invalidate;
2385	End;
2386
2387
2388	{$HINTS OFF}
2389	Procedure TComboBox.ItemFocus(Index:LongInt);
2390	Begin
2391	If FOnItemFocus <> Nil Then FOnItemFocus(Self,Index);
2392	End;
2393
2394
2395	Procedure TComboBox.ItemSelect(Index:LongInt);
2396	begin
2397	if Index = -1 then
2398	exit;
2399
2400	// Item selected from listbox, copy the item
2401	// to the edit and store the selected object
2402	FEdit.Text := Items.Strings[Index];
2403
2404	if UsesStandardEdit then
2405	begin
2406	StandardEdit.SelectAll;
2407	end;
2408	FSelectedObject := Items.Objects[Index];
2409
2410	If FOnItemSelect <> Nil Then FOnItemSelect(Self,Index);
2411	End;
2412	{$HINTS ON}
2413
2414	Procedure TComboBox.ListBoxMouseUp;
2415	var
2416	idx: longint;
2417	begin
2418	If FStyle <> csSimple Then
2419	Begin
2420	// select the item under the cursor when button released
2421	idx := FListBox.ItemIndex;
2422	If (idx < 0) Or (idx >= Items.Count) Then Exit;
2423	DroppedDown := false;
2424	ItemSelect(idx);
2425	End;
2426	end;
2427
2428	Procedure TComboBox.Invalidate;
2429	Begin
2430	If FEdit <> Nil Then FEdit.Invalidate;
2431	If FShowButton <> Nil Then FShowButton.Invalidate;
2432	If FListBox <> Nil Then FListBox.Invalidate;
2433	End;
2434
2435
2436	Procedure TComboBox.Update;
2437	Begin
2438	If FEdit <> Nil Then FEdit.Update;
2439	If FShowButton <> Nil Then FShowButton.Update;
2440	If FListBox <> Nil Then FListBox.Update;
2441	End;
2442
2443
2444	Procedure TComboBox.Hide;
2445	Begin
2446	Inherited Hide;
2447	If FStyle <> csSimple Then
2448	If DroppedDown Then DroppedDown := False;
2449	End;
2450
2451
2452	Procedure TComboBox.SelectAll;
2453	Begin
2454	if not UsesStandardEdit then
2455	exit;
2456	If FEdit <> Nil Then StandardEdit.SelectAll;
2457	End;
2458
2459
2460	Procedure TComboBox.Clear;
2461	Begin
2462	if not UsesStandardEdit then
2463	If FEdit <> Nil Then StandardEdit.Clear;
2464	If FListBox <> Nil Then FListBox.Clear;
2465	End;
2466
2467
2468	Procedure TComboBox.BeginUpdate;
2469	Begin
2470	If FListBox <> Nil Then FListBox.BeginUpdate;
2471	End;
2472
2473
2474	Procedure TComboBox.EndUpdate;
2475	Begin
2476	If FListBox <> Nil Then FListBox.EndUpdate;
2477	End;
2478
2479
2480	Function TComboBox.WriteSCUResource(Stream:TResourceStream):Boolean;
2481	Var aText:PChar;
2482	Begin
2483	Result := Inherited WriteSCUResource(Stream);
2484	If Not Result Then Exit;
2485
2486	aText := Items.GetText;
2487	If aText <> Nil Then
2488	Begin
2489	Result := Stream.NewResourceEntry(rnItems,aText^,Length(aText^)+1);
2490	StrDispose(aText);
2491	End;
2492	End;
2493
2494
2495	Procedure TComboBox.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
2496	Var aText:PChar;
2497	Begin
2498	If ResName = rnItems Then
2499	Begin
2500	aText := @Data;
2501	Items.SetText(aText);
2502	End
2503	Else Inherited ReadSCUResource(ResName,Data,DataLen)
2504	End;
2505
2506
2507	{
2508	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2509	º º
2510	º Speed-Pascal/2 Version 2.0 º
2511	º º
2512	º Speed-Pascal Component Classes (SPCC) º
2513	º º
2514	º This section: TEdit Class Implementation º
2515	º º
2516	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2517	º º
2518	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2519	}
2520
2521	Procedure TEdit.SetupComponent;
2522	Begin
2523	Inherited SetupComponent;
2524
2525	Name := 'Edit';
2526	Caption := '';
2527	Width := 100;
2528	Height := 20;
2529	color := clEntryField;
2530	ParentPenColor := False;
2531	ParentColor := False;
2532	Ownerdraw := False;
2533
2534	FUnreadable := False;
2535	FModified := False;
2536	FInsertMode := True;
2537	FReadOnly := False;
2538	FMaxLength := 0;
2539	FAutoSize := True;
2540	FAutoScroll := True;
2541	FAutoSelect := True;
2542	FCharCase := ecNormal;
2543	FBorderStyle := bsSingle;
2544	FAlignment := taLeftJustify;
2545	FExtension := Nil;
2546	FSelStart := 0;
2547	FSelLen := 0;
2548	End;
2549
2550
2551	Procedure TEdit.GetClassData(Var ClassData:TClassData);
2552	Begin
2553	Inherited GetClassData(ClassData);
2554
2555	{$IFDEF OS2}
2556	ClassData.ClassULong := WC_ENTRYFIELD;
2557	{$ENDIF}
2558	{$IFDEF Win95}
2559	CreateSubClass(ClassData,'EDIT');
2560	{$ENDIF}
2561	End;
2562
2563
2564	Procedure TEdit.CreateParams(Var Params:TCreateParams);
2565	Begin
2566	Inherited CreateParams(Params);
2567
2568	{$IFDEF OS2}
2569	Case FAlignment Of
2570	taLeftJustify: Params.Style := Params.Style Or ES_LEFT;
2571	taRightJustify: Params.Style := Params.Style Or ES_RIGHT;
2572	taCenter: Params.Style := Params.Style Or ES_CENTER;
2573	End;
2574	If FAutoScroll Then Params.Style := Params.Style Or ES_AUTOSCROLL;
2575	If FUnreadable Then Params.Style := Params.Style Or ES_UNREADABLE;
2576	If FReadOnly Then Params.Style := Params.Style Or ES_READONLY;
2577	If FBorderStyle = bsSingle Then Params.Style := Params.Style Or ES_MARGIN;
2578	{$ENDIF}
2579	{$IFDEF Win95}
2580	{Case FAlignment Of
2581	taLeftJustify: Params.Style := Params.Style Or ES_LEFT;
2582	taRightJustify: Params.Style := Params.Style Or ES_RIGHT;
2583	taCenter: Params.Style := Params.Style Or ES_CENTER;
2584	End;}
2585	If FAutoScroll Then Params.Style := Params.Style Or ES_AUTOHSCROLL;
2586	If FUnreadable Then Params.Style := Params.Style Or ES_PASSWORD;
2587	If FReadOnly Then Params.Style := Params.Style Or ES_READONLY;
2588	If FBorderStyle = bsSingle Then
2589	Begin
2590	Params.Style := Params.Style Or WS_BORDER;
2591	Params.ExStyle := Params.ExStyle Or WS_EX_CLIENTEDGE; {Double}
2592	End;
2593	{$ENDIF}
2594	End;
2595
2596
2597	Procedure TEdit.CreateWnd;
2598	Begin
2599	FTempCaption := NewStr(Caption);
2600
2601	Inherited CreateWnd;
2602	End;
2603
2604
2605	Procedure TEdit.SetupShow;
2606	{$IFDEF OS2}
2607	Var Value:LongInt;
2608	{$ENDIF}
2609	Begin
2610	Inherited SetupShow;
2611
2612	{$IFDEF OS2}
2613	If FMaxLength <= 0 Then Value := 255
2614	Else Value := FMaxLength;
2615	WinSendMsg(Handle,EM_SETTEXTLIMIT,Value,0);
2616	WinSendMsg(Handle,EM_SETINSERTMODE,LongWord(FInsertMode),0);
2617	{$ENDIF}
2618	If FTempCaption<>Nil Then Caption := FTempCaption^
2619	Else Caption:='';
2620	DisposeStr(FTempCaption);
2621	FTempCaption := Nil;
2622	SetSelection(FSelStart,FSelLen);
2623	If FAutoSize Then AdjustHeight;
2624	End;
2625
2626
2627	Procedure TEdit.UpdateWindowPos(NewLeft,NewBottom,NewWidth,NewHeight:LongInt);
2628	Begin
2629	{$IFDEF OS2}
2630	If FBorderStyle = bsSingle Then
2631	Begin
2632	Inc(NewLeft,3);
2633	Inc(NewBottom,3);
2634	Dec(NewWidth,6);
2635	Dec(NewHeight,6);
2636	End;
2637	{$ENDIF}
2638	Inherited UpdateWindowPos(NewLeft,NewBottom,NewWidth,NewHeight);
2639	End;
2640
2641
2642	{$HINTS OFF}
2643	Procedure TEdit.CharEvent(Var key:Char;RepeatCount:Byte);
2644	Var S:String;
2645	Begin
2646	If NumbersOnly Then
2647	Begin
2648	If Not (key In ['0'..'9','.','+','-']) Then
2649	Begin
2650	key := #0;
2651	Exit;
2652	End;
2653	End;
2654
2655	Case FCharCase Of
2656	ecNormal: ;
2657	ecUpperCase:
2658	Begin
2659	S := AnsiUpperCase(key);
2660	key := S[1];
2661	End;
2662	ecLowerCase:
2663	Begin
2664	S := lowercase(key);
2665	key := S[1];
2666	End;
2667	End;
2668	End;
2669	{$HINTS ON}
2670
2671
2672	Procedure TEdit.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
2673	{$IFDEF OS2}
2674	Var FCursor:LongInt;
2675	ext:String;
2676	{$ENDIF}
2677	Begin
2678	Case KeyCode Of
2679	kbCLeft: ; {!}
2680	kbCRight: {extension}
2681	Begin
2682	If FReadOnly Then Exit;
2683	{$IFDEF OS2}
2684	FCursor := WinSendMsg(Handle,EM_QUERYSEL,0,0);
2685	FCursor := FCursor Shr 16;
2686	If (Length(TextExtension) > 0) And (FCursor = Length(Text)) Then
2687	Begin
2688	ext := TextExtension;
2689	Text := Text + ext[1];
2690	Delete(ext,1,1);
2691	TextExtension := ext;
2692	End;
2693	{$ENDIF}
2694	End;
2695	Else Inherited ScanEvent(KeyCode,RepeatCount);
2696	End;
2697	End;
2698
2699	Procedure TEdit.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
2700	Begin
2701	SelectAll;
2702	inherited MouseDblClick(Button,ShiftState,X,Y);
2703	LastMsg.Handled := true; // don't want default handler.
2704	End;
2705
2706	Procedure TEdit.ParentNotification(Var Msg:TMessage);
2707	Begin
2708	{$IFDEF OS2}
2709	Case Msg.Msg Of
2710	WM_CONTROL:
2711	Begin
2712	Case Msg.Param1Hi Of
2713	EN_CHANGE:
2714	If FTempCaption = Nil Then {External Change}
2715	Begin
2716	FModified := True;
2717	Change;
2718	End;
2719	EN_SETFOCUS:
2720	If FAutoSelect Then SelectAll;
2721	End;
2722	End;
2723	End;
2724	{$ENDIF}
2725	{$IFDEF Win95}
2726	Case Msg.Msg Of
2727	WM_COMMAND:
2728	Begin
2729	Case Msg.Param1Hi Of
2730	EN_CHANGE:
2731	If FTempCaption = Nil Then
2732	Begin
2733	FModified := True;
2734	Change;
2735	End;
2736	EN_SETFOCUS:
2737	Begin
2738	DefaultHandler(Msg);
2739	If FAutoSelect Then SelectAll;
2740	End;
2741	Else DefaultHandler(Msg);
2742	End;
2743	Msg.Handled:=True; //!!!
2744	End;
2745	End;
2746	{$ENDIF}
2747	End;
2748
2749
2750	Procedure TEdit.Change;
2751	Begin
2752	TextExtension := '';
2753	If FOnChange <> Nil Then FOnChange(Self);
2754	End;
2755
2756
2757	Procedure TEdit.DestroyWnd;
2758	Begin
2759	FSelStart := SelStart;
2760	FSelLen := SelLength;
2761
2762	Inherited DestroyWnd;
2763	End;
2764
2765
2766	Destructor TEdit.Destroy;
2767	Begin
2768	DisposeStr(FExtension);
2769	FExtension := Nil;
2770
2771	Inherited Destroy;
2772	End;
2773
2774
2775	Procedure TEdit.SetBorderStyle(Value:TBorderStyle);
2776	Begin
2777	If FBorderStyle <> Value Then
2778	Begin
2779	FBorderStyle := Value;
2780	If FAutoSize Then AdjustHeight;
2781	RecreateWnd;
2782	End;
2783	End;
2784
2785
2786	Procedure TEdit.SetAutoSize(Value:Boolean);
2787	Begin
2788	If FAutoSize <> Value Then
2789	Begin
2790	FAutoSize := Value;
2791	If FAutoSize Then AdjustHeight;
2792	End;
2793	End;
2794
2795
2796	Procedure TEdit.AdjustHeight;
2797	Var NewHeight:LongInt;
2798	Begin
2799	NewHeight := Font.Height + 2;
2800	If FBorderStyle = bsSingle Then Inc(NewHeight,4);
2801	Height := NewHeight;
2802	End;
2803
2804
2805	Procedure TEdit.FontChange;
2806	Begin
2807	If FAutoSize Then AdjustHeight;
2808
2809	Inherited FontChange;
2810	End;
2811
2812
2813	Procedure TEdit.SetAlignment(Value:TAlignment);
2814	Begin
2815	If FAlignment <> Value Then
2816	Begin
2817	FAlignment := Value;
2818	RecreateWnd;
2819	End;
2820	End;
2821
2822
2823	Procedure TEdit.SetMaxLength(Value:LongInt);
2824	Begin
2825	If Value > 255 Then Value := 255;
2826	If FMaxLength <> Value Then
2827	Begin
2828	FMaxLength := Value;
2829	{$IFDEF OS2}
2830	If Handle <> 0 Then
2831	Begin
2832	If Value <= 0 Then Value := 255;
2833	WinSendMsg(Handle,EM_SETTEXTLIMIT,Value,0);
2834	End;
2835	{$ENDIF}
2836	{$IFDEF WIN32}
2837	If Handle <> 0 Then
2838	Begin
2839	If Value <= 0 Then Value := 255;
2840	WinUser.SendMessage(Handle,EM_LIMITTEXT,Value,0);
2841	End;
2842	{$ENDIF}
2843	RecreateWnd; {Reset the original string!}
2844	End;
2845	End;
2846
2847
2848	Procedure TEdit.SetAutoScroll(Value:Boolean);
2849	Begin
2850	If FAutoScroll <> Value Then
2851	Begin
2852	FAutoScroll := Value;
2853	RecreateWnd;
2854	End;
2855	End;
2856
2857
2858	Procedure TEdit.SetUnreadable(Value:Boolean);
2859	Begin
2860	If FUnreadable <> Value Then
2861	Begin
2862	FUnreadable := Value;
2863	RecreateWnd;
2864	End;
2865	End;
2866
2867
2868	Procedure TEdit.SetReadOnly(Value:Boolean);
2869	Var ro:LongBool;
2870	Begin
2871	If FReadOnly <> Value Then
2872	Begin
2873	FReadOnly := Value;
2874	{$IFDEF OS2}
2875	ro:=FReadOnly;
2876	If Handle <> 0 Then WinSendMsg(Handle,EM_SETREADONLY,LongWord(ro),0);
2877	{$ENDIF}
2878	{$IFDEF WIN32}
2879	ro:=FReadOnly;
2880	If Handle <> 0 Then WinUser.SendMessage(Handle,EM_SETREADONLY,LongWord(ro),0);
2881	{$ENDIF}
2882	End;
2883	End;
2884
2885
2886	Procedure TEdit.SetInsertMode(Value:Boolean);
2887	Begin
2888	If FInsertMode <> Value Then
2889	Begin
2890	FInsertMode := Value;
2891	{$IFDEF OS2}
2892	If Handle <> 0 Then WinSendMsg(Handle,EM_SETINSERTMODE,
2893	LongWord(FInsertMode),0);
2894	{$ENDIF}
2895	End;
2896	End;
2897
2898
2899	Procedure TEdit.SetCharCase(Value:TEditCharCase);
2900	Begin
2901	If FCharCase <> Value Then
2902	Begin
2903	FCharCase := Value;
2904	Case FCharCase Of
2905	ecNormal: ;
2906	ecUpperCase: Text := AnsiUpperCase(Text);
2907	ecLowerCase: Text := lowercase(Text);
2908	End;
2909	End;
2910	End;
2911
2912
2913	Procedure TEdit.SetExtension(Const Value:String);
2914	Begin
2915	AssignStr(FExtension,Value);
2916	End;
2917
2918
2919	Function TEdit.GetExtension:String;
2920	Begin
2921	If FExtension <> Nil Then Result := FExtension^
2922	Else Result := '';
2923	End;
2924
2925
2926	Procedure TEdit.SetSelection(Start,len:LongInt);
2927	Begin
2928	If Handle <> 0 Then
2929	Begin
2930	{$IFDEF OS2}
2931	WinSendMsg(Handle,EM_SETSEL,Start+((Start+len) Shl 16),0);
2932	{$ENDIF}
2933	{$IFDEF WIN32}
2934	If ((Start=0)And(len=255)) Then //Select all
2935	WinUser.SendMessage(Handle,EM_SETSEL,0,-1)
2936	Else
2937	WinUser.SendMessage(Handle,EM_SETSEL,Start,Start+len);
2938	{$ENDIF}
2939	End;
2940	FSelStart := Start;
2941	FSelLen := len;
2942	End;
2943
2944
2945	Procedure TEdit.SetSelStart(X:LongInt);
2946	Begin
2947	SetSelection(X,SelLength);
2948	End;
2949
2950
2951	Function TEdit.GetSelStart:LongInt;
2952	Var Sel:LongInt;
2953	Begin
2954	If Handle <> 0 Then
2955	Begin
2956	{$IFDEF OS2}
2957	Sel := WinSendMsg(Handle,EM_QUERYSEL, 0, 0);
2958	{$ENDIF}
2959	{$IFDEF WIN32}
2960	Sel := WinUser.SendMessage(Handle,EM_GETSEL,0,0);
2961	{$ENDIF}
2962	Result := Sel And $FFFF;
2963	End
2964	Else Result := FSelStart;
2965	End;
2966
2967
2968	Procedure TEdit.SetSelLength(X:LongInt);
2969	Begin
2970	SetSelection(SelStart,X);
2971	End;
2972
2973	Function TEdit.GetSelLength:LongInt;
2974	Var Sel:LongInt;
2975	Begin
2976	If Handle <> 0 Then
2977	Begin
2978	{$IFDEF OS2}
2979	Sel := WinSendMsg(Handle,EM_QUERYSEL, 0, 0);
2980	{$ENDIF}
2981	{$IFDEF WIN32}
2982	Sel := WinUser.SendMessage(Handle,EM_GETSEL,0,0);
2983	{$ENDIF}
2984	Result := (Sel Shr 16) - (Sel And $FFFF);
2985	End
2986	Else Result := FSelStart;
2987	End;
2988
2989
2990	Procedure TEdit.SetSelText(Const Value:String);
2991	Var S:String;
2992	X,CX:LongInt;
2993	Begin
2994	S := Text;
2995	X := SelStart;
2996	CX := SelLength;
2997	Delete(S,X+1,CX);
2998	Insert(Value,S,X+1);
2999	Text := S;
3000	SelStart := X;
3001	SelLength := Length(Value);
3002	End;
3003
3004
3005	Function TEdit.GetSelText:String;
3006	Begin
3007	Result := Copy(Text,SelStart+1,SelLength);
3008	End;
3009
3010
3011	Procedure TEdit.SelectAll;
3012	Begin
3013	SetSelection(0,255);
3014	End;
3015
3016
3017	Procedure TEdit.Clear;
3018	Begin
3019	Text := '';
3020	End;
3021
3022
3023	Procedure TEdit.ClearSelection;
3024	Begin
3025	If Handle = 0 Then Exit;
3026	{$IFDEF OS2}
3027	WinSendMsg(Handle,EM_CLEAR,0,0);
3028	{$ENDIF}
3029	{$IFDEF Win95}
3030	SendMessage(Handle,WM_CLEAR,0,0);
3031	{$ENDIF}
3032	End;
3033
3034
3035	Procedure TEdit.CutToClipBoard;
3036	Begin
3037	If Handle = 0 Then Exit;
3038	{$IFDEF OS2}
3039	WinSendMsg(Handle,EM_CUT,0,0);
3040	{$ENDIF}
3041	{$IFDEF Win95}
3042	SendMessage(Handle,WM_CUT,0,0);
3043	{$ENDIF}
3044	End;
3045
3046
3047	Procedure TEdit.CopyToClipboard;
3048	Begin
3049	If Handle = 0 Then Exit;
3050	{$IFDEF OS2}
3051	WinSendMsg(Handle,EM_COPY,0,0);
3052	{$ENDIF}
3053	{$IFDEF Win95}
3054	SendMessage(Handle,WM_COPY,0,0);
3055	{$ENDIF}
3056	End;
3057
3058
3059	Procedure TEdit.PasteFromClipBoard;
3060	Begin
3061	If Handle = 0 Then Exit;
3062	{$IFDEF OS2}
3063	WinSendMsg(Handle,EM_PASTE,0,0);
3064	{$ENDIF}
3065	{$IFDEF Win95}
3066	SendMessage(Handle,WM_PASTE,0,0);
3067	{$ENDIF}
3068	End;
3069
3070
3071	{
3072	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
3073	º º
3074	º Speed-Pascal/2 Version 2.0 º
3075	º º
3076	º Speed-Pascal Component Classes (SPCC) º
3077	º º
3078	º This section: TListBox Class Implementation º
3079	º º
3080	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
3081	º º
3082	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
3083	}
3084
3085	Type
3086	TListBoxStrings=Class(TStrings)
3087	Private
3088	Listbox:TListBox;
3089	Protected
3090	Function GetCount:LongInt; Override;
3091	Function Get(Index:LongInt):String; Override;
3092	Function GetObject(Index:LongInt):TObject; Override;
3093	Procedure Put(Index:LongInt;Const S:String); Override;
3094	Procedure PutObject(Index:LongInt;AObject:TObject); Override;
3095	Procedure indexerror;
3096	{$IFDEF OS2}
3097	Procedure LoadStrings( Strings: TStrings ); // quick load to displayed list
3098	{$ENDIF}
3099	Public
3100	Procedure Assign(AStrings:TStrings); Override;
3101	Procedure AddStrings(AStrings: TStrings); Override;
3102	Function Add(Const S:String):LongInt; Override;
3103	Procedure Insert(Index:LongInt;Const S:String); Override;
3104	Procedure Delete(Index:LongInt); Override;
3105	Procedure Clear; Override;
3106	{$IFDEF OS2}
3107	Function IndexOf(Const S:String):LongInt; Override;
3108	{$ENDIF}
3109	End;
3110
3111
3112	{$M+}
3113
3114
3115	Function TListBoxStrings.GetCount:LongInt;
3116	Begin
3117	{$IFDEF OS2}
3118	Result := WinSendMsg(Listbox.Handle,LM_QUERYITEMCOUNT,0,0);
3119	{$ENDIF}
3120	{$IFDEF Win95}
3121	Result := SendMessage(Listbox.Handle,LB_GETCOUNT,0,0);
3122	{$ENDIF}
3123	End;
3124
3125
3126	Function TListBoxStrings.Get(Index:LongInt):String;
3127	Var len:LongInt;
3128	{$IFDEF WIN32}
3129	c:CString;
3130	{$ENDIF}
3131	Begin
3132	Result := '';
3133	If (Index < 0) Or (Index >= Count) Then indexerror;
3134
3135	{$IFDEF OS2}
3136	len := WinSendMsg(Listbox.Handle,LM_QUERYITEMTEXT,
3137	MPFROM2SHORT(Index,SizeOf(Result)),LongWord(@Result[1]));
3138	SetLength(Result,len);
3139	{$ENDIF}
3140	{$IFDEF Win95}
3141	len := SendMessage(Listbox.Handle,LB_GETTEXT,Index,LongWord(@Result[1]));
3142	SetLength(Result,len);
3143	c:=Result;
3144	AnsiToOem(c,c);
3145	Result:=c;
3146	{$ENDIF}
3147	End;
3148
3149
3150	Function TListBoxStrings.GetObject(Index:LongInt):TObject;
3151	Begin
3152	Result := Nil;
3153	If (Index < 0) Or (Index >= Count) Then indexerror;
3154
3155	{$IFDEF OS2}
3156	Result := TObject(WinSendMsg(Listbox.Handle,LM_QUERYITEMHANDLE,Index,0));
3157	{$ENDIF}
3158	{$IFDEF Win95}
3159	Result := TObject(SendMessage(Listbox.Handle,LB_GETITEMDATA,Index,0));
3160	{$ENDIF}
3161	End;
3162
3163
3164	Procedure TListBoxStrings.Put(Index:LongInt;Const S:String);
3165	Var CS:cstring;
3166	{$IFDEF WIN32}
3167	s1:String;
3168	{$ENDIF}
3169	Begin
3170	If (Index < 0) Or (Index >= Count) Then indexerror;
3171
3172	{$IFDEF OS2}
3173	CS := S;
3174	WinSendMsg(Listbox.Handle,LM_SETITEMTEXT,Index,LongWord(@CS));
3175	{$ENDIF}
3176	{$IFDEF Win95}
3177	BeginUpdate;
3178	SendMessage(Listbox.Handle,LB_DELETESTRING,Index,0);
3179	s1:=s;
3180	StrOemToAnsi(s1);
3181	cs:=s1;
3182	SendMessage(Listbox.Handle,LB_INSERTSTRING,Index,LongWord(@CS));
3183	EndUpdate;
3184	{$ENDIF}
3185	End;
3186
3187
3188	Procedure TListBoxStrings.PutObject(Index:LongInt;AObject:TObject);
3189	Begin
3190	If (Index < 0) Or (Index >= Count) Then indexerror;
3191
3192	{$IFDEF OS2}
3193	WinSendMsg(Listbox.Handle,LM_SETITEMHANDLE,Index,LongWord(AObject));
3194	{$ENDIF}
3195	{$IFDEF Win95}
3196	SendMessage(Listbox.Handle,LB_SETITEMDATA,Index,LongWord(AObject));
3197	{$ENDIF}
3198	End;
3199
3200
3201	Procedure TListBoxStrings.Assign(AStrings:TStrings);
3202	Begin
3203	Listbox.BeginUpdate;
3204	Inherited Assign(AStrings);
3205	Listbox.EndUpdate;
3206	End;
3207
3208	{$ifdef os2}
3209	// Loads a stringlist into the displayed PM list,
3210	// quickly. This is done by copying into an array
3211	// as zero-terminated cstrings, then using PM's multi-item
3212	// load message
3213	const
3214	BufferArraySize = 100; // how many strings will be loaded at once
3215
3216	Procedure TListBoxStrings.LoadStrings( Strings: TStrings );
3217	var
3218	ArrayOfPChar: array[ 0..BufferArraySize-1 ] of pchar;
3219	ArrayOfCString: array[ 0..BufferArraySize-1 ] of cstring;
3220	StringIndex: longint;
3221	BufferIndex: longint;
3222	InitialCount: longint;
3223
3224	// This procedure sends the contents of the buffer
3225	// to PM (and instructs PM to sort the listbox, if specified)
3226	Procedure SendBuffer( Count: longint;
3227	Sort: Boolean );
3228	var
3229	ListBoxInfo: LBOXINFO;
3230	Begin
3231	if Sort then
3232	ListBoxInfo.lItemIndex:= LIT_SORTASCENDING
3233	else
3234	ListBoxInfo.lItemIndex:= LIT_END;
3235	ListBoxInfo.ulItemCount := Count;
3236	WinSendMsg( ListBox.Handle,
3237	LM_INSERTMULTITEMS,
3238	Mparam( Addr( ListBoxInfo ) ),
3239	Mparam( Addr( ArrayOfPChar ) ) );
3240	End;
3241
3242	begin
3243	InitialCount := ListBox.Items.Count;
3244
3245	BufferIndex := 0;
3246
3247	// Insert all strings
3248	for StringIndex := 0 to Strings.Count - 1 do
3249	begin
3250	// Copy string to buffer array
3251	ArrayOfCstring[ BufferIndex ] := Strings[ StringIndex ];
3252	// store pointer to the cstring
3253	ArrayOfPChar[ BufferIndex ]:= Addr( ArrayOfCstring[ BufferIndex ] );
3254	inc( BufferIndex );
3255
3256	if BufferIndex > BufferArraySize - 1 then
3257	begin
3258	// Buffer is full, send it, without sorting
3259	// so that we know the order of the added items
3260	SendBuffer( BufferArraySize, false );
3261	BufferIndex := 0;
3262	end;
3263	end;
3264
3265	if BufferIndex > 0 then
3266	// send remainder of strings
3267	SendBuffer( BufferIndex, false );
3268
3269	// Set associated objects. Unfortunately can't do this
3270	// in the LM_INSERTMULTITEMS message. However since we
3271	// have not sorted yet, we know the items have been inserted
3272	// in the same order we sent them
3273	for StringIndex := 0 to Strings.Count - 1 do
3274	begin
3275	WinSendMsg( ListBox.Handle,
3276	LM_SETITEMHANDLE,
3277	Mparam( InitialCount + StringIndex ),
3278	Mparam( Strings.Objects[ StringIndex ] ) );
3279	end;
3280
3281	// Finally sort the listbox, if needed
3282	If ListBox.FSorted then
3283	SendBuffer( 0, true );
3284
3285	End;
3286	{$endif}
3287
3288	Procedure TListBoxStrings.AddStrings( AStrings: TStrings );
3289	Begin
3290	{$ifdef os2}
3291	LoadStrings( AStrings ); // faster!
3292	{$else}
3293	Inherited AddStrings( AStrings );
3294	{$endif}
3295	End;
3296
3297	Function TListBoxStrings.Add(Const S:String):LongInt;
3298	Var CS:cstring;
3299	{$IFDEF OS2}
3300	Sort:LONG;
3301	{$ENDIF}
3302	{$IFDEF WIN32}
3303	s1:String;
3304	{$ENDIF}
3305	Begin
3306	If Not Listbox.Duplicates Then
3307	Begin
3308	Result := IndexOf(S);
3309	If Result >= 0 Then Exit;
3310	End;
3311
3312	{$IFDEF OS2}
3313	CS := S;
3314	If Listbox.FSorted Then Sort := LIT_SORTASCENDING
3315	Else Sort := LIT_END;
3316	Result := WinSendMsg(Listbox.Handle,LM_INSERTITEM,Sort,LongWord(@CS));
3317	{$ENDIF}
3318	{$IFDEF Win95}
3319	s1:=s;
3320	StrOemToAnsi(s1);
3321	cs:=s1;
3322	Result := SendMessage(Listbox.Handle,LB_ADDSTRING,0,LongWord(@CS));
3323	{$ENDIF}
3324	End;
3325
3326
3327	Procedure TListBoxStrings.Insert(Index:LongInt;Const S:String);
3328	Var CS:cstring;
3329	{$IFDEF WIN32}
3330	s1:String;
3331	{$ENDIF}
3332	Begin
3333	If (Index < 0) Or (Index > Count) Then indexerror;
3334
3335	{$IFDEF OS2}
3336	CS := S;
3337	WinSendMsg(Listbox.Handle,LM_INSERTITEM,Index,LongWord(@CS));
3338	{$ENDIF}
3339	{$IFDEF Win95}
3340	s1:=s;
3341	StrOemToAnsi(s1);
3342	cs:=s1;
3343	SendMessage(Listbox.Handle,LB_INSERTSTRING,0,LongWord(@CS));
3344	{$ENDIF}
3345	End;
3346
3347
3348	Procedure TListBoxStrings.Delete(Index:LongInt);
3349	Begin
3350	If (Index < 0) Or (Index >= Count) Then indexerror;
3351
3352	{$IFDEF OS2}
3353	WinSendMsg(Listbox.Handle,LM_DELETEITEM,Index,0);
3354	{$ENDIF}
3355	{$IFDEF Win95}
3356	SendMessage(Listbox.Handle,LB_DELETESTRING,Index,0);
3357	{$ENDIF}
3358	End;
3359
3360
3361	Procedure TListBoxStrings.Clear;
3362	Begin
3363	{$IFDEF OS2}
3364	WinSendMsg(Listbox.Handle,LM_DELETEALL,0,0);
3365	{$ENDIF}
3366	{$IFDEF Win95}
3367	SendMessage(Listbox.Handle,LB_RESETCONTENT,0,0);
3368	{$ENDIF}
3369	End;
3370
3371
3372	{$IFDEF OS2}
3373	Function TListBoxStrings.IndexOf(Const S:String):LongInt;
3374	Var CS:cstring;
3375	Begin
3376	CS := S;
3377	Result := WinSendMsg(Listbox.Handle,LM_SEARCHSTRING,
3378	MPFROM2SHORT(LSS_CASESENSITIVE,LIT_FIRST),
3379	LongWord(@CS));
3380	If Result In [LIT_ERROR,LIT_NONE] Then Result := -1;
3381	End;
3382	{$ENDIF}
3383
3384
3385	Procedure TListBoxStrings.indexerror;
3386	Begin
3387	Raise EListBoxIndexError.Create(LoadNLSStr(SInvalidListBoxItemIndex));
3388	End;
3389
3390	////////////////////////////////////////////////////////////////////////////
3391
3392	Procedure TListBox.KillFocus;
3393	Begin
3394	if FComboBox <> nil then
3395	if FComboBox.DroppedDown then
3396	FComboBox.DroppedDown := false;
3397	End;
3398
3399	Function TListBox.GetItemHeight:LongInt;
3400	Begin
3401	If FStyle = lbOwnerdrawFixed Then Result := FItemHeight
3402	Else Result := Font.Height;
3403	End;
3404
3405	Procedure TListBox.SetItemHeight(Value:LongInt);
3406	Begin
3407	If FItemHeight <> Value Then
3408	Begin
3409	FItemHeight := Value;
3410	If FStyle = lbOwnerdrawFixed Then RecreateWnd;
3411	End;
3412	End;
3413
3414
3415	Procedure TListBox.DrawDragRect;
3416	Begin
3417	If Canvas = Nil Then Exit;
3418	Canvas.Pen.Mode:=pmNot;
3419	Canvas.Pen.color:=clBlack;
3420	Canvas.Pen.Style:=psDot;
3421	Canvas.Rectangle(FDragRect);
3422	Canvas.Pen.Mode:=pmCopy;
3423	End;
3424
3425
3426	Procedure TListBox.DragOver(Source:TObject;X,Y:LongInt;State:TDragState;Var Accept:Boolean);
3427	Var Index:LongInt;
3428	Label invalid;
3429	Begin
3430	Index:=-1;
3431	Inherited DragOver(Source,X,Y,State,Accept);
3432	If FShowDragRects Then
3433	Begin
3434	If Accept Then
3435	Begin
3436	Index:=ItemAtPos(Point(X,Y),True);
3437	If Index<>-1 Then
3438	Begin
3439	Case State Of
3440	dsDragEnter:
3441	Begin
3442	CreateDragCanvas;
3443	If FDragRectValid Then DrawDragRect; //Delete old
3444	FDragRect := ItemRect(Index);
3445	FDragRectValid:=True;
3446	DrawDragRect; //Draw New
3447	DeleteDragCanvas;
3448	End;
3449	dsDragMove:
3450	If Index<>FDragSelected Then
3451	Begin
3452	CreateDragCanvas;
3453	If FDragRectValid Then DrawDragRect; //Delete old
3454	FDragRect := ItemRect(Index);
3455	FDragRectValid:=True;
3456	DrawDragRect; //Draw New
3457	DeleteDragCanvas;
3458	End;
3459	dsDragLeave:
3460	Begin
3461	If FDragRectValid Then
3462	Begin
3463	FDragRectValid:=False;
3464	CreateDragCanvas;
3465	DrawDragRect; //Delete old
3466	DeleteDragCanvas;
3467	End;
3468	End;
3469	End; //Case
3470	End
3471	Else Goto invalid;
3472	End
3473	Else
3474	Begin
3475	invalid:
3476	If FDragRectValid Then
3477	Begin
3478	FDragRectValid:=False;
3479	CreateDragCanvas;
3480	DrawDragRect; //Delete old
3481	DeleteDragCanvas;
3482	End;
3483	End;
3484	FDragSelected:=Index;
3485	End;
3486	End;
3487
3488
3489	Procedure TListBox.DragDrop(Source:TObject;X,Y:LongInt);
3490	Begin
3491	If FDragRectValid Then
3492	Begin
3493	CreateDragCanvas;
3494	DrawDragRect; //Delete old
3495	DeleteDragCanvas;
3496	FDragRectValid:=False;
3497	End;
3498	Inherited DragDrop(Source,X,Y);
3499	End;
3500
3501
3502	Function TListBox.ItemAtPos(Pos:TPoint;existing:Boolean):LongInt;
3503	Var aBottom,aTop:LongInt;
3504	Begin
3505	If PointInRect(Pos,ClientRect) Then
3506	Begin
3507	Result := TopIndex;
3508	aBottom := Height-ItemHeight-3;
3509	aTop := Height-3;
3510
3511	While Result < Items.Count Do
3512	Begin
3513	If Pos.Y >= aBottom Then
3514	If Pos.Y < aTop Then Exit; //found
3515	Dec(aTop,ItemHeight);
3516	Dec(aBottom,ItemHeight);
3517	Inc(Result);
3518	End;
3519	If Not existing Then Exit;
3520	End;
3521	Result := -1;
3522	End;
3523
3524
3525	Function TListBox.ItemRect(Index:LongInt):TRect;
3526	Var I:LongInt;
3527	Begin
3528	If Index <= Items.Count Then
3529	Begin
3530	Result.Left := 2;
3531	Result.Right := Width-4;
3532	Result.Bottom := Height-ItemHeight-3;
3533	Result.Top := Height-3;
3534	For I := TopIndex To Index-1 Do
3535	Begin
3536	Dec(Result.Top,ItemHeight);
3537	Dec(Result.Bottom,ItemHeight);
3538	End;
3539	End
3540	Else FillChar(Result,SizeOf(Result),0);
3541	End;
3542
3543
3544	Procedure TListBox.GetClassData(Var ClassData:TClassData);
3545	Begin
3546	Inherited GetClassData(ClassData);
3547
3548	{$IFDEF Win95}
3549	CreateSubClass(ClassData,'LISTBOX');
3550	{$ENDIF}
3551	{$IFDEF OS2}
3552	ClassData.ClassULong := WC_LISTBOX;
3553	{$ENDIF}
3554	End;
3555
3556
3557	Procedure TListBox.SetupComponent;
3558	Begin
3559	Inherited SetupComponent;
3560
3561	Name := 'ListBox';
3562	Height := 100;
3563	Width := 130;
3564	Ownerdraw := False;
3565	color := clEntryField;
3566	ParentPenColor := False;
3567	ParentColor := False;
3568
3569	FItems := TListBoxStrings.Create;
3570	TListBoxStrings(FItems).Listbox := Self;
3571	FInitItems.Create;
3572	FStyle := lbStandard;
3573	FIntegralHeight := False;
3574	FHorzScroll := False;
3575	FMultiSelect := False;
3576	FExtendedSelect := False;
3577	FDuplicates := True;
3578	FSorted := False;
3579	FItemHeight := Font.Height;
3580	FUpdateCount := 0;
3581	FInitItemIndex := -1;
3582	End;
3583
3584
3585	Procedure TListBox.CreateParams(Var Params:TCreateParams);
3586	Begin
3587	Inherited CreateParams(Params);
3588
3589	{$IFDEF OS2}
3590	If Not FIntegralHeight Then Params.Style := Params.Style Or LS_NOADJUSTPOS;
3591	If FHorzScroll Then Params.Style := Params.Style Or LS_HORZSCROLL;
3592	If FMultiSelect Then Params.Style := Params.Style Or LS_MULTIPLESEL;
3593	If FExtendedSelect Then Params.Style := Params.Style Or LS_EXTENDEDSEL;
3594	If FStyle = lbOwnerdrawFixed Then Params.Style := Params.Style Or LS_OWNERDRAW;
3595	{$ENDIF}
3596
3597	{$IFDEF Win95}
3598	Params.Style := Params.Style Or WS_BORDER Or LBS_NOTIFY Or WS_VSCROLL;
3599	Params.ExStyle := Params.ExStyle Or WS_EX_CLIENTEDGE;
3600
3601	If Not FIntegralHeight Then Params.Style := Params.Style Or LBS_NOINTEGRALHEIGHT;
3602	If FHorzScroll Then Params.Style := Params.Style Or WS_HSCROLL;
3603	If FMultiSelect Then Params.Style := Params.Style Or LBS_MULTIPLESEL;
3604	If FExtendedSelect Then Params.Style := Params.Style Or LBS_EXTENDEDSEL;
3605	If FStyle = lbOwnerdrawFixed Then
3606	Params.Style := Params.Style Or LBS_OWNERDRAWFIXED OR LBS_HASSTRINGS;
3607	If FSorted Then Params.Style := Params.Style Or LBS_SORT;
3608	{$ENDIF}
3609	End;
3610
3611
3612	Procedure TListBox.SetupShow;
3613	Begin
3614	Inherited SetupShow;
3615
3616	FItems.Assign(FInitItems);
3617	FInitItems.Clear;
3618
3619	If Style = lbOwnerdrawFixed Then
3620	Begin
3621	CreateCanvas;
3622	Canvas.OwnerDraw:=True;
3623	End;
3624
3625	If (FInitItemIndex >= 0) And (FInitItemIndex < Items.Count) Then
3626	Begin
3627	ItemIndex := FInitItemIndex;
3628	TopIndex := FInitTopIndex;
3629	End;
3630	End;
3631
3632
3633	Procedure TListBox.Show;
3634	Begin
3635	Inherited Show;
3636	End;
3637
3638
3639	Procedure TListBox.DestroyWnd;
3640	Begin
3641	If Handle <> 0 Then
3642	If FInitItems <> Nil Then
3643	Begin
3644	FInitItems.Assign(FItems);
3645	FInitItemIndex := ItemIndex;
3646	FInitTopIndex := TopIndex;
3647	End;
3648
3649	Inherited DestroyWnd;
3650	End;
3651
3652
3653	Destructor TListBox.Destroy;
3654	Begin
3655	FItems.Destroy;
3656	FItems := Nil;
3657	FInitItems.Destroy;
3658	FInitItems := Nil;
3659
3660	Inherited Destroy;
3661	End;
3662
3663
3664	Procedure TListBox.SetIntegralHeight(Value:Boolean);
3665	Begin
3666	If FIntegralHeight <> Value Then
3667	Begin
3668	FIntegralHeight := Value;
3669	RecreateWnd;
3670	End;
3671	End;
3672
3673
3674	Procedure TListBox.SetHorzScroll(Value:Boolean);
3675	Begin
3676	If FHorzScroll <> Value Then
3677	Begin
3678	FHorzScroll := Value;
3679	RecreateWnd;
3680	End;
3681	End;
3682
3683
3684	Procedure TListBox.SetMultiSelect(Value:Boolean);
3685	Begin
3686	If FMultiSelect <> Value Then
3687	Begin
3688	FMultiSelect := Value;
3689	RecreateWnd;
3690	End;
3691	End;
3692
3693
3694	Procedure TListBox.SetExtendedSelect(Value:Boolean);
3695	Begin
3696	If FExtendedSelect <> Value Then
3697	Begin
3698	FExtendedSelect := Value;
3699	RecreateWnd;
3700	End;
3701	End;
3702
3703
3704	Procedure TListBox.SetSorted(Value:Boolean);
3705	Begin
3706	If FSorted <> Value Then
3707	Begin
3708	FSorted := Value;
3709	If Handle <> 0 Then
3710	RecreateWnd
3711	else
3712	FInitItems.Sorted := Value;
3713	End;
3714	End;
3715
3716
3717	Procedure TListBox.SetStyle(NewStyle:TListBoxStyle);
3718	Begin
3719	If FStyle <> NewStyle Then
3720	Begin
3721	FStyle := NewStyle;
3722	RecreateWnd;
3723	End;
3724	End;
3725
3726
3727	Procedure TListBox.Clear;
3728	Begin
3729	Items.Clear;
3730	End;
3731
3732
3733	Function TListBox.GetItems:TStrings;
3734	Begin
3735	If Handle <> 0 Then Result := FItems
3736	Else Result := FInitItems;
3737	End;
3738
3739
3740	Procedure TListBox.SetItems(AStrings:TStrings);
3741	Begin
3742	If AStrings <> Items Then Items.Assign(AStrings);
3743	End;
3744
3745
3746	Function TListBox.GetItemIndex:LongInt;
3747	Begin
3748	If Handle <> 0 Then
3749	Begin
3750	{$IFDEF OS2}
3751	Result := WinSendMsg(Handle,LM_QUERYSELECTION,LIT_CURSOR,0);
3752	{$ENDIF}
3753	{$IFDEF Win95}
3754	Result := SendMessage(Handle,LB_GETCURSEL,0,0);
3755	{$ENDIF}
3756	End
3757	Else Result := FInitItemIndex;
3758	End;
3759
3760
3761	Procedure TListBox.SetItemIndex(Value:LongInt);
3762	Begin
3763	If Handle <> 0 Then
3764	Begin
3765	If GetItemIndex <> Value Then
3766	Begin
3767	{$IFDEF OS2}
3768	If FMultiSelect Then WinSendMsg(Handle,LM_SELECTITEM,LIT_NONE,0);
3769	WinSendMsg(Handle,LM_SELECTITEM,Value,1);
3770	{$ENDIF}
3771	{$IFDEF Win95}
3772	SendMessage(Handle,LB_SETCURSEL,Value,0);
3773	{$ENDIF}
3774	End;
3775	End;
3776	FInitItemIndex := Value;
3777	End;
3778
3779
3780	Function TListBox.GetSelCount:LongInt;
3781	Var I:LongInt;
3782	Begin
3783	If Handle <> 0 Then
3784	Begin
3785	{$IFDEF OS2}
3786	If FMultiSelect Then
3787	Begin
3788	I := LIT_FIRST;
3789	Result := 0;
3790	While True Do
3791	Begin
3792	I := WinSendMsg(Handle,LM_QUERYSELECTION,I,0);
3793	If I = LIT_NONE Then break;
3794	Inc(Result);
3795	End;
3796	End
3797	Else If WinSendMsg(Handle,LM_QUERYSELECTION,LIT_FIRST,0) <> LIT_NONE
3798	Then Result := 1
3799	Else Result := 0;
3800	{$ENDIF}
3801	{$IFDEF Win95}
3802	Result := SendMessage(Handle,LB_GETSELCOUNT,0,0);
3803	{$ENDIF}
3804	End
3805	Else Result := 0;
3806	End;
3807
3808
3809	Function TListBox.GetSelect(Index:LongInt):Boolean;
3810	Begin
3811	If Handle <> 0 Then
3812	Begin
3813	{$IFDEF OS2}
3814	Result := WinSendMsg(Handle,LM_QUERYSELECTION,Index-1,0) = Index;
3815	{$ENDIF}
3816	{$IFDEF Win95}
3817	Result := SendMessage(Handle,LB_GETSEL,Index,0) <> 0;
3818	{$ENDIF}
3819	End
3820	Else Result := False;
3821	End;
3822
3823
3824	Procedure TListBox.SetSelect(Index:LongInt;Value:Boolean);
3825	Begin
3826	If Handle <> 0 Then
3827	Begin
3828	{$IFDEF OS2}
3829	WinSendMsg(Handle,LM_SELECTITEM,Index,LongWord(Value));
3830	{$ENDIF}
3831	{$IFDEF Win95}
3832	SendMessage(Handle,LB_SETSEL,LongWord(Value),Index);
3833	{$ENDIF}
3834	End;
3835	End;
3836
3837
3838	Function TListBox.GetTopIndex:LongInt;
3839	Begin
3840	If Handle <> 0 Then
3841	Begin
3842	{$IFDEF OS2}
3843	Result := WinSendMsg(Handle,LM_QUERYTOPINDEX,0,0);
3844	{$ENDIF}
3845	{$IFDEF Win95}
3846	Result := SendMessage(Handle,LB_GETTOPINDEX,0,0);
3847	{$ENDIF}
3848	End
3849	Else Result := 0;
3850	End;
3851
3852
3853	Procedure TListBox.SetTopIndex(Index:LongInt);
3854	Begin
3855	If Handle <> 0 Then
3856	Begin
3857	{$IFDEF OS2}
3858	WinSendMsg(Handle,LM_SETTOPINDEX,Index,0);
3859	{$ENDIF}
3860	{$IFDEF Win95}
3861	SendMessage(Handle,LB_SETTOPINDEX,Index,0);
3862	{$ENDIF}
3863	End;
3864	FInitTopIndex := Index;
3865	End;
3866
3867	Procedure TListBox.ParentNotification(Var Msg:TMessage);
3868	Var Index:LongInt;
3869	CX,CY:LongInt;
3870	State:TOwnerDrawState;
3871	{$IFDEF OS2}
3872	OwnerItem:POwnerItem;
3873	rec:TRect;
3874	clip:TRect;
3875	{$ENDIF}
3876	{$IFDEF Win95}
3877	Measure_Item:^MEASUREITEMSTRUCT;
3878	Draw_Item:^DRAWITEMSTRUCT;
3879	rclItem:TRect;
3880	L:LongInt;
3881	OldPS:LongWord;
3882	{$ENDIF}
3883	Begin
3884	Inherited ParentNotification(Msg); {call DefaultHandler}
3885
3886	{$IFDEF OS2}
3887	Case Msg.Msg Of
3888	WM_CONTROL:
3889	Begin
3890	If FUpdateCount > 0 Then Exit;
3891	Case Msg.Param1Hi Of
3892	LN_ENTER:
3893	Begin
3894	Index := ItemIndex;
3895	If (Index < 0) Or (Index >= Items.Count) Then Exit;
3896	ItemSelect(Index);
3897	Msg.Handled := True;
3898	End;
3899	LN_SELECT:
3900	Begin
3901	ItemFocus(ItemIndex);
3902	Msg.Handled := True;
3903	End;
3904	End;
3905	End;
3906	WM_MEASUREITEM:
3907	Begin
3908	MeasureItem(Msg.Param2,CX,CY);
3909	If OnMeasureItem <> Nil Then OnMeasureItem(Self,Msg.Param2,CX,CY);
3910	Msg.Handled := True;
3911	Msg.Result := CY + 65536 * CX;
3912	End;
3913	WM_DRAWITEM:
3914	Begin
3915	If Canvas = Nil Then Exit;
3916	If Items = Nil Then Exit;
3917	OwnerItem := Pointer(Msg.Param2);
3918	If OwnerItem <> Nil Then
3919	If OwnerItem^.iditem >= 0 Then
3920	If OwnerItem^.iditem < Items.Count Then
3921	Begin
3922	rec := TRect(OwnerItem^.rclItem);
3923	Dec(rec.Left);
3924	clip := rec;
3925	clip.Left := 2;
3926	Dec(clip.Right);
3927	If clip.Bottom < 2 Then clip.Bottom := 2;
3928	Canvas.ClipRect := clip;
3929
3930	State := [];
3931	If OwnerItem^.fsState And 1=1 Then Include(State,odSelected);
3932	{...}
3933	OwnerItem^.fsState := 0;
3934	OwnerItem^.fsStateOld := 0;
3935	DrawItem(OwnerItem^.iditem,rec,State);
3936	If OnDrawItem <> Nil
3937	Then OnDrawItem(Self,OwnerItem^.iditem,rec,State);
3938	Msg.Handled := True;
3939	Msg.Result := 1;
3940	End;
3941	End;
3942	End;
3943	{$ENDIF}
3944
3945	{$IFDEF Win95}
3946	Case Msg.Msg Of
3947	WM_COMMAND:
3948	Begin
3949	Msg.Handled:=True; //!!
3950	If FUpdateCount > 0 Then Exit;
3951	Index := ItemIndex;
3952	If (Index < 0) Or (Index >= Items.Count) Then Exit;
3953	Case Msg.Param1Hi Of
3954	LBN_DBLCLK:ItemSelect(Index);
3955	LBN_SELCHANGE:ItemFocus(Index);
3956	End;
3957	End;
3958	WM_MEASUREITEM:
3959	Begin
3960	Measure_Item := Pointer(Msg.Param2);
3961	MeasureItem(0,CX,CY); {Index 0 ?}
3962	If OnMeasureItem <> Nil Then OnMeasureItem(Self,0,CX,CY);
3963	Measure_Item^.ItemHeight := CY;
3964	Msg.Handled := True;
3965	Msg.Result := 1;
3966	End;
3967	WM_DRAWITEM:
3968	Begin
3969	If Canvas = Nil Then Exit;
3970	If Items = Nil Then Exit;
3971	Draw_Item := Pointer(Msg.Param2);
3972	OldPS := Canvas.Handle;
3973	Canvas.Handle := Draw_Item^.HDC;
3974	{Canvas.Font := Canvas.Font;} //This causes recursion ??
3975	SetTextAlign(Canvas.Handle,TA_LEFT Or TA_BOTTOM);
3976	Index:=Draw_Item^.ItemId;
3977	If Index >= 0 Then
3978	If Index < Items.Count Then
3979	Begin
3980	State := [];
3981	If Draw_Item^.ItemState And ODS_SELECTED <> 0
3982	Then Include(State,odSelected);
3983	{...}
3984	rclItem := TRect(Draw_Item^.rcItem);
3985	L := rclItem.Top;
3986	rclItem.Top := rclItem.Bottom;
3987	rclItem.Bottom := L;
3988	TransformRectToOS2(rclItem,Self,Nil);
3989	DrawItem(Index,rclItem,State);
3990	If OnDrawItem <> Nil
3991	Then OnDrawItem(Self,Index,rclItem,State);
3992	Msg.Handled := True;
3993	Msg.Result := 1;
3994	End;
3995	Canvas.Handle := OldPS;
3996	End;
3997	End;
3998	{$ENDIF}
3999	End;
4000
4001
4002	{$HINTS OFF}
4003	Procedure TListBox.ItemSelect(Index:LongInt);
4004	Begin
4005	If FComboBox <> Nil Then
4006	Begin
4007	If FComboBox.Style <> csSimple Then
4008	FComboBox.DroppedDown := False; {wirkt nur bei DropDownCombo}
4009	FComboBox.ItemSelect(Index);
4010	Exit;
4011	End;
4012
4013	If OnItemSelect <> Nil Then OnItemSelect(Self,Index);
4014	End;
4015
4016
4017	Procedure TListBox.ItemFocus(Index:LongInt);
4018	Begin
4019	If FComboBox <> Nil Then
4020	Begin
4021	FComboBox.ItemFocus(Index);
4022	Exit;
4023	End;
4024
4025	If OnItemFocus <> Nil Then OnItemFocus(Self,Index);
4026	End;
4027	{$HINTS ON}
4028
4029
4030	Procedure TListBox.MeasureItem(Index:LongInt;Var Width,Height:LongInt);
4031	Begin
4032	Width := 0; {Standard}
4033	Height := FItemHeight;
4034	If Canvas = Nil Then
4035	Begin
4036	If FStyle = lbOwnerdrawFixed Then
4037	Begin
4038	If Handle=0 Then exit; //sinnlos ein Canvas zu erzeugen...
4039	CreateCanvas;
4040	End
4041	Else Exit;
4042	End;
4043	If FStyle = lbOwnerdrawFixed Then Canvas.OwnerDraw:=True;
4044
4045	If (Index >= 0) And (Index < Items.Count) Then
4046	Begin
4047	Canvas.GetTextExtent(Items.Strings[Index],Width,Height);
4048	If FItemHeight > Height Then Height := FItemHeight;
4049	End;
4050	End;
4051
4052
4053	Procedure TListBox.DrawItem(Index:LongInt;rec:TRect;State:TOwnerDrawState);
4054	Var X,Y,CX,CY,cx1,cy1:LongInt;
4055	S:String;
4056	Begin
4057	If FOnDrawItem <> Nil Then Exit;
4058	If FStyle = lbOwnerdrawFixed Then Canvas.OwnerDraw:=True;
4059
4060	If State * [odSelected] <> [] Then
4061	Begin
4062	Canvas.Pen.color := clHighlightText;
4063	Canvas.Brush.color := clHighlight;
4064	End Else
4065	Begin
4066	Canvas.Pen.color := PenColor;
4067	Canvas.Brush.color := color;
4068	End;
4069	Canvas.FillRect(rec,Canvas.Brush.color);
4070	X := rec.Left + 2;
4071	Y := rec.Bottom;
4072	CX := rec.Right - X;
4073	CY := rec.Top - Y;
4074
4075	S := Items.Strings[Index];
4076	Canvas.GetTextExtent(S,cx1,cy1);
4077	Y := Y + ((CY - cy1) Div 2);
4078	If Y < rec.Bottom Then Y := rec.Bottom;
4079	Canvas.Brush.Mode := bmTransparent;
4080	Canvas.TextOut(X,Y,S);
4081	End;
4082
4083
4084	Procedure TListBox.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
4085	Begin
4086	Inherited MouseDown(Button,ShiftState,X,Y);
4087
4088	If Button = mbLeft Then FDragging := True;
4089	End;
4090
4091
4092	Procedure TListBox.MouseUp(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
4093	Begin
4094	LastMsg.CallDefaultHandler; {ensure the Selection Is up To date}
4095
4096	Inherited MouseUp(Button,ShiftState,X,Y);
4097
4098	If Button = mbLeft Then
4099	Begin
4100	If FComboBox <> Nil Then
4101	FComboBox.ListBoxMouseUp;
4102	If Not FDragging Then Exit;
4103	End;
4104	End;
4105
4106
4107	{$HINTS OFF}
4108	Procedure TListBox.CharEvent(Var key:Char;RepeatCount:Byte);
4109	Begin
4110	{no Inherited call, To avoid passing the key To the Form}
4111	End;
4112	{$HINTS ON}
4113
4114
4115	Procedure TListBox.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
4116	Var idx:LongInt;
4117	Begin
4118	Case KeyCode Of
4119	kbCUp,kbCDown: ; {!}
4120	{$IFDEF OS2}
4121	//kbCR: ; {!}
4122	kbCR: {handle CR and don't forward to parent window}
4123	Begin
4124	idx := ItemIndex;
4125	If (idx < 0) Or (idx >= Items.Count) Then Exit;
4126	ItemSelect(idx);
4127
4128	KeyCode := kbNull;
4129	End;
4130	kbEsc:
4131	Begin
4132	If FComboBox <> Nil Then
4133	If FComboBox.FStyle <> csSimple Then
4134	FComboBox.DroppedDown := false;
4135	End;
4136	{$ENDIF}
4137	{$IFDEF Win95}
4138	kbCR:
4139	Begin
4140	idx := ItemIndex;
4141	If FComboBox <> Nil Then
4142	If FComboBox.FStyle <> csSimple Then ItemSelect(idx);
4143
4144	KeyCode := kbNull;
4145	End;
4146	{$ENDIF}
4147	kbAltCUp: If FComboBox <> Nil Then FComboBox.DroppedDown := False;
4148	Else Inherited ScanEvent(KeyCode,RepeatCount);
4149	End;
4150	End;
4151
4152
4153	Procedure TListBox.BeginUpdate;
4154	Begin
4155	If FUpdateCount = 0 Then
4156	Begin
4157	If (Handle <> 0) And Visible Then
4158	Begin
4159	FEnableWindowUpdate := True;
4160	{$IFDEF OS2}
4161	WinEnableWindowUpdate(Handle,False);
4162	{$ENDIF}
4163	{$IFDEF Win95}
4164	SendMessage(Handle,WM_SETREDRAW,0,0);
4165	{$ENDIF}
4166	End;
4167	End;
4168	Inc(FUpdateCount);
4169	End;
4170
4171
4172	Procedure TListBox.EndUpdate;
4173	Begin
4174	If FUpdateCount=0 Then Exit;
4175	Dec(FUpdateCount);
4176	If FUpdateCount = 0 Then
4177	Begin
4178	If (Handle <> 0) And FEnableWindowUpdate Then
4179	Begin
4180	FEnableWindowUpdate := False;
4181	{$IFDEF OS2}
4182	WinEnableWindowUpdate(Handle,True);
4183	{$ENDIF}
4184	{$IFDEF Win95}
4185	SendMessage(Handle,WM_SETREDRAW,1,0);
4186	{$ENDIF}
4187	End;
4188	End;
4189	End;
4190
4191
4192	Function TListBox.WriteSCUResource(Stream:TResourceStream):Boolean;
4193	Var aText:PChar;
4194	Begin
4195	Result := Inherited WriteSCUResource(Stream);
4196	If Not Result Then Exit;
4197
4198	aText := Items.GetText;
4199	If aText <> Nil Then
4200	Begin
4201	Result := Stream.NewResourceEntry(rnItems,aText^,Length(aText^)+1);
4202	StrDispose(aText);
4203	End;
4204	End;
4205
4206
4207	Procedure TListBox.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
4208	Var aText:PChar;
4209	Begin
4210	If ResName = rnItems Then
4211	Begin
4212	aText := @Data;
4213	Items.SetText(aText);
4214	End
4215	Else Inherited ReadSCUResource(ResName,Data,DataLen)
4216	End;
4217
4218
4219	{
4220	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
4221	º º
4222	º Speed-Pascal/2 Version 2.0 º
4223	º º
4224	º Speed-Pascal Component Classes (SPCC) º
4225	º º
4226	º This section: TGroupBox Class Implementation º
4227	º º
4228	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
4229	º º
4230	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
4231	}
4232
4233	Procedure TGroupBox.SetupComponent;
4234	Begin
4235	Inherited SetupComponent;
4236
4237	Name:='GroupBox';
4238	Caption:=Name;
4239	Height:=100;
4240	Width:=130;
4241	ParentPenColor:=True;
4242	ParentColor:=True;
4243	CursorTabStop:=False;
4244	TabStop:=False;
4245	ZOrder:=zoBottom;
4246	Include(ComponentState, csAcceptsControls);
4247	End;
4248
4249
4250	Procedure TGroupBox.Redraw(Const rec:TRect);
4251	Var S:String;
4252	rcy,CX,CY:LongInt;
4253	rc1,rctext:TRect;
4254	LightColor,DarkColor:TColor;
4255	P:Integer;
4256	Begin
4257	If Canvas = Nil Then Exit;
4258	Inherited Redraw(rec);
4259
4260	rc1 := ClientRect;
4261	rcy := rc1.Top;
4262
4263	If Caption <> '' Then
4264	Begin
4265	Dec(rc1.Top,Canvas.Font.Height Div 2);
4266	Canvas.Pen.color := PenColor;
4267	Canvas.Brush.color := color;
4268	Canvas.Brush.Mode := bmTransparent;
4269	S := Caption;
4270	P := Pos('~',S); { & }
4271	If P = Length(S) Then P := 0;
4272	If P > 0 Then Delete(S,P,1);
4273	Canvas.GetTextExtent(S,CX,CY);
4274	rctext.Left := 10;
4275	rctext.Bottom := rcy-Canvas.Font.Height;
4276	rctext.Right := rctext.Left + CX;
4277	rctext.Top := rctext.Bottom + CY;
4278	If P = 0 Then Canvas.TextOut(rctext.Left,rctext.Bottom, Caption)
4279	Else Canvas.MnemoTextOut(rctext.Left,rctext.Bottom, Caption);
4280	Canvas.ExcludeClipRect(rctext);
4281	End;
4282
4283	Case Application.Platform Of
4284	Win32,OS2Ver40:
4285	Begin
4286	DarkColor := clDkGray;
4287	LightColor := clWhite;
4288	End;
4289	Else
4290	Begin
4291	DarkColor := clWindowFrame;
4292	LightColor := clBtnHighlight;
4293	End;
4294	End;
4295
4296	DrawSystemFrame(Self,rc1,LightColor,DarkColor);
4297
4298	Canvas.DeleteClipRegion;
4299	End;
4300
4301
4302	Procedure TGroupBox.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
4303	Begin
4304	Inherited MouseDown(Button,ShiftState,X,Y);
4305
4306	If Button = mbLeft Then
4307	If Form Is TForm Then
4308	Begin
4309	Form.BringToFront;
4310
4311	LastMsg.Handled:=True; {!!}
4312	LastMsg.Result:=0;
4313	End;
4314	End;
4315
4316
4317	{$HINTS OFF}
4318	Procedure TGroupBox.CMTextChanged(Var Msg:TMessage);
4319	Begin
4320	Invalidate;
4321	End;
4322	{$HINTS ON}
4323
4324
4325	Function TGroupBox.EvaluateShortCut(KeyCode:TKeyCode):Boolean;
4326	Var S:String;
4327	P:Integer;
4328	key:TKeyCode;
4329	FocusControl:TControl;
4330	Begin
4331	FocusControl := GetFirstTabControl( nil, false );
4332	if FocusControl = nil Then
4333	FocusControl := Nil;
4334
4335	S := Caption;
4336	P := Pos('~',S); { & }
4337	If (P > 0) And (P < Length(S)) Then
4338	Begin
4339	key := (Ord(S[P+1]) Or $20) + kb_Alt + kb_Char;
4340	If key = KeyCode Then {found}
4341	If FocusControl <> Nil Then
4342	Begin
4343	Result := True;
4344	Try
4345	FocusControl.Focus;
4346	Except
4347	Result := False;
4348	End;
4349	If Result Then Exit;
4350	End;
4351	End;
4352	Result := Inherited EvaluateShortCut(KeyCode);
4353	End;
4354
4355
4356	{
4357	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
4358	º º
4359	º Speed-Pascal/2 Version 2.0 º
4360	º º
4361	º Speed-Pascal Component Classes (SPCC) º
4362	º º
4363	º This section: TLabel Class Implementation º
4364	º º
4365	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
4366	º º
4367	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
4368	}
4369
4370	Procedure TLabel.SetupComponent;
4371	Begin
4372	Inherited SetupComponent;
4373
4374	Name := 'Label';
4375	Caption := Name;
4376	Height := 20;
4377	Width := 100;
4378	ParentPenColor := True;
4379	ParentColor := True;
4380	CursorTabStop := False;
4381	TabStop := False;
4382	FAutoSize := False;
4383	FAlignment := taLeftJustify;
4384	FWordWrap := False;
4385	FRows := 1;
4386	FFocusControl := Nil;
4387	FShowAccelChar := True;
4388	End;
4389
4390	Procedure TLabel.SetupShow;
4391	Begin
4392	Inherited SetupShow;
4393
4394	SetAutoSize(FAutoSize);
4395	End;
4396
4397	{$HINTS OFF}
4398	Procedure TLabel.CMTextChanged(Var Msg:TMessage);
4399	Begin
4400	Invalidate;
4401	SetAutoSize(FAutoSize);
4402	End;
4403	{$HINTS ON}
4404
4405	Procedure TLabel.SetAutoSize(Value:Boolean);
4406	Var CX,CY:LongInt;
4407	S:String;
4408	P:Integer;
4409	Begin
4410	FAutoSize := Value;
4411	If FAutoSize Then
4412	Begin
4413	FWordWrap := False;
4414	If Canvas <> Nil Then
4415	Begin
4416	S := Caption;
4417	If FShowAccelChar Then
4418	Begin
4419	P := Pos('~',S); { & }
4420	If (P > 0) And (P < Length(S)) Then Delete(S,P,1);
4421	End;
4422	Canvas.GetTextExtent(S,CX,CY);
4423	SetWindowPos(Left,Bottom,CX,CY);
4424	End;
4425	End;
4426	End;
4427
4428	Procedure TLabel.SetAlignment(Value:TAlignment);
4429	Begin
4430	If Value <> FAlignment Then
4431	Begin
4432	FAlignment := Value;
4433	If Handle <> 0 Then Invalidate;
4434	End;
4435	End;
4436
4437	Procedure TLabel.SetWordWrap(Value:Boolean);
4438	Begin
4439	If Value <> FWordWrap Then
4440	Begin
4441	FWordWrap := Value;
4442	If FWordWrap Then FAutoSize := False;
4443	If Handle <> 0 Then Invalidate;
4444	End;
4445	End;
4446
4447	Procedure TLabel.SetAccelChar(Value:Boolean);
4448	Begin
4449	If FShowAccelChar <> Value Then
4450	Begin
4451	FShowAccelChar := Value;
4452	Invalidate;
4453	End;
4454	End;
4455
4456	Procedure TLabel.SetFocusControl(Value:TControl);
4457	Begin
4458	FFocusControl := Value;
4459	If FFocusControl <> Nil Then FFocusControl.FreeNotification(Self);
4460	End;
4461
4462	Procedure TLabel.Notification(AComponent:TComponent;Operation:TOperation);
4463	Begin
4464	Inherited Notification(AComponent,Operation);
4465
4466	If Operation = opRemove Then
4467	If AComponent = FFocusControl Then FFocusControl := Nil;
4468	End;
4469
4470	Function TLabel.GetRows:Integer;
4471	Var S,s1,news:String;
4472	P,p10,I:Integer;
4473	CX,CY:LongInt;
4474	forcebreak:Boolean;
4475	Begin
4476	If (Handle <> 0) And (Not Visible) Then
4477	Begin
4478	Result := 1;
4479	If FWordWrap Then
4480	Begin
4481	S := Caption;
4482	Repeat
4483	I := Pos(#13#10,S);
4484	If I > 0 Then Delete(S,I,1);
4485	Until I = 0;
4486
4487	Repeat
4488	I := Pos(#10#13,S);
4489	If I > 0 Then Delete(S,I+1,1);
4490	Until I = 0;
4491
4492	For I := 1 To Length(S) Do
4493	If S[I] = #13 Then S[I] := #10;
4494
4495	news := '';
4496	While S <> '' Do
4497	Begin
4498	P := Pos(' ',S);
4499	p10 := Pos(#10,S);
4500	{Select First separator}
4501	forcebreak := False;
4502	If p10 > 0 Then
4503	Begin
4504	If (P > p10) Or (P = 0) Then
4505	Begin
4506	S[p10] := ' ';
4507	forcebreak := True;
4508	P := p10;
4509	End;
4510	End;
4511
4512	If P > 0 Then s1 := Copy(S,1,P)
4513	Else s1 := S;
4514	Delete(S,1,Length(s1)); {s1 Is the First Word Of S}
4515
4516	Canvas.GetTextExtent(news+s1,CX,CY);
4517	If CX > Width Then
4518	Begin
4519	If news <> '' Then news := s1;
4520	Inc(Result);
4521	End
4522	Else news := news + s1;
4523
4524	If forcebreak And (news <> '') Then
4525	Begin
4526	Inc(Result);
4527	news := '';
4528	End;
4529
4530	If S = '' Then Inc(Result);
4531	End;
4532	End;
4533	End
4534	Else Result := FRows;
4535	End;
4536
4537	Procedure TLabel.DoDrawLine(Const S:String; Var Row:Integer);
4538	Var X,Y,CX,CY:LongInt;
4539	drawMnemo:Boolean;
4540	s1:String;
4541	P:Integer;
4542	Begin
4543	If S = '' Then Exit;
4544	s1 := S;
4545
4546	drawMnemo := False;
4547	If RemoveAccel Then
4548	Begin
4549	P := Pos('~',s1); { & }
4550	If (P > 0) And (P < Length(s1)) Then
4551	Begin
4552	Delete(s1,P,1);
4553	RemoveAccel := False;
4554	drawMnemo := True;
4555	End;
4556	End;
4557
4558	Canvas.GetTextExtent(s1,CX,CY);
4559
4560	Case FAlignment Of
4561	taLeftJustify: X := 0;
4562	taRightJustify: X := Width - CX;
4563	taCenter: X := (Width - CX) Div 2;
4564	End;
4565	Y := Height - (Row * CY);
4566
4567	If drawMnemo Then
4568	Begin
4569	Insert('~',s1,P);
4570	Canvas.MnemoTextOut(X,Y,s1);
4571	End
4572	Else Canvas.TextOut(X,Y,s1);
4573
4574	FRows := Row;
4575	Inc(Row);
4576	End;
4577
4578	Procedure TLabel.Redraw(Const rec:TRect);
4579	Var S,s1,news:String;
4580	Row,P,p10,I:Integer;
4581	CX,CY:LongInt;
4582	forcebreak:Boolean;
4583	Begin
4584	If Canvas = Nil Then Exit;
4585
4586	Canvas.Pen.color := PenColor;
4587	Canvas.Brush.color := color;
4588
4589	Inherited Redraw(rec);
4590
4591	RemoveAccel := FShowAccelChar;
4592	Row := 1;
4593	If FWordWrap Then
4594	Begin
4595	S := Caption;
4596	Repeat
4597	I := Pos(#13#10,S);
4598	If I > 0 Then Delete(S,I,1);
4599	Until I = 0;
4600
4601	Repeat
4602	I := Pos(#10#13,S);
4603	If I > 0 Then Delete(S,I+1,1);
4604	Until I = 0;
4605
4606	For I := 1 To Length(S) Do
4607	If S[I] = #13 Then S[I] := #10;
4608
4609	news := '';
4610	While S <> '' Do
4611	Begin
4612	{Search most Left separator}
4613	P := Pos(' ',S);
4614	p10 := Pos(#10,S);
4615
4616	{Select First separator}
4617	forcebreak := False;
4618	If p10 > 0 Then
4619	Begin
4620	If (P > p10) Or (P = 0) Then
4621	Begin
4622	S[p10] := ' ';
4623	forcebreak := True;
4624	P := p10;
4625	End;
4626	End;
4627
4628	If P > 0 Then s1 := Copy(S,1,P)
4629	Else s1 := S;
4630	Delete(S,1,Length(s1)); {s1 Is the First Word Of S}
4631
4632	Canvas.GetTextExtent(news+s1,CX,CY);
4633	If CX > Width Then
4634	Begin
4635	If news <> '' Then
4636	Begin
4637	DoDrawLine(news,Row);
4638	news := s1;
4639	End
4640	Else DoDrawLine(s1,Row);
4641	End
4642	Else news := news + s1;
4643
4644	If forcebreak And (news <> '') Then
4645	Begin
4646	DoDrawLine(news,Row);
4647	news := '';
4648	End;
4649
4650	If S = '' Then DoDrawLine(news,Row);
4651	End;
4652	End
4653	Else DoDrawLine(Caption,Row);
4654	End;
4655
4656
4657	Procedure TLabel.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
4658	Begin
4659	Inherited MouseDown(Button,ShiftState,X,Y);
4660
4661	If Button = mbLeft Then
4662	If Form Is TForm Then
4663	Begin
4664	Form.BringToFront;
4665
4666	LastMsg.Handled:=True; {!!}
4667	LastMsg.Result:=0;
4668	End;
4669	End;
4670
4671	Function TLabel.EvaluateShortCut(KeyCode:TKeyCode):Boolean;
4672	Var S:String;
4673	P:Integer;
4674	key:TKeyCode;
4675	Begin
4676	S := Caption;
4677	P := Pos('~',S); { & }
4678	If (P > 0) And (P < Length(S)) Then
4679	Begin
4680	key := (Ord(S[P+1]) Or $20) + kb_Alt + kb_Char;
4681	If key = KeyCode Then {found}
4682	If FFocusControl <> Nil Then
4683	Begin
4684	Result := True;
4685	Try
4686	FFocusControl.Focus;
4687	Except
4688	Result := False;
4689	End;
4690	If Result Then Exit;
4691	End;
4692	End;
4693	Result := Inherited EvaluateShortCut(KeyCode);
4694	End;
4695
4696
4697	{
4698	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
4699	º º
4700	º Speed-Pascal/2 Version 2.0 º
4701	º º
4702	º Speed-Pascal Component Classes (SPCC) º
4703	º º
4704	º This section: TValueSet Class Implementation º
4705	º º
4706	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
4707	º º
4708	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
4709	}
4710
4711	Type
4712	TValueSetArray=Array[0..MaxInt] Of Pointer;
4713	PValueSetArray=^TValueSetArray;
4714
4715
4716	Procedure TValueSet.SetupComponent;
4717	Begin
4718	Inherited SetupComponent;
4719
4720	Name:='ValueSet';
4721	Width:=100;
4722	Height:=100;
4723	ParentPenColor:=True;
4724	ParentColor:=True;
4725	AutoScroll := False;
4726
4727	FRows:=1;
4728	FColumns:=1;
4729	FCount:=1;
4730	GetMem(FMemory,FCount*4);
4731	FCtl3D:=True;
4732	FBorderStyle:=bsSingle;
4733	FItemBorder:=bsSingle;
4734	FScaleBitmap:=False;
4735	FSelection:=0;
4736	ContentStyle:=vscText;
4737	FMargin:=8;
4738	FSpacing:=8;
4739	FItemWidth:=30;
4740	FItemHeight:=30;
4741	FAutoSize:=True;
4742	FUpdateCount:=0;
4743	If Not Designed Then Include(ComponentState, csAcceptsControls);
4744	End;
4745
4746
4747	Procedure TValueSet.SetupShow;
4748	Begin
4749	Inherited SetupShow;
4750	SetupScrollBars;
4751	End;
4752
4753
4754	Procedure TValueSet.BeginUpdate;
4755	Begin
4756	Inc(FUpdateCount);
4757	End;
4758
4759
4760	Procedure TValueSet.EndUpdate;
4761	Begin
4762	Dec(FUpdateCount);
4763	If FUpdateCount = 0 Then
4764	Begin
4765	SetupScrollBars;
4766	Invalidate;
4767	End;
4768	End;
4769
4770
4771	Procedure TValueSet.GetXYVisible(Var xVisible,yVisible:LongInt);
4772	Var rc:TRect;
4773	Begin
4774	rc := ClientRect;
4775
4776	xVisible := (rc.Right +1 - rc.Left - (2*FMargin) + FSpacing) Div
4777	(FItemWidth + FSpacing);
4778	yVisible := (rc.Top +1 - rc.Bottom - (2*FMargin) + FSpacing) Div
4779	(FItemHeight + FSpacing);
4780	End;
4781
4782
4783	Procedure TValueSet.SetupScrollBars;
4784	Var xVisible,yVisible:LongInt;
4785	Begin
4786	If Handle = 0 Then Exit;
4787
4788	If Not AutoSize Then
4789	Begin
4790	{look If we need A ScrollBar}
4791	GetXYVisible(xVisible,yVisible);
4792
4793	If xVisible < FColumns Then
4794	Begin
4795	If yVisible < FRows Then
4796	Begin
4797	ScrollBars := ssBoth;
4798
4799	VertScrollBar.SetScrollRange(1,FRows,yVisible);
4800	VertScrollBar.Position := 1;
4801	End
4802	Else ScrollBars := ssHorizontal;
4803
4804	HorzScrollBar.SetScrollRange(1,FColumns,xVisible);
4805	HorzScrollBar.Position := 1;
4806	End
4807	Else
4808	Begin
4809	If yVisible < FRows Then
4810	Begin
4811	ScrollBars := ssVertical;
4812
4813	VertScrollBar.SetScrollRange(1,FRows,yVisible);
4814	VertScrollBar.Position := 1;
4815	End
4816	Else ScrollBars := ssNone;
4817	End;
4818	End
4819	Else ScrollBars := ssNone;
4820	End;
4821
4822
4823	Procedure TValueSet.Scroll(Sender:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);
4824	Begin
4825	Inherited Scroll(Sender,ScrollCode,ScrollPos);
4826	Invalidate;
4827	End;
4828
4829
4830	Procedure TValueSet.Resize;
4831	Begin
4832	Inherited Resize;
4833	SetupScrollBars;
4834	End;
4835
4836
4837	Procedure TValueSet.SetAutoSize(NewValue:Boolean);
4838	Begin
4839	FAutoSize := NewValue;
4840	If FUpdateCount = 0 Then Invalidate;
4841	End;
4842
4843
4844	Procedure TValueSet.SetItemWidth(NewValue:LongInt);
4845	Begin
4846	If NewValue < 2 Then NewValue := 2;
4847	FItemWidth := NewValue;
4848	If Not AutoSize Then
4849	Begin
4850	If FUpdateCount = 0 Then
4851	Begin
4852	SetupScrollBars;
4853	Invalidate;
4854	End;
4855	End;
4856	End;
4857
4858
4859	Procedure TValueSet.SetItemHeight(NewValue:LongInt);
4860	Begin
4861	If NewValue < 2 Then NewValue := 2;
4862	FItemHeight := NewValue;
4863	If Not AutoSize Then
4864	Begin
4865	If FUpdateCount = 0 Then
4866	Begin
4867	SetupScrollBars;
4868	Invalidate;
4869	End;
4870	End;
4871	End;
4872
4873
4874	Destructor TValueSet.Destroy;
4875	Var I:LongInt;
4876	Begin
4877	If FMemory <> Nil Then
4878	Begin
4879	For I := 0 To FCount-1 Do FreeData(I);
4880
4881	FreeMem(FMemory, FCount * 4);
4882	FMemory := Nil;
4883	End;
4884	Inherited Destroy;
4885	End;
4886
4887
4888	Procedure TValueSet.DrawSelection(Index:LongInt);
4889	Var rc:TRect;
4890	Begin
4891	rc := RectFromIndex(Index);
4892
4893	InflateRect(rc,4,4);
4894	Canvas.Rectangle(rc);
4895
4896	If HasFocus Then
4897	Begin
4898	InflateRect(rc,-2,-2);
4899	Canvas.DrawFocusRect(rc);
4900	End;
4901	End;
4902
4903
4904	Procedure TValueSet.DrawInterior(Index:LongInt);
4905	Var C:TColor;
4906	B:TBitmap;
4907	S:^String;
4908	P:Pointer;
4909	XX,yy,CX,CY:LongInt;
4910	rc1:TRect;
4911	rc:TRect;
4912	Begin
4913	If FMemory=Nil Then Exit;
4914
4915	rc := RectFromIndex(Index);
4916	InflateRect(rc,-1,-1); {Exclude the border}
4917
4918	P := GetData(Index);
4919
4920	Case FContentStyle Of
4921	vscText:
4922	Begin
4923	S:=P;
4924	If S<>Nil Then
4925	Begin
4926	Canvas.GetTextExtent(S^,CX,CY);
4927	XX:=rc.Right-rc.Left-CX;
4928	If XX<0 Then XX:=0;
4929	yy:=rc.Top-rc.Bottom-CY;
4930	If yy<0 Then yy:=0;
4931
4932	XX:=rc.Left+(XX Div 2);
4933	yy:=rc.Bottom+(yy Div 2);
4934
4935	Canvas.Pen.color:=PenColor;
4936	Canvas.Brush.color := color;
4937	Canvas.TextOut(XX,yy,S^);
4938
4939	rc1.Left:=XX;
4940	rc1.Right:=XX+CX-1;
4941	rc1.Bottom:=yy;
4942	rc1.Top:=yy+CY-1;
4943	Canvas.ExcludeClipRect(rc1);
4944	End;
4945	Canvas.FillRect(rc,color);
4946	End;
4947	vscBitmap:
4948	Begin
4949	B:=P;
4950	If B=Nil Then
4951	Begin
4952	Canvas.FillRect(rc,color);
4953	Exit;
4954	End;
4955
4956	If FScaleBitmap Then
4957	Begin
4958	Canvas.StretchDraw(rc.Left,rc.Bottom,
4959	rc.Right-rc.Left,
4960	rc.Top-rc.Bottom,B);
4961	End
4962	Else
4963	Begin
4964	rc1:=rc;
4965
4966	XX:=rc.Right-rc.Left-B.Width;
4967	If XX<0 Then XX:=0;
4968	yy:=rc.Top-rc.Bottom-B.Height;
4969	If yy<0 Then yy:=0;
4970
4971	XX:=rc.Left+(XX Div 2);
4972	yy:=rc.Bottom+(yy Div 2);
4973
4974	CX:=rc.Right-rc.Left;
4975	If CX>B.Width Then CX:=B.Width;
4976	CY:=rc.Top-rc.Bottom;
4977	If CY>B.Height Then CY:=B.Height;
4978
4979	rc.Left:=0;
4980	rc.Right:=CX;
4981	rc.Bottom:=0;
4982	rc.Top:=CY;
4983
4984	Canvas.PartialDraw(XX,yy,rc,B);
4985
4986	rc.Left:=XX;
4987	rc.Right:=XX+CX-1;
4988	rc.Bottom:=yy;
4989	rc.Top:=yy+CY-1;
4990	Canvas.ExcludeClipRect(rc);
4991	Canvas.FillRect(rc1,color);
4992	End;
4993	End;
4994	vscRGBColor:
4995	Begin
4996	C:=TColor(P);
4997	Canvas.FillRect(rc,C);
4998	End;
4999	End; {Case}
5000	End;
5001
5002
5003	{$HINTS OFF}
5004	Procedure TValueSet.Redraw(Const rec:TRect);
5005	Var clip,rc,rc1:TRect;
5006	X,Y:LongInt;
5007	StartRow,StartCol:LongInt;
5008	idx:LongInt;
5009	Begin
5010	If Canvas = Nil Then Exit;
5011
5012	rc := ClientRect;
5013
5014	If FBorderStyle = bsSingle Then
5015	Begin
5016	If Not FCtl3D Then
5017	Begin
5018	Canvas.Pen.color := clDkGray;
5019	Canvas.Rectangle(rc);
5020	InflateRect(rc,-1,-1);
5021	End
5022	Else DrawSystemBorder(Self,rc,FBorderStyle); {Inflate -2}
5023	End
5024	Else
5025	Begin
5026	Canvas.Pen.color := color;
5027	Canvas.Rectangle(rc);
5028	InflateRect(rc,-1,-1);
5029	End;
5030
5031	clip := Canvas.ClipRect;
5032	If IsRectEmpty(clip) Then Canvas.ClipRect := rc
5033	Else Canvas.ClipRect := IntersectRect(rec,rc);
5034
5035	If VertScrollBar <> Nil Then StartRow := VertScrollBar.Position
5036	Else StartRow := 1;
5037
5038	If HorzScrollBar <> Nil Then StartCol := HorzScrollBar.Position
5039	Else StartCol := 1;
5040
5041	For Y := StartRow To FRows Do
5042	Begin
5043	For X := StartCol To FColumns Do
5044	Begin
5045	idx := IndexFromColumnRow(X,Y);
5046	rc1 := RectFromIndex(idx);
5047
5048	If Not AutoSize Then
5049	If IsRectEmpty(IntersectRect(rc1, rec)) Then continue;
5050
5051	DrawInterior(idx);
5052
5053	If FItemBorder = bsSingle Then
5054	Begin
5055	If Not FCtl3D Then
5056	Begin
5057	Canvas.Pen.color := clDkGray;
5058	Canvas.Rectangle(rc1);
5059	End
5060	Else Canvas.ShadowedBorder(rc1,clDkGray,clWhite);
5061	End
5062	Else
5063	Begin
5064	Canvas.Pen.color := color;
5065	Canvas.Rectangle(rc1);
5066	End;
5067	Canvas.ExcludeClipRect(rc1);
5068	End;
5069	End;
5070
5071	Inherited Redraw(rec);
5072
5073	Canvas.Pen.color := clDkGray;
5074	DrawSelection(FSelection);
5075
5076	Canvas.DeleteClipRegion;
5077	End;
5078
5079
5080	Procedure TValueSet.SetCtl3D(Value:Boolean);
5081	Begin
5082	If FCtl3D <> Value Then
5083	Begin
5084	FCtl3D := Value;
5085	If FUpdateCount = 0 Then Invalidate;
5086	End;
5087	End;
5088
5089
5090	Procedure TValueSet.SetBorderStyle(Value:TBorderStyle);
5091	Begin
5092	If FBorderStyle <> Value Then
5093	Begin
5094	FBorderStyle := Value;
5095	If FUpdateCount = 0 Then Invalidate;
5096	End;
5097	End;
5098
5099
5100	Procedure TValueSet.SetItemBorder(Value:TBorderStyle);
5101	Begin
5102	If FItemBorder <> Value Then
5103	Begin
5104	FItemBorder := Value;
5105	If FUpdateCount = 0 Then Invalidate;
5106	End;
5107	End;
5108
5109
5110	Procedure TValueSet.SetScaleBitmap(Value:Boolean);
5111	Begin
5112	If FScaleBitmap <> Value Then
5113	Begin
5114	FScaleBitmap := Value;
5115	If FContentStyle = vscBitmap Then
5116	If FUpdateCount = 0 Then Invalidate;
5117	End;
5118	End;
5119
5120
5121	Procedure TValueSet.ItemFocus(Index:LongInt);
5122	Begin
5123	If FOnItemFocus <> Nil Then FOnItemFocus(Self,Index);
5124	End;
5125
5126
5127	Procedure TValueSet.ItemSelect(Index:LongInt);
5128	Begin
5129	If OnItemSelect <> Nil Then OnItemSelect(Self,Index);
5130	End;
5131	{$HINTS ON}
5132
5133
5134	Procedure TValueSet.SetSelection(Value:LongInt);
5135	Var StartRow,StartCol,ColCount,RowCount,FX,FY:LongInt;
5136	Paint:Boolean;
5137	Begin
5138	If FSelection <> Value Then
5139	Begin
5140	If Handle <> 0 Then
5141	If FUpdateCount = 0 Then
5142	Begin
5143	{Clear old Selection}
5144	Canvas.Pen.color := color;
5145	DrawSelection(FSelection);
5146
5147	Canvas.Pen.color := clDkGray;
5148	DrawSelection(Value);
5149	End;
5150	FSelection := Value;
5151
5152	//If the Selection Is outside the Visible area, Scroll the valueset !
5153	ColumnRowFromIndex(FSelection,FX,FY);
5154
5155	If VertScrollBar <> Nil Then StartRow := VertScrollBar.Position
5156	Else StartRow := 1;
5157
5158	If HorzScrollBar <> Nil Then StartCol := HorzScrollBar.Position
5159	Else StartCol := 1;
5160
5161	GetXYVisible(ColCount,RowCount);
5162
5163	Paint:=False;
5164
5165	If HorzScrollBar<>Nil Then
5166	If ((FX<StartCol)Or(FX>=StartCol+ColCount)) Then
5167	Begin
5168	HorzScrollBar.Position:=FX;
5169	Paint:=True;
5170	End;
5171
5172	If VertScrollBar<>Nil Then
5173	If ((FY<StartRow)Or(FY>=StartRow+RowCount)) Then
5174	Begin
5175	VertScrollBar.Position:=FY;
5176	Paint:=True;
5177	End;
5178
5179	If Paint Then Invalidate;
5180	End;
5181	End;
5182
5183
5184
5185
5186	Procedure TValueSet.SetContentStyle(NewStyle:TValueSetContentStyle);
5187	Var I:LongInt;
5188	Begin
5189	If FContentStyle = NewStyle Then Exit;
5190
5191	For I := 0 To FCount-1 Do FreeData(I);
5192
5193	FContentStyle := NewStyle;
5194	If FUpdateCount = 0 Then Invalidate;
5195	End;
5196
5197
5198	Procedure TValueSet.SetRows(Value:LongInt);
5199	Begin
5200	SetDimension(FColumns, Value);
5201	End;
5202
5203
5204	Procedure TValueSet.SetColumns(Value:LongInt);
5205	Begin
5206	SetDimension(Value, FRows);
5207	End;
5208
5209
5210	Procedure TValueSet.SetDimension(Column,Row:LongInt);
5211	Var NewMem:^Pointer;
5212	CopyCount,I:LongInt;
5213	Begin
5214	If Column <= 0 Then Exit;
5215	If Row <= 0 Then Exit;
5216
5217	GetMem(NewMem, Row * Column * 4); {FillChar #0}
5218
5219	CopyCount := FCount;
5220	If CopyCount > Column * Row Then CopyCount := Column * Row;
5221
5222	{Free the Last Items}
5223	For I := CopyCount To FCount-1 Do FreeData(I);
5224
5225	System.Move(FMemory^, NewMem^, CopyCount * 4);
5226	FreeMem(FMemory, FCount * 4);
5227
5228	FColumns := Column;
5229	FRows := Row;
5230	FCount := FColumns * FRows;
5231	FMemory := NewMem;
5232
5233	If FUpdateCount = 0 Then
5234	Begin
5235	SetupScrollBars;
5236	Invalidate;
5237	End;
5238	End;
5239
5240
5241	Function TValueSet.IndexFromColumnRow(Column,Row:LongInt):LongInt;
5242	Begin
5243	Result := ((Row-1) * FColumns) + Column-1;
5244	End;
5245
5246
5247	Procedure TValueSet.ColumnRowFromIndex(Index:LongInt;Var Column,Row:LongInt);
5248	Begin
5249	Column := (Index Mod FColumns) + 1;
5250	Row := (Index Div FColumns) + 1;
5251	End;
5252
5253
5254	Function TValueSet.RectFromIndex(Index:LongInt):TRect;
5255	Var W,H,X1,y1:LongInt;
5256	xInc,yInc,XPos,YPos:LongInt;
5257	rc1:TRect;
5258	StartRow,StartCol:LongInt;
5259	Row,Column:LongInt;
5260	Begin
5261	Result := Rect(0,0,0,0);
5262
5263	ColumnRowFromIndex(Index,Column,Row);
5264
5265	rc1 := ClientRect;
5266
5267	If AutoSize Then
5268	Begin
5269	W := rc1.Right - rc1.Left - (2FMargin) - (FColumns-1) FSpacing;
5270	If W < 0 Then W := 0;
5271	H := rc1.Top - rc1.Bottom - (2FMargin) - (FRows-1) FSpacing;
5272	If H < 0 Then H := 0;
5273
5274	xInc := W Div FColumns;
5275	yInc := H Div FRows;
5276	End
5277	Else
5278	Begin
5279	xInc := FItemWidth;
5280	yInc := FItemHeight;
5281	End;
5282
5283	If VertScrollBar <> Nil Then StartRow := VertScrollBar.Position
5284	Else StartRow := 1;
5285
5286	If HorzScrollBar <> Nil Then StartCol := HorzScrollBar.Position
5287	Else StartCol := 1;
5288
5289	If (Column < StartCol) Or (Row < StartRow) Then Exit;
5290
5291	XPos := rc1.Left + FMargin;
5292	YPos := rc1.Top - FMargin;
5293	For y1 := StartRow To FRows Do
5294	Begin
5295	For X1 := StartCol To FColumns Do
5296	Begin
5297	If X1 = Column Then
5298	If y1 = Row Then
5299	Begin
5300	Result.Left := XPos;
5301	Result.Right := Result.Left + xInc;
5302	Result.Top := YPos;
5303	Result.Bottom := Result.Top - yInc;
5304	Exit;
5305	End;
5306	Inc(XPos, xInc + FSpacing);
5307	End;
5308
5309	XPos := rc1.Left + FMargin;
5310	Dec(YPos, yInc + FSpacing);
5311	End;
5312	End;
5313
5314
5315	Function TValueSet.IndexFromPoint(X,Y:LongInt):LongInt;
5316	Var W,H,X1,y1:LongInt;
5317	xInc,yInc,XPos,YPos:LongInt;
5318	rec,rc1:TRect;
5319	pt:TPoint;
5320	Begin
5321	Result := -1;
5322
5323	rc1 := ClientRect;
5324
5325	If AutoSize Then
5326	Begin
5327	W := rc1.Right - rc1.Left - (2FMargin) - (FColumns-1) FSpacing;
5328	If W < 0 Then W := 0;
5329	H := rc1.Top - rc1.Bottom - (2FMargin) - (FRows-1) FSpacing;
5330	If H < 0 Then H := 0;
5331
5332	xInc := W Div FColumns;
5333	yInc := H Div FRows;
5334	End
5335	Else
5336	Begin
5337	xInc := FItemWidth;
5338	yInc := FItemHeight;
5339	End;
5340
5341	XPos := rc1.Left + FMargin;
5342	YPos := rc1.Top - FMargin;
5343	pt := Point(X,Y);
5344	For y1 := 1 To FRows Do
5345	Begin
5346	For X1 := 1 To FColumns Do
5347	Begin
5348	rec := Rect(XPos, YPos-yInc, XPos+xInc, YPos);
5349	If PointInRect(pt, rec) Then
5350	Begin
5351	If HorzScrollBar <> Nil
5352	Then Inc(X1, HorzScrollBar.Position-1);
5353	If VertScrollBar <> Nil
5354	Then Inc(y1, VertScrollBar.Position-1);
5355	Result := (y1-1) * FColumns + X1-1;
5356	Exit;
5357	End;
5358
5359	Inc(XPos, xInc + FSpacing);
5360	End;
5361
5362	XPos := rc1.Left + FMargin;
5363	Dec(YPos, yInc + FSpacing);
5364	End;
5365	End;
5366
5367
5368	{$HINTS OFF}
5369	Procedure TValueSet.MouseDown(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
5370	Var idx:LongInt;
5371	Begin
5372	Inherited MouseDown(Button,ShiftState,X,Y);
5373
5374	If Button = mbLeft Then
5375	Begin
5376	idx := IndexFromPoint(X,Y);
5377	If idx < 0 Then Exit;
5378
5379	SetSelection(idx);
5380	ItemFocus(idx);
5381	Focus;
5382	End;
5383	End;
5384
5385
5386	Procedure TValueSet.MouseDblClick(Button:TMouseButton;ShiftState:TShiftState;X,Y:LongInt);
5387	Var idx:LongInt;
5388	Begin
5389	Inherited MouseDblClick(Button,ShiftState,X,Y);
5390
5391	If Button = mbLeft Then
5392	Begin
5393	idx := IndexFromPoint(X,Y);
5394	If idx < 0 Then Exit;
5395
5396	ItemSelect(idx);
5397	End;
5398	End;
5399	{$HINTS ON}
5400
5401
5402	Procedure TValueSet.SetFocus;
5403	Begin
5404	Inherited SetFocus;
5405	Invalidate;
5406	End;
5407
5408
5409	Procedure TValueSet.KillFocus;
5410	Begin
5411	Inherited KillFocus;
5412	Invalidate;
5413	End;
5414
5415
5416	Procedure TValueSet.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
5417	Var FSel:LongInt;
5418	Begin
5419	Case KeyCode Of
5420	kbHome:
5421	Begin
5422	FSel := 0;
5423	SetSelection(FSel);
5424	ItemFocus(FSel);
5425	KeyCode := kbNull;
5426	End;
5427	kbEnd:
5428	Begin
5429	FSel := FCount-1;
5430	SetSelection(FSel);
5431	ItemFocus(FSel);
5432	KeyCode := kbNull;
5433	End;
5434	kbCLeft:
5435	Begin
5436	If FSelection >= 0 Then
5437	Begin
5438	FSel := ((FSelection Div FColumns) * FColumns) +
5439	((FSelection + FColumns - 1) Mod FColumns);
5440	End
5441	Else FSel := 0;
5442	SetSelection(FSel);
5443	KeyCode := kbNull;
5444	End;
5445	kbCRight:
5446	Begin
5447	If FSelection >= 0 Then
5448	Begin
5449	FSel := ((FSelection Div FColumns) * FColumns) +
5450	((FSelection + 1) Mod FColumns);
5451	End
5452	Else FSel := 0;
5453	SetSelection(FSel);
5454	KeyCode := kbNull;
5455	End;
5456	kbCUp:
5457	Begin
5458	If FSelection >= 0 Then
5459	Begin
5460	FSel := ((FSelection - FColumns) + FCount) Mod FCount;
5461	End
5462	Else FSel := 0;
5463	SetSelection(FSel);
5464	KeyCode := kbNull;
5465	End;
5466	kbCDown:
5467	Begin
5468	If FSelection >= 0 Then
5469	Begin
5470	FSel := (FSelection + FColumns) Mod FCount;
5471	End
5472	Else FSel := 0;
5473	SetSelection(FSel);
5474	KeyCode := kbNull;
5475	End;
5476	kbPageUp:
5477	Begin
5478	If FSelection >= 0 Then
5479	Begin
5480	FSel := FSelection Mod FColumns;
5481	End
5482	Else FSel := 0;
5483	SetSelection(FSel);
5484	KeyCode := kbNull;
5485	End;
5486	kbPageDown:
5487	Begin
5488	If FSelection >= 0 Then
5489	Begin
5490	FSel := ((FRows-1) * FColumns) + (FSelection Mod FColumns);
5491	End
5492	Else FSel := 0;
5493	SetSelection(FSel);
5494	KeyCode := kbNull;
5495	End;
5496	{$IFDEF OS2}
5497	kbEnter,
5498	{$ENDIF}
5499	kbCR:
5500	Begin
5501	If (FSelection >= 0) And (FSelection < FCount)
5502	Then ItemSelect(FSelection);
5503	KeyCode := kbNull;
5504	End;
5505	Else Inherited ScanEvent(KeyCode,RepeatCount);
5506	End; {Case}
5507	End;
5508
5509
5510	Procedure TValueSet.CharEvent(Var key:Char;RepeatCount:Byte);
5511	Var FSel:LongInt;
5512	Begin
5513	Case key Of
5514	#32:
5515	Begin
5516	If FSelection >= 0 Then
5517	Begin
5518	FSel := FSelection + 1;
5519	If FSel >= FCount Then FSel := 0;
5520	End
5521	Else FSel := 0;
5522	SetSelection(FSel);
5523	key := #0;
5524	End;
5525	Else Inherited CharEvent(key,RepeatCount);
5526	End;
5527	End;
5528
5529
5530	Procedure TValueSet.SetColorArray(Index:LongInt;Const Data:Array Of TColor);
5531	Var T:LongInt;
5532	P:PValueSetArray;
5533	Col:TColor;
5534	Begin
5535	If FContentStyle <> vscRGBColor Then Exit;
5536	If (Index < 0) Or (Index >= FCount) Then Exit;
5537
5538	P := FMemory;
5539	For T := 0 To High(Data) Do
5540	Begin
5541	If Index + T >= FCount Then break;
5542	Col := Data[T];
5543	{$IFDEF Win95}
5544	If Col = $00CCCCCC Then Col := clLtGray;
5545	{$ENDIF}
5546	P^[Index + T] := Pointer(Col);
5547	End;
5548
5549	If FUpdateCount = 0 Then Invalidate;
5550	End;
5551
5552
5553	Procedure TValueSet.SetBitmapArray(Index:LongInt;Const Data:Array Of TBitmap);
5554	Var T:LongInt;
5555	P:PValueSetArray;
5556	Bitmap:TBitmap;
5557	OldBitmap:TBitmap;
5558	Begin
5559	If FContentStyle <> vscBitmap Then Exit;
5560	If (Index < 0) Or (Index >= FCount) Then Exit;
5561
5562	P := FMemory;
5563	For T := 0 To High(Data) Do
5564	Begin
5565	If Index + T >= FCount Then break;
5566	OldBitmap := P^[Index + T];
5567	If OldBitmap <> Nil Then OldBitmap.Destroy; {Destroy old local Copy}
5568	Bitmap := Data[T];
5569	If Bitmap <> Nil Then Bitmap := Bitmap.Copy;
5570	P^[Index + T] := Pointer(Bitmap);
5571	End;
5572
5573	If FUpdateCount = 0 Then Invalidate;
5574	End;
5575
5576
5577	Procedure TValueSet.SetStringArray(Index:LongInt;Const Data:Array Of String);
5578	Var T:LongInt;
5579	P:PValueSetArray;
5580	ps:PString;
5581	Begin
5582	If FContentStyle <> vscText Then Exit;
5583	If (Index < 0) Or (Index >= FCount) Then Exit;
5584
5585	P := FMemory;
5586	For T := 0 To High(Data) Do
5587	Begin
5588	If Index + T >= FCount Then break;
5589	ps := P^[Index + T];
5590	AssignStr(ps,Data[T]);
5591	P^[Index + T] := Pointer(ps);
5592	End;
5593
5594	If FUpdateCount = 0 Then Invalidate;
5595	End;
5596
5597
5598	Function TValueSet.GetData(Index:LongInt):Pointer;
5599	Var P:PValueSetArray;
5600	Begin
5601	Result := Nil;
5602	If FMemory = Nil Then Exit;
5603	If (Index < 0) Or (Index >= FCount) Then Exit;
5604
5605	P := FMemory;
5606	Result := P^[Index];
5607	End;
5608
5609
5610	Procedure TValueSet.FreeData(Index:LongInt);
5611	Var P:PValueSetArray;
5612	Bitmap:TBitmap;
5613	ps:PString;
5614	Begin
5615	If FMemory = Nil Then Exit;
5616	If (Index < 0) Or (Index >= FCount) Then Exit;
5617
5618	P := FMemory;
5619	Case FContentStyle Of
5620	vscBitmap:
5621	Begin
5622	Bitmap := TBitmap(P^[Index]);
5623	If Bitmap <> Nil Then Bitmap.Destroy;
5624	End;
5625	vscText:
5626	Begin
5627	ps := P^[Index];
5628	DisposeStr(ps);
5629	End;
5630	End;
5631	P^[Index] := Nil;
5632	End;
5633
5634
5635	Procedure TValueSet.SetRGB(Index:LongInt;NewValue:TColor);
5636	Begin
5637	SetColorArray(Index,[NewValue]);
5638	End;
5639
5640
5641	Function TValueSet.GetRGB(Index:LongInt):TColor;
5642	Begin
5643	Result := 0;
5644	If FContentStyle <> vscRGBColor Then Exit;
5645	Result := TColor(GetData(Index));
5646	End;
5647
5648
5649	Procedure TValueSet.SetBitmap(Index:LongInt;NewValue:TBitmap);
5650	Begin
5651	SetBitmapArray(Index,[NewValue]);
5652	End;
5653
5654
5655	Function TValueSet.GetBitmap(X,Y:LongInt):TBitmap;
5656	Begin
5657	Result := Nil;
5658	If FContentStyle <> vscBitmap Then Exit;
5659	Result := TBitmap(GetData(Index));
5660	End;
5661
5662
5663	Procedure TValueSet.SetText(Index:LongInt;NewValue:String);
5664	Begin
5665	SetStringArray(Index,[NewValue]);
5666	End;
5667
5668
5669	Function TValueSet.GetText(Index:LongInt):String;
5670	Var ps:PString;
5671	Begin
5672	Result := '';
5673	If FContentStyle <> vscText Then Exit;
5674	ps := GetData(Index);
5675	If ps <> Nil Then Result := ps^;
5676	End;
5677
5678
5679	{
5680	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
5681	º º
5682	º Speed-Pascal/2 Version 2.0 º
5683	º º
5684	º Speed-Pascal Component Classes (SPCC) º
5685	º º
5686	º This section: TMemo Class Implementation º
5687	º º
5688	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
5689	º º
5690	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
5691	}
5692
5693	Type
5694	TMemoStrings=Class(TStrings)
5695	Private
5696	Memo:TMemo;
5697	Protected
5698	Function GetCount:LongInt; Override;
5699	Function Get(Index:LongInt):String; Override;
5700	Procedure Put(Index:LongInt;Const S:String); Override;
5701	Function GetText:PChar; Override;
5702	Procedure SetText(Text:PChar); Override;
5703	Procedure indexerror;
5704	Public
5705	Procedure Assign(AStrings:TStrings); Override;
5706	Procedure Clear; Override;
5707	Procedure Insert(Index:LongInt;Const S:String); Override;
5708	Procedure Delete(Index:LongInt); Override;
5709	End;
5710
5711
5712
5713	Function TMemoStrings.GetCount:LongInt;
5714	{$IFDEF OS2}
5715	Var Start:IPT;
5716	len:LongInt;
5717	{$ENDIF}
5718	Begin
5719	{$IFDEF OS2}
5720	Result := WinSendMsg(Memo.Handle,MLM_QUERYLINECOUNT,0,0);
5721
5722	Start := WinSendMsg(Memo.Handle,MLM_CHARFROMLINE,Result-1,0);
5723	len := WinSendMsg(Memo.Handle,MLM_QUERYLINELENGTH,Start,0);
5724	If len = 0 Then Dec(Result);
5725	{$ENDIF}
5726	{$IFDEF Win95}
5727	Result:=WinUser.SendMessage(Memo.Handle,EM_GETLINECOUNT,0,0);
5728	If WinUser.SendMessage(Memo.Handle,EM_LINELENGTH,
5729	WinUser.SendMessage(Memo.Handle,EM_LINEINDEX,Result-1,0),0)=0 Then
5730	Dec(Result);
5731	{$ENDIF}
5732	End;
5733
5734
5735	Function TMemoStrings.Get(Index:LongInt):String;
5736	Var cnt:LongInt;
5737	{$IFDEF OS2}
5738	Start:IPT;
5739	len,TotalLen:LongInt;
5740	pBuf:PChar;
5741	{$ENDIF}
5742	{$IFDEF WIN95}
5743	len,len1:LongInt;
5744	pBuf:CString;
5745	{$ENDIF}
5746	Begin
5747	Result := '';
5748	cnt := Count;
5749	If (Index < 0) Or (Index >= cnt) Then indexerror;
5750
5751	{$IFDEF OS2}
5752	WinSendMsg(Memo.Handle,MLM_FORMAT,MLFIE_NOTRANS,0); {LF!}
5753
5754	Start := WinSendMsg(Memo.Handle,MLM_CHARFROMLINE,Index,0);
5755	len := WinSendMsg(Memo.Handle,MLM_QUERYLINELENGTH,Start,0);
5756	If len = 0 Then Exit;
5757
5758	GetMem(pBuf,len+1);
5759	WinSendMsg(Memo.Handle,MLM_SETIMPORTEXPORT,LongWord(pBuf),len+1);
5760	TotalLen := WinSendMsg(Memo.Handle,MLM_EXPORT,ULONG(@Start),ULONG(@len));
5761	Result := StrPas(pBuf);
5762	FreeMem(pBuf,len+1);
5763
5764	If (WinSendMsg(Memo.Handle,MLM_QUERYLINECOUNT,0,0) <> cnt) Or
5765	(Index < cnt-1) Then SetLength(Result,TotalLen-1); {del lf}
5766	{$ENDIF}
5767	{$IFDEF Win95}
5768	pBuf[0]:=#254;
5769	pBuf[1]:=#0;
5770	pBuf[WinUser.SendMessage(Memo.Handle,EM_GETLINE,Index,LongWord(@pBuf))]:=#0;
5771	Result:=pBuf;
5772	{$ENDIF}
5773	End;
5774
5775
5776	Procedure TMemoStrings.Put(Index:LongInt;Const S:String);
5777	Var cnt:LongInt;
5778	{$IFDEF OS2}
5779	Start:IPT;
5780	len:LongInt;
5781	CS:cstring;
5782	{$ENDIF}
5783	{$IFDEF WIN95}
5784	Start,Len:LongInt;
5785	CS:CString;
5786	{$ENDIF}
5787	Begin
5788	cnt := Count;
5789	If (Index < 0) Or (Index >= cnt) Then indexerror;
5790
5791	{$IFDEF OS2}
5792	CS := S;
5793	WinSendMsg(Memo.Handle,MLM_FORMAT,MLFIE_NOTRANS,0); {LF!}
5794
5795	Start := WinSendMsg(Memo.Handle,MLM_CHARFROMLINE,Index,0);
5796	len := WinSendMsg(Memo.Handle,MLM_QUERYLINELENGTH,Start,0);
5797	If len > 0 Then {Delete old String}
5798	Begin
5799	If Index < cnt-1 Then Dec(len); {Not the Line break}
5800	If len > 0 Then WinSendMsg(Memo.Handle,MLM_DELETE,Start,len);
5801	End;
5802
5803	WinSendMsg(Memo.Handle,MLM_SETIMPORTEXPORT,LongWord(@CS),255);
5804	WinSendMsg(Memo.Handle,MLM_IMPORT,ULONG(@Start),Length(S));
5805	{$ENDIF}
5806	{$IFDEF Win95}
5807	Start:=WinUser.SendMessage(Memo.Handle,EM_LINEINDEX,Index,0);
5808	Len:=WinUser.SendMessage(Memo.Handle,EM_LINELENGTH,Start,0);
5809	WinUser.SendMessage(Memo.Handle,EM_SETSEL,Start,Start+Len);
5810	CS:=S;
5811	WinUser.SendMessage(Memo.Handle,EM_REPLACESEL,0,LongWord(@CS));
5812	{$ENDIF}
5813	Memo.FModified := True;
5814	End;
5815
5816
5817	Procedure TMemoStrings.Assign(AStrings:TStrings);
5818	{$IFDEF OS2}
5819	Var MemoVis:Boolean;
5820	{$ENDIF}
5821	Begin
5822	{$IFDEF OS2}
5823	MemoVis := Memo.Visible;
5824	If MemoVis Then WinSendMsg(Memo.Handle,MLM_DISABLEREFRESH,0,0);
5825	{$ENDIF}
5826	Inherited Assign(AStrings);
5827	{$IFDEF OS2}
5828	If MemoVis Then WinSendMsg(Memo.Handle,MLM_ENABLEREFRESH,0,0);
5829	{$ENDIF}
5830	End;
5831
5832
5833	Procedure TMemoStrings.Insert(Index:LongInt;Const S:String);
5834	{$IFDEF OS2}
5835	Var Start:IPT;
5836	CS:cstring;
5837	len:LongInt;
5838	ACount:LongInt;
5839	{$ENDIF}
5840	{$IFDEF WIN32}
5841	Var Start,Len:LongInt;
5842	c:CString;
5843	ACount:LongInt;
5844	{$ENDIF}
5845	Begin
5846	ACount:=Count;
5847	If (Index < 0) Or (Index > ACount) Then indexerror;
5848
5849	{$IFDEF OS2}
5850	WinSendMsg(Memo.Handle,MLM_FORMAT,MLFIE_NOTRANS,0); {LF!}
5851
5852	If ((Index>0)And(Index=ACount)) Then Start:=-1
5853	Else Start := WinSendMsg(Memo.Handle,MLM_CHARFROMLINE,Index,0);
5854	If Start < 0 Then {Add}
5855	Begin
5856	Start := WinSendMsg(Memo.Handle,MLM_CHARFROMLINE,Index-1,0);
5857	If Start < 0 Then Exit;
5858	len := WinSendMsg(Memo.Handle,MLM_QUERYLINELENGTH,Start,0);
5859	If len = 0 Then Exit;
5860	Inc(Start,len);
5861	CS := #10 + S;
5862	End
5863	Else
5864	Begin
5865	If ((Start=0)And(ACount=0)) Then CS:=S
5866	Else CS := S + #10;
5867	End;
5868
5869	WinSendMsg(Memo.Handle,MLM_SETIMPORTEXPORT,LongWord(@CS),255);
5870	WinSendMsg(Memo.Handle,MLM_IMPORT,ULONG(@Start),Length(CS));
5871	{$ENDIF}
5872	{$IFDEF Win95}
5873	Start:=WinUser.SendMessage(Memo.Handle,EM_LINEINDEX,Index,0);
5874	If Start>=0 Then c:=s+#13#10
5875	Else
5876	Begin
5877	Start:=WinUser.SendMessage(Memo.Handle,EM_LINEINDEX,Index-1,0);
5878	If Start<0 Then exit;
5879	Len:=WinUser.SendMessage(Memo.Handle,EM_LINELENGTH,Start,0);
5880	Start:=Start+Len;
5881	If Start>0 Then c:=#13#10+s
5882	Else c:=s+#13#10;
5883	End;
5884	WinUser.SendMessage(Memo.Handle,EM_SETSEL,Start,Start);
5885	WinUser.SendMessage(Memo.Handle,EM_REPLACESEL,0,LongWord(@c));
5886	{$ENDIF}
5887	Memo.FModified := True;
5888	End;
5889
5890
5891	Procedure TMemoStrings.Delete(Index:LongInt);
5892	{$IFDEF OS2}
5893	Var Start:IPT;
5894	len:LongInt;
5895	{$ENDIF}
5896	{$IFDEF WIN95}
5897	Var
5898	Start,SelEnd:LongInt;
5899	{$ENDIF}
5900	Begin
5901	If (Index < 0) Or (Index >= Count) Then indexerror;
5902
5903	{$IFDEF OS2}
5904	WinSendMsg(Memo.Handle,MLM_FORMAT,MLFIE_NOTRANS,0); {LF!}
5905
5906	Start := WinSendMsg(Memo.Handle,MLM_CHARFROMLINE,Index,0);
5907	len := WinSendMsg(Memo.Handle,MLM_QUERYLINELENGTH,Start,0);
5908	If len > 0 Then WinSendMsg(Memo.Handle,MLM_DELETE,Start,len);
5909	{$ENDIF}
5910	{$IFDEF Win95}
5911	Start:=WinUser.SendMessage(Memo.Handle,EM_LINELENGTH,Index,0);
5912	SelEnd:=WinUser.SendMessage(Memo.Handle,EM_LINEINDEX,Index+1,0);
5913	If SelEnd<0 Then
5914	SelEnd:=Start+WinUser.SendMessage(Memo.Handle,EM_LINELENGTH,Start,0);
5915	WinUser.SendMessage(Memo.Handle,EM_SETSEL,Start,SelEnd);
5916	WinUser.SendMessage(Memo.Handle,WM_CLEAR,0,0);
5917	{$ENDIF}
5918	Memo.FModified := True;
5919	End;
5920
5921
5922	Procedure TMemoStrings.Clear;
5923	{$IFDEF OS2}
5924	Var Start:IPT;
5925	len,cnt:LongInt;
5926	{$ENDIF}
5927	{$IFDEF WIN95}
5928	Var
5929	Start,Len:LongInt;
5930	{$ENDIF}
5931	Begin
5932	{$IFDEF OS2}
5933	Start := 0;
5934	len := WinSendMsg(Memo.Handle,MLM_QUERYTEXTLENGTH,0,0);
5935	cnt := Count;
5936	If cnt > 0 Then Inc(len,cnt-1); {Add the Line breaks}
5937	If len > 0 Then WinSendMsg(Memo.Handle,MLM_DELETE,Start,len);
5938	{$ENDIF}
5939	{$IFDEF Win95}
5940	{Start:=WinUser.SendMessage(Memo.Handle,EM_LINEINDEX,0,0);
5941	Len:=WinUser.SendMessage(Memo.Handle,EM_LINEINDEX,Count-1,0);
5942	WinUser.SendMessage(Memo.Handle,EM_SETSEL,Start,Start+Len);
5943	WinUser.SendMessage(Memo.Handle,WM_CLEAR,0,0);}
5944	SetWindowText(Memo.Handle,'');
5945	{$ENDIF}
5946	Memo.FModified := True;
5947	End;
5948
5949
5950	Function TMemoStrings.GetText:PChar;
5951	{$IFDEF OS2}
5952	Var Start:IPT;
5953	len,breaks:LongInt;
5954	TotalLen:LongInt;
5955	{$ENDIF}
5956	{$IFDEF WIN32}
5957	Var Len:LongInt;
5958	{$ENDIF}
5959	Begin
5960	Result := NewStr('');
5961	{$IFDEF OS2}
5962	WinSendMsg(Memo.Handle,MLM_FORMAT,MLFIE_CFTEXT,0); {CRLF!}
5963
5964	len := WinSendMsg(Memo.Handle,MLM_QUERYTEXTLENGTH,0,0);
5965	breaks := WinSendMsg(Memo.Handle,MLM_QUERYLINECOUNT,0,0) - 1;
5966	TotalLen := len + breaks;
5967	If TotalLen <= 0 Then Exit;
5968
5969	Start := 0;
5970	Result := StrAlloc(TotalLen+1);
5971	WinSendMsg(Memo.Handle,MLM_SETIMPORTEXPORT,LongWord(Result),TotalLen+1);
5972	WinSendMsg(Memo.Handle,MLM_EXPORT,ULONG(@Start),ULONG(@TotalLen));
5973	{$ENDIF}
5974	{$IFDEF Win95}
5975	Len:=WinUser.SendMessage(Memo.Handle,WM_GETTEXTLENGTH,0,0);
5976	Result:=StrAlloc(Len+1);
5977	WinUser.SendMessage(Memo.Handle,WM_GETTEXT,Len+1,LongWord(Result));
5978	{$ENDIF}
5979	End;
5980
5981
5982	Procedure TMemoStrings.SetText(Text:PChar);
5983	{$IFDEF OS2}
5984	Var Start:IPT;
5985	len:LongInt;
5986	{$ENDIF}
5987	Begin
5988	Clear;
5989	If Text = Nil Then Exit;
5990	{$IFDEF OS2}
5991	WinSendMsg(Memo.Handle,MLM_FORMAT,MLFIE_CFTEXT,0); {CRLF!}
5992
5993	Start := 0;
5994	len := StrLen(Text);
5995	WinSendMsg(Memo.Handle,MLM_SETIMPORTEXPORT,LongWord(Text),len+1);
5996	WinSendMsg(Memo.Handle,MLM_IMPORT,ULONG(@Start),len);
5997	{$ENDIF}
5998	{$IFDEF Win95}
5999	WinUser.SendMessage(Memo.Handle,WM_SETTEXT,0,LongWord(Text));
6000	{$ENDIF}
6001	End;
6002
6003
6004	Procedure TMemoStrings.indexerror;
6005	Begin
6006	Raise EMemoIndexError.Create(LoadNLSStr(SInvalidMemoLineIndex));
6007	End;
6008
6009
6010	////////////////////////////////////////////////////////////////////////////
6011
6012	Procedure TMemo.GetClassData(Var ClassData:TClassData);
6013	Begin
6014	Inherited GetClassData(ClassData);
6015
6016	{$IFDEF OS2}
6017	ClassData.ClassULong := WC_MLE;
6018	{$ENDIF}
6019	{$IFDEF Win95}
6020	CreateSubClass(ClassData,'EDIT');
6021	{$ENDIF}
6022	End;
6023
6024
6025	Procedure TMemo.SetupComponent;
6026	Begin
6027	Inherited SetupComponent;
6028
6029	Name := 'Memo';
6030	Height := 100;
6031	Width := 100;
6032	Ownerdraw := False;
6033	color := clEntryField;
6034	ParentPenColor := False;
6035	ParentColor := False;
6036
6037	FLines := TMemoStrings.Create;
6038	TMemoStrings(FLines).Memo := Self;
6039	FInitLines.Create;
6040	FScrollBars := ssNone;
6041	FBorderStyle := bsSingle;
6042	FWordWrap := True;
6043	FReadOnly := False;
6044	FModified := False;
6045	End;
6046
6047
6048	Procedure TMemo.BeginUpdate;
6049	Begin
6050	If FUpdateCount = 0 Then
6051	Begin
6052	If (Handle <> 0) And Visible Then
6053	Begin
6054	FEnableWindowUpdate := True;
6055	{$IFDEF OS2}
6056	WinEnableWindowUpdate(Handle,False);
6057	{$ENDIF}
6058	{$IFDEF Win95}
6059	SendMessage(Handle,WM_SETREDRAW,0,0);
6060	{$ENDIF}
6061	End;
6062	End;
6063	Inc(FUpdateCount);
6064	End;
6065
6066
6067	Procedure TMemo.EndUpdate;
6068	Begin
6069	If FUpdateCount=0 Then Exit;
6070	Dec(FUpdateCount);
6071	If FUpdateCount = 0 Then
6072	Begin
6073	If (Handle <> 0) And FEnableWindowUpdate Then
6074	Begin
6075	FEnableWindowUpdate := False;
6076	{$IFDEF OS2}
6077	WinEnableWindowUpdate(Handle,True);
6078	{$ENDIF}
6079	{$IFDEF Win95}
6080	SendMessage(Handle,WM_SETREDRAW,1,0);
6081	{$ENDIF}
6082	End;
6083	End;
6084	End;
6085
6086
6087	Procedure TMemo.CreateParams(Var Params:TCreateParams);
6088	Begin
6089	Inherited CreateParams(Params);
6090
6091	{$IFDEF OS2}
6092	Params.Style := Params.Style or MLS_LIMITVSCROLL;
6093	If FScrollBars In [ssHorizontal,ssBoth]
6094	Then Params.Style := Params.Style Or MLS_HSCROLL;
6095	If FScrollBars In [ssVertical,ssBoth]
6096	Then Params.Style := Params.Style Or MLS_VSCROLL;
6097	If FBorderStyle = bsSingle
6098	Then Params.Style := Params.Style Or MLS_BORDER;
6099	If FWordWrap Then Params.Style := Params.Style Or MLS_WORDWRAP;
6100	If FReadOnly Then Params.Style := Params.Style Or MLS_READONLY;
6101	If Not FWantTabs Then Params.Style := Params.Style Or MLS_IGNORETAB;
6102	{$ENDIF}
6103	{$IFDEF Win95}
6104	Params.Style := Params.Style Or ES_MULTILINE Or ES_LEFT Or
6105	ES_AUTOVSCROLL Or WS_CHILD;
6106	If FScrollBars In [ssHorizontal,ssBoth]
6107	Then Params.Style := Params.Style Or WS_HSCROLL;
6108	If FScrollBars In [ssVertical,ssBoth]
6109	Then Params.Style := Params.Style Or WS_VSCROLL;
6110	If FBorderStyle = bsSingle Then
6111	Begin
6112	Params.Style := Params.Style Or WS_BORDER; {Single}
6113	Params.ExStyle := Params.ExStyle Or WS_EX_CLIENTEDGE; {Double}
6114	End;
6115	If Not FWordWrap Then Params.Style := Params.Style Or ES_AUTOHSCROLL;
6116	{$ENDIF}
6117	End;
6118
6119
6120	Procedure TMemo.SetupShow;
6121	Begin
6122	Inherited SetupShow;
6123
6124	FLines.Assign(FInitLines);
6125	FInitLines.Clear;
6126	End;
6127
6128
6129	Procedure TMemo.DestroyWnd;
6130	Begin
6131	If Handle <> 0 Then
6132	If FInitLines <> Nil Then FInitLines.Assign(FLines);
6133
6134	Inherited DestroyWnd;
6135	End;
6136
6137
6138	Destructor TMemo.Destroy;
6139	Begin
6140	FLines.Destroy;
6141	FLines := Nil;
6142	FInitLines.Destroy;
6143	FInitLines := Nil;
6144
6145	Inherited Destroy;
6146	End;
6147
6148
6149	Procedure TMemo.Clear;
6150	Begin
6151	Lines.Clear;
6152	End;
6153
6154
6155	Procedure TMemo.SelectAll;
6156	{$IFDEF OS2}
6157	Var len:LongInt;
6158	{$ENDIF}
6159	Begin
6160	If Handle = 0 Then Exit;
6161	{$IFDEF OS2}
6162	len := WinSendMsg(Handle,MLM_QUERYTEXTLENGTH,0,0);
6163	WinSendMsg(Handle,MLM_SETSEL,0,len);
6164	{$ENDIF}
6165	{$IFDEF Win95}
6166	SendMessage(Handle,EM_SETSEL,0,-1);
6167	{$ENDIF}
6168	End;
6169
6170
6171	Procedure TMemo.ClearSelection;
6172	Begin
6173	If Handle = 0 Then Exit;
6174	{$IFDEF OS2}
6175	WinSendMsg(Handle,MLM_CLEAR,0,0);
6176	{$ENDIF}
6177	{$IFDEF Win95}
6178	SendMessage(Handle,WM_CLEAR,0,0);
6179	{$ENDIF}
6180	End;
6181
6182
6183	Procedure TMemo.CutToClipBoard;
6184	Begin
6185	If Handle = 0 Then Exit;
6186	{$IFDEF OS2}
6187	WinSendMsg(Handle,MLM_CUT,0,0);
6188	{$ENDIF}
6189	{$IFDEF Win95}
6190	SendMessage(Handle,WM_CUT,0,0);
6191	{$ENDIF}
6192	End;
6193
6194
6195	Procedure TMemo.CopyToClipboard;
6196	Begin
6197	If Handle = 0 Then Exit;
6198	{$IFDEF OS2}
6199	WinSendMsg(Handle,MLM_COPY,0,0);
6200	{$ENDIF}
6201	{$IFDEF Win95}
6202	SendMessage(Handle,WM_COPY,0,0);
6203	{$ENDIF}
6204	End;
6205
6206
6207	Procedure TMemo.PasteFromClipBoard;
6208	Begin
6209	If Handle = 0 Then Exit;
6210	{$IFDEF OS2}
6211	WinSendMsg(Handle,MLM_PASTE,0,0);
6212	{$ENDIF}
6213	{$IFDEF Win95}
6214	SendMessage(Handle,WM_PASTE,0,0);
6215	{$ENDIF}
6216	End;
6217
6218
6219	Function TMemo.GetLines:TStrings;
6220	Begin
6221	If Handle <> 0 Then Result := FLines
6222	Else Result := FInitLines;
6223	End;
6224
6225
6226	Procedure TMemo.SetLines(AStrings:TStrings);
6227	Begin
6228	If AStrings <> Lines Then Lines.Assign(AStrings);
6229	End;
6230
6231
6232	Procedure TMemo.SetScrollBars(NewValue:TScrollStyle);
6233	Begin
6234	If FScrollBars <> NewValue Then
6235	Begin
6236	FScrollBars := NewValue;
6237	RecreateWnd;
6238	End;
6239	End;
6240
6241
6242	Procedure TMemo.SetBorderStyle(NewBorder:TBorderStyle);
6243	Begin
6244	If FBorderStyle <> NewBorder Then
6245	Begin
6246	FBorderStyle := NewBorder;
6247	RecreateWnd;
6248	End;
6249	End;
6250
6251
6252	Procedure TMemo.SetWordWrap(Value:Boolean);
6253	Begin
6254	If FWordWrap <> Value Then
6255	Begin
6256	FWordWrap := Value;
6257	{$IFDEF OS2}
6258	If Handle <> 0 Then SendMsg(Handle,MLM_SETWRAP,Ord(Value),0);
6259	{$ENDIF}
6260	{$IFDEF Win95}
6261	RecreateWnd;
6262	{$ENDIF}
6263	End;
6264	End;
6265
6266
6267	Procedure TMemo.SetReadOnly(Value:Boolean);
6268	Begin
6269	If FReadOnly <> Value Then
6270	Begin
6271	FReadOnly := Value;
6272	{$IFDEF OS2}
6273	If Handle <> 0 Then SendMsg(Handle,MLM_SETREADONLY,Ord(Value),0);
6274	{$ENDIF}
6275	{$IFDEF Win95}
6276	If Handle <> 0 Then SendMsg(Handle,EM_SETREADONLY,Ord(Value),0);
6277	{$ENDIF}
6278	End;
6279	End;
6280
6281
6282	Procedure TMemo.SetWantTabs(Value:Boolean);
6283	Begin
6284	If FWantTabs <> Value Then
6285	Begin
6286	FWantTabs := Value;
6287	{$IFDEF OS2}
6288	RecreateWnd;
6289	{$ENDIF}
6290	End;
6291	End;
6292
6293
6294	{$IFDEF Win95}
6295	Procedure TMemo.WMGetDlgCode(Var Msg:TMessage);
6296	Begin
6297	If FWantTabs Then Msg.Result := Msg.Result Or DLGC_WANTTAB
6298	Else Msg.Result := Msg.Result And Not DLGC_WANTTAB;
6299	{If Not FWantReturns Then
6300	Message.Result := Message.Result And Not DLGC_WANTALLKEYS;}
6301	End;
6302	{$ENDIF}
6303
6304
6305	Procedure TMemo.Resize;
6306	Begin
6307	Inherited Resize;
6308	Invalidate;
6309	End;
6310
6311
6312	Procedure TMemo.changed;
6313	Begin
6314	If OnChange <> Nil Then OnChange(Self);
6315	End;
6316
6317
6318	Procedure TMemo.ParentNotification(Var Msg:TMessage);
6319	Begin
6320	Inherited ParentNotification(Msg); {call DefaultHandler}
6321
6322	{$IFDEF OS2}
6323	If Msg.Param1Hi = MLN_CHANGE Then
6324	{$ENDIF}
6325	{$IFDEF Win95}
6326	If Msg.Param1Hi = EN_CHANGE Then
6327	{$ENDIF}
6328	Begin
6329	FModified := True;
6330	changed;
6331	Msg.Handled := True;
6332	End;
6333	End;
6334
6335	{$HINTS OFF}
6336	Procedure TMemo.CharEvent(Var key:Char;RepeatCount:Byte);
6337	Begin
6338	End;
6339
6340
6341	Procedure TMemo.ScanEvent(Var KeyCode:TKeyCode;RepeatCount:Byte);
6342	Begin
6343	// Always pass shift-Tab thru to TControl as focus change.
6344	// Pass Tab through as focus change, unless
6345	// it's an editable memo (FReadOnly not set)
6346	// AND WantTabs is set.
6347	// If it's editable and WantTabs is set then
6348	// the memo will allow tabs to be inserted in it's text.
6349	If ( KeyCode = kbShiftTab )
6350	Or ( ( KeyCode = kbTab )
6351	And ( ( Not FWantTabs )
6352	Or FReadOnly ) ) Then
6353	Begin
6354	// Handle as focus change
6355	Inherited ScanEvent(KeyCode,RepeatCount);
6356	KeyCode := kbNull;
6357	End
6358	Else
6359	Begin
6360	// Pass to memo for insertion.
6361	LastMsg.CallDefaultHandler;
6362	KeyCode := kbNull;
6363	End;
6364	End;
6365	{$HINTS ON}
6366
6367
6368	Function TMemo.WriteSCUResource(Stream:TResourceStream):Boolean;
6369	Var aText:PChar;
6370	Begin
6371	Result := Inherited WriteSCUResource(Stream);
6372	If Not Result Then Exit;
6373
6374	aText := Lines.GetText;
6375	If aText <> Nil Then
6376	Begin
6377	Result := Stream.NewResourceEntry(rnLines,aText^,Length(aText^)+1);
6378	StrDispose(aText);
6379	End;
6380	End;
6381
6382
6383	Procedure TMemo.ReadSCUResource(Const ResName:TResourceName;Var Data;DataLen:LongInt);
6384	Var aText:PChar;
6385	Begin
6386	If ResName = rnLines Then
6387	Begin
6388	aText := @Data;
6389	Lines.SetText(aText);
6390	End
6391	Else Inherited ReadSCUResource(ResName,Data,DataLen)
6392	End;
6393
6394
6395	Begin
6396	End.

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

Download in other formats:

Original Format