source: trunk/Components/ComponentsTestForm.pas@ 141

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

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