Bu unit program "çeşitli işlemler 3" işleminde kullanılır.
Kod: Tümünü seç
Unit ads_comp;
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@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 maley@advdelphisys.com so that the
entire Delphi community can benefit. All comments are welcome.
}
Interface
Uses
SysUtils, ExtCtrls, Classes, Controls, Forms, Grids, Buttons, StdCtrls,
WinProcs, Graphics;
{!~ 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
boRetVal := ComboIncremental(Sender,Key);
If boRetVal Then ShowMessage('Do Something');
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);
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
If Y < Grid.DefaultRowHeight Then StringGridSortOnXY(Grid, x);
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;
{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 = 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');
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(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
//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 < 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;
End;
{!~ Centers a child component on a TPanel}
procedure CenterChild(Panel : TPanel);
Begin
Panel.Controls[0].Left :=
(Panel.Width - Panel.Controls[0].Width) div 2;
Panel.Controls[0].Top :=
(Panel.Height - Panel.Controls[0].Height) div 2;
End;
{!~ Horizontally Centers all children of a TPanel }
procedure CenterChildren_H(Panel : TPanel);
Var
i : Integer;
Begin
For i := 0 To Panel.ControlCount - 1 Do
Begin
Panel.Controls[i].Left :=
(Panel.Width - Panel.Controls[i].Width) div 2;
End;
End;
{!~ Centers a Control Inside its Parent}
Procedure CenterComponent(ParentControl, ChildControl: TControl);
Var
ChildControlTop,ChildControlLeft: Integer;
Begin
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;
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;
{!~ 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
boRetVal := ComboIncremental(Sender,Key);
If boRetVal Then ShowMessage('Do Something');
End;
}
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
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;
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 < FormWidth Then
Begin
Result := Screen.Width-26;
End
Else
Begin
Result := (Screen.Width - FormWidth) div 2;
End;
End;
{!~ Returns the form's Top value that will center the form vertically}
Function GetCenterFormTop(FormHeight : Integer): Integer;
Begin
If Screen.Height < FormHeight Then
Begin
Result := Screen.Height-26;
End
Else
Begin
Result := (Screen.Height - FormHeight) div 2;
End;
End;
{!~ Deletes a row in a TStringGrid}
procedure GridDeleteRow(RowNumber : Integer; Grid : TStringGrid);
Var
i : Integer;
Begin
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;
End;
{!~ Moves a row in a TStringGrid to the bottom of the grid}
procedure GridMoveRowToBottom(RowNumber : Integer; Grid : TStringGrid);
Var
i : Integer;
Begin
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;
End;
{!~ 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;
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 := 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;
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;
procedure StringGridSortOnCol(
var Grid : TStringGrid;
inColNum : Integer);
Var
lst : TStringList;
GridBack : TStringGrid;
inCols : Integer;
inRows : Integer;
inCounter : Integer;
sgStr : String;
begin
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;
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:
procedure TForm1.GridMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If Y < Grid.DefaultRowHeight Then StringGridSortOnXY(Grid, x);
end;
}
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
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;
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;
End.