Unit ads_comp;
{Copyright(c)2016 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
dickmaley@advdelphisys.com
The code herein can be used or modified by anyone. Please retain references
to Richard Maley at Advanced Delphi Systems. If you make improvements to the
code please send your improvements to dickmaley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
(*UnitIndex Master Index Implementation Section Download UnitsDescription: ads_Comp.pas This unit contains the following routines.
AboutBox_ads ButtonReSizer CenterChild CenterChildren_H CenterChildren_V CenterComponent CenterForm CenterFormHorizontally CenterFormVertically ComboIncremental CompDimensions DialogAboutBox_ads DialogInputBoxOnlyAToZ DialogInputBoxOnlyNumbers DialogInputBoxOnlyNumbersAbsolute FileDate FindOwnedControlByName FormCenterHorizontal FormCenterVertical FormDimensions GetCenterFormLeft GetCenterFormTop GetChildByNameBelow GetFirstChildByClassBelow GetLastChildByClassBelow GetListOfChildrenByClass GetNextChildByClassBelow GetParentByClassAbove GetParentByNameAbove GetPriorChildByClassBelow GridDeleteRow GridMoveRowToBottom InputBoxFilterDetail InputBoxOnlyAToZ InputBoxOnlyNumbers InputBoxOnlyNumbersAbsolute KeyPressOnlyAToZ KeyPressOnlyNumbers KeyPressOnlyNumbersAbsolute PanelBevel ProgressScreenCursor ScaleForm SetChildHeights SetChildHeightsToParents SetChildLefts SetChildTops SetChildWidths_1 SetChildWidths_2 SetChildWidthsToParents StringGridSortOnCol StringGridSortOnXY StringPad TEditKeyFilter.OnlyAToZ TEditKeyFilter.OnlyNumbers TEditKeyFilter.OnlyNumbersAbsolute TForm1.ComboBoxKeyPress TForm1.GridMouseDown TFormMain.AboutClick ToolBarButtonVisibleOne TPanel_Cmp_Sec_ads.ResizeShadowLabel VersionInformation
*)
Interface
Uses
SysUtils, ExtCtrls, Classes, Controls, Forms, Grids, Buttons, StdCtrls,
WinProcs, Graphics;
procedure CenterChildren_V(WinControl : TWinControl);
procedure SetChildWidthsToParents(WinControl : TWinControl);
procedure SetChildHeightsToParents(WinControl : TWinControl);
procedure SetChildLefts(WinControl : TWinControl; Value: Integer);
procedure SetChildTops(WinControl : TWinControl; Value: Integer);
procedure SetChildHeights(WinControl : TWinControl; Value: Integer);
procedure SetChildWidths(WinControl : TWinControl; Value: Integer);OverLoad;
Function GetParentByClassAbove(ChildObject : TWinControl;ParentClass : TClass): TWinControl;
Function GetParentByNameAbove(ChildObject : TWinControl;ParentName : String): TWinControl;
Function GetChildByNameBelow(ParentObject : TWinControl;ChildName : String): TWinControl;
Function GetFirstChildByClassBelow(ParentObject : TWinControl;ChildClass : TClass): TWinControl;
Function GetPriorChildByClassBelow(ParentObject,CurrentObject : TWinControl;ChildClass : TClass): TWinControl;
Function GetNextChildByClassBelow(ParentObject,CurrentObject : TWinControl;ChildClass : TClass): TWinControl;
Function GetLastChildByClassBelow(ParentObject : TWinControl;ChildClass : TClass): TWinControl;
Procedure GetListOfChildrenByClass(var WinControls: TStringList;ParentObject: TWinControl;ChildClass : TClass);
Function FindOwnedControlByName(OwnedBy: TWinControl;OwnedControlName: String): TControl;
{!~ ABOUTBOX_ADS
This procedure presents an About Box.
TITLE The title is set by the AboutTitle parameter.
INFORMATION
The information displayed in the about box is pulled directly
from the executable. The programmer can configure this information
in Delphi by doing the following:
(1) in Delphi go to Project|Options|VersionInfo and make sure
that the check box for Include Version information in project
is checked.
(2)Auto-increment build number should also be checked so
that each time a build-all is run the version number is
automatically updated. This makes life simple and in automatic.
(3)Edit/Add items in the section at the bottom of this page
where key and value items are listed. Whatever you put in
this section is what will appear in the about box.
(2) Save the project and recompile
(3) The newly edited information will appear in the about box.
IMAGE
The Application Icon is presented as the image. To change the
image do the following:
(1) in Delphi go to Project|Options|Application|Load Icon
and select an Icon for the application
(2) Save the project and
recompile
(3) The newly selected Icon will appear in the about box.
SIZE
The About box size can be pased as the parameters AboutWidth
and AboutHeight. If however you wish to have the procedure
size the About Box automatically set these two parameters to
zero. }
Procedure AboutBox_ads(
AboutTitle : String;
AboutWidth : Integer;
AboutHeight : Integer
);
{!~ ButtonReSizer handles button alignment, ordering and appearance.
To use this procedure place a TPanel on a form and either align alTop
or alBottom. This panel is passed as the ButtonBase parameter. Place
another panel on the ButtonBase panel and set its align property to
alClient. This second panel is passed as the ButtonSlider parameter.
Place (Create) all buttons on the ButtonSlider in the reverse order
that they should appear at run time. Any button type can be used.
In the ButtonBase component's resize event place this procedure
with all the appropriate parameters.
ButtonBase: The bottom Panel.
ButtonSlider: The top panel.
ButtonWidth: RunTime width of buttons, normally about 75.
ButtonSpacer: Distance between buttons, normally about 5.
ButtonResize:
If true the buttons resize, False they keep fixed
dimensions. Normally false.
Beveled:
If true the panels have a beveled appearance, otherwise they
have no beveling.
ButtonsAlignment:
Uses TAlignment values of taRightJustify, taLeftJustify, taCenter
to establish whether the buttons will be aligned left, right or
centered.
}
procedure ButtonReSizer(
ButtonBase : TPanel;
ButtonSlider : TPanel;
ButtonWidth : Integer;
ButtonSpacer : Integer;
ButtonsReSize : Boolean;
ButtonsAlignment: TAlignment;
Beveled : Boolean);
{!~ Centers a child component on a TPanel}
procedure CenterChild(Panel : TPanel);
{!~ Horizontally Centers all children of a TPanel }
procedure CenterChildren_H(Panel : TPanel);
{!~ Centers a Control Inside its Parent}
Procedure CenterComponent(ParentControl, ChildControl: TControl);
{!~ Centers A Form}
Procedure CenterForm(f : TForm);
{!~ Centers A Form Horizontally}
Procedure CenterFormHorizontally(f : TForm);
{!~ Centers A Form Vertically}
Procedure CenterFormVertically(f : TForm);
{!~ ComboIncremental
This function should be used in the onKeyPress event of a TComboBox.
This function implements Windows Style incremental typing for a ComboBox.
The standard Windows functionality is that if a letter is typed windows
finds the next item in the ComboBox list that starts with this letter.
If there are no other items and the current item starts with this letter
the current value is retained. If there are no items that start with this
letter the ComboBox text field is cleared. If the currently selected item
from the ComboBox is changed this function returns True, otherwise it
returns False. The Boolean return value can be used to respond to changes
if other actions are required when the ComboBox value changes.
example:
procedure TForm1.ComboBoxKeyPress(Sender: TObject; var Key: Char);
Var
boRetVal : Boolean;
Begin
Result := False;
ProcName := ' GetParentByClassAbove'; Try
boRetVal := ComboIncremental(Sender,Key);
If boRetVal Then ShowMessage('Do Something');
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
}
Function ComboIncremental(var ComboBox: TComboBox; var Key: Char): Boolean;
{!~ Sets The Dimensions Of A Component}
procedure CompDimensions(
Comp: TControl;
TopDim,
LeftDim,
HeightDim,
WidthDim: Integer);
{!~ DIALOGABOUTBOX_ADS
This procedure presents an About Box.
TITLE The title is set by the AboutTitle parameter.
INFORMATION
The information displayed in the about box is pulled directly
from the executable. The programmer can configure this information
in Delphi by doing the following:
(1) in Delphi go to Project|Options|VersionInfo and make sure
that the check box for Include Version information in project
is checked.
(2)Auto-increment build number should also be checked so
that each time a build-all is run the version number is
automatically updated. This makes life simple and in automatic.
(3)Edit/Add items in the section at the bottom of this page
where key and value items are listed. Whatever you put in
this section is what will appear in the about box.
(2) Save the project and recompile
(3) The newly edited information will appear in the about box.
IMAGE
The Application Icon is presented as the image. To change the
image do the following:
(1) in Delphi go to Project|Options|Application|Load Icon
and select an Icon for the application
(2) Save the project and
recompile
(3) The newly selected Icon will appear in the about box.
SIZE
The About box size can be pased as the parameters AboutWidth
and AboutHeight. If however you wish to have the procedure
size the About Box automatically set these two parameters to
zero. }
Procedure DialogAboutBox_ads(
AboutTitle : String;
AboutWidth : Integer;
AboutHeight : Integer
);
{!~ Presents an input dialog that accepts a-z and A-Z only.
All other keys are thrown away except for the backspace key.
The result is returned as a string}
Function DialogInputBoxOnlyAToZ(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
{!~ Presents an input dialog that accepts 0-9,-,+,".".
All other keys are thrown away except for the backspace key.
The result is returned as a string}
Function DialogInputBoxOnlyNumbers(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
{!~ Presents an input dialog that accepts 0-9.
All other keys are thrown away except for the backspace key.
The result is returned as a string}
Function DialogInputBoxOnlyNumbersAbsolute(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
{!~ Returns The Left Property To Center A Form}
Function FormCenterHorizontal(FormWidth: Integer): Integer;
{!~ Returns The Top Property To Center A Form}
Function FormCenterVertical(FormHeight: Integer): Integer;
{!~ Sets The Dimensions Of A Form}
procedure FormDimensions(
Form: TForm;
TopDim,
LeftDim,
HeightDim,
WidthDim: Integer);
{!~ Returns the form's left value that will center the form horizontally}
Function GetCenterFormLeft(FormWidth : Integer): Integer;
{!~ Returns the form's Top value that will center the form vertically}
Function GetCenterFormTop(FormHeight : Integer): Integer;
{!~ Deletes a row in a TStringGrid}
procedure GridDeleteRow(RowNumber : Integer; Grid : TStringGrid);
{!~ Moves a row in a TStringGrid to the bottom of the grid}
procedure GridMoveRowToBottom(RowNumber : Integer; Grid : TStringGrid);
{!~ This is the underlying engine for InputBoxOnlyAToZ,
InputBoxOnlyAToZ and InputBoxOnlyNumbersAbsolute}
Function InputBoxFilterDetail(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string;
const FilterString : string
): string;
{!~ Presents an input dialog that accepts a-z and A-Z only.
All other keys are thrown away except for the backspace key.
The result is returned as a string}
Function InputBoxOnlyAToZ(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
{!~ Presents an input dialog that accepts 0-9,-,+,".".
All other keys are thrown away except for the backspace key.
The result is returned as a string}
Function InputBoxOnlyNumbers(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
{!~ Presents an input dialog that accepts 0-9.
All other keys are thrown away except for the backspace key.
The result is returned as a string}
Function InputBoxOnlyNumbersAbsolute(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
{!~ Sets or unsets beveling in a panel}
Procedure PanelBevel(Beveled : Boolean; Panel: TPanel);
{!~ Increments the screen cursor to show progress}
procedure ProgressScreenCursor;
{!~ Scales a Form To A Particular Resolution}
Procedure ScaleForm(F: TForm;ScreenWidth, ScreenHeight: LongInt);
{!~ Sets all Children of a TPanel to the same width}
procedure SetChildWidths(Panel : TPanel);OverLoad;
procedure StringGridSortOnCol(
var Grid : TStringGrid;
inColNum : Integer);
{!~
StringGridSortOnXY
This procedure sorts all the records in a StringGrid based on the values in a
column. This procedure should be used in the on MouseDown event of the
StringGrid. When a column header is clicked, the grid is sorted based on the
values in that column.
Example Code:
procedure TForm1.GridMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Result := False;
ProcName := 'ComboIncremental'; Try
If Y < Grid.DefaultRowHeight Then StringGridSortOnXY(Grid, x);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
end;
}
procedure StringGridSortOnXY(
var Grid : TStringGrid;
inColX : Integer);
{!~ Turns the panel upon which a TSpeedButton is placed
invisible if the SpeedButton's glyph is empty}
Procedure ToolBarButtonVisibleOne(P:TPanel;B : TSpeedButton);
{!~ Populates a listbox with the executable's version information}
Function VersionInformation(
ListBox : TListBox): Boolean;
implementation
Uses ads_File, ads_Exception;
Var
ProcName : String = 'Unknown';
UnitName : String = 'ads_comp';
{Pads or truncates a String and Justifies Left if StrJustify=True}
//Unit Description UnitIndex Master Index
Function StringPad(
InputStr,
FillChar: String;
StrLen: Integer;
StrJustify: Boolean): String;
Var
TempFill: String;
Counter : Integer;
Begin
ProcName := 'StringGridSortOnXY'; Try
If Not (Length(InputStr) = StrLen) Then
Begin
If Length(InputStr) > StrLen Then
Begin
InputStr := Copy(InputStr,1,StrLen);
End
Else
Begin
TempFill := '';
For Counter := 1 To StrLen-Length(InputStr) Do
Begin
TempFill := TempFill + FillChar;
End;
If StrJustify Then
Begin
{Left Justified}
InputStr := InputStr + TempFill;
End
Else
Begin
{Right Justified}
InputStr := TempFill + InputStr ;
End;
End;
End;
Result := InputStr;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Populates a listbox with the executable's version information}
//Unit Description UnitIndex Master Index
Function VersionInformation(
ListBox : TListBox): Boolean;
const
(*
InfoNum = 12;
InfoStr : array [1..InfoNum] of String =
('CompanyName', 'FileDescription', 'FileVersion', 'InternalName',
'LegalCopyright', 'LegalTradeMarks', 'OriginalFilename',
'ProductName', 'ProductVersion', 'Comments', 'Author','Agency');
LabelStr : array [1..InfoNum] of String =
('Company Name', 'Description', 'File Version', 'Internal Name',
'Copyright', 'TradeMarks', 'Original File Name',
'Product Name', 'Product Version', 'Comments', 'Author','Agency');
*)
InfoNum = 19;
InfoStr : array [1..InfoNum] of String =
(
'CompanyName',
'Company_Zip',
'Company_URL',
'Company_State',
'Company_Phone',
'Company_City',
'FileDescription',
'FileVersion',
'InternalName',
'LegalCopyright',
'LegalTradeMarks',
'OriginalFilename',
'ProductName',
'ProductVersion',
'Comments',
'Author',
'Author_Name',
'Author_Email',
'Agency'
);
LabelStr : array [1..InfoNum] of String =
(
'Company Name',
'Company Zip Code',
'Company URL',
'Company State',
'Company Phone',
'Company City',
'Description',
'File Version',
'Internal Name',
'Copyright',
'TradeMarks',
'Original File Name',
'Product Name',
'Product Version',
'Comments',
'Author',
'Author Name',
'Author Email',
'Agency'
);
var
S : String;
i : Integer;
Len : Cardinal;
n : Cardinal;
Buf : PChar;
Value : PChar;
begin
Result := False;
ProcName := 'VersionInformation'; Try
Try
S := Application.ExeName;
ListBox.Items.Clear;
ListBox.Sorted := True;
ListBox.Font.Name := 'Arial';
n := GetFileVersionInfoSize(PChar(S),n);
If n > 0 Then
Begin
Buf := AllocMem(n);
ListBox.Items.Add('Size'+^I+'= '
+IntToStr(ads_File.GetFileSize(ParamStr(0))));
GetFileVersionInfo(PChar(S),0,n,Buf);
For i:=1 To InfoNum Do
Begin
If VerQueryValue(Buf,PChar('StringFileInfo\040904E4\'+
InfoStr[i]),Pointer(Value),Len) Then
Begin
If Length(Value) > 0 Then
Begin
ListBox.Items.Add(StringPad(labelStr[i],' ',20,True)+' '+^I+'= '+Value);
End;
End;
End;
FreeMem(Buf,n);
End
Else
Begin
ListBox.Items.Add('No FileVersionInfo found');
End;
Result := True;
Except
Result := False;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Returns The Files Date Time Stamp as TDateTime.
Returns 0 if there is an error}
//Unit Description UnitIndex Master Index
Function FileDate(FileString: String): TDateTime;
Begin
Result := 0.00;
ProcName := 'FileDate'; Try
Result := 0;
Try
If Not FileExists(FileString) Then Exit;
{$WARNINGS OFF}
Result := FileDateToDateTime(FileAge(FileString));
{$WARNINGS ON}
Except
Result := 0;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Throws away all keys except a-z and A-Z}
//Unit Description UnitIndex Master Index
Procedure KeyPressOnlyAToZ(Var Key: Char);
Begin
ProcName := 'KeyPressOnlyAToZ'; Try
Case Key Of
'a': Exit;
'b': Exit;
'c': Exit;
'd': Exit;
'e': Exit;
'f': Exit;
'g': Exit;
'h': Exit;
'i': Exit;
'j': Exit;
'k': Exit;
'l': Exit;
'm': Exit;
'n': Exit;
'o': Exit;
'p': Exit;
'q': Exit;
'r': Exit;
's': Exit;
't': Exit;
'u': Exit;
'v': Exit;
'w': Exit;
'x': Exit;
'y': Exit;
'z': Exit;
'A': Exit;
'B': Exit;
'C': Exit;
'D': Exit;
'E': Exit;
'F': Exit;
'G': Exit;
'H': Exit;
'I': Exit;
'J': Exit;
'K': Exit;
'L': Exit;
'M': Exit;
'N': Exit;
'O': Exit;
'P': Exit;
'Q': Exit;
'R': Exit;
'S': Exit;
'T': Exit;
'U': Exit;
'V': Exit;
'W': Exit;
'X': Exit;
'Y': Exit;
'Z': Exit;
#8 : Exit; {Backspace}
End;
Key := #0; {Throw the key away}
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Throws away all keys except 0-9}
//Unit Description UnitIndex Master Index
Procedure KeyPressOnlyNumbersAbsolute(Var Key: Char);
Begin
ProcName := 'KeyPressOnlyNumbersAbsolute'; Try
Case Key Of
'0': Exit;
'1': Exit;
'2': Exit;
'3': Exit;
'4': Exit;
'5': Exit;
'6': Exit;
'7': Exit;
'8': Exit;
'9': Exit;
#8 : Exit; {Backspace}
End;
Key := #0; {Throw the key away}
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{Throws away all keys except 0-9,-,+,.}
//Unit Description UnitIndex Master Index
Procedure KeyPressOnlyNumbers(Var Key: Char);
Begin
ProcName := 'KeyPressOnlyNumbers'; Try
Case Key Of
'0': Exit;
'1': Exit;
'2': Exit;
'3': Exit;
'4': Exit;
'5': Exit;
'6': Exit;
'7': Exit;
'8': Exit;
'9': Exit;
'-': Exit;
'+': Exit;
'.': Exit;
#8 : Exit; {Backspace}
End;
Key := #0; {Throw the key away}
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
Type
TPanel_Cmp_Sec_ads = class(TPanel)
Public
procedure ResizeShadowLabel(Sender: TObject);
End;
//Unit Description UnitIndex Master Index
procedure TPanel_Cmp_Sec_ads.ResizeShadowLabel(
Sender : TObject);
Var
PH, PW : Integer;
LH, LW : Integer;
begin
ProcName := 'TPanel_Cmp_Sec_ads.ResizeShadowLabel'; Try
PH := TPanel(Sender).Height;
PW := TPanel(Sender).Width;
LH := TLabel(Controls[0]).Height;
LW := TLabel(Controls[0]).Width;
TLabel(Controls[0]).Top := ((PH-LH) div 2)-3;
TLabel(Controls[0]).Left := ((Pw-Lw) div 2)-3;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
end;
Type
TEditKeyFilter = Class(TEdit)
Published
{!~ Throws away all keys except 0-9,-,+,.}
Procedure OnlyNumbers(Sender: TObject; var Key: Char);
{!~ Throws away all keys except 0-9}
Procedure OnlyNumbersAbsolute(Sender: TObject; var Key: Char);
{!~ Throws away all keys except a-z and A-Z}
Procedure OnlyAToZ(Sender: TObject; var Key: Char);
End;
{!~ Throws away all keys except 0-9,-,+,.}
//Unit Description UnitIndex Master Index
Procedure TEditKeyFilter.OnlyNumbers(Sender: TObject; var Key: Char);
Begin
ProcName := 'TEditKeyFilter.OnlyNumbers'; Try
KeyPressOnlyNumbers(Key);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Throws away all keys except 0-9}
//Unit Description UnitIndex Master Index
Procedure TEditKeyFilter.OnlyNumbersAbsolute(Sender: TObject; var Key: Char);
Begin
ProcName := 'TEditKeyFilter.OnlyNumbersAbsolute'; Try
KeyPressOnlyNumbersAbsolute(Key);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Throws away all keys except a-z and A-Z}
//Unit Description UnitIndex Master Index
Procedure TEditKeyFilter.OnlyAToZ(Sender: TObject; var Key: Char);
Begin
ProcName := 'TEditKeyFilter.OnlyAToZ'; Try
KeyPressOnlyAToZ(Key);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ ABOUTBOX_ADS
This procedure presents an About Box.
TITLE The title is set by the AboutTitle parameter.
INFORMATION
The information displayed in the about box is pulled directly
from the executable. The programmer can configure this information
in Delphi by doing the following:
(1) in Delphi go to Project|Options|VersionInfo and make sure
that the check box for Include Version information in project
is checked.
(2)Auto-increment build number should also be checked so
that each time a build-all is run the version number is
automatically updated. This makes life simple and in automatic.
(3)Edit/Add items in the section at the bottom of this page
where key and value items are listed. Whatever you put in
this section is what will appear in the about box.
(2) Save the project and recompile
(3) The newly edited information will appear in the about box.
IMAGE
The Application Icon is presented as the image. To change the
image do the following:
(1) in Delphi go to Project|Options|Application|Load Icon
and select an Icon for the application
(2) Save the project and
recompile
(3) The newly selected Icon will appear in the about box.
SIZE
The About box size can be pased as the parameters AboutWidth
and AboutHeight. If however you wish to have the procedure
size the About Box automatically set these two parameters to
zero. }
//Unit Description UnitIndex Master Index
Procedure AboutBox_ads(
AboutTitle : String;
AboutWidth : Integer;
AboutHeight : Integer
);
Var
About_Title : TLabel;
AboutBase : TPanel;
AboutBaseButtons: TPanel;
AboutBaseTop : TPanel;
AboutBaseTopTop : TPanel;
AboutImage : TImage;
Bevel1 : TBevel;
Form : TForm;
i : Integer;
inTabWidth : Integer;
ListBox : TListBox;
ListBoxFirst : TListBox;
MaxLength : Integer;
OKButton : TButton;
Spacer : TPanel;
Spacer2 : TPanel;
Spacer3 : TPanel;
Title : TPanel_Cmp_Sec_ads;
Begin
ProcName := 'AboutBox_ads'; Try
Form := TForm.Create(Application);
Try
inTabWidth:=75;
With Form Do
Begin;
Left := 209;
Top := 108;
Width := AboutWidth;
Height := AboutHeight;
BorderIcons := [biSystemMenu];
Caption := 'About';
Font.Charset := DEFAULT_CHARSET;
Font.Color := clWindowText;
Font.Height := -11;
Font.Name := 'Arial';
Font.Style := [];
Position := poScreenCenter;
PixelsPerInch := 96;
End;
AboutBase := TPanel.Create(Form);
With AboutBase Do
Begin
Parent := Form;
Left := 0;
Top := 0;
Width := 420;
Height := 322;
Align := alClient;
BevelOuter := bvNone;
BorderWidth := 10;
Caption := ' ';
TabOrder := 0;
End;
AboutBaseButtons:= TPanel.Create(Form);
With AboutBaseButtons Do
Begin
Parent := AboutBase;
Left := 10;
Top := 285;
Width := 400;
Height := 27;
Align := alBottom;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 0;
OKButton := TButton.Create(Form);
End;
With OKButton Do
Begin
Parent := AboutBaseButtons;
Left := 168;
Top := 1;
Width := 75;
Height := 25;
Caption := 'OK';
Default := True;
ModalResult := 1;
TabOrder := 0;
Align := alRight;
end;
AboutBaseTop := TPanel.Create(Form);
With AboutBaseTop Do
Begin
Parent := AboutBase;
Left := 10;
Top := 10;
Width := 400;
Height := 268;
Align := alClient;
BevelWidth := 2;
BorderWidth := 10;
Caption := ' ';
ParentColor := True;
TabOrder := 1;
Bevel1 := TBevel.Create(Form);
End;
With Bevel1 Do
Begin
Parent := AboutBaseTop;
Left := 12;
Top := 62;
Width := 376;
Height := 5;
Align := alTop;
end;
ListBoxFirst := TListBox.Create(Form);
With ListBoxFirst Do
Begin
Parent := AboutBaseTop;
Left := 12;
Top := 75;
Width := 376;
Height := 50;
Align := alTop;
BorderStyle := bsNone;
ItemHeight := 13;
ParentColor := True;
TabOrder := 0;
TabWidth := inTabWidth;
Font.Style := [fsBold];
Font.Name := 'Arial';
Height := ItemHeight;
end;
ListBox := TListBox.Create(Form);
With ListBox Do
Begin
Parent := AboutBaseTop;
Left := 12;
Top := 75;
Width := 376;
Height := 181;
Align := alClient;
BorderStyle := bsNone;
ItemHeight := 13;
ParentColor := True;
TabOrder := 0;
TabWidth := inTabWidth;
Font.Style := [fsBold];
Font.Name := 'Arial';
end;
AboutBaseTopTop := TPanel.Create(Form);
With AboutBaseTopTop Do
Begin
Parent := AboutBaseTop;
Left := 12;
Top := 12;
Width := 376;
Height := 45;
Align := alTop;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 1;
AboutImage := TImage.Create(Form);
End;
With AboutImage Do
Begin
Parent := AboutBaseTopTop;
Left := 0;
Top := 0;
Width := 56;
Height := 45;
Align := alLeft;
Stretch := True;
end;
Title := TPanel_Cmp_Sec_ads.Create(Form);
With Title Do
Begin
Parent := AboutBaseTopTop;
Left := 56;
Top := 0;
Width := 320;
Height := 45;
Align := alClient;
BevelOuter := bvNone;
Caption := AboutTitle;
Font.Charset := ANSI_CHARSET;
Font.Color := clWhite;
Font.Height := -21;
Font.Name := 'Arial';
Font.Style := [fsBold];
ParentFont := False;
TabOrder := 0;
OnResize := ResizeShadowLabel;
End;
About_Title := TLabel.Create(Form);
With About_Title Do
Begin
Parent := Title;
Left := 69;
Top := 18;
Width := 40;
Height := 24;
Caption := AboutTitle;
Font.Charset := DEFAULT_CHARSET;
Font.Color := clNavy;
Font.Height := -21;
Font.Name := 'Arial';
Font.Style := [fsBold];
ParentFont := False;
Transparent := True;
end;
Spacer2 := TPanel.Create(Form);
With Spacer2 Do
Begin
Parent := AboutBaseTop;
Left := 12;
Top := 57;
Width := 376;
Height := 5;
Align := alTop;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 2;
end;
Spacer3 := TPanel.Create(Form);
With Spacer3 Do
Begin
Parent := AboutBaseTop;
Left := 12;
Top := 67;
Width := 376;
Height := 8;
Align := alTop;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 3;
end;
Spacer := TPanel.Create(Form);
With Spacer Do
Begin
Parent := AboutBase;
Left := 10;
Top := 278;
Width := 400;
Height := 7;
Align := alBottom;
BevelOuter := bvNone;
Caption := ' ';
TabOrder := 2;
end;
ListBoxFirst.Items.Clear;
ListBoxFirst.Items.Add(
StringPad('Version Date',' ',20,True)+' '+^I+'= '+
FormatDateTime('mm/dd/yyyy',FileDate(Application.ExeName))
);
VersionInformation(ListBox);
AboutImage.Picture := TPicture(Application.Icon);
AboutImage.Width := AboutImage.Height;
If AboutHeight = 0 Then
Begin
Form.Height :=
AboutBaseButtons.Height +
Spacer .Height +
Spacer2 .Height +
Spacer3 .Height +
AboutBaseTopTop .Height +
Bevel1 .Height +
(ListBox.Items.Count * ListBox.ItemHeight) +
(ListBoxFirst.Items.Count * ListBoxFirst.ItemHeight)+
(AboutBaseTop.BorderWidth * 2) +
(AboutBase .BorderWidth * 2) +
(AboutBaseTop.BevelWidth * 4) +
26
;
End;
If AboutWidth = 0 Then
Begin
MaxLength := 0;
For i := 0 To ListboxFirst.Items.Count - 1 Do
Begin
If Length(ListBox.Items[i]) > MaxLength Then
Begin
MaxLength := Length(ListBox.Items[i]);
End;
End;
For i := 0 To Listbox.Items.Count - 1 Do
Begin
If Length(ListBox.Items[i]) > MaxLength Then
Begin
MaxLength := Length(ListBox.Items[i]);
End;
End;
If MaxLength < 23 Then
Begin
Form.Width :=
(AboutBaseTop.BorderWidth * 2) +
(AboutBase .BorderWidth * 2) +
(AboutBaseTop.BevelWidth * 4) +
400;
End
Else
Begin
Form.Width :=
(AboutBaseTop.BorderWidth * 2) +
(AboutBase .BorderWidth * 2) +
(AboutBaseTop.BevelWidth * 4) +
(MaxLength * 9);
End;
End;
Form.ShowModal;
Finally
Form.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ ButtonReSizer handles button alignment, ordering and appearance.
To use this procedure place a TPanel on a form and either align alTop
or alBottom. This panel is passed as the ButtonBase parameter. Place
another panel on the ButtonBase panel and set its align property to
alClient. This second panel is passed as the ButtonSlider parameter.
Place (Create) all buttons on the ButtonSlider in the reverse order
that they should appear at run time. Any button type can be used.
In the ButtonBase component's resize event place this procedure
with all the appropriate parameters.
ButtonBase: The bottom Panel.
ButtonSlider: The top panel.
ButtonWidth: RunTime width of buttons, normally about 75.
ButtonSpacer: Distance between buttons, normally about 5.
ButtonResize:
If true the buttons resize, False they keep fixed
dimensions. Normally false.
Beveled:
If true the panels have a beveled appearance, otherwise they
have no beveling.
ButtonsAlignment:
Uses TAlignment values of taRightJustify, taLeftJustify, taCenter
to establish whether the buttons will be aligned left, right or
centered.
}
//Unit Description UnitIndex Master Index
procedure ButtonReSizer(
ButtonBase : TPanel;
ButtonSlider : TPanel;
ButtonWidth : Integer;
ButtonSpacer : Integer;
ButtonsReSize : Boolean;
ButtonsAlignment: TAlignment;
Beveled : Boolean);
Var
MinFormWidth : Integer;
NButtons : Integer;
i : Integer;
NSpacers : Integer;
SpacerWidth : Integer;
SpacersWidth : Integer;
W : Integer;
LeftPos : Integer;
Begin
ProcName := 'ButtonReSizer'; Try
NButtons := ButtonSlider.ControlCount;
If ButtonSpacer > 0 Then
Begin
SpacerWidth := ButtonSpacer;
NSpacers := NButtons +1;
SpacersWidth := ButtonSpacer * NSpacers;
End
Else
Begin
SpacerWidth := 0;
SpacersWidth:= 0;
End;
MinFormWidth :=
SpacersWidth +
(NButtons * ButtonWidth) +
(ButtonBase.BorderWidth * 2) +
(ButtonBase.BevelWidth * 4) +
25;
Try
If ButtonBase.Parent is TForm Then
Begin
If ButtonBase.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
Try
If ButtonBase.Parent.Parent.Parent.Parent is TForm Then
Begin
If ButtonBase.Parent.Parent.Parent.Parent.Width < MinFormWidth Then
Begin
ButtonBase.Parent.Parent.Parent.Parent.Width := MinFormWidth;
End;
End
Else
Begin
{Not going to set a minimum form width}
End;
Except
End;
End;
Except
End;
End;
Except
End;
End;
Except
End;
If Beveled Then
Begin
ButtonBase.Height :=
(ButtonBase.BorderWidth * 2) +
(ButtonBase.BevelWidth * 4) +
2 {for borderStyle} +
25 {for standard button height} +
3;
End
else
Begin
ButtonBase.Height :=
(ButtonBase.BorderWidth * 2) +
25 {for standard button height} +
4;
End;
If ButtonsReSize Then
Begin
Buttonslider.Align := alClient;
W := (Buttonslider.Width - SpacersWidth) div NButtons;
LeftPos := SpacerWidth;
For i := 0 To NButtons - 1 Do
Begin
ButtonSlider.Controls[i].Align := alNone;
ButtonSlider.Controls[i].Top := 0;
ButtonSlider.Controls[i].Height := 25;
ButtonSlider.Controls[i].Width := W;
ButtonSlider.Controls[i].Left := LeftPos;
LeftPos := LeftPos + W + SpacerWidth;
End;
End
Else
Begin
ButtonSlider.Align := alNone;
If Beveled Then
Begin
ButtonSlider.Top :=
ButtonBase.BorderWidth +
(ButtonBase.BevelWidth * 2)+
1 + {For BorderStyle}
0; {For Margin}
End
Else
Begin
ButtonSlider.Top :=
ButtonBase.BorderWidth +
1; {For Margin}
End;
ButtonSlider.Height := 25;
ButtonSlider.Width :=
SpacersWidth +
(NButtons * ButtonWidth);
If (Not Beveled) Then
Begin
{Align totally left with not leftmost spacer}
If ButtonsAlignment = taLeftJustify Then
Begin
LeftPos := 0;
End
Else
Begin
If ButtonsAlignment = taRightJustify Then
Begin
{Align totally Right with not rightmost spacer}
LeftPos := 2 * SpacerWidth;
End
Else
Begin
LeftPos := SpacerWidth;
End;
End;
End
Else
Begin
LeftPos := SpacerWidth;
End;
For i := 0 To NButtons - 1 Do
Begin
ButtonSlider.Controls[i].Align := alNone;
ButtonSlider.Controls[i].Top := 0;
ButtonSlider.Controls[i].Height := 25;
ButtonSlider.Controls[i].Width := ButtonWidth;
ButtonSlider.Controls[i].Left := LeftPos;
LeftPos := LeftPos + ButtonWidth+ SpacerWidth;
End;
If ButtonsAlignment = taLeftJustify Then ButtonSlider.Align := alLeft;
If ButtonsAlignment = taRightJustify Then ButtonSlider.Align := alRight;
If ButtonsAlignment = taCenter Then
Begin
ButtonSlider.Align := alNone;
ButtonSlider.Left :=
(ButtonBase.Width -
ButtonSlider.Width) div 2;
End;
End;
ButtonBase.Refresh;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Centers a child component on a TPanel}
//Unit Description UnitIndex Master Index
procedure CenterChild(Panel : TPanel);
Begin
ProcName := 'CenterChild'; Try
Panel.Controls[0].Left :=
(Panel.Width - Panel.Controls[0].Width) div 2;
Panel.Controls[0].Top :=
(Panel.Height - Panel.Controls[0].Height) div 2;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Horizontally Centers all children of a TPanel }
//Unit Description UnitIndex Master Index
procedure CenterChildren_H(Panel : TPanel);
Var
i : Integer;
Begin
ProcName := 'CenterChildren_H'; Try
For i := 0 To Panel.ControlCount - 1 Do
Begin
Panel.Controls[i].Left :=
(Panel.Width - Panel.Controls[i].Width) div 2;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Horizontally Centers all children of a TPanel }
//Unit Description UnitIndex Master Index
procedure CenterChildren_V(WinControl : TWinControl);
Var
i : Integer;
Begin
ProcName := 'CenterChildren_V'; Try
For i := 0 To WinControl.ControlCount - 1 Do
Begin
WinControl.Controls[i].Top :=
(WinControl.Height - WinControl.Controls[i].Height) div 2;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
procedure SetChildWidthsToParents(WinControl : TWinControl);
Var
i : Integer;
Begin
ProcName := 'SetChildWidthsToParents'; Try
For i := 0 To WinControl.ControlCount - 1 Do
Begin
WinControl.Controls[i].Width := WinControl.Width;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
procedure SetChildHeightsToParents(WinControl : TWinControl);
Var
i : Integer;
Begin
ProcName := 'SetChildHeightsToParents'; Try
For i := 0 To WinControl.ControlCount - 1 Do
Begin
WinControl.Controls[i].Height := WinControl.Height;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
procedure SetChildLefts(WinControl : TWinControl; Value: Integer);
Var
i : Integer;
Begin
ProcName := 'SetChildLefts'; Try
For i := 0 To WinControl.ControlCount - 1 Do
Begin
WinControl.Controls[i].Left := Value;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
procedure SetChildHeights(WinControl : TWinControl; Value: Integer);
Var
i : Integer;
Begin
ProcName := 'SetChildHeights'; Try
For i := 0 To WinControl.ControlCount - 1 Do
Begin
WinControl.Controls[i].Height := Value;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
procedure SetChildWidths(WinControl : TWinControl; Value: Integer);
Var
i : Integer;
Begin
ProcName := 'SetChildWidths'; Try
For i := 0 To WinControl.ControlCount - 1 Do
Begin
WinControl.Controls[i].Width := Value;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
procedure SetChildTops(WinControl : TWinControl; Value: Integer);
Var
i : Integer;
Begin
ProcName := 'SetChildTops'; Try
For i := 0 To WinControl.ControlCount - 1 Do
Begin
WinControl.Controls[i].Top := Value;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Centers a Control Inside its Parent}
//Unit Description UnitIndex Master Index
Procedure CenterComponent(ParentControl, ChildControl: TControl);
Var
ChildControlTop,ChildControlLeft: Integer;
Begin
ProcName := 'CenterComponent'; Try
ChildControlTop := (ParentControl.Height-ChildControl.Height) div 2;
ChildControlLeft := (ParentControl.Width -ChildControl.Width) div 2;
If ChildControlTop < 0 Then
Begin
ChildControl.Top := 0;
End
Else
Begin
ChildControl.Top := ChildControlTop;
End;
If ChildControlLeft < 0 Then
Begin
ChildControl.Left := 0;
End
Else
Begin
ChildControl.Left := ChildControlLeft;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Centers A Form}
//Unit Description UnitIndex Master Index
Procedure CenterForm(f : TForm);
Begin
ProcName := 'CenterForm'; Try
f.left := (Screen.width - f.width) div 2;
f.top := (Screen.height - f.height) div 2;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Centers A Form Horizontally}
//Unit Description UnitIndex Master Index
Procedure CenterFormHorizontally(f : TForm);
Begin
ProcName := 'CenterFormHorizontally'; Try
f.left := (Screen.width - f.width) div 2;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Centers A Form Vertically}
//Unit Description UnitIndex Master Index
Procedure CenterFormVertically(f : TForm);
Begin
ProcName := 'CenterFormVertically'; Try
f.top := (Screen.height - f.height) div 2;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ ComboIncremental
This function should be used in the onKeyPress event of a TComboBox.
This function implements Windows Style incremental typing for a ComboBox.
The standard Windows functionality is that if a letter is typed windows
finds the next item in the ComboBox list that starts with this letter.
If there are no other items and the current item starts with this letter
the current value is retained. If there are no items that start with this
letter the ComboBox text field is cleared. If the currently selected item
from the ComboBox is changed this function returns True, otherwise it
returns False. The Boolean return value can be used to respond to changes
if other actions are required when the ComboBox value changes.
example:
//Unit Description UnitIndex Master Index
procedure TForm1.ComboBoxKeyPress(Sender: TObject; var Key: Char);
Var
boRetVal : Boolean;
Begin
ProcName := 'TForm1.ComboBoxKeyPress'; Try
boRetVal := ComboIncremental(Sender,Key);
If boRetVal Then ShowMessage('Do Something');
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
}
//Unit Description UnitIndex Master Index
Function ComboIncremental(var ComboBox: TComboBox; var Key: Char): Boolean;
Var
inC : Integer;
inCount: Integer;
inCur : Integer;
inMax : Integer;
inNew : Integer;
inStart: Integer;
sgKey : String;
sgNew : String;
sgTemp : String;
sgText : String;
begin
Result := False;
ProcName := 'ComboIncremental'; Try
sgText := ComboBox.Text;
Try
Try
If (Key >= #32) And (Key <= #126) Then
Begin
sgKey := UpperCase(Chr(Ord(Key)));
Key := #0;
With ComboBox Do
Begin
inCount:= Items.Count;
If inCount = 0 Then
Begin
Text := '';
ItemIndex := -1;
Result := (sgText = '');
Exit;
End;
inNew := -1;
inCur := Items.IndexOf(sgText);
inMax := Items.Count-1;
If inCur = -1 Then
Begin
inStart := 0;
End
Else
Begin
If inCur = inMax Then
Begin
inStart := 0;
End
Else
Begin
inStart := inCur+1;
End;
End;
For inC := inStart To inMax Do
Begin
sgTemp := UpperCase(Items[inC]);
sgTemp := Copy(sgTemp,1,1);
If sgTemp = sgKey Then
Begin
inNew := inC;
Break;
End;
End;
If inNew = -1 Then
Begin
For inC := 0 To inStart-1 Do
Begin
sgTemp := UpperCase(Items[inC]);
sgTemp := Copy(sgTemp,1,1);
If sgTemp = sgKey Then
Begin
inNew := inC;
Break;
End;
End
End;
If inNew = -1 Then
Begin
Text := '';
ItemIndex := -1;
End
Else
Begin
Text := Items[inNew];
ItemIndex := inNew;
End;
End;
End
Else
Begin
//Backspace
If Key = #8 Then
Begin
With ComboBox Do
Begin
Text := '';
ItemIndex := -1;
End;
End
Else
Begin
//Enter
If Key = #13 Then
Begin
keybd_event(VK_TAB,0,0,0);
End;
End;
End;
Except
End;
Finally
sgNew := UpperCase(ComboBox.Text);
sgText := UpperCase(sgText);
Result := (sgNew <> sgText);
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
end;
{!~ Sets The Dimensions Of A Component}
//Unit Description UnitIndex Master Index
procedure CompDimensions(
Comp: TControl;
TopDim,
LeftDim,
HeightDim,
WidthDim: Integer);
Begin
ProcName := 'CompDimensions'; Try
With Comp Do
Begin
Left := LeftDim;
Top := TopDim;
Height := HeightDim;
Width := WidthDim;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ DIALOGABOUTBOX_ADS
This procedure presents an About Box.
TITLE The title is set by the AboutTitle parameter.
INFORMATION
The information displayed in the about box is pulled directly
from the executable. The programmer can configure this information
in Delphi by doing the following:
(1) in Delphi go to Project|Options|VersionInfo and make sure
that the check box for Include Version information in project
is checked.
(2)Auto-increment build number should also be checked so
that each time a build-all is run the version number is
automatically updated. This makes life simple and in automatic.
(3)Edit/Add items in the section at the bottom of this page
where key and value items are listed. Whatever you put in
this section is what will appear in the about box.
(2) Save the project and recompile
(3) The newly edited information will appear in the about box.
IMAGE
The Application Icon is presented as the image. To change the
image do the following:
(1) in Delphi go to Project|Options|Application|Load Icon
and select an Icon for the application
(2) Save the project and
recompile
(3) The newly selected Icon will appear in the about box.
SIZE
The About box size can be pased as the parameters AboutWidth
and AboutHeight. If however you wish to have the procedure
size the About Box automatically set these two parameters to
zero. }
//Unit Description UnitIndex Master Index
Procedure DialogAboutBox_ads(
AboutTitle : String;
AboutWidth : Integer;
AboutHeight : Integer
);
Begin
ProcName := 'DialogAboutBox_ads'; Try
AboutBox_ads(AboutTitle, AboutWidth, AboutHeight);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~
When this menu item is clicked an about box dialog is displayed.
The title that appears is "My Application". The width is 400 and
the height is 300.
//Unit Description UnitIndex Master Index
Procedure TFormMain.AboutClick(Sender: TObject);
Begin
ProcName := 'TFormMain.AboutClick'; Try
DialogAboutBox_ads('My Application',400,300);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
}
{!~ Presents an input dialog that accepts a-z and A-Z only.
All other keys are thrown away except for the backspace key.
The result is returned as a string}
//Unit Description UnitIndex Master Index
Function DialogInputBoxOnlyAToZ(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
Begin
Result := '';
ProcName := 'DialogInputBoxOnlyAToZ'; Try
Result :=
InputBoxOnlyAToZ(
DialogCaption,
InputPrompt,
DefaultValue
);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Presents an input dialog that accepts 0-9,-,+,".".
All other keys are thrown away except for the backspace key.
The result is returned as a string}
//Unit Description UnitIndex Master Index
Function DialogInputBoxOnlyNumbers(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
Begin
Result := '';
ProcName := 'DialogInputBoxOnlyNumbers'; Try
Result :=
InputBoxOnlyNumbers(
DialogCaption,
InputPrompt,
DefaultValue
);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Presents an input dialog that accepts 0-9.
All other keys are thrown away except for the backspace key.
The result is returned as a string}
//Unit Description UnitIndex Master Index
Function DialogInputBoxOnlyNumbersAbsolute(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
Begin
Result := '';
ProcName := 'DialogInputBoxOnlyNumbersAbsolute'; Try
Result :=
InputBoxOnlyNumbersAbsolute(
DialogCaption,
InputPrompt,
DefaultValue
);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Returns The Left Property To Center A Form}
//Unit Description UnitIndex Master Index
Function FormCenterHorizontal(FormWidth: Integer): Integer;
Var
ScreenWidth: Integer;
ScreenCenter: Integer;
FormCenter: Integer;
NewLeft: Integer;
Begin
Result := 0;
ProcName := 'FormCenterHorizontal'; Try
ScreenWidth := Screen.Width;
ScreenCenter := ScreenWidth Div 2;
FormCenter := FormWidth Div 2;
NewLeft := ScreenCenter-FormCenter;
Result := NewLeft;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Returns The Top Property To Center A Form}
//Unit Description UnitIndex Master Index
Function FormCenterVertical(FormHeight: Integer): Integer;
Var
ScreenHeight: Integer;
ScreenCenter: Integer;
FormCenter: Integer;
NewTop: Integer;
Begin
Result := 0;
ProcName := 'FormCenterVertical'; Try
ScreenHeight := Screen.Height;
ScreenCenter := ScreenHeight Div 2;
FormCenter := FormHeight Div 2;
NewTop := ScreenCenter-FormCenter;
If NewTop < 0 Then
NewTop := 0;
Result := NewTop;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Sets The Dimensions Of A Form}
//Unit Description UnitIndex Master Index
procedure FormDimensions(
Form: TForm;
TopDim,
LeftDim,
HeightDim,
WidthDim: Integer);
Begin
ProcName := 'FormDimensions'; Try
With Form Do
Begin
Left := LeftDim;
Top := TopDim;
ClientHeight := HeightDim;
ClientWidth := WidthDim;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Returns the form's left value that will center the form horizontally}
//Unit Description UnitIndex Master Index
Function GetCenterFormLeft(FormWidth : Integer): Integer;
Begin
Result := 0;
ProcName := ' GetCenterFormLeft'; Try
If Screen.Width < FormWidth Then
Begin
Result := Screen.Width-26;
End
Else
Begin
Result := (Screen.Width - FormWidth) div 2;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Returns the form's Top value that will center the form vertically}
//Unit Description UnitIndex Master Index
Function GetCenterFormTop(FormHeight : Integer): Integer;
Begin
Result := 0;
ProcName := ' GetCenterFormTop'; Try
If Screen.Height < FormHeight Then
Begin
Result := Screen.Height-26;
End
Else
Begin
Result := (Screen.Height - FormHeight) div 2;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Deletes a row in a TStringGrid}
//Unit Description UnitIndex Master Index
procedure GridDeleteRow(RowNumber : Integer; Grid : TStringGrid);
Var
i : Integer;
Begin
ProcName := 'GridDeleteRow'; Try
Grid.Row := RowNumber;
If (Grid.Row = Grid.RowCount -1) Then
Begin
{On the last row}
Grid.RowCount := Grid.RowCount - 1;
End
Else
Begin
{Not the last row}
For i := RowNumber To Grid.RowCount - 1 Do
Begin
Grid.Rows[i] := Grid.Rows[i+ 1];
End;
Grid.RowCount := Grid.RowCount - 1;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Moves a row in a TStringGrid to the bottom of the grid}
//Unit Description UnitIndex Master Index
procedure GridMoveRowToBottom(RowNumber : Integer; Grid : TStringGrid);
Var
i : Integer;
Begin
ProcName := 'GridMoveRowToBottom'; Try
Grid.Row := RowNumber;
Grid.RowCount := Grid.RowCount + 1;
Grid.Rows[Grid.RowCount-1] := Grid.Rows[Grid.Row];
For i := RowNumber+1 To Grid.RowCount -1 Do
Begin
Grid.Rows[i-1] := Grid.Rows[i];
End;
Grid.RowCount := Grid.RowCount - 1;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ This is the underlying engine for InputBoxOnlyAToZ,
InputBoxOnlyAToZ and InputBoxOnlyNumbersAbsolute}
//Unit Description UnitIndex Master Index
Function InputBoxFilterDetail(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string;
const FilterString : string
): string;
Var
Form : TForm;
Prompt : TLabel;
Edit : TEditKeyFilter;
DialogUnits : TPoint;
ButtonTop : Integer;
ButtonWidth : Integer;
ButtonHeight: Integer;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;
Begin
Result := '';
ProcName := 'InputBoxFilterDetail'; Try
Result := DefaultValue;
Form := TForm.Create(Application);
With Form Do
Begin
Try
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
BorderStyle := bsDialog;
Caption := DialogCaption;
ClientWidth := MulDiv(180, DialogUnits.X, 4);
ClientHeight := MulDiv(63, DialogUnits.Y, 8);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
With Prompt Do
Begin
Parent := Form;
AutoSize := True;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Caption := InputPrompt;
End;
Edit := TEditKeyFilter.Create(Form);
With Edit Do
Begin
Parent := Form;
Left := Prompt.Left;
Top := MulDiv(19, DialogUnits.Y, 8);
Width := MulDiv(164, DialogUnits.X, 4);
MaxLength := 255;
Text := DefaultValue;
If FilterString <> '' Then
Begin
If FilterString = 'OnlyNumbers' Then
OnKeyPress:= OnlyNumbers;
If FilterString = 'OnlyNumbersAbsolute' Then
OnKeyPress:= OnlyNumbersAbsolute;
If FilterString = 'OnlyAToZ' Then
OnKeyPress:= OnlyAToZ;
End;
SelectAll;
End;
ButtonTop := MulDiv(41, DialogUnits.Y, 8);
ButtonWidth := MulDiv(50, DialogUnits.X, 4);
ButtonHeight:= MulDiv(14, DialogUnits.Y, 8);
With TButton.Create(Form) Do
Begin
Parent := Form;
Caption := 'OK';
ModalResult := mrOk;
Default := True;
SetBounds(
MulDiv(38, DialogUnits.X, 4),
ButtonTop,
ButtonWidth,
ButtonHeight);
End;
With TButton.Create(Form) Do
Begin
Parent := Form;
Caption := 'Cancel';
ModalResult := mrCancel;
Cancel := True;
SetBounds(
MulDiv(92, DialogUnits.X, 4),
ButtonTop,
ButtonWidth,
ButtonHeight);
End;
If ShowModal = mrOk Then
Begin
Result := Edit.Text;
End;
Finally
Form.Free;
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Presents an input dialog that accepts a-z and A-Z only.
All other keys are thrown away except for the backspace key.
The result is returned as a string}
//Unit Description UnitIndex Master Index
Function InputBoxOnlyAToZ(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
Begin
Result := '';
ProcName := 'InputBoxOnlyAToZ'; Try
Result :=
InputBoxFilterDetail(
DialogCaption,
InputPrompt,
DefaultValue,
'OnlyAToZ'
);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Presents an input dialog that accepts 0-9,-,+,".".
All other keys are thrown away except for the backspace key.
The result is returned as a string}
//Unit Description UnitIndex Master Index
Function InputBoxOnlyNumbers(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
Begin
Result := '';
ProcName := 'InputBoxOnlyNumbers'; Try
Result :=
InputBoxFilterDetail(
DialogCaption,
InputPrompt,
DefaultValue,
'OnlyNumbers'
);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Presents an input dialog that accepts 0-9.
All other keys are thrown away except for the backspace key.
The result is returned as a string}
//Unit Description UnitIndex Master Index
Function InputBoxOnlyNumbersAbsolute(
const DialogCaption : string;
const InputPrompt : string;
const DefaultValue : string): string;
Begin
Result := '';
ProcName := 'InputBoxOnlyNumbersAbsolute'; Try
Result :=
InputBoxFilterDetail(
DialogCaption,
InputPrompt,
DefaultValue,
'OnlyNumbersAbsolute'
);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Sets or unsets beveling in a panel}
//Unit Description UnitIndex Master Index
Procedure PanelBevel(Beveled : Boolean; Panel: TPanel);
Begin
ProcName := 'PanelBevel'; Try
If Not Beveled Then
Begin
Panel.BevelOuter := bvNone;
Panel.BevelInner := bvNone;
Panel.BorderStyle:= bsNone;
End
Else
Begin
Panel.BevelOuter := bvRaised;
Panel.BevelInner := bvLowered;
Panel.BorderStyle:= bsSingle;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Increments the screen cursor to show progress}
//Unit Description UnitIndex Master Index
procedure ProgressScreenCursor;
Begin
ProcName := 'ProgressScreenCursor'; Try
If Screen.Cursor = crUpArrow Then
Begin
Screen.Cursor := crSizeNESW;
Exit;
End;
If Screen.Cursor = crSizeNESW Then
Begin
Screen.Cursor := crSizeWE;
Exit;
End;
If Screen.Cursor = crSizeWE Then
Begin
Screen.Cursor := crSizeNWSE;
Exit;
End;
If Screen.Cursor = crSizeNWSE Then
Begin
Screen.Cursor := crSizeNS;
Exit;
End;
If Screen.Cursor = crSizeNS Then
Begin
Screen.Cursor := crHSplit;
Exit;
End;
If Screen.Cursor = crHSplit Then
Begin
Screen.Cursor := crSize;
Exit;
End;
If Screen.Cursor = crSize Then
Begin
Screen.Cursor := crArrow;
Exit;
End;
If Screen.Cursor = crArrow Then
Begin
Screen.Cursor := crUpArrow;
Exit;
End;
Screen.Cursor := crUpArrow;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Scales a Form To A Particular Resolution}
//Unit Description UnitIndex Master Index
Procedure ScaleForm(F: TForm;ScreenWidth, ScreenHeight: LongInt);
Begin
ProcName := 'ScaleForm'; Try
F.Scaled := True;
F.AutoScroll := False;
F.Position := poScreenCenter;
F.Font.Name := 'Arial';
If (Screen.Width <> ScreenWidth) Then
Begin
F.Height := LongInt(F.Height)* LongInt(Screen.Height) div ScreenHeight;
F.Width := LongInt(F.Width) * LongInt(Screen.Width) div ScreenWidth;
F.ScaleBy(Screen.Width,ScreenWidth);
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
{!~ Sets all Children of a TPanel to the same width}
//Unit Description UnitIndex Master Index
procedure SetChildWidths(Panel : TPanel);
Var
i : Integer;
Width : Integer;
Begin
ProcName := 'SetChildWidths'; Try
Width :=
(Panel.Width -
(Panel.BorderWidth * 2) -
(Panel.BevelWidth * 4)) div Panel.ControlCount;
For i := 0 To Panel.ControlCount - 1 Do
Begin
Panel.Controls[i].Width := Width;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
procedure StringGridSortOnCol(
var Grid : TStringGrid;
inColNum : Integer);
Var
lst : TStringList;
GridBack : TStringGrid;
inCols : Integer;
inRows : Integer;
inCounter : Integer;
sgStr : String;
begin
ProcName := 'StringGridSortOnCol'; Try
lst := TStringList.Create();
GridBack := TStringGrid.Create(nil);
Try
GridBack.RowCount := Grid.RowCount;
GridBack.ColCount := Grid.ColCount;
GridBack.FixedCols := Grid.FixedCols;
GridBack.FixedRows := Grid.FixedRows;
For inCols := 0 To Grid.ColCount - 1 Do
Begin
For inRows := 0 To Grid.RowCount - 1 Do
Begin
GridBack.Cells[inCols, inRows] := Grid.Cells[inCols, inRows];
End;
End;
For inRows := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
sgStr := Grid.Cells[inColNum, inRows];
For inCols := 0 To 255 Do
Begin
sgStr := sgStr + ' ';
End;
sgStr := Copy(sgStr,1,250)+IntToStr(inRows);
lst.Add(sgStr);
End;
lst.Sorted := True;
For inCounter := 0 To lst.Count -1 Do
Begin
sgStr := lst[inCounter];
inRows := StrToInt(Copy(sgStr,251,Length(sgStr)-250));
For inCols := 0 To Grid.ColCount - 1 Do
Begin
Grid.Cells[inCols, inCounter+Grid.FixedRows] := GridBack.Cells[inCols, inRows];
End;
End;
Finally
lst.Free;
GridBack.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
end;
{!~
StringGridSortOnXY
This procedure sorts all the records in a StringGrid based on the values in a
column. This procedure should be used in the on MouseDown event of the
StringGrid. When a column header is clicked, the grid is sorted based on the
values in that column.
Example Code:
//Unit Description UnitIndex Master Indexprocedure TForm1.GridMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ProcName := 'TForm1.GridMouseDown'; Try If Y < Grid.DefaultRowHeight Then StringGridSortOnXY(Grid, x); Except On E : Exception Do RaiseError(UnitName,ProcName,E);End; end; } //Unit Description UnitIndex Master Index
procedure StringGridSortOnXY(
var Grid : TStringGrid;
inColX : Integer);
Var
lst : TStringList;
GridBack : TStringGrid;
inCols : Integer;
inRows : Integer;
inCounter : Integer;
sgStr : String;
inColWidth: Integer;
inColNum : Integer;
begin
ProcName := 'StringGridSortOnXY'; Try
lst := TStringList.Create();
GridBack := TStringGrid.Create(nil);
InColNum := 0;
Try
inColWidth := 0;
For inCounter := 0 To Grid.ColCount - 1 Do
Begin
inColWidth := inColWidth + Grid.ColWidths[inCounter];
If inColWidth > inColX Then
Begin
inColNum := inCounter;
If inColNum < 0 Then inColNum := 0;
Break;
End;
End;
GridBack.RowCount := Grid.RowCount;
GridBack.ColCount := Grid.ColCount;
GridBack.FixedCols := Grid.FixedCols;
GridBack.FixedRows := Grid.FixedRows;
For inCols := 0 To Grid.ColCount - 1 Do
Begin
For inRows := 0 To Grid.RowCount - 1 Do
Begin
GridBack.Cells[inCols, inRows] := Grid.Cells[inCols, inRows];
End;
End;
For inRows := Grid.FixedRows To Grid.RowCount - 1 Do
Begin
sgStr := Grid.Cells[inColNum, inRows];
For inCols := 0 To 255 Do
Begin
sgStr := sgStr + ' ';
End;
sgStr := Copy(sgStr,1,250)+IntToStr(inRows);
lst.Add(sgStr);
End;
lst.Sorted := True;
For inCounter := 0 To lst.Count -1 Do
Begin
sgStr := lst[inCounter];
inRows := StrToInt(Copy(sgStr,251,Length(sgStr)-250));
For inCols := 0 To Grid.ColCount - 1 Do
Begin
Grid.Cells[inCols, inCounter+Grid.FixedRows] := GridBack.Cells[inCols, inRows];
End;
End;
Finally
lst.Free;
GridBack.Free;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
end;
{!~ Turns the panel upon which a TSpeedButton is placed
invisible if the SpeedButton's glyph is empty}
//Unit Description UnitIndex Master IndexProcedure ToolBarButtonVisibleOne(P:TPanel;B : TSpeedButton); Begin ProcName := 'ToolBarButtonVisibleOne'; Try If B.Glyph.Empty = True Then P.Visible := False; Except On E : Exception Do RaiseError(UnitName,ProcName,E);End; End; //Unit Description UnitIndex Master Index
Function FindOwnedControlByName(OwnedBy: TWinControl;OwnedControlName: String): TControl;
Var
inCounter : Integer;
Control : TControl;
Begin
Result := nil;
ProcName := 'FindOwnedControlByName'; Try
Result := nil;
OwnedControlName := UpperCase(OwnedControlName);
For inCounter := 0 To OwnedBy.ControlCount - 1 Do
Begin
If UpperCase(OwnedBy.Controls[inCounter].Name) = OwnedControlName Then
Begin
Result := OwnedBy.Controls[inCounter];
Break;
End;
If OwnedBy.Controls[inCounter] is TWinControl Then
Begin
If TWinControl(OwnedBy.Controls[inCounter]).ControlCount > 0 Then
Begin
Control := FindOwnedControlByName(TWinControl(OwnedBy.Controls[inCounter]),OwnedControlName);
If Control <> nil Then
Begin
Result := Control;
Break;
End;
End;
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
Function GetParentByClassAbove(ChildObject : TWinControl;ParentClass : TClass): TWinControl;
Begin
Result := nil;
ProcName := 'GetParentByClassAbove'; Try
Result := nil;
If ChildObject.Parent <> nil Then
Begin
If ChildObject.Parent is ParentClass Then
Begin
Result := TWinControl(ChildObject.Parent);
End
Else
Begin
Result := GetParentByClassAbove(TWinControl(ChildObject.Parent),ParentClass);
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
Function GetParentByNameAbove(ChildObject : TWinControl;ParentName : String): TWinControl;
Begin
Result := nil;
ProcName := 'GetParentByNameAbove'; Try
Result := nil;
If ChildObject.Parent <> nil Then
Begin
If UpperCase(ChildObject.Parent.Name) = UpperCase(ParentName) Then
Begin
Result := TWinControl(ChildObject.Parent);
End
Else
Begin
Result := GetParentByNameAbove(TWinControl(ChildObject.Parent),ParentName);
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
Function GetChildByNameBelow(ParentObject : TWinControl;ChildName : String): TWinControl;
Var
inCounter : Integer;
WinControl : TWinControl;
Begin
Result := nil;
ProcName := 'GetChildByNameBelow'; Try
Result := nil;
ChildName := UpperCase(ChildName);
For inCounter := 0 To ParentObject.ControlCount - 1 Do
Begin
If Not (ParentObject.Controls[inCounter] is TWinControl) Then Continue;
If UpperCase(ParentObject.Controls[inCounter].Name) = ChildName Then
Begin
Result := TWinControl(ParentObject.Controls[inCounter]);
Break;
End
Else
Begin
WinControl := GetChildByNameBelow(TWinControl(ParentObject.Controls[inCounter]),ChildName);
If WinControl <> nil Then
Begin
Result := WinControl;
Break;
End;
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
Function GetFirstChildByClassBelow(ParentObject : TWinControl;ChildClass : TClass): TWinControl;
Var
inCounter : Integer;
WinControl : TWinControl;
Begin
Result := nil;
ProcName := 'GetFirstChildByClassBelow'; Try
Result := nil;
For inCounter := 0 To ParentObject.ControlCount - 1 Do
Begin
If Not (ParentObject.Controls[inCounter] is TWinControl) Then Continue;
If ParentObject.Controls[inCounter] is ChildClass Then
Begin
Result := TWinControl(ParentObject.Controls[inCounter]);
Break;
End
Else
Begin
WinControl := GetFirstChildByClassBelow(TWinControl(ParentObject.Controls[inCounter]),ChildClass);
If WinControl <> nil Then
Begin
Result := WinControl;
Break;
End;
End;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
Function GetNextChildByClassBelow(ParentObject,CurrentObject : TWinControl;ChildClass : TClass): TWinControl;
Function GetNextDetail(ParentObject,CurrentObject : TWinControl;ChildClass : TClass;FoundCurrent: Boolean): TWinControl;
Var
inCounter : Integer;
WinControl : TWinControl;
Begin
Result := nil;
For inCounter := 0 To ParentObject.ControlCount - 1 Do
Begin
If Not (ParentObject.Controls[inCounter] is TWinControl) Then Continue;
If ParentObject.Controls[inCounter] is ChildClass Then
Begin
If FoundCurrent Then
Begin
Result := TWinControl(ParentObject.Controls[inCounter]);
Break;
End
Else
Begin
If CurrentObject = TWinControl(ParentObject.Controls[inCounter]) Then
Begin
FoundCurrent := True;
End
Else
Begin
FoundCurrent := False;
End;
End;
End;
WinControl := GetNextDetail(TWinControl(ParentObject.Controls[inCounter]),CurrentObject,ChildClass,FoundCurrent);
If WinControl <> nil Then
Begin
Result := WinControl;
Break;
End;
End;
End;
Begin
Result := nil;
ProcName := 'GetNextChildByClassBelow'; Try
Result :=
GetNextDetail(
ParentObject,
CurrentObject,
ChildClass,
False);
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
Function GetLastChildByClassBelow(ParentObject : TWinControl;ChildClass : TClass): TWinControl;
Var
WinControlFirst : TWinControl;
WinControlPrior : TWinControl;
WinControlNext : TWinControl;
WinControlLast : TWinControl;
Begin
Result := nil;
ProcName := 'GetLastChildByClassBelow'; Try
WinControlLast := nil;
Result := WinControlLast;
WinControlFirst := GetFirstChildByClassBelow(ParentObject,ChildClass);
If WinControlFirst = nil Then Exit;
WinControlPrior := WinControlFirst;
While True Do
Begin
WinControlNext := GetNextChildByClassBelow(ParentObject,WinControlPrior,ChildClass);
If WinControlNext = nil Then
Begin
WinControlLast := WinControlPrior;
Break;
End
Else
Begin
WinControlPrior := WinControlNext;
End;
End;
Result := WinControlLast;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
Function GetPriorChildByClassBelow(ParentObject,CurrentObject : TWinControl;ChildClass : TClass): TWinControl;
Var
WinControlFirst : TWinControl;
WinControlPrior : TWinControl;
WinControlNext : TWinControl;
Begin
Result := nil;
ProcName := 'GetPriorChildByClassBelow'; Try
Result := nil;
If CurrentObject = nil Then Exit;
If ParentObject = nil Then Exit;
WinControlFirst := GetFirstChildByClassBelow(ParentObject,ChildClass);
If WinControlFirst = nil Then Exit;
If CurrentObject = WinControlFirst Then Exit;
WinControlPrior := WinControlFirst;
WinControlNext := GetNextChildByClassBelow(ParentObject,WinControlPrior,ChildClass);
If WinControlNext = nil Then Exit;
If WinControlNext = CurrentObject Then
Begin
Result := WinControlPrior;
Exit;
End;
WinControlPrior := WinControlNext;
While True Do
Begin
WinControlNext := GetNextChildByClassBelow(ParentObject,WinControlPrior,ChildClass);
If WinControlNext = nil Then Exit;
If WinControlNext = CurrentObject Then
Begin
Result := WinControlPrior;
Exit;
End;
WinControlPrior := WinControlNext;
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
//Unit Description UnitIndex Master Index
Procedure GetListOfChildrenByClass(var WinControls: TStringList;ParentObject: TWinControl;ChildClass : TClass);
Var
inCounter : Integer;
inIndex : Integer;
Begin
ProcName := 'GetListOfChildrenByClass'; Try
For inCounter := 0 To ParentObject.ControlCount - 1 Do
Begin
If Not (ParentObject.Controls[inCounter] is TWinControl) Then Continue;
If ParentObject.Controls[inCounter] is ChildClass Then
Begin
WinControls.Add(ParentObject.Controls[inCounter].Name);
inIndex := WinControls.indexOf(ParentObject.Controls[inCounter].Name);
If inIndex <> -1 Then
WinControls.Objects[inIndex] := TWinControl(ParentObject.Controls[inCounter]);
End;
GetListOfChildrenByClass(WinControls,TWinControl(ParentObject.Controls[inCounter]),ChildClass);
End;
Except On E : Exception Do RaiseError(UnitName,ProcName,E);End;
End;
End.
//