source: trunk/Components/ComponentsTestForm.pas@ 201

Last change on this file since 201 was 145, checked in by RBRi, 18 years ago

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