1
0
mirror of synced 2024-09-19 17:56:09 +00:00

Added: String utilities + FormatSize test

This commit is contained in:
Mark van Renswoude 2004-06-07 15:31:14 +00:00
parent 57d01e9821
commit e2651f6105
5 changed files with 152 additions and 4 deletions

View File

@ -4,7 +4,7 @@ object frmMain: TfrmMain
BorderIcons = [biSystemMenu] BorderIcons = [biSystemMenu]
BorderStyle = bsDialog BorderStyle = bsDialog
Caption = 'X'#178'Utils Test' Caption = 'X'#178'Utils Test'
ClientHeight = 157 ClientHeight = 206
ClientWidth = 455 ClientWidth = 455
Color = clBtnFace Color = clBtnFace
Font.Charset = DEFAULT_CHARSET Font.Charset = DEFAULT_CHARSET
@ -70,6 +70,21 @@ object frmMain: TfrmMain
Height = 13 Height = 13
Caption = 'Instances:' Caption = 'Instances:'
end end
object lblFormatSize: TLabel
Left = 8
Top = 160
Width = 56
Height = 13
Caption = 'Format size:'
end
object lblFormatSizeValue: TLabel
Left = 244
Top = 160
Width = 205
Height = 13
AutoSize = False
Caption = '<unknown>'
end
object lstInstances: TListBox object lstInstances: TListBox
Left = 112 Left = 112
Top = 84 Top = 84
@ -78,4 +93,21 @@ object frmMain: TfrmMain
ItemHeight = 13 ItemHeight = 13
TabOrder = 0 TabOrder = 0
end end
object txtSize: TEdit
Left = 112
Top = 156
Width = 121
Height = 21
TabOrder = 1
OnChange = txtSizeChange
end
object chkBytes: TCheckBox
Left = 112
Top = 180
Width = 97
Height = 17
Caption = '&Keep bytes'
TabOrder = 2
OnClick = txtSizeChange
end
end end

View File

@ -6,21 +6,27 @@ uses
Controls, Controls,
Forms, Forms,
StdCtrls, StdCtrls,
SysUtils,
X2UtSingleInstance; X2UtSingleInstance;
type type
TfrmMain = class(TForm, IX2InstanceNotifier) TfrmMain = class(TForm, IX2InstanceNotifier)
chkBytes: TCheckBox;
lblAppPath: TLabel; lblAppPath: TLabel;
lblAppPathValue: TLabel; lblAppPathValue: TLabel;
lblAppVersion: TLabel; lblAppVersion: TLabel;
lblAppVersionValue: TLabel; lblAppVersionValue: TLabel;
lblFormatSize: TLabel;
lblFormatSizeValue: TLabel;
lblInstances: TLabel; lblInstances: TLabel;
lblOSVersion: TLabel; lblOSVersion: TLabel;
lblOSVersionValue: TLabel; lblOSVersionValue: TLabel;
lstInstances: TListBox; lstInstances: TListBox;
txtSize: TEdit;
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure txtSizeChange(Sender: TObject);
protected protected
// IX2InstanceNotifier implementation // IX2InstanceNotifier implementation
procedure OnInstance(const ACmdLine: String); procedure OnInstance(const ACmdLine: String);
@ -29,7 +35,8 @@ type
implementation implementation
uses uses
X2UtApp, X2UtApp,
X2UtOS; X2UtOS,
X2UtStrings;
{$R *.dfm} {$R *.dfm}
@ -38,9 +45,12 @@ uses
========================================} ========================================}
procedure TfrmMain.FormCreate; procedure TfrmMain.FormCreate;
begin begin
Randomize();
lblAppPathValue.Caption := App.Path; lblAppPathValue.Caption := App.Path;
lblAppVersionValue.Caption := App.FormatVersion(); lblAppVersionValue.Caption := App.FormatVersion();
lblOSVersionValue.Caption := OS.FormatVersion(); lblOSVersionValue.Caption := OS.FormatVersion();
txtSize.Text := IntToStr(Random(MaxInt));
RegisterInstance(Self); RegisterInstance(Self);
end; end;
@ -51,6 +61,19 @@ begin
end; end;
procedure TfrmMain.txtSizeChange;
var
iSize: Int64;
begin
if TryStrToInt64(txtSize.Text, iSize) then
lblFormatSizeValue.Caption := FormatSize(iSize, chkBytes.Checked)
else
lblFormatSizeValue.Caption := 'Not a valid integer.';
end;
{=============================== TfrmMain {=============================== TfrmMain
IX2InstanceNotifier implementation IX2InstanceNotifier implementation
========================================} ========================================}

View File

@ -79,7 +79,7 @@ LegalCopyright=
LegalTrademarks= LegalTrademarks=
OriginalFilename= OriginalFilename=
ProductName= ProductName=
ProductVersion= ProductVersion=1.0.0.0
Comments= Comments=
[Excluded Packages] [Excluded Packages]
c:\program files\borland\delphi6\Projects\Bpl\VirtualTreesD6D.bpl=Virtual Treeview c:\program files\borland\delphi6\Projects\Bpl\VirtualTreesD6D.bpl=Virtual Treeview
@ -142,6 +142,12 @@ c:\program files\borland\delphi6\Bin\dclwebsnap60.bpl=Borland WebSnap Components
c:\program files\borland\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment c:\program files\borland\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment
c:\program files\borland\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components c:\program files\borland\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components
c:\program files\borland\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components c:\program files\borland\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components
[HistoryLists\hlConditionals]
Count=1
Item0=madExcept
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
[Included Packages] [Included Packages]
C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components C:\Program Files\Borland\Delphi6\Bin\dclstd60.bpl=Borland Standard Components
c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements c:\program files\borland\delphi6\Bin\dclsmpedit60.bpl=Borland Editor Script Enhancements

View File

@ -8,7 +8,8 @@ uses
X2UtApp in '..\X2UtApp.pas', X2UtApp in '..\X2UtApp.pas',
X2UtHandCursor in '..\X2UtHandCursor.pas', X2UtHandCursor in '..\X2UtHandCursor.pas',
X2UtSingleInstance in '..\X2UtSingleInstance.pas', X2UtSingleInstance in '..\X2UtSingleInstance.pas',
FMain in 'Forms\FMain.pas' {frmMain}; FMain in 'Forms\FMain.pas' {frmMain},
X2UtStrings in '..\X2UtStrings.pas';
{$R *.res} {$R *.res}
@ -23,6 +24,7 @@ begin
exit; exit;
Application.Initialize; Application.Initialize;
Application.Title := 'X²Utils Test';
Application.CreateForm(TfrmMain, frmMain); Application.CreateForm(TfrmMain, frmMain);
Application.Run; Application.Run;
end. end.

85
X2UtStrings.pas Normal file
View File

@ -0,0 +1,85 @@
{
:: X2UtStrings provides various string-related functions.
::
:: Subversion repository available at:
:: $URL$
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $LastChangedBy$
:$
:$
:$ X2Utils is released under the zlib/libpng OSI-approved license.
:$ For more information: http://www.opensource.org/
:$ /n/n
:$ /n/n
:$ Copyright (c) 2003 X2Software
:$ /n/n
:$ This software is provided 'as-is', without any express or implied warranty.
:$ In no event will the authors be held liable for any damages arising from
:$ the use of this software.
:$ /n/n
:$ Permission is granted to anyone to use this software for any purpose,
:$ including commercial applications, and to alter it and redistribute it
:$ freely, subject to the following restrictions:
:$ /n/n
:$ 1. The origin of this software must not be misrepresented; you must not
:$ claim that you wrote the original software. If you use this software in a
:$ product, an acknowledgment in the product documentation would be
:$ appreciated but is not required.
:$ /n/n
:$ 2. Altered source versions must be plainly marked as such, and must not be
:$ misrepresented as being the original software.
:$ /n/n
:$ 3. This notice may not be removed or altered from any source distribution.
}
unit X2UtStrings;
interface
{
:$ Formats the specified size
:: If KeepBytes is true, the size will be formatted for decimal separators
:: and 'bytes' will be appended. If KeepBytes is false the best suitable
:: unit will be chosen (KB, MB, GB).
}
function FormatSize(const Bytes: Int64; KeepBytes: Boolean = False): String;
implementation
uses
SysUtils;
function FormatSize;
const
KB = 1024;
MB = KB * 1024;
GB = MB * 1024;
var
dSize: Double;
sExt: String;
begin
sExt := ' bytes';
dSize := Bytes;
if (not KeepBytes) and (Bytes >= KB) then
if (Bytes >= KB) and (Bytes < MB) then begin
// 1 kB ~ 1 MB
dSize := Bytes / KB;
sExt := ' KB';
end else if (Bytes >= MB) and (Bytes < GB) then begin
// 1 MB ~ 1 GB
dSize := Bytes / MB;
sExt := ' MB';
end else begin
// 1 GB ~ x
dSize := Bytes / GB;
sExt := ' GB';
end;
Result := FormatFloat(',0.##', dSize) + sExt;
end;
end.