Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

DIALOGS.PAS@ 433

Last change on this file since 433 was 7, checked in by RBRi, 19 years ago
+ sibyl staff
Property svn:eol-style set to `native`
File size: 97.2 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 Dialogs;
11
12
13	Interface
14
15	{$IFDEF OS2}
16	Uses BseDos,BseErr,PmWin,PmStdDlg;
17	{$ENDIF}
18	{$IFDEF Win95}
19	Uses WinDef,WinBase,WinUser,CommDlg;
20	{$ENDIF}
21
22	Uses Dos,SysUtils,Classes,Graphics,Forms,Buttons,StdCtrls,ExtCtrls,ComCtrls,
23	FileCtrl,Printers;
24
25	Type
26	TDialog=Class(TForm)
27	Protected
28	Procedure SetupComponent;Override;
29	Property AutoScroll;
30	Property EnableDocking;
31	Property HorzScrollBar;
32	Property MinTrackWidth;
33	Property MinTrackHeight;
34	Property MaxTrackWidth;
35	Property MaxTrackHeight;
36	Property Menu;
37	Property FormStyle;
38	Property VertScrollBar;
39	Property OnMDIActivate;
40	Property OnMDIDeactivate;
41	Property OnMenuInit;
42	Property OnMenuEnd;
43	Property OnMenuItemFocus;
44	Public
45	Function Execute:Boolean;Virtual;
46	Property Align;
47	Property BorderIcons;
48	Property BorderStyle;
49	Property Bottom;
50	Property ClientHeight;
51	Property ClientWidth;
52	Property Color;
53	Property Cursor;
54	Property Enabled;
55	Property Font;
56	Property Height;
57	Property Hint;
58	Property Icon;
59	Property Left;
60	Property PenColor;
61	Property PopupMenu;
62	Property Right;
63	Property ScrollBars;
64	Property ShowHint;
65	Property Top;
66	Property Visible;
67	Property Width;
68	Property WindowState;
69	Property XAlign;
70	Property XStretch;
71	Property YAlign;
72	Property YStretch;
73
74	Property OnActivate;
75	Property OnClose;
76	Property OnCloseQuery;
77	Property OnCommand;
78	Property OnCreate;
79	Property OnDeactivate;
80	Property OnDestroy;
81	Property OnDismissDlg;
82	Property OnDragDrop;
83	Property OnDragOver;
84	Property OnEndDrag;
85	Property OnFontChange;
86	Property OnHide;
87	Property OnKeyPress;
88	Property OnMaximize;
89	Property OnMinimize;
90	Property OnMouseClick;
91	Property OnMouseDblClick;
92	Property OnMouseDown;
93	Property OnMouseMove;
94	Property OnMouseUp;
95	Property OnMove;
96	Property OnPaint;
97	Property OnResize;
98	Property OnRestore;
99	Property OnScan;
100	Property OnSetupShow;
101	Property OnShow;
102	Property OnTranslateShortCut;
103	End;
104
105
106	TSystemOpenSaveDialog=Class(TComponent)
107	Private
108	FOkName:String;
109	FTitle:String;
110	FFileName:String;
111	FDefaultExt:String;
112	FFilter:String;
113	FFilterIndex:LongInt;
114	FMaskList:TStringList;
115	Protected
116	Procedure SetupComponent;Override;
117	Public
118	Destructor Destroy;Override;
119	Published
120	Property DefaultExt:String Read FDefaultExt Write FDefaultExt;
121	Property FileName:String Read FFileName Write FFileName;
122	Property Filter:String Read FFilter Write FFilter;
123	Property FilterIndex:LongInt Read FFilterIndex Write FFilterIndex;
124	Property OkName:String Read FOkName Write FOkName;
125	Property Title:String Read FTitle Write FTitle;
126	End;
127
128
129	TSystemOpenDialog=Class(TSystemOpenSaveDialog)
130	Protected
131	Procedure SetupComponent;Override;
132	Public
133	Function Execute:Boolean;
134	End;
135
136
137	TSystemSaveDialog=Class(TSystemOpenSaveDialog)
138	Protected
139	Procedure SetupComponent;Override;
140	Public
141	Function Execute:Boolean;
142	End;
143
144
145	TOpenDialog=Class(TDialog)
146	Private
147	FCurDir:String;
148	FTitle:String;
149	FFileName:String;
150	FFilter:String;
151	FFilterIndex:LongInt;
152	FDefaultExt:String;
153	FOkName:String;
154	FFileNameEdit:TEdit;
155	FFilterCombo:TFilterComboBox;
156	FDriveCombo:TDriveComboBox;
157	FFileList:TFileListBox;
158	FDirectoryList:TDirectoryListBox;
159	FCurrentNamePanel:TPanel;
160	FOkButton:TBitBtn;
161	FCancelButton:TBitBtn;
162	FHelpButton:TBitBtn;
163	Procedure SetFileName(Value:String);
164	Function GetFileName:String;
165	Procedure SetCurDir(Value:String);
166	Procedure FileChange(Sender:TObject);
167	Procedure FileSelect(Sender:TObject;Index:LongInt);
168	Procedure EvKillFocus(Sender:TObject);
169	Procedure CMTextChanged(Var Msg:TMessage);Message CM_TEXTCHANGED;
170	Protected
171	Procedure SetupComponent;Override;
172	Procedure SetupShow;Override;
173	Public
174	Procedure DismissDlg(Result:TCommand);Override;
175	Procedure AddFilter(Name,Mask:String);
176	Property Caption;
177	Published
178	Property DefaultExt:String Read FDefaultExt Write FDefaultExt;
179	Property FileName:String Read FFileName Write FFileName;
180	Property Filter:String Read FFilter Write FFilter;
181	Property FilterIndex:LongInt Read FFilterIndex Write FFilterIndex;
182	Property OkName:String Read FOkName Write FOkName;
183	Property Title:String Read FTitle Write FTitle;
184	End;
185
186
187	TSaveDialog=Class(TOpenDialog)
188	Private
189	FCreateButton:TSpeedButton;
190	Procedure EvCreateDir(Sender:TObject);
191	Protected
192	Procedure SetupComponent;Override;
193	End;
194
195
196	TCreateDirDialog=Class(TDialog)
197	Private
198	FOkName:String;
199	FDirectory:String;
200	FChangeDir:Boolean;
201	FDirEdit:TEdit;
202	FChangeCheck:TCheckBox;
203	FOkButton:TBitBtn;
204	FCancelButton:TBitBtn;
205	FHelpButton:TBitBtn;
206	Protected
207	Procedure SetupComponent;Override;
208	Procedure SetupShow;Override;
209	Public
210	Procedure DismissDlg(Result:TCommand);Override;
211	Published
212	Property ChangeDir:Boolean Read FChangeDir Write FChangeDir;
213	Property Directory:String Read FDirectory Write FDirectory;
214	Property OkName:String Read FOkName Write FOkName;
215	End;
216
217
218	TChangeDirDialog=Class(TDialog)
219	Private
220	FOkName:String;
221	FDirectory:String;
222	FFileNameEdit:TEdit;
223	FDriveCombo:TDriveComboBox;
224	FDirectoryList:TDirectoryListBox;
225	FOkButton:TBitBtn;
226	FCancelButton:TBitBtn;
227	FCreateButton:TBitBtn;
228	FHelpButton:TBitBtn;
229	Procedure DirectoryChange(Sender:TObject);
230	Procedure EvCreateDir(Sender:TObject);
231	Protected
232	Procedure SetupComponent;Override;
233	Procedure SetupShow;Override;
234	Public
235	Function Execute:Boolean;Override;
236	Published
237	Property Directory:String Read FDirectory Write FDirectory;
238	Property OkName:String Read FOkName Write FOkName;
239	End;
240
241
242	{$M+}
243	TFindDirection = (fdForward,fdBackward);
244	TFindOrigin = (foEntireScope,foCursor);
245	TFindScope = (fsGlobal,fsSelection);
246	TFindOptions = Set Of (foCaseSensitive,foWordsOnly);
247	{$M-}
248
249	TFindDialog=Class(TDialog)
250	Private
251	Lab_Find:TLabel;
252	CoB_Find:TComboBox;
253	Grp_Options:TGroupBox;
254	ChB_CaseSense:TCheckBox;
255	ChB_WordsOnly:TCheckBox;
256	Grp_Scope:TGroupBox;
257	RaB_Global:TRadioButton;
258	RaB_Selection:TRadioButton;
259	Grp_Origin:TGroupBox;
260	RaB_EntireScope:TRadioButton;
261	RaB_Cursor:TRadioButton;
262	Grp_Direction:TGroupBox;
263	RaB_Forward:TRadioButton;
264	RaB_Backward:TRadioButton;
265	BiB_Find:TBitBtn;
266	BiB_Cancel:TBitBtn;
267	BiB_Help:TBitBtn;
268	FFindTextExt:String;
269	Function GetFindOptions:TFindOptions;
270	Procedure SetFindOptions(Value:TFindOptions);
271	Function GetFindOrigin:TFindOrigin;
272	Procedure SetFindOrigin(Value:TFindOrigin);
273	Function GetFindScope:TFindScope;
274	Procedure SetFindScope(Value:TFindScope);
275	Function GetFindDirection:TFindDirection;
276	Procedure SetFindDirection(Value:TFindDirection);
277	Function GetFindText:String;
278	Procedure SetFindText(Const Value:String);
279	Procedure SetFindTextExtend(Const Value:String);
280	Procedure SetFindHistory(Const Strings:TStringList);
281	Protected
282	Procedure SetupComponent;Override;
283	Procedure SetupShow;Override;
284	Public
285	Property FindHistory:TStringList Write SetFindHistory;
286	Published
287	Property Options:TFindOptions Read GetFindOptions Write SetFindOptions;
288	Property Origin:TFindOrigin Read GetFindOrigin Write SetFindOrigin;
289	Property Scope:TFindScope Read GetFindScope Write SetFindScope;
290	Property Direction:TFindDirection Read GetFindDirection Write SetFindDirection;
291	Property FindText:String Read GetFindText Write SetFindText;
292	Property FindTextExtend:String Read FFindTextExt Write SetFindTextExtend;
293	End;
294
295
296	TReplaceDialog=Class(TFindDialog)
297	Private
298	CoB_Replace:TComboBox;
299	ChB_Confirm:TCheckBox;
300	Function GetConfirm:Boolean;
301	Procedure SetConfirm(Value:Boolean);
302	Function GetReplaceText:String;
303	Procedure SetReplaceText(Const Value:String);
304	Procedure SetReplaceHistory(Const Strings:TStringList);
305	Protected
306	Procedure SetupComponent;Override;
307	Public
308	Property ReplaceHistory:TStringList Write SetReplaceHistory;
309	Published
310	Property Confirm:Boolean Read GetConfirm Write SetConfirm;
311	Property ReplaceText:String Read GetReplaceText Write SetReplaceText;
312	End;
313
314
315	TColorDialog=Class(TDialog)
316	Private
317	FSelColor:TColor;
318	FRedScroll,FGreenScroll,FBlueScroll:TScrollBar;
319	FColorArea:TPanel;
320	FOkBtn:TBitBtn;
321	FDefaultCombo:TComboBox;
322	Procedure SetSelColor(Value:TColor);
323	Procedure EvSelectComboItem(Sender:TObject;Index:LongInt);
324	Protected
325	Procedure SetupComponent;Override;
326	Procedure SetupShow;Override;
327	Procedure Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);Override;
328	Procedure UpdateColorArea;
329	Public
330	Property RGBColor:TColor Read FSelColor Write SetSelColor;
331	End;
332
333
334	TFontDialog=Class(TDialog)
335	Private
336	FNameCombo:TComboBox;
337	FSizeCombo:TComboBox;
338	FExampleText:TButton;
339	FItalicCheck:TCheckBox;
340	FBoldCheck:TCheckBox;
341	FOutlineCheck:TCheckBox;
342	FUnderscoreCheck:TCheckBox;
343	FStrikeOutCheck:TCheckBox;
344	FOkBtn:TBitBtn;
345	Function GetFontName:String;
346	Procedure SetFontName(Value:String);
347	Function GetFaceName:String;
348	Procedure SetFaceName(Value:String);
349	Function GetPointSize:LongInt;
350	Procedure SetPointSize(Value:LongInt);
351	Procedure SetTheFont;
352	Procedure InsertSizes(Var TheFont:TFont);
353	Procedure EvComboSelect(Sender:TObject;Index:LongInt);
354	Procedure EvComboSizeSelect(Sender:TObject;Index:LongInt);
355	Function GetEditFont:TFont;
356	Procedure SetEditFont(NewFont:TFont);
357	Function GetAttributes:TFontAttributes;
358	Procedure SetAttributes(NewValue:TFontAttributes);
359	Procedure StyleChanged(Sender:TObject);
360	Protected
361	Procedure SetupComponent;Override;
362	Procedure SetupShow;Override;
363	Public
364	Property FaceName:String Read GetFaceName Write SetFaceName;
365	Property PointSize:LongInt Read GetPointSize Write SetPointSize;
366	Published
367	Property FontName:String Read GetFontName Write SetFontName;
368	Property EditFont:TFont Read GetEditFont Write SetEditFont;
369	Property Attributes:TFontAttributes Read GetAttributes Write SetAttributes;
370	End;
371
372
373	TPrinterSetupDialog = Class (TDialog)
374	Private
375	FPrinterListHeadLine: TLabel;
376	FPrinterList: TListBox;
377	FPrinterGroupCaption: String;
378	FSetPrinterButton: TBitBtn;
379	FCancelButton: TBitBtn;
380	FPropertyButton: TBitBtn;
381	FHelpButton: TBitBtn;
382	FOkName: String;
383	FOldPrinterIndex: LongInt;
384	Procedure PrinterSelected (Sender: TObject; Index: LongInt);
385	Procedure PrinterFocused (Sender: TObject; Index: LongInt);
386	Procedure PropertyBtnClicked (Sender: TObject);
387	Procedure SetOkName (NewName: String);
388	Protected
389	Procedure SetupComponent; Override;
390	Public
391	Function Execute: Boolean; Override;
392	Published
393	Property OkName: String Read FOkName Write SetOkName;
394	End;
395
396
397	TPrintDialog = Class (TDialog)
398	Private
399	FTitleBox: TGroupBox;
400	FTitle: TEdit;
401	FOptionsGroupBox: TGroupBox;
402	FNumberOfCopiesLabel: TLabel;
403	FNumberOfCopies: TUpDown;
404	FNumberOfCopiesEdit: TEdit;
405	FPagesBox: TRadioGroup;
406	FPrintFromLabel: TRadioButton;
407	FPrintFrom: TUpDown;
408	FPrintFromEdit: TEdit;
409	FPrintToLabel: TLabel;
410	FPrintTo: TUpDown;
411	FPrintToEdit: TEdit;
412	FPrintAll: TRadioButton;
413	FOptionsBox: TRadioGroup;
414	FPrinter: TRadioButton;
415	FFileOutPut: TRadioButton;
416	FFile: TEdit;
417	FPrintButton: TBitBtn;
418	FCancelButton: TBitBtn;
419	FPropertyButton: TBitBtn;
420	FHelpButton: TBitBtn;
421	FCopies: LongInt;
422	FMinPage: LongInt;
423	FMaxPage: LongInt;
424	FFromPage: LongInt;
425	FToPage: LongInt;
426	FAllPages: Boolean;
427	FOkName: String;
428	FOldPrinterIndex: LongInt;
429	Protected
430	Procedure PropertyBtnClicked (Sender: TObject);
431	Procedure SetupComponent; Override;
432	Procedure SetMinPage (NewValue: LongInt);
433	Procedure SetMaxPage (NewValue: LongInt);
434	Procedure SetToPage (NewValue: LongInt);
435	Procedure SetFromPage (NewValue: LongInt);
436	Procedure SetOkName (NewName: String);
437	Procedure UpdateSpinSize (Sender: TObject);
438	Public
439	Function Execute: Boolean; Override;
440	Property AllPages: Boolean Read FAllPages;
441	Property MinPage: LongInt Read FMinPage Write SetMinPage;
442	Property MaxPage: LongInt Read FMaxPage Write SetMaxPage;
443	Property FromPage: LongInt Read FFromPage Write SetFromPage;
444	Property ToPage: LongInt Read FToPage Write SetToPage;
445	Published
446	Property OkName: String Read FOkName Write SetOkName;
447	End;
448
449
450	TMessageBox=Class(TDialog)
451	Private
452	FMsg:String;
453	FHelpCtx:THelpContext;
454	FButtons:TMsgDlgButtons;
455	fType:TMsgDlgType;
456	Protected
457	Procedure SetupShow;Override;
458	Procedure SetupComponent;Override;
459	Published
460	Property Message:String Read FMsg Write FMsg;
461	Property Buttons:TMsgDlgButtons Read FButtons Write FButtons;
462	Property DlgType:TMsgDlgType Read fType Write fType;
463	Property HelpCtx:THelpContext Read FHelpCtx Write FHelpCtx;
464	End;
465
466
467
468	Function MessageBox(Const Msg:String;Typ:TMsgDlgType;Buttons:TMsgDlgButtons):TMsgDlgReturn;
469	Function ErrorBox(Const Msg:String):TMsgDlgReturn;
470
471	Function CreateMessageDialog(Const Msg:String;DlgType:TMsgDlgType;DlgButtons:TMsgDlgButtons):TForm;
472	Function MessageDlg(Const Msg:String;DlgType:TMsgDlgType;DlgButtons:TMsgDlgButtons;HelpCtx:THelpContext):TMsgDlgReturn;
473	Function MessageDlgPos(Const Msg:String;DlgType: TMsgDlgType;DlgButtons:TMsgDlgButtons;HelpCtx:THelpContext;
474	X,Y:LongInt):TMsgDlgReturn;
475	Procedure ShowMessage(Const Msg:String);
476	Procedure ShowMessagePos(Const Msg:String;X,Y:LongInt);
477	Function InputBox(Const ACaption,APrompt,ADefault:String):String;
478	Function InputQuery(Const ACaption,APrompt:String;Var Value:String):Boolean;
479
480	Function ExpandPath(Path,CurDir:String):String;
481
482	Implementation
483
484	{
485	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
486	º º
487	º Speed-Pascal/2 Version 2.0 º
488	º º
489	º Speed-Pascal Component Classes (SPCC) º
490	º º
491	º This section: Some useful FUNCTIONs º
492	º º
493	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
494	º º
495	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
496	}
497
498	Function MessageBox(Const Msg:String;Typ:TMsgDlgType;Buttons:TMsgDlgButtons):TMsgDlgReturn;
499	Var Dlg:TMessageBox;
500	OldDesignerForm:TForm;
501	Begin
502	OldDesignerForm := Nil;
503	If Screen.ActiveForm <> Nil Then
504	If Screen.ActiveForm.Designed Then
505	Begin {Clear the designer flag To Assign the correct Font}
506	OldDesignerForm := Screen.ActiveForm;
507	Exclude(OldDesignerForm.ComponentState, csDesigning);
508	End;
509
510	Dlg.Create(Screen.ActiveForm);
511	Dlg.Width:=200;
512	Dlg.Height:=200;
513	Dlg.Buttons:=Buttons;
514	Dlg.DlgType:=Typ;
515	Dlg.FMsg:=Msg;
516
517	If OldDesignerForm <> Nil {Reset the designer flag}
518	Then Include(OldDesignerForm.ComponentState, csDesigning);
519
520	Dlg.Execute;
521	Case Dlg.ModalResult Of
522	cmOk: Result:=mrOk;
523	cmCancel: Result:=mrCancel;
524	cmYes: Result:=mrYes;
525	cmNo: Result:=mrNo;
526	cmIgnore: Result:=mrIgnore;
527	cmRetry: Result:=mrRetry;
528	cmAbort: Result:=mrAbort;
529	Else Result:=mrCancel;
530	End;
531	Dlg.Destroy;
532	End;
533
534
535	Function ErrorBox(Const Msg:String):TMsgDlgReturn;
536	Begin
537	Beep(1000,200);
538	Result:=MessageBox(Msg,mtError,[mbOk]);
539	End;
540
541
542	Procedure ShowMessage(Const Msg:String);
543	Var Dlg:TMessageBox;
544	OldDesignerForm:TForm;
545	Begin
546	OldDesignerForm := Nil;
547	If Screen.ActiveForm <> Nil Then
548	If Screen.ActiveForm.Designed Then
549	Begin {Clear the designer flag To Assign the correct Font}
550	OldDesignerForm := Screen.ActiveForm;
551	Exclude(OldDesignerForm.ComponentState, csDesigning);
552	End;
553
554	Dlg.Create(Screen.ActiveForm);
555	Dlg.Width:=200;
556	Dlg.Height:=200;
557	Dlg.FButtons:=[mbOk];
558	Dlg.fType:=mtInformation;
559	Dlg.FMsg:=Msg;
560	Dlg.Caption:=ParamStr(0);
561
562	If OldDesignerForm <> Nil {Reset the designer flag}
563	Then Include(OldDesignerForm.ComponentState, csDesigning);
564
565	Dlg.Execute;
566	Dlg.Destroy;
567	End;
568
569	Procedure ShowMessagePos(Const Msg:String;X,Y:LongInt);
570	Var Dlg:TMessageBox;
571	OldDesignerForm:TForm;
572	Begin
573	OldDesignerForm := Nil;
574	If Screen.ActiveForm <> Nil Then
575	If Screen.ActiveForm.Designed Then
576	Begin {Clear the designer flag To Assign the correct Font}
577	OldDesignerForm := Screen.ActiveForm;
578	Exclude(OldDesignerForm.ComponentState, csDesigning);
579	End;
580
581	Dlg.Create(Screen.ActiveForm);
582	Dlg.Width:=200;
583	Dlg.Height:=200;
584	Dlg.Left:=X;
585	Dlg.Top:=Y;
586	Dlg.FButtons:=[mbOk];
587	Dlg.fType:=mtInformation;
588	Dlg.FMsg:=Msg;
589	Dlg.Caption:=ParamStr(0);
590
591	If OldDesignerForm <> Nil {Reset the designer flag}
592	Then Include(OldDesignerForm.ComponentState, csDesigning);
593
594	Dlg.Execute;
595	Dlg.Destroy;
596	End;
597
598	Function CreateMessageDialog(Const Msg:String;DlgType:TMsgDlgType;DlgButtons:TMsgDlgButtons):TForm;
599	Var Dlg:TMessageBox;
600	OldDesignerForm:TForm;
601	Begin
602	OldDesignerForm := Nil;
603	If Screen.ActiveForm <> Nil Then
604	If Screen.ActiveForm.Designed Then
605	Begin {Clear the designer flag To Assign the correct Font}
606	OldDesignerForm := Screen.ActiveForm;
607	Exclude(OldDesignerForm.ComponentState, csDesigning);
608	End;
609
610	Dlg.Create(Screen.ActiveForm);
611	Dlg.Width:=200;
612	Dlg.Height:=200;
613	Dlg.DlgType:=DlgType;
614	Dlg.Buttons:=DlgButtons;
615	Dlg.FMsg:=Msg;
616
617	If OldDesignerForm <> Nil {Reset the designer flag}
618	Then Include(OldDesignerForm.ComponentState, csDesigning);
619
620	Result:=Dlg;
621	End;
622
623	Function MessageDlg(Const Msg:String;DlgType:TMsgDlgType;DlgButtons:TMsgDlgButtons;HelpCtx:THelpContext):TMsgDlgReturn;
624	Var Dlg:TMessageBox;
625	Begin
626	Dlg:=TMessageBox(CreateMessageDialog(Msg,DlgType,DlgButtons));
627	Dlg.HelpCtx:=HelpCtx;
628	Dlg.Execute;
629	Case Dlg.ModalResult Of
630	cmOk: Result:=mrOk;
631	cmCancel: Result:=mrCancel;
632	cmYes: Result:=mrYes;
633	cmNo: Result:=mrNo;
634	cmIgnore: Result:=mrIgnore;
635	cmRetry: Result:=mrRetry;
636	cmAbort: Result:=mrAbort;
637	Else Result:=mrCancel;
638	End;
639	Dlg.Destroy;
640	End;
641
642	Function MessageDlgPos(Const Msg:String;DlgType: TMsgDlgType;DlgButtons:TMsgDlgButtons;HelpCtx:THelpContext;
643	X,Y:LongInt):TMsgDlgReturn;
644	Var Dlg:TMessageBox;
645	Begin
646	Dlg:=TMessageBox(CreateMessageDialog(Msg,DlgType,DlgButtons));
647	Dlg.HelpCtx:=HelpCtx;
648	Dlg.Left:=X;
649	Dlg.Top:=Y;
650	Dlg.Execute;
651	Case Dlg.ModalResult Of
652	cmOk: Result:=mrOk;
653	cmCancel: Result:=mrCancel;
654	cmYes: Result:=mrYes;
655	cmNo: Result:=mrNo;
656	cmIgnore: Result:=mrIgnore;
657	cmRetry: Result:=mrRetry;
658	cmAbort: Result:=mrAbort;
659	Else Result:=mrCancel;
660	End;
661	Dlg.Destroy;
662	End;
663
664	Function InputBox(Const ACaption,APrompt,ADefault:String):String;
665	Begin
666	Result:=ADefault;
667	InputQuery(ACaption,APrompt,Result);
668	End;
669
670	Function InputQuery(Const ACaption,APrompt:String;Var Value:String):Boolean;
671	Var
672	Dlg:TDialog;
673	OldDesignerForm:TForm;
674	FEdit:TEdit;
675	Begin
676	OldDesignerForm := Nil;
677	If Screen.ActiveForm <> Nil Then
678	If Screen.ActiveForm.Designed Then
679	Begin {Clear the designer flag To Assign the correct Font}
680	OldDesignerForm := Screen.ActiveForm;
681	Exclude(OldDesignerForm.ComponentState, csDesigning);
682	End;
683
684	Dlg.Create(Screen.ActiveForm);
685	Dlg.Width:=355;
686	Dlg.Height:=150;
687	Dlg.Caption:=ACaption;
688
689	InsertBitBtn(Dlg,20,10,90,30,bkOk,LoadNLSStr(SOkButton),'');
690	InsertBitBtn(Dlg,120,10,90,30,bkCancel,LoadNLSStr(SCancelButton),'');
691
692	InsertLabel(Dlg,20,90,310,20,APrompt);
693
694	FEdit.Create(Dlg);
695	FEdit.SetWindowPos(20,60,310,20);
696	FEdit.Text:=Value;
697	FEdit.parent:=Dlg;
698	FEdit.Focus;
699
700	If OldDesignerForm <> Nil {Reset the designer flag}
701	Then Include(OldDesignerForm.ComponentState, csDesigning);
702
703	Dlg.Execute;
704	Case Dlg.ModalResult Of
705	cmOk:
706	Begin
707	Value:=FEdit.Text;
708	Result:=True;
709	End;
710	Else Result:=False;
711	End; {Case}
712	Dlg.Destroy;
713	End;
714
715	{
716	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
717	º º
718	º Speed-Pascal/2 Version 2.0 º
719	º º
720	º Speed-Pascal Component Classes (SPCC) º
721	º º
722	º This section: TDialog Class Implementation º
723	º º
724	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
725	º º
726	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
727	}
728
729	Procedure TDialog.SetupComponent;
730	Begin
731	Inherited SetupComponent;
732
733	Name := 'Dialog';
734	XAlign := xaCenter;
735	YAlign := yaCenter;
736	PenColor := clStaticText;
737	Color := clDlgWindow;
738	ParentPenColor := False;
739	ParentColor := False;
740	BorderIcons := [biSystemMenu];
741	BorderStyle := bsDialog;
742	Visible := FALSE;
743	End;
744
745
746	Function TDialog.Execute:Boolean;
747	Begin
748	ShowModal;
749	Result := ModalResult In [cmOk,cmYes];
750	DestroyHandle;
751	End;
752
753
754	{
755	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
756	º º
757	º Speed-Pascal/2 Version 2.0 º
758	º º
759	º Speed-Pascal Component Classes (SPCC) º
760	º º
761	º This section: TSystemOpenSaveDialog Class Implementation º
762	º º
763	º (C) 1995,98 SpeedSoft. All rights reserved. Disclosure probibited ! º
764	º º
765	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
766	}
767
768	Procedure TSystemOpenSaveDialog.SetupComponent;
769	Begin
770	Inherited SetupComponent;
771
772	Name := 'SystemOpenSaveDialog';
773	FFileName := '';
774	FDefaultExt := '';
775	FFilter := '';
776	FFilterIndex := 1;
777	FMaskList.Create;
778	End;
779
780
781	Destructor TSystemOpenSaveDialog.Destroy;
782	Begin
783	Inherited Destroy;
784
785	FMaskList.Destroy;
786	FMaskList := Nil;
787	End;
788
789	{$IFDEF OS2}
790	Procedure SetupFilters(hFCB:Longword;SOSD:TSystemOpenSaveDialog);
791	Var AMask,AFilter:String;
792	S:String;
793	cs:CString;
794	P:Integer;
795	Begin
796	If hFCB = 0 Then exit;
797	If SOSD = Nil Then exit;
798
799	WinSendMsg(hFCB,LM_DELETEALL,0,0);
800	WinSetWindowText(hFCB,'');
801
802	SOSD.FMaskList.Clear;
803
804	S := SOSD.FFilter;
805	P := Pos('\|',S);
806	While P > 0 Do
807	Begin
808	AFilter := Copy(S,1,P-1);
809	Delete(S,1,P);
810	P := Pos('\|',S);
811	If P > 0 Then
812	Begin
813	AMask := Copy(S,1,P-1);
814	Delete(S,1,P);
815	End
816	Else
817	Begin
818	AMask := S;
819	S := '';
820	End;
821	cs := AFilter;
822	WinSendMsg(hFCB,LM_INSERTITEM,LIT_END,LongWord(@cs));
823	SOSD.FMaskList.Add(AMask);
824	P := Pos('\|',S);
825	End;
826	WinSendMsg(hFCB,LM_SELECTITEM,SOSD.FFilterIndex-1,1);
827	End;
828
829
830	Function GetMask(hFCB:Longword;SOSD:TSystemOpenSaveDialog):String;
831	Var itp:LONGINT;
832	Begin
833	Result := '';
834	If hFCB = 0 Then exit;
835	If SOSD = Nil Then exit;
836
837	itp := WinSendMsg(hFCB,LM_QUERYSELECTION,MPFROMSHORT(LIT_FIRST),0);
838
839	If (itp >= 0) And (itp < SOSD.FMaskList.Count)
840	Then Result := SOSD.FMaskList[itp]
841	End;
842
843	Function FileDlgWndProc(Win:HWindow;Msg:LONGWORD;Param1,Param2:LONGWORD):LONGWORD;CDECL;
844	Var hFCB,hFNEd:HWindow;
845	Ext:CString;
846	DlgAdr:^FileDlg;
847	SOSD:TSystemOpenSaveDialog;
848	Begin
849	If (Msg = WM_INITDLG) Then
850	Begin
851	DlgAdr := Pointer(WinQueryWindowULong(Win,QWL_USER));
852	SOSD := TSystemOpenSaveDialog (DlgAdr^.ulUser);
853	hFCB := WinWindowFromId(Win,DID_FILTER_CB);
854	hFNEd := WinWindowFromId(Win,DID_FILENAME_ED);
855	// init the filter combobox
856	SetupFilters(hFCB, SOSD);
857	(*
858	If SOSD.FFileName = '' Then
859	If SOSD.FFilterIndex > 0 Then
860	If SOSD.FFilterIndex <= SOSD.FMaskList.Count Then
861	Begin
862	Ext := SOSD.FMaskList[SOSD.FFilterIndex-1];
863	WinSetWindowText(hFNEd,Ext);
864	WinSetFocus(HWND_DESKTOP,hFNEd);
865	WinPostMsg(hFNEd, WM_CHAR, MPFROM2SHORT(KC_VIRTUALKEY,0),MPFROM2SHORT(0,VK_ENTER));
866	End;
867	*)
868	End;
869
870	If (Msg = WM_CONTROL) And
871	(Lo(param1) = DID_FILTER_CB) And (Hi(param1) = CBN_ENTER) Then
872	Begin
873	DlgAdr := Pointer(WinQueryWindowULong(Win,QWL_USER));
874	SOSD := TSystemOpenSaveDialog (DlgAdr^.ulUser);
875	hFCB := WinWindowFromId(Win,DID_FILTER_CB);
876	hFNEd := WinWindowFromId(Win,DID_FILENAME_ED);
877	// get selected extension
878	Ext := GetMask(hFCB, SOSD);
879	WinSetWindowText(hFNEd,Ext);
880	WinSetFocus(HWND_DESKTOP,hFNEd);
881	WinPostMsg(hFNEd, WM_CHAR, MPFROM2SHORT(KC_VIRTUALKEY,0),MPFROM2SHORT(0,VK_ENTER));
882	FileDlgWndProc := 0;
883	exit;
884	End;
885
886	FileDlgWndProc := WinDefFileDlgProc(Win, Msg, Param1, Param2);
887	End;
888	{$ENDIF}
889
890	{
891	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
892	º º
893	º Speed-Pascal/2 Version 2.0 º
894	º º
895	º Speed-Pascal Component Classes (SPCC) º
896	º º
897	º This section: TSystemOpenDialog Class Implementation º
898	º º
899	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
900	º º
901	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
902	}
903
904	Procedure TSystemOpenDialog.SetupComponent;
905	Begin
906	Inherited SetupComponent;
907
908	Name := 'SystemOpenDialog';
909	FTitle := LoadNLSStr(SOpenAFile);
910	FOkName := LoadNLSStr(SOpen);
911	End;
912
913
914	Function TSystemOpenDialog.Execute:Boolean;
915	Var cTitle,cOKName:cstring;
916	D,N,E:String;
917	{$IFDEF OS2}
918	Dlg:FileDlg;
919	{$ENDIF}
920	{$IFDEF Win95}
921	O:OPENFILENAME;
922	cDefExt:cstring;
923	cres:cstring;
924	{$ENDIF}
925	Begin
926	cTitle:=FTitle;
927	cOKName:=FOkName;
928	{$IFDEF OS2}
929	FillChar(Dlg,SizeOf(FileDlg),0); {Clear Dialog structure}
930
931	Dlg.cbSize:=SizeOf(FileDlg);
932	Dlg.fl:=FDS_OPEN_DIALOG \| FDS_CENTER \| FDS_ENABLEFILELB \| FDS_FILTERUNION;
933	Dlg.pszTitle:=@cTitle;
934	Dlg.pszOkButton:=@cOKName;
935	Dlg.szFullFile:=FFileName;
936	Dlg.ulUser := Longword(Self);
937	Dlg.pfnDlgProc := @FileDlgWndProc;
938
939	WinFileDlg(HWND_DESKTOP,HWND_DESKTOP,Dlg);
940	Result := Dlg.lReturn = 1; {DID_OK}
941	If Result Then FFileName := Dlg.szFullFile;
942	{$ENDIF}
943
944	{$IFDEF Win95}
945	FillChar(O,SizeOf(OPENFILENAME),0); {Clear Dialog structure}
946
947	O.lStructSize:=SizeOf(OPENFILENAME);
948	If Owner Is TControl Then O.hwndOwner:=TControl(Owner).Handle
949	Else O.hwndOwner:=0;
950	O.lpStrTitle:=@cTitle;
951	cDefExt:=FDefaultExt;
952	O.lpstrDefExt:=@cDefExt;
953	O.Flags:=OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST;
954	cres:=FFileName;
955	O.lpStrFile:=@cres;
956	O.nMaxFile:=254;
957	O.hInstance:=AppHandle;
958	Result := GetOpenFileName(O);
959	If Result Then FFileName := O.lpStrFile^;
960	{$ENDIF}
961
962	If Result Then
963	Begin
964	FSplit(FFileName,D,N,E);
965	If E = '' Then FFileName := FFileName + '.' + FDefaultExt;
966	End;
967	End;
968
969	{
970	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
971	º º
972	º Speed-Pascal/2 Version 2.0 º
973	º º
974	º Speed-Pascal Component Classes (SPCC) º
975	º º
976	º This section: TSystemSaveDialog Class Implementation º
977	º º
978	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
979	º º
980	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
981	}
982
983	Procedure TSystemSaveDialog.SetupComponent;
984	Begin
985	Inherited SetupComponent;
986
987	Name := 'SystemSaveDialog';
988	FTitle := LoadNLSStr(SSaveFileAs);
989	FOkName := LoadNLSStr(SSave);
990	End;
991
992
993	Function TSystemSaveDialog.Execute:Boolean;
994	Var cTitle,cOKName:cstring;
995	D,N,E:String;
996	{$IFDEF OS2}
997	Dlg:FileDlg;
998	{$ENDIF}
999	{$IFDEF Win95}
1000	O:OPENFILENAME;
1001	cDefExt:cstring;
1002	cres:cstring;
1003	{$ENDIF}
1004	Begin
1005	cTitle:=FTitle;
1006	cOKName:=FOkName;
1007	{$IFDEF OS2}
1008	FillChar(Dlg,SizeOf(FileDlg),0); {Clear Dialog structure}
1009
1010	Dlg.cbSize:=SizeOf(FileDlg);
1011	Dlg.fl:=FDS_SAVEAS_DIALOG \| FDS_CENTER \| FDS_ENABLEFILELB \| FDS_FILTERUNION;
1012	Dlg.pszTitle:=@cTitle;
1013	Dlg.pszOkButton:=@cOKName;
1014	Dlg.szFullFile:=FFileName;
1015	Dlg.ulUser := Longword(Self);
1016	Dlg.pfnDlgProc := @FileDlgWndProc;
1017
1018	WinFileDlg(HWND_DESKTOP,HWND_DESKTOP,Dlg);
1019	Result := Dlg.lReturn = 1; {DID_OK}
1020	If Result Then FFileName := Dlg.szFullFile;
1021	{$ENDIF}
1022	{$IFDEF Win95}
1023	FillChar(O,SizeOf(OPENFILENAME),0); {Clear Dialog structure}
1024
1025	O.lStructSize:=SizeOf(OPENFILENAME);
1026	If Owner Is TControl Then O.hwndOwner:=TControl(Owner).Handle
1027	Else O.hwndOwner:=0;
1028	O.lpStrTitle:=@cTitle;
1029	cDefExt:=FDefaultExt;
1030	O.lpstrDefExt:=@cDefExt;
1031	O.Flags:=0;
1032	cres:=FFileName;
1033	O.lpStrFile:=@cres;
1034	O.nMaxFile:=254;
1035	O.hInstance:=AppHandle;
1036	Result := GetOpenFileName(O);
1037	If Result Then FFileName := O.lpStrFile^;
1038	{$ENDIF}
1039
1040	If Result Then
1041	Begin
1042	FSplit(FFileName,D,N,E);
1043	If E = '' Then FFileName := FFileName + '.' + FDefaultExt;
1044	End;
1045	End;
1046
1047
1048	{
1049	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1050	º º
1051	º Speed-Pascal/2 Version 2.0 º
1052	º º
1053	º Speed-Pascal Component Classes (SPCC) º
1054	º º
1055	º This section: TOpenDialog Class Implementation º
1056	º º
1057	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1058	º º
1059	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1060	}
1061
1062	Procedure TOpenDialog.SetupComponent;
1063	Begin
1064	Inherited SetupComponent;
1065
1066	ClientWidth := 470;
1067	ClientHeight := 370;
1068	Name := 'OpenDialog';
1069	FOkName := LoadNLSStr(SOpenButton);
1070	FTitle := LoadNLSStr(SOpenAFile);
1071	FFileName := '';
1072	FFilter := '';
1073	FFilterIndex := 1;
1074	FDefaultExt := '';
1075
1076	InsertLabel(Self,20,340,390,20,LoadNLSStr(SFilename)+':');
1077	FFileNameEdit := InsertEdit(Self,20,314,430,26,'',''); {oder Combo}
1078
1079	InsertLabel(Self,20,290,160,20,LoadNLSStr(SDrive)+':');
1080	FDriveCombo := InsertDriveComboBox(Self,20,264,170,26);
1081
1082	InsertLabel(Self,200,290,250,20,LoadNLSStr(SFileType)+':');
1083	FFilterCombo := InsertFilterComboBox(Self,200,264,250,26);
1084
1085	InsertLabel(Self,20,240,160,20,LoadNLSStr(SDirectories)+':');
1086	FDirectoryList := InsertDirectoryListBox(Self,20,90,170,148);
1087	FDirectoryList.HorzScroll := True;
1088	FDirectoryList.OnExit := EvKillFocus;
1089
1090	InsertLabel(Self,200,240,250,20,LoadNLSStr(SFiles)+':');
1091	FFileList := InsertFileListBox(Self,200,90,250,148);
1092	FFileList.HorzScroll := True;
1093	FFileList.OnChange := FileChange;
1094	FFileList.OnItemSelect := FileSelect;
1095	FFileList.OnExit := EvKillFocus;
1096
1097	FCurrentNamePanel := InsertPanel(Self,20,55,430,25,bvNone,bvLowered,1,'');
1098	FCurrentNamePanel.Alignment := taLeftJustify;
1099	FCurrentNamePanel.PenColor := clWindowText;
1100
1101	FOkButton := InsertBitBtn(Self,20,15,100,30,bkOk,LoadNLSStr(SOpenButton),LoadNLSStr(SClickHereToAccept));
1102	FCancelButton := InsertBitBtn(Self,130,15,100,30,bkCancel,LoadNLSStr(SCancelButton),LoadNLSStr(SClickHereToCancel));
1103	FHelpButton := InsertBitBtn(Self,350,15,100,30,bkHelp,LoadNLSStr(SHelpButton),LoadNLSStr(SClickHereToGetHelp));
1104
1105	{Connect}
1106	FDriveCombo.DirList := FDirectoryList;
1107	FFilterCombo.FileList := FFileList;
1108	FDirectoryList.FileList := FFileList;
1109	{FFileList.FileEdit := FFileNameEdit; See FileChange}
1110
1111	SetCurDir(''); {Current dir}
1112	End;
1113
1114
1115	Procedure TOpenDialog.SetupShow;
1116	Begin
1117	Inherited SetupShow;
1118
1119	Caption := FTitle;
1120	FOkButton.Caption := FOkName;
1121
1122	If FFilter <> '' Then FFilterCombo.Filter := FFilter;
1123	If FFilterIndex >= 1 Then FFilterCombo.ItemIndex := FFilterIndex - 1;
1124	SetFileName(FFileName);
1125	FileChange(Nil);
1126
1127	{$IFDEF Win32}
1128	FFileList.SetWindowPos(200,90,250,148);
1129	{$ENDIF}
1130
1131	FFileNameEdit.Focus;
1132	FOkButton.Default := True;
1133	End;
1134
1135
1136	Function ExpandPath(Path,CurDir:String):String;
1137	Var I,P:Byte;
1138	S:String;
1139	Label L,l2;
1140	Begin
1141	S := CurDir;
1142	If Length(S) = 3 Then
1143	If S[2] = ':' Then
1144	If S[3] In ['\','/'] Then Dec(S[0]);
1145
1146	If (Pos('\',Path) = 1) Or (Pos('/',Path) = 1)
1147	Then Path := Copy(S,1,2) + Path;
1148
1149	If (Length(Path) >= 2) And (Path[2] = ':') Then
1150	Begin
1151	S := Copy(Path,1,2);
1152	Delete(Path,1,2);
1153	End;
1154	If Not (Path[1] In ['\','/']) Then Path := '\'+ Path;
1155
1156	Repeat
1157	If ((Pos('\..',Path) = 1) Or (Pos('/..',Path) = 1)) Then
1158	Begin
1159	If (Length(Path) >= 4) And (Not (Path[4] In ['\','/'])) Then Goto l2;
1160	Delete(Path,1,3);
1161	For I := Length(S) DownTo 3 Do
1162	Begin
1163	If S[I] = ':' Then break;
1164	Dec(S[0]);
1165	If S[I] In ['\','/'] Then break;
1166	End;
1167	End
1168	Else
1169	If ((Pos('\.',Path) = 1) Or (Pos('/.',Path) =1)) Then
1170	Begin
1171	If (Length(Path) >= 3) And (Not (Path[3] In ['\','/'])) Then Goto l2;
1172	Delete(Path,1,2);
1173	End
1174	Else
1175	If ((Pos('\',Path) = 1) Or (Pos('/',Path) = 1)) Then
1176	Begin
1177	l2:
1178	Delete(Path,1,1);
1179	S := S + '\';
1180	End
1181	Else
1182	Begin
1183	L:
1184	P := Pos('\',Path);
1185	If P = 0 Then P := Pos('/',Path);
1186	If P > 0 Then
1187	Begin
1188	S := S + Copy(Path,1,P-1);
1189	Delete(Path,1,P-1);
1190	End
1191	Else
1192	Begin
1193	S := S + Path;
1194	Path := '';
1195	End;
1196	End;
1197	Until Path = '';
1198	If Length(S) = 2 Then S := S +'\';
1199
1200	Result := S;
1201	End;
1202
1203
1204	Procedure TOpenDialog.DismissDlg(Result:TCommand);
1205	Var S,D,N,E,lw,dn:String;
1206	dismiss:Boolean;
1207	Status:Integer;
1208	Search:TSearchRec;
1209	pn:Integer;
1210	Begin
1211	If Result = cmOk Then
1212	Begin
1213	{check If we can dismiss}
1214	S := FFileNameEdit.Caption;
1215	While S[Length(S)] = #32 Do Dec(S[0]);
1216	If S = '' Then
1217	Begin
1218	ModalResult := cmNull; {Reset}
1219	Exit;
1220	End;
1221
1222	dismiss := True;
1223	{check If we MUST Change dir}
1224	S := ExpandPath(S,FCurDir);
1225	FSplit(S,D,N,E);
1226	pn := Pos('*',N);
1227	If (E = '') Or (pn <> 0) Then
1228	Begin {Test If we MUST Change Directory}
1229	lw := D+N;
1230	Delete(lw,1,1); {Test 'x:\'; FindFirst can't detect it}
1231
1232	dn := D + N;
1233	If dn[Length(dn)] In ['\','/'] Then SetLength(dn,Length(dn)-1);
1234
1235	Status := FindFirst(dn,faDirectory,Search);
1236	If (Status = 0) Or (lw = ':\') Or (lw = ':/') Then
1237	Begin
1238	If pn <> 0 Then SetCurDir(D)
1239	Else SetCurDir(D+N);
1240
1241	If pn = 0 Then {no wildcards}
1242	Begin
1243	FFileList.Directory := FCurDir; {?}
1244	If E = '' Then FFileNameEdit.Caption := FFileList.Mask
1245	Else FFileNameEdit.Caption := E; {???}
1246	FFileNameEdit.SelectAll;
1247	dismiss := False;
1248	End;
1249	End;
1250	FindClose(Search);
1251	End;
1252
1253	If pn <> 0 Then
1254	Begin
1255	FFileList.Directory := FCurDir; {?}
1256	FFileList.Mask := N + E;
1257	FFileNameEdit.Caption := FFileList.Mask;
1258	FFileNameEdit.SelectAll;
1259	dismiss := False;
1260	End;
1261
1262	If Not dismiss Then
1263	Begin
1264	ModalResult := cmNull; {Reset}
1265	Exit;
1266	End;
1267	End;
1268
1269	FFileName := GetFileName;
1270	FFilterIndex := FFilterCombo.ItemIndex + 1;
1271
1272	Inherited DismissDlg(Result);
1273	End;
1274
1275
1276	Procedure TOpenDialog.AddFilter(Name,Mask:String);
1277	Begin
1278	If FFilter <> '' Then Name := '\|' + Name;
1279	FFilter := FFilter + Name + '\|' + Mask;
1280	End;
1281
1282
1283	{$HINTS OFF}
1284	Procedure TOpenDialog.FileChange(Sender:TObject);
1285	Var S,D,N,E:String;
1286	Begin
1287	{TFileListBox.Change}
1288	If ExtractFileName(FFileList.FileName) <> '' Then
1289	Begin
1290	FFileNameEdit.Caption := ExtractFileName(FFileList.FileName);
1291	FFileNameEdit.SelectAll;
1292	End; {Else the old FileName}
1293
1294	FCurDir := FFileList.Directory;
1295	S := FCurDir + '\' + FFileNameEdit.Caption;
1296	If FDefaultExt <> '' Then
1297	Begin
1298	FSplit(S,D,N,E);
1299	If E = '' Then S := S + '.' + FDefaultExt;
1300	End;
1301	FCurrentNamePanel.Caption := S;
1302	End;
1303
1304
1305	Procedure TOpenDialog.FileSelect(Sender:TObject;Index:LongInt);
1306	Begin
1307	FileChange(Sender);
1308	DismissDlg(cmOk);
1309	End;
1310	{$HINTS ON}
1311
1312
1313	Procedure TOpenDialog.SetFileName(Value:String);
1314	Var D,N,E,actdir:String;
1315	Begin
1316	FSplit(Value,D,N,E);
1317
1318	{$I-}
1319	GetDir(0,actdir);
1320	If Length(D) > 3 Then Dec(D[0]);
1321	ChDir(D);
1322	If InOutRes = 0 Then
1323	Begin
1324	SetCurDir(D);
1325	FFileList.Directory := FCurDir; {?}
1326	End;
1327	ChDir(actdir);
1328	{$I+}
1329
1330	If N + E <> '' Then FFileNameEdit.Caption := N + e
1331	Else FFileNameEdit.Caption := FFileList.Mask;
1332	End;
1333
1334
1335	Function TOpenDialog.GetFileName:String;
1336	Var D,N,E:String;
1337	Begin
1338	Result := FFileNameEdit.Caption;
1339	If Pos('\',Result) = 0 Then Result := FCurDir + '\' + Result;
1340
1341	FSplit(Result,D,N,E);
1342	If E = '' Then If N<>'' Then Result := D + N + '.' + FDefaultExt;
1343	End;
1344
1345
1346	Procedure TOpenDialog.SetCurDir(Value:String);
1347	Begin
1348	If Value = '' Then
1349	Begin
1350	{$I-}
1351	GetDir(0,FCurDir);
1352	{$I+}
1353	End
1354	Else FCurDir := Value;
1355
1356	If FCurDir[Length(FCurDir)] In ['\','/'] Then Dec(FCurDir[0]);
1357	FCurrentNamePanel.Caption := FCurDir + '\' + FFileNameEdit.Caption;
1358	End;
1359
1360
1361	{$HINTS OFF}
1362	Procedure TOpenDialog.CMTextChanged(Var Msg:TMessage);
1363	Begin
1364	FTitle := Caption;
1365	End;
1366
1367
1368	Procedure TOpenDialog.EvKillFocus(Sender:TObject);
1369	Begin
1370	If Sender Is TListBox Then TListBox(Sender).ItemIndex := -1;
1371	End;
1372	{$HINTS ON}
1373
1374	{
1375	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1376	º º
1377	º Speed-Pascal/2 Version 2.0 º
1378	º º
1379	º Speed-Pascal Component Classes (SPCC) º
1380	º º
1381	º This section: TSaveDialog Class Implementation º
1382	º º
1383	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1384	º º
1385	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1386	}
1387
1388	Procedure TSaveDialog.SetupComponent;
1389	Begin
1390	Inherited SetupComponent;
1391
1392	Name := 'SaveDialog';
1393	FOkName := LoadNLSStr(SSaveButton);
1394	FTitle := LoadNLSStr(SSaveFileAs);
1395
1396	FFileNameEdit.Width := FFileNameEdit.Width - 30;
1397
1398	FCreateButton := InsertSpeedButton(Self,450-25,314,25,25,0,'',
1399	LoadNLSStr(SCreateDirectory));
1400	FCreateButton.Kind := bkOpen;
1401	FCreateButton.Caption := '';
1402	FCreateButton.OnClick := EvCreateDir;
1403	End;
1404
1405	{$HINTS OFF}
1406	Procedure TSaveDialog.EvCreateDir(Sender:TObject);
1407	Var CreateDirDlg:TCreateDirDialog;
1408	Begin
1409	CreateDirDlg.Create(Self);
1410	CreateDirDlg.Directory := FDirectoryList.Directory;
1411	If CreateDirDlg.Execute Then
1412	Begin
1413	If CreateDirDlg.ChangeDir
1414	Then FDirectoryList.Directory := CreateDirDlg.Directory
1415	Else FDirectoryList.Directory := FDirectoryList.Directory; {rebuild List}
1416	End;
1417	CreateDirDlg.Destroy;
1418	End;
1419	{$HINTS ON}
1420
1421	{
1422	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1423	º º
1424	º Speed-Pascal/2 Version 2.0 º
1425	º º
1426	º Speed-Pascal Component Classes (SPCC) º
1427	º º
1428	º This section: TCreateDirDialog Class Implementation º
1429	º º
1430	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1431	º º
1432	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1433	}
1434
1435	Procedure TCreateDirDialog.SetupComponent;
1436	Var group:TGroupBox;
1437	Begin
1438	Inherited SetupComponent;
1439
1440	ClientWidth := 370;
1441	ClientHeight := 180;
1442
1443	Name := 'CreateDirDialog';
1444	Caption := LoadNLSStr(SCreateDirectory);
1445	FOkName := LoadNLSStr(SCreateButton);
1446	FDirectory := '';
1447
1448	group := InsertGroupBox(Self,20,60,330,100,LoadNLSStr(SEnterNewDirectory));
1449	FDirEdit := InsertEdit(group,15,45,300,26,'','');
1450	FChangeCheck := InsertCheckBox(group,15,15,300,20,LoadNLSStr(SChangeToTargetDir),'');
1451
1452	FOkButton := InsertBitBtn(Self,20,15,100,30,bkOk,FOkName,LoadNLSStr(SClickHereToAccept));
1453	FCancelButton := InsertBitBtn(Self,130,15,100,30,bkCancel,LoadNLSStr(SCancelButton),LoadNLSStr(SClickHereToCancel));
1454	FHelpButton := InsertBitBtn(Self,240,15,100,30,bkHelp,LoadNLSStr(SHelpButton),LoadNLSStr(SClickHereToGetHelp));
1455	End;
1456
1457
1458	Procedure TCreateDirDialog.SetupShow;
1459	Begin
1460	Inherited SetupShow;
1461
1462	If FDirectory = '' Then
1463	Begin
1464	{$I-}
1465	GetDir(0,FDirectory);
1466	{$I+}
1467	If FDirectory[Length(FDirectory)] In ['\','/']
1468	Then Dec(FDirectory[0]);
1469	End;
1470
1471	FDirEdit.Text := FDirectory;
1472	FDirEdit.Focus;
1473	FDirEdit.SelectAll;
1474	FChangeCheck.Checked := FChangeDir;
1475	FOkButton.Caption := FOkName;
1476	FOkButton.Default := True;
1477	End;
1478
1479
1480	Function CreateDir(Init,dir:String):Boolean;
1481	{$IFDEF OS2}
1482	Const
1483	NoError = NO_ERROR;
1484	PathNotFound = ERROR_PATH_NOT_FOUND;
1485	{$ENDIF}
1486	{$IFDEF WIN32}
1487	Const
1488	NoError = 0;
1489	PathNotFound = 3;
1490	{$ENDIF}
1491
1492	Procedure NormalizeDir(Var S:String);
1493	Begin
1494	If Length(S) > 3 Then
1495	If S[Length(S)] = '\' Then SetLength(S,Length(S)-1);
1496	End;
1497
1498	Var
1499	Name,ext,makedir,dir1:String;
1500	rc,P:LongWord;
1501	Label err;
1502	Begin
1503	Result := True;
1504	If Init = '' Then
1505	Begin
1506	{$I-}
1507	GetDir(0,Init);
1508	{$I+}
1509	End;
1510	NormalizeDir(dir);
1511
1512	If Pos('\',dir) = 1 Then dir := Copy(Init,1,2) + dir;
1513	If Pos(':',dir) = 0 Then dir := Init + '\' + dir;
1514	NormalizeDir(dir);
1515
1516	makedir := '';
1517	rc := PathNotFound;
1518	While rc <> NoError Do
1519	Begin
1520	{$I-}
1521	MkDir(dir);
1522	{$I+}
1523	rc := IOResult;
1524	If rc = PathNotFound Then
1525	Begin
1526	FSplit(dir,dir1,Name,ext);
1527	dir := dir1;
1528	NormalizeDir(dir);
1529	If dir[Length(dir)] = ':' Then Goto err;
1530	makedir := Name + '\' + makedir;
1531	End
1532	Else If rc <> NoError Then Goto err;
1533	End;
1534
1535	While makedir <> '' Do
1536	Begin
1537	P := Pos('\',makedir);
1538	dir := dir + '\' + Copy(makedir,1,P-1);
1539	Delete(makedir,1,P);
1540	{$I-}
1541	MkDir(dir);
1542	{$I+}
1543	rc := IOResult;
1544	If rc <> NoError Then Goto err;
1545	End;
1546	Exit;
1547	err:
1548	ErrorBox(LoadNLSStr(SError)+' [' + tostr(rc) + '] : '+LoadNLSStr(SCannotCreateDir)+' !');
1549	Result := False;
1550	End;
1551
1552
1553	Procedure TCreateDirDialog.DismissDlg(Result:TCommand);
1554	Var FInitDir:String;
1555	Begin
1556	If Result = cmOk Then
1557	Begin
1558	FInitDir := FDirectory; {Initial Directory from App}
1559	FDirectory := ExpandPath(FDirEdit.Text,FInitDir);
1560	FChangeDir := FChangeCheck.Checked;
1561
1562	If CreateDir(FInitDir,FDirectory) Then
1563	Begin
1564	If FChangeDir Then
1565	Begin
1566	{$I-}
1567	ChDir(FDirectory);
1568	{$I+}
1569	End;
1570	End
1571	Else
1572	Begin
1573	ModalResult := cmNull; {Reset}
1574	FDirEdit.CaptureFocus;
1575	Exit;
1576	End;
1577	End;
1578
1579	Inherited DismissDlg(Result);
1580	End;
1581
1582
1583	{
1584	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1585	º º
1586	º Speed-Pascal/2 Version 2.0 º
1587	º º
1588	º Speed-Pascal Component Classes (SPCC) º
1589	º º
1590	º This section: TChangeDirDialog Class Implementation º
1591	º º
1592	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1593	º º
1594	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1595	}
1596
1597	Procedure TChangeDirDialog.SetupComponent;
1598	Begin
1599	Inherited SetupComponent;
1600
1601	ClientWidth := 440;
1602	ClientHeight := 300;
1603
1604	Name := 'ChangeDirDialog';
1605	Caption := LoadNLSStr(SChangeDirectory);
1606	FOkName := LoadNLSStr(SChangeButton);
1607	InsertLabel(Self,20,265,270,20,LoadNLSStr(SDirectoryName)+':');
1608	FFileNameEdit := InsertEdit(Self,20,240,270,26,'','');
1609
1610	InsertLabel(Self,20,215,270,20,LoadNLSStr(SDrive)+':');
1611	FDriveCombo := InsertDriveComboBox(Self,20,185,270,26);
1612
1613	InsertLabel(Self,20,160,270,20,LoadNLSStr(SDirectories)+':');
1614	{$IFDEF OS2}
1615	FDirectoryList := InsertDirectoryListBox(Self,20,20,270,140);
1616	{$ENDIF}
1617	{$IFDEF WIN32}
1618	FDirectoryList := InsertDirectoryListBox(Self,20,45{???},270,140);
1619	{$ENDIF}
1620	FDirectoryList.OnChange := DirectoryChange;
1621	FDriveCombo.DirList := FDirectoryList;
1622
1623	FOkButton := InsertBitBtn(Self,315,240,105,30,bkOk,FOkName,LoadNLSStr(SClickHereToAccept));
1624	FOkButton.Margin := 10;
1625	FCancelButton := InsertBitBtn(Self,315,200,105,30,bkCancel,LoadNLSStr(SCancelButton),LoadNLSStr(SClickHereToCancel));
1626	FCancelButton.Margin := 10;
1627	FCreateButton := InsertBitBtn(Self,315,160,105,30,bkOpen,LoadNLSStr(SCreateButton),LoadNLSStr(SClickHereToCreateADir));
1628	FCreateButton.Margin := 10;
1629	FCreateButton.ModalResult := 0; {dont Close the Dialog}
1630	FCreateButton.OnClick := EvCreateDir;
1631	FHelpButton := InsertBitBtn(Self,315,120,105,30,bkHelp,LoadNLSStr(SHelpButton),LoadNLSStr(SClickHereToGetHelp));
1632	FHelpButton.Margin := 10;
1633	End;
1634
1635
1636	Procedure TChangeDirDialog.SetupShow;
1637	Begin
1638	Inherited SetupShow;
1639
1640	If FDirectory = '' Then
1641	Begin
1642	{$I-}
1643	GetDir(0,FDirectory);
1644	{$I+}
1645	If FDirectory[Length(FDirectory)] In ['\','/']
1646	Then Dec(FDirectory[0]);
1647	End;
1648	FDirectoryList.Directory := FDirectory;
1649
1650	FFileNameEdit.Focus;
1651	FFileNameEdit.SelectAll;
1652	FOkButton.Caption := FOkName;
1653	FOkButton.Default := True;
1654	End;
1655
1656
1657	{$HINTS OFF}
1658	Procedure TChangeDirDialog.DirectoryChange(Sender:TObject);
1659	Begin
1660	FFileNameEdit.Caption := FDirectoryList.Directory;
1661	End;
1662	{$HINTS ON}
1663
1664
1665	Function TChangeDirDialog.Execute:Boolean;
1666	Begin
1667	Result := Inherited Execute;
1668	If Result Then
1669	Begin
1670	FDirectory := ExpandPath(FFileNameEdit.Caption, FDirectoryList.Directory);
1671
1672	If Length(FDirectory) > 3 Then
1673	If FDirectory[Length(FDirectory)] = '\'
1674	Then SetLength(FDirectory,Length(FDirectory)-1);
1675	{$I-}
1676	ChDir(FDirectory);
1677	{$I+}
1678	End;
1679	End;
1680
1681	{$HINTS OFF}
1682	Procedure TChangeDirDialog.EvCreateDir(Sender:TObject);
1683	Var CreateDirDlg:TCreateDirDialog;
1684	Begin
1685	CreateDirDlg.Create(Self);
1686	CreateDirDlg.Directory := FDirectoryList.Directory;
1687	If CreateDirDlg.Execute Then
1688	Begin
1689	If CreateDirDlg.ChangeDir
1690	Then FDirectoryList.Directory := CreateDirDlg.Directory
1691	Else FDirectoryList.Directory := FDirectoryList.Directory; {rebuild List}
1692	End;
1693	CreateDirDlg.Destroy;
1694	End;
1695	{$HINTS ON}
1696
1697	{
1698	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1699	º º
1700	º Speed-Pascal/2 Version 2.0 º
1701	º º
1702	º Speed-Pascal Component Classes (SPCC) º
1703	º º
1704	º This section: TFindDialog Class Implementation º
1705	º º
1706	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1707	º º
1708	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1709	}
1710
1711	Procedure TFindDialog.SetupComponent;
1712	Begin
1713	Inherited SetupComponent;
1714
1715	Name := 'FindDialog';
1716	Caption := LoadNLSStr(SFindText);
1717	ClientWidth := 430;
1718	ClientHeight := 310;
1719
1720	Lab_Find := InsertLabel(Self,20,270,70,20,LoadNLSStr(SFind)+':');
1721	CoB_Find := InsertComboBox(Self,110,270,300,20,csDropDown);
1722
1723	Grp_Options := InsertGroupBox(Self,20,170,180,75,LoadNLSStr(SOptions));
1724	ChB_CaseSense := InsertCheckBox(Grp_Options,15,30,160,20,LoadNLSStr(SCaseSensitive),'');
1725	ChB_WordsOnly := InsertCheckBox(Grp_Options,15,10,160,20,LoadNLSStr(SWordsOnly),'');
1726
1727	Grp_Scope := InsertGroupBox(Self,230,170,180,75,LoadNLSStr(SScope));
1728	RaB_Global := InsertRadioButton(Grp_Scope,15,30,160,20,LoadNLSStr(SGlobal),'');
1729	RaB_Selection := InsertRadioButton(Grp_Scope,15,10,160,20,LoadNLSStr(SSelectedText),'');
1730
1731	Grp_Origin := InsertGroupBox(Self,20,70,180,75,LoadNLSStr(SOrigin));
1732	RaB_EntireScope := InsertRadioButton(Grp_Origin,15,30,160,20,LoadNLSStr(SEntireScope),'');
1733	RaB_Cursor := InsertRadioButton(Grp_Origin,15,10,160,20,LoadNLSStr(SFromCursor),'');
1734
1735	Grp_Direction := InsertGroupBox(Self,230,70,180,75,LoadNLSStr(SDirection));
1736	RaB_Forward := InsertRadioButton(Grp_Direction,15,30,160,20,LoadNLSStr(SForwardButton),'');
1737	RaB_Backward := InsertRadioButton(Grp_Direction,15,10,160,20,LoadNLSStr(SBackwardButton),'');
1738
1739	BiB_Find := InsertBitBtn(Self,20,20,90,30,bkOk,LoadNLSStr(SFindButton),LoadNLSStr(SClickHereToAccept));
1740	BiB_Cancel := InsertBitBtn(Self,130,20,100,30,bkCancel,LoadNLSStr(SCancelButton),LoadNLSStr(SClickHereToCancel));
1741	BiB_Help := InsertBitBtn(Self,320,20,90,30,bkHelp,LoadNLSStr(SHelpButton),LoadNLSStr(SClickHereToGetHelp));
1742	End;
1743
1744
1745	Procedure TFindDialog.SetupShow;
1746	Begin
1747	Inherited SetupShow;
1748
1749	CoB_Find.Focus;
1750	BiB_Find.Default := True;
1751	End;
1752
1753
1754	Function TFindDialog.GetFindOptions:TFindOptions;
1755	Begin
1756	Result := [];
1757	If ChB_CaseSense.Checked Then Result := Result + [foCaseSensitive];
1758	If ChB_WordsOnly.Checked Then Result := Result + [foWordsOnly];
1759	End;
1760
1761	Procedure TFindDialog.SetFindOptions(Value:TFindOptions);
1762	Begin
1763	ChB_CaseSense.Checked := Value * [foCaseSensitive] <> [];
1764	ChB_WordsOnly.Checked := Value * [foWordsOnly] <> [];
1765	End;
1766
1767	Function TFindDialog.GetFindOrigin:TFindOrigin;
1768	Begin
1769	If RaB_EntireScope.Checked Then Result := foEntireScope
1770	Else Result := foCursor;
1771	End;
1772
1773	Procedure TFindDialog.SetFindOrigin(Value:TFindOrigin);
1774	Begin
1775	RaB_EntireScope.Checked := Value = foEntireScope;
1776	RaB_Cursor.Checked := Value = foCursor;
1777	End;
1778
1779	Function TFindDialog.GetFindScope:TFindScope;
1780	Begin
1781	If RaB_Global.Checked Then Result := fsGlobal
1782	Else Result := fsSelection;
1783	End;
1784
1785	Procedure TFindDialog.SetFindScope(Value:TFindScope);
1786	Begin
1787	RaB_Global.Checked := Value = fsGlobal;
1788	RaB_Selection.Checked := Value = fsSelection;
1789	End;
1790
1791	Function TFindDialog.GetFindDirection:TFindDirection;
1792	Begin
1793	If RaB_Forward.Checked Then Result := fdForward
1794	Else Result := fdBackward;
1795	End;
1796
1797	Procedure TFindDialog.SetFindDirection(Value:TFindDirection);
1798	Begin
1799	RaB_Forward.Checked := Value = fdForward;
1800	RaB_Backward.Checked := Value = fdBackward;
1801	End;
1802
1803	Function TFindDialog.GetFindText:String;
1804	Begin
1805	Result := CoB_Find.Caption;
1806	End;
1807
1808	Procedure TFindDialog.SetFindText(Const Value:String);
1809	Begin
1810	CoB_Find.Caption := Value;
1811	End;
1812
1813	Procedure TFindDialog.SetFindTextExtend(Const Value:String);
1814	Begin
1815	CoB_Find.TextExtension := Value;
1816	FFindTextExt := Value;
1817	End;
1818
1819	Procedure TFindDialog.SetFindHistory(Const Strings:TStringList);
1820	Begin
1821	CoB_Find.Items := Strings;
1822	End;
1823
1824
1825	{
1826	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1827	º º
1828	º Speed-Pascal/2 Version 2.0 º
1829	º º
1830	º Speed-Pascal Component Classes (SPCC) º
1831	º º
1832	º This section: TReplaceDialog Class Implementation º
1833	º º
1834	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1835	º º
1836	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1837	}
1838
1839	Procedure TReplaceDialog.SetupComponent;
1840	Var BiB_All:TBitBtn;
1841	Begin
1842	Inherited SetupComponent;
1843
1844	Name := 'ReplaceDialog';
1845	Caption := LoadNLSStr(SReplaceText);
1846	ClientWidth := 430;
1847	ClientHeight := 350;
1848
1849	Lab_Find.Bottom := 310;
1850	CoB_Find.Bottom := 310;
1851	InsertLabel(Self,20,270,70,20,LoadNLSStr(SReplace)+':');
1852	CoB_Replace := InsertComboBox(Self,110,270,300,20,csDropDown);
1853	CoB_Replace.TabOrder := CoB_Find.TabOrder +1;
1854
1855	Grp_Options.SetWindowPos(20,150,180,95);
1856	ChB_CaseSense.Bottom := 50;
1857	ChB_WordsOnly.Bottom := 30;
1858	ChB_Confirm := InsertCheckBox(Grp_Options,15,10,160,20,LoadNLSStr(SConfirmButton),'');
1859	ChB_Confirm.TabOrder := ChB_WordsOnly.TabOrder +1;
1860
1861	BiB_Find.Width := 110;
1862	BiB_Find.Caption := LoadNLSStr(SReplaceButton);
1863	BiB_All := InsertBitBtn(Self,140,20,75,30,bkAll,LoadNLSStr(SAllButton),'');
1864	BiB_All.TabOrder := BiB_Find.TabOrder +1;
1865	BiB_Cancel.SetWindowPos(225,20,95,30);
1866	BiB_Help.SetWindowPos(330,20,80,30);
1867	End;
1868
1869	Function TReplaceDialog.GetConfirm:Boolean;
1870	Begin
1871	Result := ChB_Confirm.Checked;
1872	End;
1873
1874	Procedure TReplaceDialog.SetConfirm(Value:Boolean);
1875	Begin
1876	ChB_Confirm.Checked := Value;
1877	End;
1878
1879	Function TReplaceDialog.GetReplaceText:String;
1880	Begin
1881	Result := CoB_Replace.Caption;
1882	End;
1883
1884	Procedure TReplaceDialog.SetReplaceText(Const Value:String);
1885	Begin
1886	CoB_Replace.Caption := Value;
1887	End;
1888
1889	Procedure TReplaceDialog.SetReplaceHistory(Const Strings:TStringList);
1890	Begin
1891	CoB_Replace.Items := Strings;
1892	End;
1893
1894
1895	{
1896	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1897	º º
1898	º Speed-Pascal/2 Version 2.0 º
1899	º º
1900	º Speed-Pascal Component Classes (SPCC) º
1901	º º
1902	º This section: TColorDialog Class Implementation º
1903	º º
1904	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
1905	º º
1906	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1907	}
1908
1909	Procedure TColorDialog.SetupComponent;
1910	Var T:LongInt;
1911	Btn:TBitBtn;
1912	Begin
1913	Inherited SetupComponent;
1914
1915	ClientWidth:=420;
1916	ClientHeight:=200;
1917	Name:='ColorDialog';
1918	Caption:=LoadNLSStr(SSelectAColor);
1919
1920	FRedScroll:=InsertScrollBar(Self,20,20,16,160,sbVertical);
1921	FRedScroll.color:=clRed;
1922	FRedScroll.SetScrollRange(0,255,1);
1923	FRedScroll.LargeChange:=8;
1924	FGreenScroll:=InsertScrollBar(Self,50,20,16,160,sbVertical);
1925	FGreenScroll.color:=clLime;
1926	FGreenScroll.SetScrollRange(0,255,1);
1927	FGreenScroll.LargeChange:=8;
1928	FBlueScroll:=InsertScrollBar(Self,80,20,16,160,sbVertical);
1929	FBlueScroll.color:=clBlue;
1930	FBlueScroll.SetScrollRange(0,255,1);
1931	FBlueScroll.LargeChange:=8;
1932
1933	FDefaultCombo:=InsertComboBox(Self,120,160,150,20,csDropDownList);
1934	FDefaultCombo.Text:=LoadNLSStr(SDefaultColors);
1935	FDefaultCombo.sorted:=True;
1936	FDefaultCombo.DropDownCount := 7;
1937	FDefaultCombo.OnItemSelect:=EvSelectComboItem;
1938	For T:=1 To MaxDefaultColors
1939	Do FDefaultCombo.Items.Add(DefaultColors[T].Name);
1940	For T:=1 To MaxSystemColors
1941	Do FDefaultCombo.Items.Add(SystemColors[T].Name);
1942
1943	FColorArea.Create(Self);
1944	FColorArea.SetWindowPos(120,20,150,120);
1945	FColorArea.BorderStyle:=bsSingle;
1946	FColorArea.BevelInner:=bvNone;
1947	FColorArea.BevelOuter:=bvNone;
1948	InsertControl(FColorArea);
1949	SetSelColor(FSelColor);
1950
1951	FOkBtn := InsertBitBtn(Self,300,145,100,35,bkOk,LoadNLSStr(SSelectButton),LoadNLSStr(SClickHereToAccept));
1952	FOkBtn.Margin := 10;
1953	Btn := InsertBitBtn(Self,300,105,100,35,bkCancel,LoadNLSStr(SCancelButton),LoadNLSStr(SClickHereToCancel));
1954	Btn.Margin := 10;
1955	Btn := InsertBitBtn(Self,300,65,100,35,bkHelp,LoadNLSStr(SHelpButton),LoadNLSStr(SClickHereToGetHelp));
1956	Btn.Margin := 10;
1957	End;
1958
1959
1960	Procedure TColorDialog.SetupShow;
1961	Begin
1962	Inherited SetupShow;
1963
1964	FColorArea.Canvas.Brush.Mode := bmTransparent;
1965
1966	FDefaultCombo.Focus;
1967	FOkBtn.Default := True;
1968	End;
1969
1970
1971	Procedure TColorDialog.SetSelColor(Value:TColor);
1972	Begin
1973	FSelColor := SysColorToRGB(Value);
1974	FColorArea.color := FSelColor;
1975	FRedScroll.Position := TRGB(FSelColor).Red;
1976	FGreenScroll.Position := TRGB(FSelColor).Green;
1977	FBlueScroll.Position := TRGB(FSelColor).Blue;
1978	UpdateColorArea;
1979	End;
1980
1981	{$HINTS OFF}
1982	Procedure TColorDialog.Scroll(ScrollBar:TScrollBar;ScrollCode:TScrollCode;Var ScrollPos:LongInt);
1983	Begin
1984	TRGB(FSelColor).Fill:=0;
1985	If ScrollBar=FRedScroll Then TRGB(FSelColor).Red:=ScrollPos
1986	Else If ScrollBar=FGreenScroll Then TRGB(FSelColor).Green:=ScrollPos
1987	Else If ScrollBar=FBlueScroll Then TRGB(FSelColor).Blue:=ScrollPos;
1988
1989	FDefaultCombo.Text := LoadNLSStr(SDefaultColors);
1990	UpdateColorArea;
1991	End;
1992
1993
1994	Procedure TColorDialog.EvSelectComboItem(Sender:TObject;Index:LongInt);
1995	Var S:String;
1996	Col:TColor;
1997	T:LongInt;
1998	Label found;
1999	Begin
2000	S:=FDefaultCombo.Caption;
2001
2002	For T:=1 To MaxDefaultColors Do
2003	Begin
2004	If DefaultColors[T].Name=S Then
2005	Begin
2006	FSelColor:=DefaultColors[T].Value;
2007	Goto found;
2008	End;
2009	End;
2010
2011	For T:=1 To MaxSystemColors Do
2012	Begin
2013	If SystemColors[T].Name=S Then
2014	Begin
2015	FSelColor:=SystemColors[T].Value;
2016	break;
2017	End;
2018	End;
2019	found:
2020
2021	Col:=SysColorToRGB(FSelColor);
2022	FRedScroll.Position:=TRGB(Col).Red;
2023	FGreenScroll.Position:=TRGB(Col).Green;
2024	FBlueScroll.Position:=TRGB(Col).Blue;
2025
2026	UpdateColorArea;
2027	End;
2028	{$HINTS ON}
2029
2030
2031	Procedure TColorDialog.UpdateColorArea;
2032	Var Col:TColor;
2033	Begin
2034	Col:=SysColorToRGB(FSelColor);
2035	FColorArea.PenColor := OppositeRGB(Col);
2036	FColorArea.color := Col;
2037	FColorArea.Caption := 'RGB('+tostr(TRGB(Col).Red)+','
2038	+tostr(TRGB(Col).Green)+','
2039	+tostr(TRGB(Col).Blue)+')';
2040	End;
2041
2042	{
2043	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2044	º º
2045	º Speed-Pascal/2 Version 2.0 º
2046	º º
2047	º Speed-Pascal Component Classes (SPCC) º
2048	º º
2049	º This section: TFontDialog Class Implementation º
2050	º º
2051	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2052	º º
2053	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2054	}
2055
2056	Procedure TFontDialog.SetupComponent;
2057	Var T:LongInt;
2058	aFont:TFont;
2059	group:TGroupBox;
2060	Begin
2061	Inherited SetupComponent;
2062
2063	Name:='FontDialog';
2064	Caption:=LoadNLSStr(SSelectAFont);
2065	Width:=400;
2066	Height:=330;
2067	color:=clLtGray;
2068
2069	group:=InsertGroupBox(Self,5,5,280,Height-40,'');
2070	group.ZOrder:=zoBottom;
2071
2072	InsertLabel(Self,12,270,80,20,LoadNLSStr(SName)+':');
2073	FNameCombo:=InsertComboBox(Self,12,250-100,200,120,csDropDownList);
2074	FNameCombo.sorted := True;
2075	FNameCombo.Duplicates:=False;
2076	FNameCombo.OnItemSelect:=EvComboSelect;
2077
2078	InsertLabel(Self,218,270,50,20,LoadNLSStr(SSize)+':');
2079	FSizeCombo:=InsertComboBox(Self,218,250-100,60,120,csDropDown);
2080	FSizeCombo.OnItemSelect:=EvComboSizeSelect;
2081	FSizeCombo.Duplicates:=False;
2082
2083	group:=InsertGroupBox(Self,12,150,110,90,LoadNLSStr(SStyle));
2084	group.ZOrder:=zoTop;
2085	FItalicCheck:=InsertCheckBox(Self,20,200,95,20,LoadNLSStr(SItalic),'');
2086	FItalicCheck.OnClick:=StyleChanged;
2087	FBoldCheck:=InsertCheckBox(Self,20,180,95,20,LoadNLSStr(SBold),'');
2088	FBoldCheck.OnClick:=StyleChanged;
2089
2090	group:=InsertGroupBox(Self,127,150,150,90,LoadNLSStr(SEmphasis));
2091	group.ZOrder:=zoTop;
2092	FOutlineCheck:=InsertCheckBox(Self,135,200,135,20,LoadNLSStr(SOutline),'');
2093	FOutlineCheck.OnClick:=StyleChanged;
2094	FStrikeOutCheck:=InsertCheckBox(Self,135,180,135,20,LoadNLSStr(SStrikeout),'');
2095	FStrikeOutCheck.OnClick:=StyleChanged;
2096	FUnderscoreCheck:=InsertCheckBox(Self,135,160,135,20,LoadNLSStr(SUnderscore),'');
2097	FUnderscoreCheck.OnClick:=StyleChanged;
2098
2099	FExampleText:=InsertButton(Self,10,20,270,120,LoadNLSStr(SExampleText),'');
2100	FExampleText.OnClick:=StyleChanged;
2101
2102	For T:=0 To Screen.FontCount-1 Do
2103	Begin
2104	aFont:=Screen.Fonts[T];
2105	FNameCombo.Items.Add(aFont.FaceName);
2106	End;
2107	FNameCombo.Items.Add('System Default Font');
2108
2109	FOkBtn := InsertBitBtn(Self,290,240,90,30,bkOk,LoadNLSStr(SOkButton),LoadNLSStr(SClickHereToAccept));
2110	InsertBitBtn(Self,290,200,90,30,bkCancel,LoadNLSStr(SCancelButton),LoadNLSStr(SClickHereToCancel));
2111	InsertBitBtn(Self,290,160,90,30,bkHelp,LoadNLSStr(SHelpButton),LoadNLSStr(SClickHereToGetHelp));
2112
2113	SetFontName(''); {Init}
2114	End;
2115
2116
2117	Procedure TFontDialog.SetupShow;
2118	Begin
2119	SetTheFont;
2120
2121	Inherited SetupShow;
2122
2123	FNameCombo.Focus;
2124	FOkBtn.Default := True;
2125	End;
2126
2127	Function ModifyFontName(FontName:String;Const Attrs:TFontAttributes):String;
2128	Begin
2129	Result:=FontName;
2130	UpcaseStr(FontName);
2131	If Attrs*[faItalic]<>[] Then If Pos(' ITALIC',FontName)=0 Then Result:=Result+'.Italic';
2132	If Attrs*[faBold]<>[] Then If Pos(' BOLD',FontName)=0 Then Result:=Result+'.Bold';
2133	If Attrs*[faOutline]<>[] Then Result:=Result+'.Outline';
2134	If Attrs*[faStrikeOut]<>[] Then Result:=Result+'.Strikeout';
2135	If Attrs*[faUnderScore]<>[] Then Result:=Result+'.Underscore';
2136	End;
2137
2138	Function TFontDialog.GetAttributes:TFontAttributes;
2139	Var S:String;
2140	Begin
2141	Result:=[];
2142
2143	S:=FNameCombo.Caption;
2144	UpcaseStr(S);
2145	If FItalicCheck.Checked Then
2146	If Pos(' ITALIC',S)=0 Then Result:=Result+[faItalic];
2147	If FBoldCheck.Checked Then
2148	If Pos(' BOLD',S)=0 Then Result:=Result+[faBold];
2149	If FOutlineCheck.Checked Then Result:=Result+[faOutline];
2150	If FStrikeOutCheck.Checked Then Result:=Result+[faStrikeOut];
2151	If FUnderscoreCheck.Checked Then Result:=Result+[faUnderScore];
2152	End;
2153
2154	Procedure TFontDialog.SetAttributes(NewValue:TFontAttributes);
2155	Var S:String;
2156	Begin
2157	S:=FNameCombo.Caption;
2158	S:=ModifyFontName(S,NewValue);
2159	If PointSize<>0 Then FontName:=tostr(PointSize)+'.'+s
2160	Else FontName:=S;
2161	End;
2162
2163	Function TFontDialog.GetFaceName:String;
2164	Begin
2165	Result:=FNameCombo.Caption;
2166	Result:=ModifyFontName(Result,Attributes);
2167	End;
2168
2169	Procedure TFontDialog.SetFaceName(Value:String);
2170	Var S:String;
2171	Begin
2172	S:=Value;
2173	UpcaseStr(S);
2174	FBoldCheck.Checked:=FBoldCheck.Checked Or(Pos(' BOLD',S)<>0);
2175	FItalicCheck.Checked:=FItalicCheck.Checked Or(Pos(' ITALIC',S)<>0);
2176	Value:=ModifyFontName(Value,Attributes);
2177	If PointSize<>0 Then FontName:=tostr(PointSize)+'.'+Value
2178	Else FontName:=Value;
2179	End;
2180
2181
2182	Function TFontDialog.GetPointSize:LongInt;
2183	Var S:String;
2184	C:Integer;
2185	Begin
2186	If FNameCombo.Caption='System Default Font' Then Result:=Screen.DefaultFont.PointSize
2187	Else
2188	Begin
2189	S:=FSizeCombo.Caption;
2190	Val(S,Result,C);
2191	If C<>0 Then Result:=0;
2192	End;
2193	End;
2194
2195
2196	Procedure TFontDialog.SetPointSize(Value:LongInt);
2197	Begin
2198	If Value=0 Then Value:=8;
2199	FontName:=tostr(Value)+'.'+FaceName;
2200	End;
2201
2202
2203	Function TFontDialog.GetEditFont:TFont;
2204	Begin
2205	Result:=Screen.GetFontFromPointSize(FaceName,PointSize);
2206	End;
2207
2208	Procedure TFontDialog.SetEditFont(NewFont:TFont);
2209	Var S:String;
2210	Attrs:TFontAttributes;
2211	Begin
2212	If NewFont=Nil Then NewFont:=Screen.DefaultFont;
2213
2214	If NewFont.IsDefault Then
2215	Begin
2216	S:=tostr(Screen.DefaultFont.PointSize)+'.'+'System Default Font';;
2217	FBoldCheck.Checked:=False;
2218	FItalicCheck.Checked:=False;
2219	FontName:=S;
2220	End
2221	Else
2222	Begin
2223	S:=NewFont.FaceName;
2224	UpcaseStr(S);
2225	Attrs:=NewFont.Attributes;
2226	FBoldCheck.Checked:=(Pos(' BOLD',S)<>0)Or(Attrs*[faBold]<>[]);
2227	FItalicCheck.Checked:=(Pos(' ITALIC',S)<>0)Or(Attrs*[faItalic]<>[]);
2228	S:=NewFont.FaceName;
2229	S:=ModifyFontName(S,NewFont.Attributes);
2230	If NewFont.PointSize<>0 Then FontName:=tostr(NewFont.PointSize)+'.'+s
2231	Else FontName:=S;
2232	End;
2233	End;
2234
2235	{$HINTS OFF}
2236	Procedure TFontDialog.StyleChanged(Sender:TObject);
2237	Begin
2238	If Handle<>0 Then SetTheFont;
2239	End;
2240	{$HINTS ON}
2241
2242	Function TFontDialog.GetFontName:String;
2243	Begin
2244	Result := tostr(PointSize) + '.' + FaceName;
2245	End;
2246
2247
2248	Procedure TFontDialog.SetFontName(Value:String);
2249	Var S,s1:String;
2250	DefPointSize,T:LongInt;
2251	B:Byte;
2252	C:Integer;
2253	Attrs:TFontAttributes;
2254	Label L;
2255	Begin
2256	If Value = '' Then Value := '8.Helv';
2257	B := Pos('.',Value);
2258	If B <> 0 Then
2259	Begin
2260	S := Copy(Value,1,B-1);
2261	Delete(Value,1,B);
2262	If Value='' Then Value:='Helv';
2263	Val(S,DefPointSize,C);
2264	If C <> 0 Then DefPointSize := 8;
2265	End
2266	Else DefPointSize := 8;
2267
2268	Attrs:=[];
2269	S:=Value;
2270	UpcaseStr(S);
2271	L:
2272	For T:=Length(S) DownTo 1 Do
2273	Begin
2274	If S[T]='.' Then
2275	Begin
2276	s1:=Copy(S,T+1,255);
2277	If ((s1='BOLD')Or(s1='ITALIC')Or(s1='UNDERSCORE')Or(s1='STRIKEOUT')Or
2278	(s1='OUTLINE')) Then
2279	Begin
2280	S[0]:=Chr(T-1);
2281	Value[0]:=Chr(T-1);
2282
2283	If s1='BOLD' Then Attrs:=Attrs+[faBold]
2284	Else If s1='ITALIC' Then Attrs:=Attrs+[faItalic]
2285	Else If s1='UNDERSCORE' Then Attrs:=Attrs+[faUnderScore]
2286	Else If s1='STRIKEOUT' Then Attrs:=Attrs+[faStrikeOut]
2287	Else If s1='OUTLINE' Then Attrs:=Attrs+[faOutline];
2288	End;
2289	End;
2290	End;
2291
2292	If Value='System Default Font' Then
2293	Begin
2294	FNameCombo.Caption := Value;
2295	FSizeCombo.Caption := tostr(Screen.DefaultFont.PointSize);
2296	End
2297	Else
2298	Begin
2299	For T := 0 To Screen.FontCount-1 Do If Screen.Fonts[T].FaceName = Value Then
2300	Begin
2301	FNameCombo.Caption := Value;
2302	FSizeCombo.Caption := tostr(DefPointSize);
2303	break;
2304	End;
2305	End;
2306
2307	UpcaseStr(Value);
2308	FItalicCheck.Checked:=((Attrs*[faItalic]<>[])Or(Pos(' ITALIC',Value)<>0));
2309	FBoldCheck.Checked:=((Attrs*[faBold]<>[])Or(Pos(' BOLD',Value)<>0));
2310
2311	FOutlineCheck.Checked:=Attrs*[faOutline]<>[];
2312	FUnderscoreCheck.Checked:=Attrs*[faUnderScore]<>[];
2313	FStrikeOutCheck.Checked:=Attrs*[faStrikeOut]<>[];
2314
2315	If Handle<>0 Then SetTheFont;
2316	End;
2317
2318
2319	Procedure TFontDialog.SetTheFont;
2320	{$IFDEF OS2}
2321	Var C:cstring;
2322	{$ENDIF}
2323	Var Font:TFont;
2324	IsDefault:Boolean;
2325	S,Value:String;
2326	T:LongInt;
2327	B:Byte;
2328	Label L;
2329	Begin
2330	IsDefault:=False;
2331	S:=FNameCombo.Caption;
2332	If S='System Default Font' Then
2333	Begin
2334	FSizeCombo.Caption:=tostr(Screen.DefaultFont.PointSize);
2335	FSizeCombo.Enabled:=False;
2336	IsDefault:=True;
2337	End
2338	Else FSizeCombo.Enabled:=True;
2339
2340	For T:=0 To Screen.FontCount-1 Do
2341	Begin
2342	Font:=Screen.Fonts[T];
2343	If Font.FaceName=S Then
2344	Begin
2345	If Font.FontType=ftBitmap Then
2346	Begin
2347	FOutlineCheck.Checked:=False;
2348	FOutlineCheck.Enabled:=False;
2349	End
2350	Else FOutlineCheck.Enabled:=Not IsDefault;
2351	Goto L;
2352	End;
2353	End;
2354
2355	FOutlineCheck.Enabled:=Not IsDefault;
2356	L:
2357	Value:=FNameCombo.Caption;
2358	UpcaseStr(Value);
2359
2360	If Pos(' ITALIC',Value)<>0 Then
2361	Begin
2362	If Not FItalicCheck.Checked Then
2363	Begin
2364	B:=Pos(' ITALIC',Value);
2365	S:=FNameCombo.Caption;
2366	Delete(S,B,7);
2367	FNameCombo.Caption:=S;
2368	End;
2369	FItalicCheck.Enabled:=True;
2370	End
2371	Else FItalicCheck.Enabled:=Not IsDefault;
2372
2373	If Pos(' BOLD',Value)<>0 Then
2374	Begin
2375	If Not FBoldCheck.Checked Then
2376	Begin
2377	B:=Pos(' BOLD',Value);
2378	S:=FNameCombo.Caption;
2379	Delete(S,B,5);
2380	FNameCombo.Caption:=S;
2381	End;
2382	FBoldCheck.Enabled:=True;
2383	End
2384	Else FBoldCheck.Enabled:=Not IsDefault;
2385
2386	Value:=FNameCombo.Caption;
2387	UpcaseStr(Value);
2388	FItalicCheck.Checked:=FItalicCheck.Checked Or (Pos(' ITALIC',Value)<>0);
2389	FBoldCheck.Checked:=FBoldCheck.Checked Or (Pos(' BOLD',Value)<>0);
2390
2391	FStrikeOutCheck.Enabled:=Not IsDefault;
2392	FUnderscoreCheck.Enabled:=Not IsDefault;
2393
2394	Font:=Screen.GetFontFromPointSize(FaceName,PointSize);
2395	InsertSizes(Font);
2396	If Font<>Nil Then
2397	Begin
2398	Font:=Screen.CreateCompatibleFont(Font);
2399	Font.AutoDestroy:=True;
2400	FExampleText.Font:=Font;
2401	FNameCombo.Caption:=FExampleText.Font.FaceName;
2402	FSizeCombo.Caption:=tostr(FExampleText.Font.PointSize);
2403	End
2404	Else
2405	Begin
2406	{$IFDEF OS2}
2407	C := FontName;
2408	WinSetPresParam(FExampleText.Handle,PP_FONTNAMESIZE,Length(C)+1,C);
2409	{$ENDIF}
2410	End;
2411	End;
2412
2413	Procedure TFontDialog.InsertSizes(Var TheFont:TFont);
2414	Var C,c1,c2,T,t1:LongInt;
2415	OldCaption:String;
2416	cc:Integer;
2417	CaptionUpdated:Boolean;
2418	OldFont:TFont;
2419	Label weiter,found,TryThis;
2420	{$IFDEF WIN32}
2421	Label defSize;
2422	{$ENDIF}
2423	Begin
2424	OldCaption:=FSizeCombo.Caption;
2425
2426	FSizeCombo.BeginUpdate;
2427	FSizeCombo.Clear;
2428
2429	{$IFDEF WIN32}
2430	goto defSize;
2431	{$ENDIF}
2432
2433	If TheFont=Nil Then
2434	Begin
2435	{$IFDEF WIN32}
2436	defsize:
2437	{$ENDIF}
2438	C:=4;
2439	While C<48 Do
2440	Begin
2441	FSizeCombo.Items.Add(tostr(C));
2442	Inc(C,2);
2443	End;
2444	End
2445	Else
2446	Begin
2447	If TheFont.MinimumPointSize=TheFont.MaximumPointSize Then
2448	Begin
2449	CaptionUpdated:=False;
2450	TryThis:
2451	For T:=0 To Screen.FontCount-1 Do
2452	Begin
2453	If Screen.Fonts[T].FaceName=FNameCombo.Caption Then
2454	Begin
2455	c2:=Screen.Fonts[T].MinimumPointSize;
2456	If c2<4 Then c2:=4;
2457
2458	While ((c2<48)And(c2<=Screen.Fonts[T].MaximumPointSize)) Do
2459	Begin
2460	C:=c2;
2461
2462	For t1:=0 To FSizeCombo.Items.Count-1 Do
2463	Begin
2464	Val(FSizeCombo.Items[t1],c1,cc);
2465	If cc=0 Then
2466	Begin
2467	If c1<4 Then c1:=4;
2468	If c1=C Then Goto weiter;
2469	If c1>C Then
2470	Begin
2471	Goto found;
2472	End;
2473	End;
2474	End;
2475	t1:=FSizeCombo.Items.Count;
2476	found:
2477	FSizeCombo.Items.Insert(t1,tostr(C));
2478	weiter:
2479	If c2 And 1<>0 Then Inc(c2)
2480	Else Inc(c2,2);
2481	End; //While
2482	End;
2483	End;
2484
2485	If ((Not CaptionUpdated)And(FSizeCombo.Items.IndexOf(OldCaption)<0)) Then
2486	Begin
2487	If ((TheFont.NominalPointSize<>0)And
2488	(FSizeCombo.Items.IndexOf(tostr(TheFont.NominalPointSize))>=0)) Then
2489	OldCaption:=tostr(TheFont.NominalPointSize)
2490	Else If FSizeCombo.Items.Count>0 Then
2491	OldCaption:=FSizeCombo.Items[0];
2492	End;
2493	End
2494	Else
2495	Begin
2496	C:=TheFont.MinimumPointSize;
2497	If C<4 Then C:=4;
2498
2499	While ((C<48)And(C<=TheFont.MaximumPointSize)) Do
2500	Begin
2501	FSizeCombo.Items.Add(tostr(C));
2502	If C And 1<>0 Then Inc(C)
2503	Else Inc(C,2);
2504	End;
2505
2506	Val(OldCaption,c1,cc);
2507	If cc=0 Then
2508	Begin
2509	If ((c1<TheFont.MinimumPointSize)Or(c1>TheFont.MaximumPointSize)) Then
2510	Begin
2511	If TheFont.NominalPointSize<>0 Then
2512	OldCaption:=tostr(TheFont.NominalPointSize)
2513	Else If FSizeCombo.Items.Count>0 Then
2514	OldCaption:=FSizeCombo.Items[0];
2515	End;
2516	End;
2517	CaptionUpdated:=True;
2518	Goto TryThis;
2519	End;
2520	End;
2521
2522	FSizeCombo.Caption := OldCaption;
2523	FSizeCombo.EndUpdate;
2524	//recreate Font In Case that Size changed
2525	OldFont:=TheFont;
2526	TheFont:=Screen.GetFontFromPointSize(FaceName,PointSize);
2527	If TheFont=Nil Then TheFont:=OldFont;
2528	End;
2529
2530
2531	{$HINTS OFF}
2532	Procedure TFontDialog.EvComboSelect(Sender:TObject;Index:LongInt);
2533	Var S:String;
2534	Begin
2535	S:=FNameCombo.Text;
2536	UpcaseStr(S);
2537	If Pos(' BOLD',S)<>0 Then
2538	Begin
2539	If Pos(' ITALIC',S)<>0 Then
2540	Begin
2541	FBoldCheck.Checked:=True;
2542	FItalicCheck.Checked:=True;
2543	End
2544	Else
2545	Begin
2546	FBoldCheck.Checked:=True;
2547	FItalicCheck.Checked:=False;
2548	End;
2549	End
2550	Else If Pos(' ITALIC',S)<>0 Then
2551	Begin
2552	FBoldCheck.Checked:=False;
2553	FItalicCheck.Checked:=True;
2554	End
2555	Else
2556	Begin
2557	FBoldCheck.Checked:=False;
2558	FItalicCheck.Checked:=False;
2559	End;
2560
2561	SetTheFont;
2562	End;
2563
2564
2565	Procedure TFontDialog.EvComboSizeSelect(Sender:TObject;Index:LongInt);
2566	Begin
2567	SetTheFont;
2568	End;
2569	{$HINTS ON}
2570
2571
2572	{
2573	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2574	º º
2575	º Speed-Pascal/2 Version 2.0 º
2576	º º
2577	º Speed-Pascal Component Classes (SPCC) º
2578	º º
2579	º This section: TPrintDialog Class Implementation º
2580	º º
2581	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2582	º º
2583	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2584	}
2585
2586	Function TPrintDialog.Execute;
2587	Begin
2588	FPrintAll.Checked := True;
2589	FPrinter.Checked := True;
2590	FPrinter.Caption := Printer.Printers [Printer.PrinterIndex];
2591	FNumberOfCopiesEdit.Caption := '1';
2592	FPrintFromEdit.Caption := IntToStr (FMinPage);
2593	FPrintToEdit.Caption := IntToStr (FMaxPage);
2594	FNumberOfCopies.Min := 1;
2595	FNumberOfCopies.Max := 9999;
2596	FTitle.Caption := Printer.Title;
2597	Result := Inherited Execute;
2598	If Result Then
2599	Begin
2600	Printer.Title := FTitle.Caption;
2601	If FFileOutPut.Checked Then
2602	Begin
2603	Printer.PrintToFile := True;
2604	Printer.FileName := FFile.Caption;
2605	End
2606	Else
2607	Printer.PrintToFile := False;
2608	If FPrintAll.Checked Then
2609	Begin
2610	FAllPages := True;
2611	FromPage := MinPage;
2612	ToPage := MaxPage;
2613	End
2614	Else
2615	Begin
2616	FAllPages := False;
2617	FromPage := StrToInt (FPrintFromEdit.Caption);
2618	ToPage := StrToInt (FPrintToEdit.Caption);
2619	MinPage := StrToInt (FPrintFromEdit.Caption);
2620	MaxPage := StrToInt (FPrintToEdit.Caption);
2621	End;
2622	Printer.copies := StrToInt (FNumberOfCopiesEdit.Caption);
2623	End;
2624	End;
2625
2626	Procedure TPrintDialog.SetMinPage;
2627	Begin
2628	FMinPage := NewValue;
2629	FFromPage := FMinPage;
2630	FPrintFrom.Min := FFromPage;
2631	FPrintTo.Min := FFromPage;
2632	End;
2633
2634	Procedure TPrintDialog.SetMaxPage;
2635	Begin
2636	FMaxPage := NewValue;
2637	FToPage := FMaxPage;
2638	FPrintFrom.Max := FToPage;
2639	FPrintTo.Max := FToPage;
2640	End;
2641
2642	Procedure TPrintDialog.SetToPage;
2643	Begin
2644	FToPage := NewValue;
2645	FPrintFrom.Max := FToPage;
2646	FPrintTo.Max := FToPage;
2647	End;
2648
2649	Procedure TPrintDialog.SetFromPage;
2650	Begin
2651	FFromPage := NewValue;
2652	FPrintFrom.Min := FFromPage;
2653	FPrintTo.Min := FFromPage;
2654	End;
2655
2656	Procedure TPrintDialog.SetOkName;
2657	Begin
2658	FPrintButton.Caption := NewName;
2659	FOkName := NewName;
2660	End;
2661
2662	{$HINTS OFF}
2663	Procedure TPrintDialog.PropertyBtnClicked;
2664	Begin
2665	Printer.OptionsDlg;
2666	End;
2667	{$HINTS ON}
2668
2669	Procedure TPrintDialog.SetupComponent;
2670	Begin
2671	Inherited SetupComponent;
2672	Name := 'PrintDialog';
2673	Caption := LoadNLSStr(SPrint);
2674	FOkName := LoadNLSStr(SPrintButton);
2675	Width := 500;
2676	Height := 330;
2677	FPrintButton := TBitBtn.Create (Self);
2678	FPrintButton.Kind := bkOk;
2679	FPrintButton.Margin := 10;
2680	FCancelButton := TBitBtn.Create (Self);
2681	FCancelButton.Kind := bkCancel;
2682	FCancelButton.Margin := 10;
2683	FPropertyButton := TBitBtn.Create (Self);
2684	FPropertyButton.Glyph.LoadFromResourceName('StdBmpProp');
2685	FPropertyButton.Kind := bkCustom;
2686	FPropertyButton.Margin := 10;
2687	FHelpButton := TBitBtn.Create (Self);
2688	FHelpButton.Kind := bkHelp;
2689	FHelpButton.Command := cmHelp;
2690	FHelpButton.Margin := 10;
2691	FTitleBox := TGroupBox.Create (Self);
2692	FTitle := TEdit.Create (Self);
2693	FPagesBox := TRadioGroup.Create (Self);
2694	FPrintFromLabel := TRadioButton.Create (Self);
2695	FPrintFromEdit := TEdit.Create (Self);
2696	FPrintFrom := TUpDown.Create (Self);
2697	FPrintToLabel := TLabel.Create (Self);
2698	FPrintToEdit := TEdit.Create (Self);
2699	FPrintTo := TUpDown.Create (Self);
2700	FPrintAll := TRadioButton.Create (Self);
2701	FOptionsBox := TRadioGroup.Create (Self);
2702	FPrinter := TRadioButton.Create (Self);
2703	FFileOutPut := TRadioButton.Create (Self);
2704	FFile := TEdit.Create (Self);
2705	FNumberOfCopiesLabel := TLabel.Create (Self);
2706	FNumberOfCopiesEdit := TEdit.Create (Self);
2707	FNumberOfCopies := TUpDown.Create (Self);
2708	FPrintButton.SetWindowPos (330, 250, 150, 30);
2709	FCancelButton.SetWindowPos (330, 210, 150, 30);
2710	FPropertyButton.SetWindowPos (330, 170, 150, 30);
2711	FHelpButton.SetWindowPos (330, 15, 150, 30);
2712	FTitleBox.SetWindowPos (15, 230, 300, 60);
2713	FTitle.SetWindowPos (10, 13, 280, 20);
2714	FPagesBox.SetWindowPos (15, 140, 300, 85);
2715	FPrintFromLabel.SetWindowPos (10, 40, 70, 20);
2716	FPrintFromEdit.SetWindowPos (85, 37, 60, 20);
2717	FPrintFrom.SetWindowPos (145, 37, 21, 20);
2718	FPrintToLabel.SetWindowPos (175, 37, 30, 20);
2719	FPrintToLabel.PenColor := clBlack;
2720	FPrintToEdit.SetWindowPos (205, 37, 60, 20);
2721	FPrintTo.SetWindowPos (265, 37, 21, 20);
2722	FPrintAll.SetWindowPos (10, 15, 60, 20);
2723	FOptionsBox.SetWindowPos (15, 15, 300, 120);
2724	FPrinter.SetWindowPos (10, 75, 280, 20);
2725	FFileOutPut.SetWindowPos (10, 50, 50, 20);
2726	FFile.SetWindowPos (85, 48, 200, 20);
2727	FNumberOfCopiesLabel.SetWindowPos (12, 17, 60, 20);
2728	FNumberOfCopiesLabel.PenColor := clBlack;
2729	FNumberOfCopiesEdit.SetWindowPos (85, 15, 60, 20);
2730	FNumberOfCopies.SetWindowPos (145, 15, 21, 20);
2731	InsertControl (FPrintButton);
2732	InsertControl (FCancelButton);
2733	InsertControl (FPropertyButton);
2734	InsertControl (FHelpButton);
2735	InsertControl (FTitleBox);
2736	FTitleBox.InsertControl (FTitle);
2737	InsertControl (FOptionsBox);
2738	FOptionsBox.InsertControl (FNumberOfCopiesLabel);
2739	FOptionsBox.InsertControl (FNumberOfCopies);
2740	FOptionsBox.InsertControl (FNumberOfCopiesEdit);
2741	InsertControl (FPagesBox);
2742	FPagesBox.InsertControl (FPrintFromLabel);
2743	FPagesBox.InsertControl (FPrintFrom);
2744	FPagesBox.InsertControl (FPrintFromEdit);
2745	FPagesBox.InsertControl (FPrintToLabel);
2746	FPagesBox.InsertControl (FPrintTo);
2747	FPagesBox.InsertControl (FPrintToEdit);
2748	FPagesBox.InsertControl (FPrintAll);
2749	FOptionsBox.InsertControl (FPrinter);
2750	FOptionsBox.InsertControl (FFileOutPut);
2751	FOptionsBox.InsertControl (FFile);
2752	FPrintButton.Caption := LoadNLSStr(SPrintButton);
2753	FCancelButton.Caption := LoadNLSStr(SCancelButton);
2754	FPropertyButton.Caption := LoadNLSStr(SProperties);
2755	FHelpButton.Caption := LoadNLSStr(SHelpButton);
2756	FTitleBox.Caption := LoadNLSStr(STitle);
2757	FOptionsBox.Caption := LoadNLSStr(SOptions);
2758	FNumberOfCopiesLabel.Caption := LoadNLSStr(SCopies);
2759	FPagesBox.Caption := LoadNLSStr(SPages);
2760	FPrintFromLabel.Caption := LoadNLSStr(SFrom);
2761	FPrintToLabel.Caption := LoadNLSStr(STo);
2762	FPrintAll.Caption := LoadNLSStr(SAllButton);
2763	FOptionsBox.Caption := LoadNLSStr(SOptions);
2764	FFileOutPut.Caption := LoadNLSStr(SFile);
2765	FPrintFrom.Associate := FPrintFromEdit;
2766	FPrintTo.Associate := FPrintToEdit;
2767	FNumberOfCopies.Associate := FNumberOfCopiesEdit;
2768	FTitle.Caption := Printer.Title;
2769	FPropertyButton.OnClick := PropertyBtnClicked;
2770	FMaxPage := 1;
2771	FMinPage := 1;
2772	FFromPage := FMinPage;
2773	FToPage := FMaxPage;
2774	FPrintFrom.Min := FFromPage;
2775	FPrintFrom.Max := FToPage;
2776	FPrintTo.Min := FFromPage;
2777	FPrintTo.Max := FToPage;
2778	FPrintButton.Hint := LoadNLSStr(SClickHereToAccept);
2779	FCancelButton.Hint := LoadNLSStr(SClickHereToCancel);
2780	FPropertyButton.Hint := LoadNLSStr(SClickHereToSetProperties);
2781	FHelpButton.Hint := LoadNLSStr(SClickHereToGetHelp);
2782	FNumberOfCopiesEdit.OnFontChange := UpdateSpinSize;
2783	FPrintFromEdit.OnFontChange := UpdateSpinSize;
2784	FPrintToEdit.OnFontChange := UpdateSpinSize;
2785	FPrintButton.Focus;
2786	FPrintButton.TabStop := True;
2787	FCancelButton.TabStop := True;
2788	FPropertyButton.TabStop := True;
2789	FHelpButton.TabStop := True;
2790	FTitle.TabStop := True;
2791	FNumberOfCopiesEdit.TabStop := True;
2792	FPrintFromLabel.TabStop := True;
2793	FPrintFromEdit.TabStop := True;
2794	FTitleBox.TabStop := False;
2795	FOptionsBox.TabStop := False;
2796	FNumberOfCopiesLabel.TabStop := False;
2797	FNumberOfCopies.TabStop := False;
2798	FPagesBox.TabStop := False;
2799	FPrintFrom.TabStop := False;
2800	FPrintToLabel.TabStop := False;
2801	FPrintTo.TabStop := False;
2802	FPrintButton.TabOrder := 0;
2803	FCancelButton.TabOrder := 1;
2804	FPropertyButton.TabOrder := 2;
2805	FHelpButton.TabOrder := 3;
2806	FTitle.TabOrder := 4;
2807	FPrintFromLabel.TabOrder := 5;
2808	FPrintFromEdit.TabOrder := 6;
2809	FPrintToEdit.TabOrder := 7;
2810	FPrintAll.TabOrder := 8;
2811	FPrinter.TabOrder := 9;
2812	FFileOutPut.TabOrder := 10;
2813	FFile.TabOrder := 11;
2814	FNumberOfCopiesEdit.TabOrder := 12;
2815	End;
2816
2817	{$HINTS OFF}
2818	Procedure TPrintDialog.UpdateSpinSize;
2819	Begin
2820	FNumberOfCopies.Height := FNumberOfCopiesEdit.Height;
2821	FPrintFrom.Height := FPrintFromEdit.Height;
2822	FPrintTo.Height := FPrintToEdit.Height;
2823	End;
2824	{$HINTS ON}
2825
2826
2827
2828	{
2829	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2830	º º
2831	º Speed-Pascal/2 Version 2.0 º
2832	º º
2833	º Speed-Pascal Component Classes (SPCC) º
2834	º º
2835	º This section: TPrinterSetupDialog Class Implementation º
2836	º º
2837	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2838	º º
2839	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2840	}
2841
2842	{$HINTS OFF}
2843	Procedure TPrinterSetupDialog.PrinterSelected(Sender:TObject;Index:LongInt);
2844	Begin
2845	Printer.PrinterIndex := FPrinterList.ItemIndex;
2846	DismissDlg (cmOk);
2847	End;
2848
2849	Procedure TPrinterSetupDialog.PrinterFocused(Sender:TObject;Index:LongInt);
2850	Begin
2851	Printer.PrinterIndex := FPrinterList.ItemIndex;
2852	End;
2853
2854	Procedure TPrinterSetupDialog.PropertyBtnClicked(Sender:TObject);
2855	Begin
2856	Printer.OptionsDlg;
2857	End;
2858	{$HINTS ON}
2859
2860	Procedure TPrinterSetupDialog.SetOkName;
2861	Begin
2862	FSetPrinterButton.Caption := NewName;
2863	FOkName := NewName;
2864	End;
2865
2866	Procedure TPrinterSetupDialog.SetupComponent;
2867	Begin
2868	Inherited SetupComponent;
2869	Name := 'PrinterSetupDialog';
2870	Caption := LoadNLSStr(SSetupPrinter);
2871	FOkName := LoadNLSStr(SSetPrinter);
2872	Width := 450;
2873	Height := 285;
2874	color := clDlgWindow;
2875	FPrinterListHeadLine := TLabel.Create (Self);
2876	FPrinterList := TListBox.Create (Self);
2877	FSetPrinterButton := TBitBtn.Create (Self);
2878	FSetPrinterButton.Kind := bkOk;
2879	FSetPrinterButton.Margin := 10;
2880	FCancelButton := TBitBtn.Create (Self);
2881	FCancelButton.Kind := bkCancel;
2882	FCancelButton.Margin := 10;
2883	FPropertyButton := TBitBtn.Create (Self);
2884	FPropertyButton.ModalResult := cmNull;
2885	FPropertyButton.Glyph.LoadFromResourceName('StdBmpProp');
2886	FPropertyButton.Margin := 10;
2887	FHelpButton := TBitBtn.Create (Self);
2888	FHelpButton.Kind := bkHelp;
2889	FHelpButton.Command := cmHelp;
2890	FHelpButton.Margin := 10;
2891	FPrinterListHeadLine.SetWindowPos (15, 230, 250, 20);
2892	FPrinterList.SetWindowPos (15, 15, 250, 215);
2893	FSetPrinterButton.SetWindowPos (280, 200, 150, 30);
2894	FCancelButton.SetWindowPos (280, 160, 150, 30);
2895	FPropertyButton.SetWindowPos (280, 120, 150, 30);
2896	FHelpButton.SetWindowPos (280, 15, 150, 30);
2897	InsertControl (FPrinterListHeadLine);
2898	InsertControl (FPrinterList);
2899	InsertControl (FSetPrinterButton);
2900	InsertControl (FCancelButton);
2901	InsertControl (FPropertyButton);
2902	InsertControl (FHelpButton);
2903	FPropertyButton.OnClick := PropertyBtnClicked;
2904	FPrinterList.OnItemSelect := PrinterSelected;
2905	FPrinterList.OnItemFocus := PrinterFocused;
2906	FPrinterListHeadLine.Caption := LoadNLSStr(SCurrentPrinter)+':';
2907	FSetPrinterButton.Caption := LoadNLSStr(SSetPrinter);
2908	FCancelButton.Caption := LoadNLSStr(SCancelButton);
2909	FPropertyButton.Caption := LoadNLSStr(SProperties);
2910	FSetPrinterButton.Hint := LoadNLSStr(SClickHereToAccept);
2911	FPropertyButton.Hint := LoadNLSStr(SClickHereToSetProperties);
2912	FCancelButton.Hint := LoadNLSStr(SClickHereToCancel);
2913	FHelpButton.Hint := LoadNLSStr(SClickHereToGetHelp);
2914	FPrinterListHeadLine.TabStop := False;
2915	FPrinterList.TabStop := True;
2916	FSetPrinterButton.TabStop := True;
2917	FPropertyButton.TabStop := True;
2918	FCancelButton.TabStop := True;
2919	FHelpButton.TabStop := True;
2920	FPrinterList.TabOrder := 1;
2921	FSetPrinterButton.TabOrder := 2;
2922	FCancelButton.TabOrder := 3;
2923	FPropertyButton.TabOrder := 4;
2924	FHelpButton.TabOrder := 5;
2925	FSetPrinterButton.Focus;
2926	End;
2927
2928	Function TPrinterSetupDialog.Execute;
2929	Begin
2930	FPrinterList.Items := Printer.Printers;
2931	FOldPrinterIndex := Printer.PrinterIndex;
2932	FPrinterList.ItemIndex := FOldPrinterIndex;
2933	Result := Inherited Execute;
2934	If Not Result Then
2935	Printer.PrinterIndex := FOldPrinterIndex;
2936	End;
2937
2938
2939	{
2940	ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2941	º º
2942	º Speed-Pascal/2 Version 2.0 º
2943	º º
2944	º Speed-Pascal Component Classes (SPCC) º
2945	º º
2946	º This section: TMessageBox Class Implementation º
2947	º º
2948	º (C) 1995,97 SpeedSoft. All rights reserved. Disclosure probibited ! º
2949	º º
2950	ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2951	}
2952
2953	Procedure TMessageBox.SetupComponent;
2954	Begin
2955	Inherited SetupComponent;
2956
2957	FButtons:=[mbOk];
2958	fType:=mtInformation;
2959	Caption:='';
2960	End;
2961
2962	Procedure TMessageBox.SetupShow;
2963	Const SButtonNames:Array[mbYes..mbHelp] Of String[15]=
2964	(
2965	'~Yes','~No','~OK','~Cancel','~Abort','~Retry','~Ignore','~All','~Help'
2966	);
2967	SButtonKinds:Array[mbYes..mbHelp] Of TBitBtnKind=
2968	(
2969	bkYes,bkNo,bkOk,bkCancel,bkAbort,bkRetry,bkIgnore,bkAll,bkHelp
2970	);
2971	ButtonOrder:Array[0..8] of TMsgDlgBtn=
2972	(
2973	mbHelp, mbYes, mbOK, mbRetry, mbAll, mbIgnore, mbNo, mbAbort, mbCancel
2974	);
2975	Var FLabel:TLabel;
2976	CX,CY:LongInt;
2977	LabelX:LongInt;
2978	BtnX:LongInt;
2979	tw:LongInt;
2980	PictureY:LongWord;
2981	ButtonNames:Array[1..10] Of String[15];
2982	ButtonKinds:Array[1..10] Of TBitBtnKind;
2983	ButtonCount,T:LongInt;
2984	Btn:TBitBtn;
2985	Button:TMsgDlgBtn;
2986	ButtonIndex:longint;
2987	MaxWidth,W:LongInt;
2988	Begin
2989	Inherited SetupShow;
2990
2991	SButtonNames[mbYes]:=LoadNLSStr(SYesButton);
2992	SButtonNames[mbNo]:=LoadNLSStr(SNoButton);
2993	SButtonNames[mbOk]:=LoadNLSStr(SOkButton);
2994	SButtonNames[mbCancel]:=LoadNLSStr(SCancelButton);
2995	SButtonNames[mbAbort]:=LoadNLSStr(SAbortButton);
2996	SButtonNames[mbRetry]:=LoadNLSStr(SRetryButton);
2997	SButtonNames[mbIgnore]:=LoadNLSStr(SIgnoreButton);
2998	SButtonNames[mbAll]:=LoadNLSStr(SAllButton);
2999	SButtonNames[mbHelp]:=LoadNLSStr(SHelpButton);
3000
3001	//check Single Buttons. only the following values are Valid And can be or'ed
3002	//mbYes,mbNo,mbOk,mbCancel,mbHelp,mbAbort.mbRetry,mbIgnore,mbAll
3003	//All Buttons are invisible
3004	MaxWidth:=340;
3005	W:=0;
3006	ButtonCount:=0;
3007
3008	For ButtonIndex:=Low(ButtonOrder) To High(ButtonOrder) Do
3009	Begin
3010	Button := ButtonOrder[ ButtonIndex ];
3011	If Button IN FButtons Then
3012	Begin
3013	Inc(ButtonCount);
3014	ButtonNames[ButtonCount]:=SButtonNames[ Button ];
3015	ButtonKinds[ButtonCount]:=SButtonKinds[ Button ];
3016
3017	Inc(W, Canvas.TextWidth(ButtonNames[ButtonCount]) + 20);
3018	If ShowBitBtnGlyph Then Inc(W, 25);
3019	//Inc(W,100);
3020
3021	If W > MaxWidth Then
3022	Begin
3023	If W > Screen.Width-50 Then break;
3024	MaxWidth := W;
3025	End;
3026	End;
3027	End;
3028
3029	LabelX := 20;
3030	If fType<>mtCustom Then Inc(LabelX,32);
3031
3032	FLabel := InsertLabel(Self,LabelX,60,MaxWidth,20,FMsg);
3033	FLabel.WordWrap := True;
3034	FLabel.ShowAccelChar := False;
3035	FLabel.Height := FLabel.Canvas.Font.Height * FLabel.Rows;
3036
3037	PictureY := FLabel.Bottom + FLabel.Height - 32;
3038
3039	CX := LabelX + MaxWidth + 25;
3040	CY := 10 + 30 + 20 + FLabel.Height + 45;
3041
3042	{Center Box}
3043	SetWindowPos(Left,Bottom,CX,CY);
3044
3045	If fType<>mtCustom Then
3046	Begin
3047	If fType=mtConfirmation Then InsertImageName(Self,10,PictureY,32,32,'StdBmpAsk')
3048	Else If fType In [mtError,mtCritical,mtWarning] Then InsertImageName(Self,10,PictureY,32,32,'StdBmpHand')
3049	Else InsertImageName(Self,10,PictureY,32,32,'StdBmpInfo');
3050	End;
3051
3052	If Caption='' Then //overwrite Default
3053	Begin
3054	If fType=mtWarning Then Caption:=LoadNLSStr(SWarning)
3055	Else If fType=mtInformation Then Caption:=LoadNLSStr(sInformation)
3056	Else If fType=mtConfirmation Then Caption:=LoadNLSStr(SConfirmation)
3057	Else If fType=mtCritical Then Caption:=LoadNLSStr(SCriticalError)
3058	Else If fType=mtError Then Caption:=LoadNLSStr(SError)
3059	Else If fType=mtCustom Then Caption:=ParamStr(0)
3060	Else Caption:=LoadNLSStr(sInformation);
3061	End;
3062
3063	//Create the Buttons
3064	BtnX:=10;
3065	For T:=1 To ButtonCount Do
3066	Begin
3067	tw := Canvas.TextWidth(ButtonNames[T]) + 20;
3068	If ShowBitBtnGlyph Then Inc(tw, 25);
3069	Btn := InsertBitBtn(Self,BtnX,10,tw,30,ButtonKinds[T],ButtonNames[T],'');
3070	Inc(BtnX, tw + 10);
3071	//Inc(BtnX,100);
3072	If T=1 Then Btn.Focus;
3073	End;
3074	End;
3075
3076
3077
3078	Begin
3079	End.
3080

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

Download in other formats:

Original Format