1
0
mirror of synced 2024-12-22 09:13:07 +01:00

Added: X2UtCursors unit (WaitCursor function)

Changed: Added SkipEmptyItems parameter to Join function
This commit is contained in:
Mark van Renswoude 2013-10-02 20:38:15 +00:00
parent be474bd006
commit 195c3e6dde
4 changed files with 131 additions and 41 deletions

View File

@ -56,6 +56,7 @@ contains
X2UtElevation in '..\..\X2UtElevation.pas', X2UtElevation in '..\..\X2UtElevation.pas',
X2UtPersistXML in '..\..\X2UtPersistXML.pas', X2UtPersistXML in '..\..\X2UtPersistXML.pas',
X2UtPersistXMLBinding in '..\..\X2UtPersistXMLBinding.pas', X2UtPersistXMLBinding in '..\..\X2UtPersistXMLBinding.pas',
XMLDataBindingUtils in '..\..\XMLDataBinding\XMLDataBindingUtils.pas'; XMLDataBindingUtils in '..\..\XMLDataBinding\XMLDataBindingUtils.pas',
X2UtCursors in '..\..\X2UtCursors.pas';
end. end.

View File

@ -6,7 +6,7 @@
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration> <Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform> <Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler> <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
<DCC_DependencyCheckOutputName>P:\algemeen\bin\D2007\X2Utils2007.bpl</DCC_DependencyCheckOutputName> <DCC_DependencyCheckOutputName>..\..\..\Bpl\D2006\X2Utils2007.bpl</DCC_DependencyCheckOutputName>
</PropertyGroup> </PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' "> <PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version> <Version>7.0</Version>
@ -38,6 +38,8 @@
<Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDS)\bin\dcloffice2k100.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
<Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages> <Excluded_Packages Name="$(BDS)\bin\dclofficexp100.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
</Excluded_Packages></Delphi.Personality></BorlandProject></BorlandProject> </Excluded_Packages></Delphi.Personality></BorlandProject></BorlandProject>
@ -49,6 +51,7 @@
</DelphiCompile> </DelphiCompile>
<DCCReference Include="..\..\X2UtApp.pas" /> <DCCReference Include="..\..\X2UtApp.pas" />
<DCCReference Include="..\..\X2UtBits.pas" /> <DCCReference Include="..\..\X2UtBits.pas" />
<DCCReference Include="..\..\X2UtCursors.pas" />
<DCCReference Include="..\..\X2UtElevation.pas" /> <DCCReference Include="..\..\X2UtElevation.pas" />
<DCCReference Include="..\..\X2UtGraphics.pas" /> <DCCReference Include="..\..\X2UtGraphics.pas" />
<DCCReference Include="..\..\X2UtHandCursor.pas" /> <DCCReference Include="..\..\X2UtHandCursor.pas" />
@ -71,8 +74,8 @@
<DCCReference Include="..\..\X2UtStrings.pas" /> <DCCReference Include="..\..\X2UtStrings.pas" />
<DCCReference Include="..\..\X2UtTempFile.pas" /> <DCCReference Include="..\..\X2UtTempFile.pas" />
<DCCReference Include="..\..\XMLDataBinding\XMLDataBindingUtils.pas" /> <DCCReference Include="..\..\XMLDataBinding\XMLDataBindingUtils.pas" />
<DCCReference Include="P:\algemeen\rtl.dcp" /> <DCCReference Include="C:\Users\PsychoMark\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\Development\rtl.dcp" />
<DCCReference Include="P:\algemeen\vcl.dcp" /> <DCCReference Include="C:\Users\PsychoMark\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\Development\vcl.dcp" />
<DCCReference Include="P:\algemeen\xmlrtl.dcp" /> <DCCReference Include="C:\Users\PsychoMark\AppData\Roaming\Microsoft\Internet Explorer\Quick Launch\Development\xmlrtl.dcp" />
</ItemGroup> </ItemGroup>
</Project> </Project>

72
X2UtCursors.pas Normal file
View File

@ -0,0 +1,72 @@
{
:: X2UtCursors implements utility functions for cursor operations.
::
:: Including this unit in your project will automatically include
:: the X2UtHandCursor unit.
::
:: Last changed: $Date$
:: Revision: $Rev$
:: Author: $Author$
}
unit X2UtCursors;
interface
{**
* Changes the screen cursor temporarily to an hourglass.
*
* The result does not need to be stored in a variable unless early
* restoration of the cursor is desired.
*
* @param ACursor the cursor type to show
* @result the interface which, when freed, will restore the cursor
*}
function TempWaitCursor: IInterface;
implementation
uses
Controls,
Forms;
var
WaitCursorRefCount: Integer;
type
TWaitCursor = class(TInterfacedObject)
public
constructor Create;
destructor Destroy; override;
end;
function TempWaitCursor: IInterface;
begin
Result := TWaitCursor.Create;
end;
{ TWaitCursor }
constructor TWaitCursor.Create;
begin
inherited;
Inc(WaitCursorRefCount);
Screen.Cursor := crHourGlass;
end;
destructor TWaitCursor.Destroy;
begin
Dec(WaitCursorRefCount);
if WaitCursorRefCount = 0 then
Screen.Cursor := crDefault;
inherited;
end;
end.

View File

@ -84,9 +84,10 @@ type
* *
* @param ASource the source parts * @param ASource the source parts
* @param AGlue the string added between the parts * @param AGlue the string added between the parts
* @param ASkipEmptyItems if True, include only items of Length > 0
* @result the composed parts * @result the composed parts
*} *}
function Join(const ASource: TStringDynArray; const AGlue: String): String; function Join(ASource: array of string; const AGlue: String; ASkipEmptyItems: Boolean = False): String;
{** Determines if one path is the child of another path. {** Determines if one path is the child of another path.
* *
@ -321,14 +322,16 @@ begin
until False; until False;
end; end;
function Join(const ASource: TStringDynArray; const AGlue: String): String;
function Join(ASource: array of string; const AGlue: string; ASkipEmptyItems: Boolean): string;
var var
iGlue: Integer; totalLength: Integer;
iHigh: Integer; itemIndex: Integer;
iItem: Integer; itemLength: Integer;
iLength: Integer; itemCount: Integer;
pGlue: PChar; glueLength: Integer;
pPos: PChar; resultPos: PChar;
firstItem: Boolean;
begin begin
if High(ASource) = -1 then if High(ASource) = -1 then
@ -337,36 +340,47 @@ begin
exit; exit;
end; end;
iGlue := Length(AGlue); { Om geheugen-reallocaties te verminderen, vantevoren even
pGlue := PChar(AGlue); uitrekenen hoe groot het resultaat gaat worden. }
iLength := -iGlue; itemCount := 0;
totalLength := 0;
// First run: calculate the size we need to reserve (two loops should for itemIndex := High(ASource) downto Low(ASource) do
// generally be more efficient than a lot of memory resizing)
iHigh := High(ASource);
for iItem := iHigh downto 0 do
Inc(iLength, Length(ASource[iItem]) + iGlue);
SetLength(Result, iLength);
pPos := PChar(Result);
Inc(pPos, Length(Result));
// Copy last item
iLength := Length(ASource[iHigh]);
Dec(pPos, iLength);
Move(PChar(ASource[iHigh])^, pPos^, iLength);
// Copy remaining items and glue strings
for iItem := iHigh - 1 downto 0 do
begin begin
Dec(pPos, iGlue); if (not ASkipEmptyItems) or (Length(ASource[itemIndex]) > 0) then
Move(pGlue^, pPos^, iGlue); begin
Inc(totalLength, Length(ASource[itemIndex]));
Inc(itemCount);
end;
end;
iLength := Length(ASource[iItem]); glueLength := Length(AGlue);
Dec(pPos, iLength); Inc(totalLength, Pred(itemCount) * glueLength);
Move(PChar(ASource[iItem])^, pPos^, iLength);
SetLength(Result, totalLength);
firstItem := True;
resultPos := PChar(Result);
for itemIndex := Low(ASource) to High(ASource) do
begin
itemLength := Length(ASource[itemIndex]);
if (not ASkipEmptyItems) or (itemLength > 0) then
begin
if not firstItem then
begin
Move(PChar(AGlue)^, resultPos^, glueLength);
Inc(resultPos, glueLength);
end else
firstItem := False;
Move(PChar(ASource[itemIndex])^, resultPos^, itemLength);
Inc(resultPos, itemLength);
end; end;
end; end;
end;
function ChildPath(const AChild, AParent: String; function ChildPath(const AChild, AParent: String;