source: trunk/Components/ComponentsTestForm.pas@ 15

Last change on this file since 15 was 15, checked in by RBRi, 19 years ago

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