source: trunk/Components/ComponentsTestForm.pas@ 143

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

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