source: branches/2.20_branch/Components/ComponentsTestForm.pas

Last change on this file was 239, checked in by RBRi, 18 years ago

improved directory flag handling (see #31)
  • Property svn:eol-style set to native
File size: 14.0 KB
Line 
1Unit ComponentsTestForm;
2
3Interface
4
5Uses
6 Classes,
7 Forms,
8 Graphics,
9 RichTextView,
10 Buttons,
11 TabCtrls,
12 ComCtrls,
13 ExtCtrls,
14 StdCtrls,
15 Outline2,
16 ACLDialogs,
17 ColorWheel,
18 CustomListBox,
19 Coolbar2,
20 CustomFileControls,
21 CustomFontDialog,
22 MultiColumnListBox,
23 SystemIconUnit,
24
25 // custom components not directly used but there to
26 // compile
27 SplitBar,
28 Tabset2Unit,
29 GenericThread;
30
31type
32 TScanParameters = class
33 Path: string;
34 end;
35
36 TComponentsTestForm = Class (TForm)
37 TabbedNotebook1: TTabbedNotebook;
38 StatusBar: TStatusBar;
39 ImageList1: TImageList;
40 MainMenu5: TMainMenu;
41 ImageList2: TImageList;
42 Button7: TButton;
43 SpeedButton1: TSpeedButton;
44 Button10: TButton;
45 ListBox2: TListBox;
46 Button13: TButton;
47 Button14: TButton;
48 Memo1: TMemo;
49 Button16: TButton;
50 Image1: TImage;
51 DirectoryListBox1: TCustomDirectoryListBox;
52 Button15: TButton;
53 Panel1: TPanel;
54 Button12: TButton;
55 Button11: TButton;
56 Button9: TButton;
57 Edit1: TEdit;
58 Button6: TButton;
59 RadioGroup1: TRadioGroup;
60 Button3: TButton;
61 Button8: TButton;
62 Button4: TButton;
63 Button5: TButton;
64 RT: TRichTextView;
65 Button2: TButton;
66 Button1: TButton;
67 AnOutline: TOutline2;
68 Procedure Edit1OnChange (Sender: TObject);
69 Procedure Button16OnClick (Sender: TObject);
70 Procedure Button15OnClick (Sender: TObject);
71 Procedure Button14OnClick (Sender: TObject);
72 Procedure Button13OnClick (Sender: TObject);
73 Procedure Button12OnClick (Sender: TObject);
74 Procedure Button11OnClick (Sender: TObject);
75 Procedure Button10OnClick (Sender: TObject);
76 Procedure Button9OnClick (Sender: TObject);
77 Procedure SpeedButton1OnClick (Sender: TObject);
78 Procedure Button7OnMouseDown (Sender: TObject; Button: TMouseButton;
79 Shift: TShiftState; X: LongInt; Y: LongInt);
80 Procedure Button6OnClick (Sender: TObject);
81 Procedure CoolBar1OnSectionClick (HeaderControl: THeaderControl;
82 section: THeaderSection);
83 Procedure Button8OnClick (Sender: TObject);
84 Procedure Button7OnClick (Sender: TObject);
85 Procedure Button5OnClick (Sender: TObject);
86 Procedure Button4OnClick (Sender: TObject);
87 Procedure Button3OnClick (Sender: TObject);
88 Procedure RTOnClickLink (Sender: TRichTextView; Link: String);
89 Procedure RTOnOverLink (Sender: TRichTextView; Link: String);
90 Procedure RichTextView1OnOverLink (Sender: TRichTextView; Link: String);
91 Procedure Button2OnClick (Sender: TObject);
92 Procedure TabbedNotebook1OnSetupShow (Sender: TObject);
93 Procedure MainFormOnCreate (Sender: TObject);
94 Procedure RTOnSetupShow (Sender: TObject);
95 Procedure MainFormOnShow (Sender: TObject);
96 Procedure Button1OnClick (Sender: TObject);
97 Protected
98 MLB: TMultiColumnListBox;
99 cb: TCoolbar2;
100 clb: TCustomListBox;
101 Procedure Oncustomlistitemfocus( Sender: TObject; Index: longint );
102 procedure OnOutlineEvent( Node: TNode );
103 Procedure loadcustomlist;
104 End;
105
106Var
107 ComponentsTestForm: TComponentsTestForm;
108
109Implementation
110
111uses
112 PMWin,
113 Os2Def,
114 Dialogs,
115 SysUtils,
116 Printers,
117 ControlScrolling,
118 ACLResourceUtility,
119 RichTextPrintUnit,
120 RichTextStyleUnit,
121 ACLLanguageUnit,
122 CharUtilsUnit,
123 DebugUnit;
124
125{$R DialogIcons}
126
127Procedure TComponentsTestForm.Edit1OnChange (Sender: TObject);
128Begin
129
130End;
131
132Procedure TComponentsTestForm.Button16OnClick (Sender: TObject);
133var
134 p: pchar;
135 l: longint;
136Begin
137 l := SendMsg( RT.Handle,
138 RT_QUERYSELTEXT,
139 0, // length only
140 0 );
141 Memo1.Lines.Add( 'length is ' + IntToStr( l ) );
142 p := StrAlloc( l );
143
144 SendMsg( RT.Handle,
145 RT_QUERYSELTEXT,
146 ULONG( p ),
147 4 );
148
149 Memo1.Lines.Add( StrPasWithLength( p, l ) );
150
151 StrDispose( p );
152End;
153
154Procedure TComponentsTestForm.Button15OnClick (Sender: TObject);
155var
156 s: string;
157Begin
158 DoInputQUery( 'Cake', 'Enter cake:', s );
159End;
160
161Procedure TComponentsTestForm.Button14OnClick (Sender: TObject);
162Begin
163 Application.HelpContents;
164End;
165
166Procedure TComponentsTestForm.Button13OnClick (Sender: TObject);
167var
168 PageY: longint;
169 RichTextSettings: TRichTextSettings;
170Begin
171 if Printer.Printers.Count = 0 then
172 begin
173 ShowMessage( 'You don''t have a printer configured.' );
174 exit;
175 end;
176
177 Printer.Title := 'Test print';
178
179 Printer.BeginDoc;
180
181// Printer.Canvas.Font := Screen.GetFontFromPointSize( 'Courier', 12 );
182// Printer.Canvas.TextOut( 0, 0, 'Bergurk' );
183
184
185 PageY := Printer.PageHeight - 1;
186
187 RichTextSettings:= TRichTextSettings.Create( self );
188
189 RichTextSettings.NormalFont := Screen.GetFontFromPointSize( 'Tms Rmn', 8 );
190// RichTextSettings.FixedFont := Screen.GetFontFromPointSize( 'Helv', 8 );
191
192 PrintRichText( 'Some cake and cheese honk-wozel',
193 nil,
194 RichTextSettings,
195 PageY );
196
197 Printer.EndDoc;
198
199End;
200
201Procedure TComponentsTestForm.Button12OnClick (Sender: TObject);
202Begin
203 loadcustomlist;
204End;
205
206Procedure TComponentsTestForm.Button11OnClick (Sender: TObject);
207Begin
208 cb.EditSections;
209End;
210
211Procedure TComponentsTestForm.Button10OnClick (Sender: TObject);
212var
213 dlg: TFontDialog;
214Begin
215 dlg:= TFontDialog.Create( self );
216 dlg.Execute;
217 dlg.Destroy;
218End;
219
220Procedure TComponentsTestForm.Button9OnClick (Sender: TObject);
221var
222 dlg: TCustomFontDialog;
223Begin
224 dlg:= TCustomFontDialog.Create( self );
225 dlg.Execute;
226 dlg.Destroy;
227End;
228
229Procedure TComponentsTestForm.SpeedButton1OnClick (Sender: TObject);
230Begin
231 MLB.Enabled := not MLB.Enabled;
232End;
233
234Procedure TComponentsTestForm.Button7OnMouseDown (Sender: TObject;
235 Button: TMouseButton; Shift: TShiftState; X: LongInt; Y: LongInt);
236Begin
237
238End;
239
240Procedure TComponentsTestForm.Button6OnClick (Sender: TObject);
241Begin
242End;
243
244Procedure TComponentsTestForm.CoolBar1OnSectionClick (HeaderControl: THeaderControl; section: THeaderSection);
245Begin
246
247End;
248
249Procedure TComponentsTestForm.Button8OnClick (Sender: TObject);
250Begin
251// DirectoryListBox1.Directory:= DriveComboBox3.Drive + ':\';
252End;
253
254Procedure TComponentsTestForm.Button7OnClick (Sender: TObject);
255Begin
256End;
257
258
259Procedure TComponentsTestForm.Button5OnClick (Sender: TObject);
260Begin
261 AnOutline.GotoNextNodeDown;
262End;
263
264Procedure TComponentsTestForm.Button4OnClick (Sender: TObject);
265Begin
266 AnOutline.GotoNextNodeUp;
267End;
268
269Procedure TComponentsTestForm.Button3OnClick (Sender: TObject);
270var
271 M1: longword;
272Begin
273 M1:= MemAvail;
274 AnOutline.Clear;
275 StatusBar.SimpleText:= 'Mem freed from outline: ' + IntToStr( MemAvail - M1 );
276End;
277
278Procedure TComponentsTestForm.RTOnClickLink (Sender: TRichTextView;
279 Link: String);
280Begin
281 ShowMessage( 'You clicked: ' + Link );
282End;
283
284Procedure TComponentsTestForm.RTOnOverLink (Sender: TRichTextView;
285 Link: String);
286Begin
287 StatusBar.SimpleText:= 'Link to: ' + Link;
288 StatusBar.Refresh;
289End;
290
291Procedure TComponentsTestForm.RichTextView1OnOverLink (Sender: TRichTextView;
292 Link: String);
293Begin
294
295End;
296
297Procedure TComponentsTestForm.Button2OnClick (Sender: TObject);
298Begin
299 DoConfirmDlg( 'Test', 'THis is the prompt you should be seeing' );
300End;
301
302Procedure TComponentsTestForm.TabbedNotebook1OnSetupShow (Sender: TObject);
303Begin
304End;
305
306Procedure TComponentsTestForm.Oncustomlistitemfocus( Sender: TObject;
307 Index: longint );
308begin
309 if Panel1.Color = clBlack then
310 Panel1.Color := clRed
311 else
312 Panel1.Color := clBlack;
313end;
314
315Procedure TComponentsTestForm.loadcustomlist;
316begin
317 clb.StartUpdate;
318 clb.Items.Clear;
319 clb.Items.Add( 'A' );
320 clb.Items.Add( 'B' );
321 clb.Items.Add( 'C' );
322 clb.ItemIndex := 0;
323 clb.CompleteUpdate;
324end;
325
326Procedure TComponentsTestForm.MainFormOnCreate (Sender: TObject);
327var
328// DriveCombobox: TCustomDriveComboBox;
329 IconImage: TSystemIcon;
330Begin
331 IconImage := TSystemIcon.Create( self );
332 IconImage.Parent := self; //TabbedNotebook1.Pages.Pages[ 3 ];
333
334 IconImage.Bottom := ListBox2.Bottom;
335 IconImage.ID := siIconInformation;
336
337 clb:= Tcustomlistbox.Create( self );
338 clb.Parent := TabbedNotebook1.Pages.Pages[ 0 ];
339 clb.MultiSelect := true;
340 clb.ExtendedSelect := true;
341 clb.OnItemFocus := Oncustomlistitemfocus;
342
343 loadcustomlist;
344
345 cb := TCoolbar2.Create( self );
346 cb.Parent := TabbedNotebook1.Pages.Pages[ 6 ];
347
348
349
350// DriveCombobox:= TCustomDriveComboBox.Create( self );
351// DriveCombobox.Parent:= self;
352// DriveCombobox.Width := 200;
353 RadioGRoup1.ItemIndex := 3;
354
355// RT.Images:= nil;
356// ImageList2.Destroy;
357 TabbedNotebook1.yStretch:= ysFrame;
358 StatusBar.SimpleText:= 'OK';
359End;
360
361Procedure TComponentsTestForm.RTOnSetupShow (Sender: TObject);
362Begin
363
364End;
365
366Procedure TComponentsTestForm.MainFormOnShow (Sender: TObject);
367var
368 Node, Node2: TNode;
369 i,j: integer;
370 M1: longint;
371
372
373 Stream:TResourceStream;
374 met: TMetafile;
375 cw: TColorWHeel;
376Begin
377 met := TMetafile.cReate;
378 met.LoadFromFIle( 'w:\sibyl\martin\test1.met' );
379
380 Image1.Graphic := met;
381 ListBox2.Sorted := true;
382 ListBox2.Items.Add( 'Banana' );
383 ListBox2.Items.Add( 'Apple' );
384
385 cw := TColorWHeel.Create( self );
386 cw.Parent := TabbedNotebook1.Pages.Pages[ 1 ];
387
388 RT:= TRichTextView.Create( self );
389
390 RT.Parent:= TabbedNotebook1.Pages.Pages[ 1 ];
391
392 RT.RichTextSettings.Margins.Left := 0; // 50;
393 RT.RichTextSettings.Margins.Right := 0; // 50;
394
395 RT.RichTextSettings.DefaultWrap := true;
396 RT.RichTextSettings.AtLeastOneWordBeforeWrap := true;
397 RT.RichTextSettings.MarginSizeStyle := msAverageCharWidth;
398
399
400 RT.Align:= alClient;
401// RT.BorderStyle := bsNone;
402// RT.RichTextSettings.NormalFont := Screen.GetFontFromPointSize( 'Times New Roman', 10 );
403// RT.RichTextSettings.FixedFont := Screen.GetFontFromPointSize( 'Courier New', 10 );
404// RT.AddParagraph( 'Bok<leftmargin 10>Cheese weasels and cake, not to mention substantial '
405// + 'widgings of wodgeriness!' );
406// RT.RichTextSettings.NormalFont := Screen.GetFontFromPointSize( 'Arial', 24 );
407
408 RT.AddParagraph( 'This <leftmargin here><b>is</b> a big <h2>box</h> of cheese' );
409 RT.AddParagraph( '<tt>This <i>is</i> a </tt> big <h2>box</h> of cheese' );
410 RT.AddParagraph( '<font "Photina" 11><leftmargin 4>big font </font> heading by << Jiggolo >>' );
411
412 RT.AddParagraph( '<align center>Centered<align default>' );
413 Rt.AddParagraph( '<leftmargin 5>WinAddAtom <leftmargin 2>' );
414 RT.AddParagraph( '<h2>Left subheading</h> some more text' );
415 RT.AddParagraph( 'Some more cake' );
416 RT.AddParagraph( 'This is the <color #c0c0c0>t<color #808080>e<color #404040>x<color #000000>t for this subheading, what it''s about I cannot tell' );
417// RT.AddParagraph( 'And here <font "Tms Rmn" 12>is an image <image 0> to test the scrolling changes.' );
418 RT.AddParagraph( '' );
419 RT.AddParagraph( 'In <tt>theory</tt> this is a <red><u><link cake>hyperlink</link><black></u>' );
420 RT.AddParagraph( '<align right>A right aligned part.<align default>' );
421 RT.AddParagraph( 'Back to normal, but now <font Impact 18>different font</font>' );
422 RT.AddParagraph( '<backcolor green>Background color</backcolor> and now not.' );
423
424 RT.AddParagraph( 'Let''s<leftmargin 10>test some margins' );
425
426 RT.AddParagraph( '<font "Courier" 10>__ANSI__ </font><leftmargin 4>' );
427 RT.AddParagraph( 'Allows only language constructs that conform to ISO/ANSI C standard.' );
428
429 RT.Images:= Imagelist2;
430// RT.TopCharIndex := 50;
431 RT.Color := clWhite;//Red;
432
433 AnOutline:= TOutline2.Create( self );
434 AnOutline.TabStop := true;
435 AnOutline.Parent:= TabbedNotebook1.Pages.Pages[ 2 ];
436 AnOutline.Align:= alLeft;
437 AnOutline.Width:= 200;
438// AnOutline.Height:= 180;
439 AnOutline.LineHeight:= 16;
440// AnOutline.PlusMinusWidth:= 11;
441// AnOutline.PlusMinusHeight:= 11;
442
443 AnOutline.SelectLine:= false;
444 AnOutline.PlusMinusStyle:= pm3d;
445
446 AnOutline.OnItemDblClick:= OnOutlineEvent;
447 AnOutline.PenColor:= clBlue;
448
449 M1:= MemAvail;
450
451 AnOutline.BeginUpdate;
452
453 Node:= AnOutline.AddChild( 'Seven', nil );
454 Node:= Node.AddChild( 'Biscuit', nil );
455 Node.AddChild( 'Afghan', nil );
456 node2:= Node.AddChild( 'Toffee pop', nil );
457 node2.AddChild( 'Supreme toffee pop', nil );
458 node2.AddChild( 'Budget toffee pop', nil );
459 node2.AddChild( 'Mysterious toffee pop', nil );
460 node2.AddChild( 'Cheese flavoured toffee pop', nil );
461 node2.Expand;
462
463// AnOutline.SelectedNode:= node2;
464
465 Node.AddChild( 'Cheese', nil );
466 Node.AddChild( 'Cake', nil );
467
468 for i:= 0 to 20 do
469 begin
470 Node2:= AnOutline.AddChild( 'Item ' + IntToStr( i ) + ' This is a big cheese', nil );
471 for j:= 0 to 20 do
472 Node2.AddChild( 'Item ' + IntToStr( j ) + 'this is a giant sausage', nil );
473 end;
474 AnOutline.EndUpdate;
475 StatusBar.SimpleText:= 'Mem used loading outline: ' + IntToStr( M1 - MemAvail );
476
477
478 MLB:= TMultiColumnListBox.Create( self );
479
480 MLB.Parent:= TabbedNotebook1.Pages.Pages[ 5 ];
481 MLB.ALign:= alClient;
482 MLB.Items.Add( 'CHeese' + #9 + 'Cake' + #9 + 'Sausage' + #9 + '_1' );
483 MLB.Items.Add( 'CHeese' + #9 + 'Cake' + #9 + 'Sausage' + #9 + '_1' );
484 MLB.Items.Add( 'CHeese' + #9 + 'Cake' + #9 + 'Sausage' + #9 + '_1' );
485 MLB.Items.Add( 'CHeese' + #9 + 'Cake' + #9 + 'Sausage' + #9 + '_1' );
486 MLB.Items.Add( 'CHeese' + #9 + 'Cake' + #9 + 'Sausage' + #9 + '_1' );
487 MLB.Items.Add( 'CHeese' + #9 + 'Cake' + #9 + 'Sausage' + #9 + '_1' );
488 MLB.Items.Add( 'CHeese' + #9 + 'Cake' + #9 + 'Sausage' + #9 + '_1' );
489 MLB.Items.Add( 'CHeese' + #9 + 'Cake' + #9 + 'Sausage' + #9 + '_1' );
490 MLB.ImageList:= ImageList1;
491
492End;
493
494Procedure TComponentsTestForm.Button1OnClick (Sender: TObject);
495var
496 TheList: TStringList;
497Begin
498 TheList:= TStringList.Create;
499 TheList.Add( 'List item 1' );
500 TheList.Add( 'LIst item 2' );
501 DoConfirmListDlg( 'Test',
502 'THis is the message. In theory it can be quite long and the dialog '
503 + 'should autosize to fit it best.',
504 TheList );
505 TheList.Destroy;
506
507End;
508
509procedure TComponentsTestForm.OnOutlineEvent( Node: TNode );
510begin
511 ShowMessage( 'Node string: ' + Node.Text );
512end;
513
514Initialization
515 RegisterClasses ([TComponentsTestForm, TTabbedNotebook, TStatusBar
516 , TImageList, TOutline2, TMainMenu, TButton, TRichTextView,
517 TCustomDriveComboBox,
518 TCustomDirectoryListBox, TCustomFilelistBox, TListBox, TRadioGroup
519 , TEdit, TSpeedButton, TPanel, THeaderControl, TMemo, TImage]);
520
521 SetLogAspects('LogDebug');
522End.
Note: See TracBrowser for help on using the repository browser.