source: trunk/Components/ControlsUtility.pas@ 353

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

+ components stuff
  • Property svn:eol-style set to native
File size: 23.6 KB
RevLine 
[15]1unit ControlsUtility;
2
3interface
4
5uses
6 Classes, StdCtrls, SysUtils,
7 ACLUtility,
8{$ifdef win32}
9 ExtCtrls, Forms, Controls, ComCtrls, Windows, Messages, Graphics;
10{$else}
11 OS2Def, Forms;
12{$endif}
13
14const
15{$ifdef win32}
16 Mnem = '&';
17{$else}
18 Mnem = '~';
19{$endif}
20
21function GetComponentsVersion: string;
22
23function InvertRGB( Arg: TColor ): TColor;
24
25function GetScreenColorDepth: longint;
26function GetVideoDriverName: string;
27
28procedure SmartGetWindowPos( Form: TForm;
29 Var X, Y, W, H: longint;
30 Var Maximised: boolean );
31
32procedure SmartSetWindowPos( Form: TForm;
33 X, Y, W, H: longint;
34 Maximised: boolean );
35
36// Load/save form to inifile
37Procedure SaveFormSizePosition( Form: TForm;
38 IniFile: TMyIniFile );
39Procedure LoadFormSizePosition( Form: TForm;
40 IniFile: TMyIniFile );
41
42{$ifdef os2}
43// Utility access to the link (hand) cursor
44Function GetLinkCursor: TCursor;
45
46// set a wait cursor. If already set, increments a count
47procedure SetWaitCursor;
48
49// clear wait cursor. Only actually clears it if the count is now 0.
50procedure ClearWaitCursor;
51
52function GetNiceDefaultFont: TFont;
53{$endif}
54
55procedure StartTimer( Timer: TTimer );
56procedure StopTimer( Timer: TTimer );
57
58// Listbox utility functions
59Function SelectedObject( ListBox: TListBox ): TObject;
60Procedure SetSelectedByObject( ListBox: TListBox;
61 SelectObject: TObject );
62Function SelectedItem( ListBox: TListBox ): string;
63Procedure GetSelectedItems( ListBox: TListBox;
64 Dest: TStrings );
65
66{$ifdef win32}
67procedure SetFocusTo( Control: TWinControl );
68{$else}
69procedure SetFocusTo( Control: TControl );
70{$endif}
71
72{$ifdef win32}
73Procedure AddBoldedLine( RichEdit: TRichEdit;
74 BoldPart: string;
75 NormalPart: string );
76
77Procedure GetExpandedNodes( TreeView: TTreeView;
78 ExpandedNodeList: TStrings );
79
80{$endif}
81
82{$ifdef os2}
83Procedure ScaleForm( Form: TForm;
84 OriginalFontWidth: longint;
85 OriginalFontHeight: longint );
86
87// Validate all known SPCC components
88// Checks that their memory storage is valid
89// (refers to valid parts of the heap)
90procedure ValidateSPCCObjects;
91
92Procedure LogException( E: Exception;
93 const LogFileName: string;
94 const Title: string;
95 const AppVersion: string;
96 var F: TextFile );
97
98// Find topmost form window of specified class name
99Function FindTopFormWindow( const WindowClassName: string ): HWND;
100
101{$endif}
102
103
104implementation
105
106{$ifdef os2}
107uses
108 PMGpi, PMDev, PMShl, DOS, PMWin, BseDos,
109 TabCtrls,
110 MultiColumnListBox,
111 Graphics;
112
113{$R ControlsUtility}
114
115Var
116 TheLinkCursor: TCursor; // loaded on unit initialisation.
117 TheLinkPointer: TPointer; // loaded on unit initialisation.
118
119function GetNiceDefaultFont: TFont;
120var
121 OverrideAppFontName: string;
122 OverrideAppFontSize: string;
123begin
124 // For Marco!
125 OverrideAppFontName := GetEnv( 'ACL_OVERRIDE_FONT_NAME' );
126 OverrideAppFontSize := GetEnv( 'ACL_OVERRIDE_FONT_SIZE' );
127
128 try
129 if OverrideAppFontName <> '' then
130 begin
131 Result := Screen.GetFontFromPointSize( OverrideAppFontName,
132 StrToInt( OverrideAppFontSize ) );
133 if Result <> nil then
134 exit;
135 end;
136 except
137 end;
138
139 if Application.DBCSSystem then
140 begin
141 // try Warpsans Combined
142 Result := Screen.GetFontFromPointSize( 'WarpSans Combined', 9 );
143 if Result <> nil then
144 // ok use warpsans
145 exit;
146 end;
147 // try warpsans.9
148 Result := Screen.GetFontFromPointSize( 'WarpSans', 9 );
149 if Result <> nil then
150 // ok use warpsans
151 exit;
152
153 // try Helv.8
154 Result := Screen.GetFontFromPointSize( 'Helv', 8 );
155 if Result <> nil then
156 // ok use helv
157 exit;
158
159 // Ok, system default
160 Result := Screen.DefaultFont;
161end;
162{$endif}
163
164var
165 g_WaitCursorCount: longint;
166
167procedure SetWaitCursor;
168begin
169 if g_WaitCursorCount = 0 then
170 Screen.Cursor := crHourGlass;
171
172 inc( g_WaitCursorCount );
173end;
174
175procedure ClearWaitCursor;
176begin
177 if g_WaitCursorCount > 0 then
178 begin
179 dec( g_WaitCursorCount );
180 if g_WaitCursorCount = 0 then
181 begin
182 Screen.Cursor := crDefault;
183 end;
184 end;
185
186end;
187
188procedure StartTimer( Timer: TTimer );
189begin
190{$ifdef win32}
191 Timer.Enabled := true;
192{$else}
193 Timer.Start;
194{$endif}
195end;
196
197procedure StopTimer( Timer: TTimer );
198begin
199{$ifdef win32}
200 Timer.Enabled := false;
201{$else}
202 Timer.Stop;
203{$endif}
204end;
205
206{$ifdef win32}
207procedure SetFocusTo( Control: TWinControl );
208begin
209 Control.SetFocus;
210end;
211{$else}
212procedure SetFocusTo( Control: TControl );
213begin
214 Control.Focus;
215end;
216{$endif}
217
218{$ifdef win32}
219const
220 EndLineStr = #13 +#10;
221
222Procedure AddBoldedLine( RichEdit: TRichEdit;
223 BoldPart: string;
224 NormalPart: string );
225var
226 LineStart: integer;
227 Dummy: integer;
228begin
229 with RichEdit do
230 begin
231 SendMessage( Handle,
232 EM_GETSEL,
233 Longint( Addr( LineStart ) ),
234 Longint( Addr( Dummy ) ) );
235
236 SendMessage( Handle,
237 EM_REPLACESEL,
238 0,
239 Longint(PChar( BoldPart)));
240
241 SelStart:= LineStart;
242 SelLength:= Length( BoldPart );
243 SelAttributes.Style:= [ fsBold ];
244
245 SelStart:= LineStart + Length( BoldPart );
246 SelLength:= 0;
247 SendMessage( Handle,
248 EM_REPLACESEL,
249 0,
250 Longint(PChar( NormalPart)));
251 SelStart:= LineStart + Length( BoldPart );
252 SelLength:= Length( NormalPart );
253 SelAttributes.Style:= [];
254 SelStart:= LineStart + Length( BoldPart )
255 + Length( NormalPart );
256 SelLength:= 0;
257 SendMessage( Handle,
258 EM_REPLACESEL,
259 0,
260 Longint(PChar( EndLineStr )));
261
262 end;
263
264end;
265
266Procedure GetExpandedNodesCumulative( Node: TTreeNode;
267 ExpandedNodeList: TStrings;
268 const Path: string );
269var
270 SubNode: TTreeNode;
271begin
272 if Node.Expanded then
273 begin
274 ExpandedNodeList.Add( Path + Node.Text );
275
276 SubNode := Node.getFirstChild;
277 while SubNode <> nil do
278 begin
279 GetExpandedNodesCumulative( SubNode,
280 ExpandedNodeList,
281 Path + Node.Text + '\' );
282 SubNode := SubNode.getNextSibling;
283 end;
284 end;
285end;
286
287Procedure GetExpandedNodes( TreeView: TTreeView;
288 ExpandedNodeList: TStrings );
289begin
290 ExpandedNodeList.Clear;
291 if TreeView.Items.GetFirstNode = nil then
292 exit;
293 GetExpandedNodesCumulative( TreeView.Items.GetFirstNode,
294 ExpandedNodeList,
295 '' );
296end;
297
298{$endif}
299
300function InvertRGB( Arg: TColor ): TColor;
301begin
302{$ifdef os2}
303 Result:= SysColorToRGB( Arg ); // in case it's a system color e.g. button face
304{$endif}
305{$ifdef win32}
306 Result := ColorToRGB( Arg );
307{$endif}
308 Result:= Result xor $ffffff; // now invert the RGB components
309end;
310
311function GetScreenColorDepth: longint;
312var
313 DeviceContext: HDC;
314begin
315{$ifdef os2}
316 // OS/2
317 DeviceContext := GpiQueryDevice( Screen.Canvas.Handle );
318 DevQueryCaps( DeviceContext,
319 CAPS_COLOR_BITCOUNT,
320 1,
321 Result );
322{$endif}
323{$ifdef win32}
324 // Windows
325 DeviceContext := CreateCompatibleDC( 0 ); // get screen dc
326 Result := GetDeviceCaps( DeviceContext,
327 BITSPIXEL );
328 DeleteDC( DeviceContext );
329{$endif}
330end;
331
332function GetVideoDriverName: string;
333{$ifdef os2}
334var
335 BaseDisplayDriverName: cstring;
336 GraddChains: string;
337 GraddDriverName: string;
338{$endif}
339begin
340{$ifdef os2}
341 // Get the PM display driver name from OS2.ini (strangely, NOT os2sys.ini).
342 PrfQueryProfileString( HINI_USERPROFILE, // OS2 INI
343 'PM_DISPLAYDRIVERS', // app
344 'CURRENTDRIVER', // key
345 'Unknown Display Driver', // default
346 BaseDisplayDriverName,
347 sizeof( BaseDisplayDriverName ) );
348
349 if BaseDisplayDriverName <> 'GRE2VMAN' then
350 begin
351 // non-gradd (old style) driver.
352 Result := BaseDisplayDriverName;
353 exit;
354 end;
355
356 // it's a GRADD driver
357 // Get the GRADD_CHAINS environment variable, this tells us
358 // where to look for more info...
359 GraddChains := GetEnv( 'GRADD_CHAINS' );
360 if GraddChains = '' then
361 begin
362 Result := 'Unknown GRADD driver (GRADD_CHAINS not set)';
363 exit;
364 end;
365
366 // OK, now get the environment variable GRADD_CHAINS refers to...
367 GraddDriverName := GetEnv( GraddChains );
368 if GraddDriverName = '' then
369 begin
370 Result := 'Unknown GRADD driver (GRADD_CHAINS: '
371 + GraddChains
372 + ' returns blank)';
373 exit;
374 end;
375
376 // Normal GRADD case
377 Result := 'GRADD: '
378 + GraddDriverName;
379
380 // if sddgradd then ...?
381{$endif}
382end;
383
384procedure SmartSetWindowPos( Form: TForm;
385 X, Y, W, H: longint;
386 Maximised: boolean );
387begin
388{$ifdef os2}
389 if Form.Handle = 0 then
390 begin
391 // window not yet created, set the position for restore then maximize
392 Form.SetWindowPos( X, Y, W, H );
393 if Maximised then
394 Form.WindowState := wsMaximized;
395 exit;
396 end;
397
398 // window already created
399
400 if Form.WindowState = wsMaximized then
401 begin
402 // window already maximized, so set the restore position in window USHORTs
403 WinSetWindowUShort( Form.Frame.Handle, QWS_XRESTORE, X );
404 WinSetWindowUShort( Form.Frame.Handle, QWS_YRESTORE, Y );
405 WinSetWindowUShort( Form.Frame.Handle, QWS_CXRESTORE, W );
406 WinSetWindowUShort( Form.Frame.Handle, QWS_CYRESTORE, H );
407
408 // And reposition in maximized state
409 X := 0;
410 Y := 0;
411
412 if Form.Parent = nil then
413 begin
414 W := Screen.Width;
415 H := Screen.Height;
416 end
417 else
418 begin
419 W := Form.Parent.ClientWidth;
420 H := Form.Parent.ClientHeight;
421 end;
422
423 // We enlarge the area used so that the border is off screen.
424 if Form.BorderStyle <> bsNone then
425 begin
426 dec( X, GetBorderWidth( Form ) );
427 dec( Y, GetBorderHeight( Form ) );
428 inc( W, GetBorderWidth( Form ) * 2 );
429 inc( H, GetBorderHeight( Form ) * 2 );
430 end;
431 Form.SetWindowPos( X, Y, W, H );
432 end
433 else
434 begin
435 // Window not currently maximized
436 Form.SetWindowPos( X, Y, W, H );
437 if Maximised then
438 Form.WindowState := wsMaximized;
439 end;
440{$else}
441 // set the position for restore then maximize
442 Form.Left := X;
443 Form.Top := Y;
444 Form.Width := W;
445 Form.Height := H;
446 if Maximised then
447 Form.WindowState := wsMaximized;
448{$endif}
449end;
450
451procedure SmartGetWindowPos( Form: TForm;
452 Var X, Y, W, H: longint;
453 Var Maximised: boolean );
454{$ifdef win32}
455var
456 Placement: WINDOWPLACEMENT;
457{$endif}
458begin
459 X := Form.Left;
460{$ifdef os2}
461 Y := Form.Bottom;
462{$else}
463 Y := Form.Top;
464{$endif}
465 W := Form.Width;
466 H := Form.Height;
467 Maximised := Form.WindowState = wsMaximized;
468 if Form.Handle = 0 then
469 begin
470 // window not yet created, so we are done.
471 exit;
472 end;
473
474 // window already created
475
476{$ifdef os2}
477 if Form.WindowState in [ wsMaximized, wsMinimized ] then
478 begin
479 // window already maximized, so get the restore position from window USHORTs
480 X := WinQueryWindowUShort( Form.Frame.Handle, QWS_XRESTORE );
481 Y := WinQueryWindowUShort( Form.Frame.Handle, QWS_YRESTORE );
482 W := WinQueryWindowUShort( Form.Frame.Handle, QWS_CXRESTORE );
483 H := WinQueryWindowUShort( Form.Frame.Handle, QWS_CYRESTORE );
484 end;
485{$endif}
486{$ifdef win32}
487 // get normal position
488 Placement.length := sizeof( Placement );
489 GetWindowPlacement( Form.Handle, @Placement );
490 X := Placement.rcNormalPosition.Left;
491 Y := Placement.rcNormalPosition.Top;
492 W := Placement.rcNormalPosition.Right - Placement.rcNormalPosition.Left;
493 H := Placement.rcNormalPosition.Bottom - Placement.rcNormalPosition.Top;
494{$endif}
495end;
496
497Procedure SaveFormSizePosition( Form: TForm;
498 IniFile: TMyIniFile );
499Var
500 Maximised: boolean;
501 X: longint;
502 Y: longint;
503 W: longint;
504 H: longint;
505 Section: string;
506Begin
507 Section := Form.Name;
508
509 SmartGetWindowPos( Form, X, Y, W, H, Maximised );
510
511 IniFile.WriteInteger( Section,
512 'X',
513 X );
514 IniFile.WriteInteger( Section,
515 'Y',
516 Y );
517 IniFile.WriteInteger( Section,
518 'Width',
519 W );
520 IniFile.WriteInteger( Section,
521 'Height',
522 H );
523
524 IniFile.WriteBool( Section,
525 'Maximised',
526 Maximised );
527End;
528
529Procedure LoadFormSizePosition( Form: TForm;
530 IniFile: TMyIniFile );
531Var
532 Maximised: boolean;
533 X: longint;
534 Y: longint;
535 W: longint;
536 H: longint;
537 Section: string;
538Begin
539 Section := Form.Name;
540
541 X := IniFile.ReadInteger( Section,
542 'X',
543 Form.Left );
544 Y := IniFile.ReadInteger( Section,
545 'Y',
546{$ifdef os2}
547 Form.Bottom );
548{$else}
549 Form.Top );
550{$endif}
551 W := IniFile.ReadInteger( Section,
552 'Width',
553 Form.Width );
554 H := IniFile.ReadInteger( Section,
555 'Height',
556 Form.Height );
557
558 Maximised := IniFile.ReadBool( Section,
559 'Maximised',
560 Form.WindowState = wsMaximized );
561 SmartSetWindowPos( Form, X, Y, W, H, Maximised );
562
563End;
564
565Function SelectedObject( ListBox: TListBox ): TObject;
566begin
567 if ( ListBox.ItemIndex >= 0 )
568 and ( ListBox.ItemIndex < ListBox.Items.Count ) then
569 Result:= ListBox.Items.Objects[ ListBox.ItemIndex ]
570 else
571 Result:= nil;
572end;
573
574Procedure SetSelectedByObject( ListBox: TListBox;
575 SelectObject: TObject );
576var
577 Index: integer;
578begin
579 Index := ListBox.Items.IndexOfObject( SelectObject );
580 ListBox.ItemIndex := Index;
581end;
582
583Function SelectedItem( ListBox: TListBox ): string;
584begin
585 if ( ListBox.ItemIndex >= 0 )
586 and ( ListBox.ItemIndex < ListBox.Items.Count ) then
587 Result:= ListBox.Items[ ListBox.ItemIndex ]
588 else
589 Result:= '';
590end;
591
592Procedure GetSelectedItems( ListBox: TListBox;
593 Dest: TStrings );
594var
595 i: integer;
596begin
597 for i:= 0 to ListBox.Items.Count - 1 do
598 if ListBox.Selected[ i ] then
599 Dest.AddObject( ListBox.Items[ i ],
600 ListBox.Items.Objects[ i ] );
601end;
602
603{$ifdef os2}
604
605procedure ScaleChildren( Control: TControl;
606 ScalePosition: boolean;
607 XFactor: double;
608 YFactor: double );
609 forward;
610
611Procedure ScaleControl( Control: TControl;
612 ScalePosition: boolean;
613 XFactor: double;
614 YFactor: double );
615var
616 SizeX: boolean;
617 SizeY: boolean;
618begin
619 SizeX := true;
620 SizeY := true;
621
622 if Control is TEdit then
623 if TEdit( Control ).AutoSize then
624 SizeY := false;
625
626 if Control is TLabel then
627 begin
628 if TLabel( Control ).AutoSize then
629 begin
630 SizeX := false;
631 SizeY := false;
632 end;
633 end;
634
635 if SizeX then
636 Control.ClientWidth := Round( Control.ClientWidth * XFactor );
637
638 if SizeY then
639 Control.ClientHeight := Round( Control.ClientHeight * YFactor );
640
641 if ScalePosition then
642 begin
643 Control.Left := Round( Control.Left * XFactor );
644 Control.Bottom := Round( Control.Bottom * YFactor );
645 end;
646
647 if Control is TTabbedNotebook then
648 // size the tabset to match
649 TTabbedNotebook( Control ).TabHeight :=
650 Round( TTabbedNotebook( Control ).TabHeight * YFactor );
651
652 if Control is TMultiColumnListBox then
653 TMultiColumnListBox( Control ).HeaderHeight :=
654 Round( TMultiColumnListBox( Control ).HeaderHeight * YFactor );
655
656 if csDetail in Control.ComponentState then
657 exit;
658 if not ( csAcceptsControls in Control.ComponentState ) then
659 exit;
660
661 ScaleChildren( Control,
662 ScalePosition,
663 XFactor,
664 YFactor );
665end;
666
667procedure ScaleChildren( Control: TControl;
668 ScalePosition: boolean;
669 XFactor: double;
670 YFactor: double );
671var
672 i: longint;
673 Child: TControl;
674begin
675 for i := 0 to Control.ControlCount do
676 begin
677 Child := Control.Controls[ i ];
678 if Child = nil then
679 continue;
680
681 if Control is TTabbedNotebook then
682 begin
683 if Child is TTabSet then
684 // tabset sized elsewhere
685 continue;
686
687 if Child is TNotebook then
688 begin
689 // notebook has been sized as part of TTabbedNotebook
690 ScaleChildren( Child, true, XFactor, YFactor );
691 continue;
692 end;
693
694 end;
695
696 if Child is TPage then
697 begin
698 // Only size children, notebook has sized page
699 ScaleChildren( Child, true, XFactor, YFactor );
700 continue;
701 end;
702
703 ScaleControl( Child,
704 true,
705 XFactor,
706 YFactor );
707 end;
708end;
709
710Function AdjustFactor( Factor: double ): double;
711begin
712 if Factor <= 1.0 then
713 result := Factor
714 else if ( Factor > 1.0 ) and ( Factor < 1.2 ) then
715 result := 1.0
716 else
717 result := Factor - 0.2;
718
719end;
720
721var
722 ScaledForms: TList;
723
724Procedure ScaleForm( Form: TForm;
725 OriginalFontWidth: longint;
726 OriginalFontHeight: longint );
727var
728 XFactor: double;
729 YFactor: double;
730 UseWidth: double;
731 UseHeight: double;
732begin
733 if ScaledForms.IndexOf( Form ) <> -1 then
734 // already scaled this form.
735 exit;
736 ScaledForms.Add( Form );
737
738 UseWidth := Form.Canvas.TextWidth( 'M' );
739 UseHeight := Form.Canvas.TextHeight( 'M' );
740
741 XFactor := AdjustFactor( UseWidth / OriginalFontWidth );
742 YFactor := AdjustFactor( UseHeight / OriginalFontHeight );
743
744 if ( XFactor = 1.0 )
745 and ( YFactor = 1.0 ) then
746 // no scaling to do, skip it for efficiency
747 exit;
748
749 ScaleControl( Form,
750 false,
751 XFactor,
752 YFactor );
753
754end;
755
756// Validate component memory and it's owned components
757procedure ValidateComponent( Component: TComponent );
758var
759 i: longint;
760begin
761 CheckMem( Component );
762 for i := 0 to Component.ComponentCount - 1 do
763 ValidateComponent( Component.Components[ i ] );
764end;
765
766// Validate all known SPCC components
767procedure ValidateSPCCObjects;
768var
769 i: longint;
770 Form: TForm;
771begin
772 CheckHeap;
773
774 ValidateComponent( Screen );
775 ValidateComponent( ClipBoard );
776 for i := 0 to Screen.FormCount - 1 do
777 begin
778 Form := Screen.Forms[ i ];
779 ValidateComponent( Form );
780 end;
781end;
782
783Function GetSystemInfoItem( Item: ULONG ): ULONG;
784begin
785 DosQuerySysInfo( Item,
786 Item,
787 Result,
788 sizeof( Result ) );
789end;
790
791Procedure LogException( E: Exception;
792 const LogFileName: string;
793 const Title: string;
794 const AppVersion: string;
795 var F: TextFile );
796var
797 i: integer;
798 OSMajorVersion: ULONG;
799 OSMinorVersion: ULONG;
800 OSRevision: ULONG;
801 RamMB: ULONG;
802 BootDrive: ULONG;
803begin
804 AssignFile( F, LogFilename );
805 FileMode := fmInOut;
806
807 try
808 if FileExists( LogFilename ) then
809 Append( F )
810 else
811 Rewrite( F );
812 except
813 exit;
814 end;
815
816 try
817 WriteLn( F, '' );
818 WriteLn( F, '---- ' + Title + ' crash log ----' );
819 WriteLn( F, 'App Version: ' + AppVersion );
820 WriteLn( F, 'Components Version: ' + GetComponentsVersion );
821 WriteLn( F, 'Library Version: ' + GetACLLibraryVersion );
822 WriteLn( F, '' );
823 WriteLn( F, 'Running as process: ' + GetApplicationFilename );
824 WriteLn( F, FormatDateTime( 'd mmmm yyyy, hh:mm:ss', now ) );
825 WriteLn( F, 'Exception type: ' + E.ClassName );
826 WriteLn( F, 'Description: ' + E.Message );
827 WriteLn( F, 'Location: $'
828 + IntToHex( longword( E.ExcptAddr ), 8 ) );
829
830 WriteLn( F, 'Callstack:' );
831
832 for i := 0 to GetExceptionCallCount - 1 do
833 begin
834 WriteLn( F, ' $' + IntToHex( GetExceptionCallstackEntry( i ), 8 ) );
835 end;
836
837 OSMajorVersion := GetSystemInfoItem( QSV_VERSION_MAJOR );
838 OSMinorVersion := GetSystemInfoItem( QSV_VERSION_MINOR );
839 OSRevision := GetSystemInfoItem( QSV_VERSION_REVISION );
840
841 WriteLn( F, 'System version:'
842 + IntToStr( OSMajorVersion )
843 + '.'
844 + IntToStr( OSMinorVersion )
845 + '.'
846 + IntToStr( OSRevision ) );
847 if OSMajorVersion = 20 then
848 begin
849 case OSMinorVersion of
850 00: WriteLn( F, ' OS/2 2.0' );
851 10: WriteLn( F, ' OS/2 2.1' );
852 11: WriteLn( F, ' OS/2 2.11' );
853 30: WriteLn( F, ' OS/2 3.0' );
854 40: WriteLn( F, ' OS/2 4.0' );
855 45: WriteLn( F, ' OS/2 4.5' ); // I guess
856 end;
857 end;
858
859 RamMB := GetSystemInfoItem( QSV_TOTPHYSMEM )
860 div ( 1024 * 1024 );
861 WriteLn( F, 'RAM: '
862 + IntToStr( RamMB )
863 + ' MB' );
864
865 BootDrive := GetSystemInfoItem( QSV_BOOT_DRIVE ); // nA = 1
866 WriteLn( F, 'Boot drive: '
867 + Chr( Ord( 'A' )
868 + BootDrive - 1 ) );
869
870 // Video information
871 WriteLn( F, 'Video resolution: '
872 + IntToStr( Screen.Width )
873 + 'x'
874 + IntToStr( Screen.Height ) );
875 WriteLn( F, 'Color depth: '
876 + IntToStr( GetScreenColorDepth )
877 + ' bits' );
878 WriteLn( F, 'Video driver: '
879 + GetVideoDriverName );
880 except
881 end;
882
883end;
884
885Function FindTopFormWindow( const WindowClassName: string ): HWND;
886var
887 EnumHandle: HENUM;
888 ChildEnumHandle: HENUM;
889 Child: HWND;
890
891 Buffer: array[ 0..31 ] of char;
892 FrameClassName: array[ 0..31 ] of char;
893 MyClassName: array[ 0..31 ] of char;
894 Len: longint;
895 FrameClassConst: longint;
896 Found: boolean;
897begin
898 FrameClassConst := WC_FRAME;
899 StrPCopy( FrameClassName, '#' + IntToStr( USHORT( FrameClassConst ) ) );
900 StrPCopy( MyClassName, WindowClassName );
901
902 // first enum desktop children to find Frame windows
903 EnumHandle := WinBeginEnumWindows( HWND_DESKTOP );
904 while true do
905 begin
906 result := WinGetNextWindow( EnumHandle );
907 if result = NULLHANDLE then
908 // ran out
909 break;
910
911 Len := WinQueryClassName( result, sizeof( Buffer ), Buffer );
912 Buffer[ Len ] := #0;
913 if StrLComp( Buffer, FrameClassName, sizeof( Buffer ) ) = 0 then
914 begin
915 // this is a WC_FRAME window
916 // look thru it's children for the form name we want...
917
918 ChildEnumHandle := WinBeginEnumWindows( result );
919
920 Found := false;
921 while true do
922 begin
923 Child := WinGetNextWindow( ChildEnumHandle );
924 if Child = NULLHANDLE then
925 break;
926
927 Len := WinQueryClassName( Child, sizeof( Buffer ), Buffer );
928 if StrLComp( Buffer, MyClassName, sizeof( Buffer ) ) = 0 then
929 begin
930 // found
931 Found := true;
932 break;
933 end;
934 end;
935 WinEndEnumWindows( ChildEnumHandle );
936 if Found then
937 break;
938 end;
939 end;
940 WinEndEnumWindows( EnumHandle );
941end;
942
943Function GetLinkCursor: TCursor;
944begin
945 Result := TheLinkCursor;
946end;
947{$endif}
948
949const
950 LibVersion = 'v1.11.26'; // // $SS_REQUIRE_NEW_VERSION$
951
952function GetComponentsVersion: string;
953begin
954 Result := LibVersion;
955end;
956
957{$ifdef os2}
958Initialization
959 ScaledForms := TList.Create;
960
961 TheLinkPointer := TPointer.Create;
962 TheLinkPointer.LoadFromResourceName( 'LinkPointer' );
963 TheLinkCursor := Screen.AddCursor( TheLinkPointer.Handle );
964
965Finalization
966 ScaledForms.Destroy;
967 TheLinkPointer.Destroy;
968{$endif}
969end.
Note: See TracBrowser for help on using the repository browser.