HomePage   Delphi Library  

Unit ads_comp;

{Copyright(c)1998 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 [email protected]
 [email protected]
 [email protected]}

Interface

Uses
  SysUtils, ExtCtrls, Classes, Controls, Forms, Grids, Buttons, stdctrls,
  WinProcs, Graphics, Ads_Misc;

{!~ 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);

{!~ 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);

{!~ Turns the panel upon which a TSpeedButton is placed
invisible if the SpeedButton's glyph is empty}
Procedure ToolBarButtonVisibleOne(P:TPanel;B : TSpeedButton);

Implementation

{Pads or truncates a String and Justifies Left if StrJustify=True}
Function StringPad(
  InputStr,
  FillChar: String;
  StrLen: Integer;
  StrJustify: Boolean): String;
Var
  TempFill: String;
  Counter : Integer;
Begin
  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;
End;

{!~ Populates a listbox with the executable's version information}
Function VersionInformation(
  ListBox : TListBox): Boolean;
const
  InfoNum = 11;
  InfoStr : array [1..InfoNum] of String =
    ('CompanyName', 'FileDescription', 'FileVersion', 'InternalName',
     'LegalCopyright', 'LegalTradeMarks', 'OriginalFilename',
     'ProductName', 'ProductVersion', 'Comments', 'Author');
  LabelStr : array [1..InfoNum] of String =
    ('Company Name', 'Description', 'File Version', 'Internal Name',
     'Copyright', 'TradeMarks', 'Original File Name',
     'Product Name', 'Product Version', 'Comments', 'Author');
var
  S         : String;
  i         : Integer;
  Len       : Cardinal;
  n         : Cardinal;
  Buf       : PChar;
  Value     : PChar;
begin
  Try
    S := Application.ExeName;
    ListBox.Items.Clear;
    ListBox.Sorted := True;
    ListBox.Font.Name := 'Courier New';
    n := GetFileVersionInfoSize(PChar(S),n);
    If n  0 Then
    Begin
      Buf := AllocMem(n);
      ListBox.Items.Add(StringPad('Size',' ',20,True)+' = '+IntToStr(n));
      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
          //Value := PChar(Trim(Value));
          If Length(Value)  0 Then
          Begin
            ListBox.Items.Add(StringPad(labelStr[i],' ',20,True)+' = '+Value);
          End;
        End;
      End;
      FreeMem(Buf,n);
    End
    Else
    Begin
      ListBox.Items.Add('No FileVersionInfo found');
    End;
    Result := True;
  Except
    Result := False;
  End;
End;

{!~ Returns The Files Date Time Stamp as TDateTime.
Returns 0 if there is an error}
Function FileDate(FileString: String): TDateTime;
Begin
  Result := 0;
  Try
    If Not FileExists(FileString) Then Exit;
    Result := FileDateToDateTime(FileAge(FileString));
  Except
    Result := 0;
  End;
End;

{!~ Throws away all keys except a-z and A-Z}
Procedure KeyPressOnlyAToZ(Var Key: Char);
Begin
  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}
End;


{!~ Throws away all keys except 0-9}
Procedure KeyPressOnlyNumbersAbsolute(Var Key: Char);
Begin
  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}
End;

{Throws away all keys except 0-9,-,+,.}
Procedure KeyPressOnlyNumbers(Var Key: Char);
Begin
  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}
End;

Type
  TPanel_Cmp_Sec_ads = class(TPanel)
  Public
    procedure ResizeShadowLabel(Sender: TObject);
  End;

procedure TPanel_Cmp_Sec_ads.ResizeShadowLabel(
  Sender     : TObject);
Var
  PH, PW : Integer;
  LH, LW : Integer;
begin
  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;
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,-,+,.}
Procedure TEditKeyFilter.OnlyNumbers(Sender: TObject; var Key: Char);
Begin
  KeyPressOnlyNumbers(Key);
End;

{!~ Throws away all keys except 0-9}
Procedure TEditKeyFilter.OnlyNumbersAbsolute(Sender: TObject; var Key: Char);
Begin
  KeyPressOnlyNumbersAbsolute(Key);
End;

{!~ Throws away all keys except a-z and A-Z}
Procedure TEditKeyFilter.OnlyAToZ(Sender: TObject; var Key: Char);
Begin
  KeyPressOnlyAToZ(Key);
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.  }
Procedure AboutBox_ads(
  AboutTitle  : String;
  AboutWidth  : Integer;
  AboutHeight : Integer
  );
Var
  Spacer          : TPanel;
  Spacer2         : TPanel;
  Spacer3         : TPanel;
  About_Title     : TLabel;
  Title           : TPanel_Cmp_Sec_ads;
  AboutImage      : TImage;
  AboutBaseTopTop : TPanel;
  ListBoxFirst    : TListBox;
  ListBox         : TListBox;
  Bevel1          : TBevel;
  AboutBaseTop    : TPanel;
  OKButton        : TButton;
  AboutBaseButtons: TPanel;
  AboutBase       : TPanel;
  Form            : TForm;
  MaxLength       : Integer;
  i               : Integer;
Begin
  Form := TForm.Create(Application);
  Try
    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     := 'MS Sans Serif';
      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;
      Font.Style    := [fsBold];
      Font.Name     := 'Courier New';
      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;
      Font.Style    := [fsBold];
      Font.Name     := 'Courier New';
    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     := 'Times New Roman';
      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     := 'Times New Roman';
      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)+' = '+
      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;
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.
}
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
  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 <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;
End;

{!~ Centers A Form}
Procedure CenterForm(f : TForm);
Begin
  f.left := (Screen.width - f.width) div 2;
  f.top := (Screen.height - f.height) div 2;
End;

{!~ Centers A Form Horizontally}
Procedure CenterFormHorizontally(f : TForm);
Begin
  f.left := (Screen.width - f.width) div 2;
End;

{!~ Centers A Form Vertically}
Procedure CenterFormVertically(f : TForm);
Begin
  f.top := (Screen.height - f.height) div 2;
End;

{!~ Sets The Dimensions Of A Component}
procedure CompDimensions(
            Comp: TControl;
            TopDim,
            LeftDim,
            HeightDim,
            WidthDim: Integer);
Begin
  With Comp Do
  Begin
    Left    := LeftDim;
    Top     := TopDim;
    Height  := HeightDim;
    Width   := WidthDim;
  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.  }
Procedure DialogAboutBox_ads(
  AboutTitle  : String;
  AboutWidth  : Integer;
  AboutHeight : Integer
  );
Begin
  AboutBox_ads(AboutTitle, AboutWidth, AboutHeight);
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.

Procedure TFormMain.AboutClick(Sender: TObject);
Begin
  DialogAboutBox_ads('My Application',400,300);
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}
Function DialogInputBoxOnlyAToZ(
  const DialogCaption : string;
  const InputPrompt   : string;
  const DefaultValue  : string): string;
Begin
  Result :=
    InputBoxOnlyAToZ(
      DialogCaption,
      InputPrompt,
      DefaultValue
      );
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}
Function DialogInputBoxOnlyNumbers(
  const DialogCaption : string;
  const InputPrompt   : string;
  const DefaultValue  : string): string;
Begin
  Result :=
    InputBoxOnlyNumbers(
      DialogCaption,
      InputPrompt,
      DefaultValue
      );
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}
Function DialogInputBoxOnlyNumbersAbsolute(
  const DialogCaption : string;
  const InputPrompt   : string;
  const DefaultValue  : string): string;
Begin
  Result :=
    InputBoxOnlyNumbersAbsolute(
      DialogCaption,
      InputPrompt,
      DefaultValue
      );
End;

{!~ Returns The Left Property To Center A Form}
Function FormCenterHorizontal(FormWidth: Integer): Integer;
Var
  ScreenWidth:         Integer;
  ScreenCenter:        Integer;
  FormCenter:          Integer;
  NewLeft:             Integer;
Begin
  ScreenWidth    := Screen.Width;
  ScreenCenter   := ScreenWidth Div 2;
  FormCenter     := FormWidth Div 2;
  NewLeft        := ScreenCenter-FormCenter;
  Result         := NewLeft;
End;

{!~ Returns The Top Property To Center A Form}
Function FormCenterVertical(FormHeight: Integer): Integer;
Var
  ScreenHeight:         Integer;
  ScreenCenter:         Integer;
  FormCenter:           Integer;
  NewTop:               Integer;
Begin
  ScreenHeight   := Screen.Height;
  ScreenCenter   := ScreenHeight Div 2;
  FormCenter     := FormHeight Div 2;
  NewTop         := ScreenCenter-FormCenter;
  If NewTop <0 Then
    NewTop := 0;
  Result         := NewTop;
End;

{!~ Sets The Dimensions Of A Form}
procedure FormDimensions(
            Form: TForm;
            TopDim,
            LeftDim,
            HeightDim,
            WidthDim: Integer);
Begin
  With Form Do
  Begin
    Left          := LeftDim;
    Top           := TopDim;
    ClientHeight  := HeightDim;
    ClientWidth   := WidthDim;
  End;
End;

{!~ Returns the form's left value that will center the form horizontally}
Function  GetCenterFormLeft(FormWidth : Integer): Integer;
Begin
  If Screen.Width <> '' 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;
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}

Function InputBoxOnlyAToZ(
  const DialogCaption : string;
  const InputPrompt   : string;
  const DefaultValue  : string): string;

Begin
  Result :=
    InputBoxFilterDetail(
      DialogCaption,
      InputPrompt,
      DefaultValue,
      'OnlyAToZ'
      );
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}

Function InputBoxOnlyNumbers(
  const DialogCaption : string;
  const InputPrompt   : string;
  const DefaultValue  : string): string;
Begin
  Result :=
    InputBoxFilterDetail(
      DialogCaption,
      InputPrompt,
      DefaultValue,
      'OnlyNumbers'
      );
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}
Function InputBoxOnlyNumbersAbsolute(
  const DialogCaption : string;
  const InputPrompt   : string;
  const DefaultValue  : string): string;
Begin
  Result :=
    InputBoxFilterDetail(
      DialogCaption,
      InputPrompt,
      DefaultValue,
      'OnlyNumbersAbsolute'
      );
End;

{!~ Sets or unsets beveling in a panel}
Procedure PanelBevel(Beveled : Boolean; Panel: TPanel);
Begin
  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;
End;

{!~ Increments the screen cursor to show progress}
procedure ProgressScreenCursor;
Begin
  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;
End;

{!~ Scales a Form To A Particular Resolution}
Procedure ScaleForm(F: TForm;ScreenWidth, ScreenHeight: LongInt);
Begin
  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;
End;

{!~ Sets all Children of a TPanel to the same width}
procedure SetChildWidths(Panel : TPanel);
Var
  i     : Integer;
  Width : Integer;
Begin
  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;
End;

{!~ Turns the panel upon which a TSpeedButton is placed
invisible if the SpeedButton's glyph is empty}
Procedure ToolBarButtonVisibleOne(P:TPanel;B : TSpeedButton);
Begin
  If B.Glyph.Empty = True Then P.Visible := False;
End;

Initialization
  DelphiChecker(
    RunOutsideIDE_ads,
    'Advanced Delphi Systems Code',
    RunOutsideIDECompany_ads,
    RunOutsideIDEPhone_ads,
    RunOutsideIDEDate_ads);
End.
Hosted by www.Geocities.ws

1