From 195c3e6ddeb58f06db6ac1ba3246c847ffca2f14 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Wed, 2 Oct 2013 20:38:15 +0000 Subject: [PATCH] Added: X2UtCursors unit (WaitCursor function) Changed: Added SkipEmptyItems parameter to Join function --- Packages/D2007/X2Utils.dpk | 3 +- Packages/D2007/X2Utils.dproj | 11 +++-- X2UtCursors.pas | 72 ++++++++++++++++++++++++++++++ X2UtStrings.pas | 86 +++++++++++++++++++++--------------- 4 files changed, 131 insertions(+), 41 deletions(-) create mode 100644 X2UtCursors.pas diff --git a/Packages/D2007/X2Utils.dpk b/Packages/D2007/X2Utils.dpk index 0ad0f43..065a37c 100644 --- a/Packages/D2007/X2Utils.dpk +++ b/Packages/D2007/X2Utils.dpk @@ -56,6 +56,7 @@ contains X2UtElevation in '..\..\X2UtElevation.pas', X2UtPersistXML in '..\..\X2UtPersistXML.pas', X2UtPersistXMLBinding in '..\..\X2UtPersistXMLBinding.pas', - XMLDataBindingUtils in '..\..\XMLDataBinding\XMLDataBindingUtils.pas'; + XMLDataBindingUtils in '..\..\XMLDataBinding\XMLDataBindingUtils.pas', + X2UtCursors in '..\..\X2UtCursors.pas'; end. diff --git a/Packages/D2007/X2Utils.dproj b/Packages/D2007/X2Utils.dproj index 3c855e0..43835ff 100644 --- a/Packages/D2007/X2Utils.dproj +++ b/Packages/D2007/X2Utils.dproj @@ -6,7 +6,7 @@ Debug AnyCPU DCC32 - P:\algemeen\bin\D2007\X2Utils2007.bpl + ..\..\..\Bpl\D2006\X2Utils2007.bpl 7.0 @@ -38,6 +38,8 @@ + + Microsoft Office 2000 Sample Automation Server Wrapper Components Microsoft Office XP Sample Automation Server Wrapper Components @@ -49,6 +51,7 @@ + @@ -71,8 +74,8 @@ - - - + + + \ No newline at end of file diff --git a/X2UtCursors.pas b/X2UtCursors.pas new file mode 100644 index 0000000..79e6d56 --- /dev/null +++ b/X2UtCursors.pas @@ -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. diff --git a/X2UtStrings.pas b/X2UtStrings.pas index 9434061..7ed24db 100644 --- a/X2UtStrings.pas +++ b/X2UtStrings.pas @@ -82,11 +82,12 @@ type {** Appends string parts with a specified glue value. * - * @param ASource the source parts - * @param AGlue the string added between the parts - * @result the composed parts + * @param ASource the source parts + * @param AGlue the string added between the parts + * @param ASkipEmptyItems if True, include only items of Length > 0 + * @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. * @@ -321,14 +322,16 @@ begin until False; end; -function Join(const ASource: TStringDynArray; const AGlue: String): String; + +function Join(ASource: array of string; const AGlue: string; ASkipEmptyItems: Boolean): string; var - iGlue: Integer; - iHigh: Integer; - iItem: Integer; - iLength: Integer; - pGlue: PChar; - pPos: PChar; + totalLength: Integer; + itemIndex: Integer; + itemLength: Integer; + itemCount: Integer; + glueLength: Integer; + resultPos: PChar; + firstItem: Boolean; begin if High(ASource) = -1 then @@ -337,38 +340,49 @@ begin exit; end; - iGlue := Length(AGlue); - pGlue := PChar(AGlue); - iLength := -iGlue; + { Om geheugen-reallocaties te verminderen, vantevoren even + uitrekenen hoe groot het resultaat gaat worden. } + itemCount := 0; + totalLength := 0; - // First run: calculate the size we need to reserve (two loops should - // 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 + for itemIndex := High(ASource) downto Low(ASource) do begin - Dec(pPos, iGlue); - Move(pGlue^, pPos^, iGlue); + if (not ASkipEmptyItems) or (Length(ASource[itemIndex]) > 0) then + begin + Inc(totalLength, Length(ASource[itemIndex])); + Inc(itemCount); + end; + end; - iLength := Length(ASource[iItem]); - Dec(pPos, iLength); - Move(PChar(ASource[iItem])^, pPos^, iLength); + glueLength := Length(AGlue); + Inc(totalLength, Pred(itemCount) * glueLength); + + 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; + function ChildPath(const AChild, AParent: String; const AFailIfSame: Boolean): Boolean; var