source: trunk/Components/ComponentsTestForm.pas@ 94

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

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