Type
TFieldTypeSet = set of TFieldType;
var
s, cFieldName: string;
i: integer;
DataSet: TDataSet;
GridFieldTypeSet: TFieldTypeSet;
procedure SetTitle;
var
ii: integer;
cStr: string;
c: TColumn;
begin
for ii := 0 to TDBGrid(Column.Grid).Columns.Count - 1 do
begin
c := TDBGrid(Column.Grid).Columns[ii];
cStr := c.Title.Caption;
if (pos('??', cStr) = 1) or (pos('??', cStr) = 1) then
begin
Delete(cStr, 1, 2);
c.Title.Caption := cStr;
end;
end;
end;
begin
SetTitle;
DataSet := Column.Grid.DataSource.DataSet;
GridFieldTypeSet := [ftString, ftSmallint, ftInteger, ftWord,
ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,
ftTime, ftDateTime, ftBytes, ftVarBytes,
ftTypedBinary, ftFixedChar, ftWideString,
ftLargeint, ftVariant];
if not (Column.Field.DataType in GridFieldTypeSet) then Exit; //摟P?_|r?q?t??
if Column.Field.FieldKind = fkLookup then
cFieldName := Column.Field.KeyFields
else if Column.Field.FieldKind = fkCalculated then
cFieldName := Column.Field.KeyFields
else
cFieldName := Column.FieldName;
//=================================AdoDataSet=====================
if DataSet is TCustomADODataSet then
begin
s := TCustomADODataSet(DataSet).Sort;
if s = '' then
begin
s := cFieldName;
Column.Title.Caption := '??' + Column.Title.Caption;
end
else
begin
if Pos(cFieldName, s) <> 0 then
begin
i := Pos('DESC', s);
if i <= 0 then
begin
s := s + ' DESC';
Column.Title.Caption := '??' + Column.Title.Caption;
end
else
begin
Column.Title.Caption := '??' + Column.Title.Caption;
Delete(s, i, 4);
end;
end
else
begin
s := cFieldName;
Column.Title.Caption := '??' + Column.Title.Caption;
end;
end;
TCustomADODataSet(DataSet).Sort := s;
end
//============================Clientdataset==========================
else if DataSet is TClientDataSet then
begin
if TClientDataSet(DataSet).indexfieldnames <> '' then
begin
i := TClientDataSet(DataSet).IndexDefs.IndexOf('i' + Column.FieldName);
if i = -1 then
begin
with TClientDataSet(DataSet).IndexDefs.AddIndexDef do
begin
Name := 'i' + Column.FieldName;
Fields := Column.FieldName;
DescFields := Column.FieldName;
end;
end;
TClientDataSet(DataSet).IndexFieldNames := '';
TClientDataSet(DataSet).IndexName := 'i' + Column.FieldName;
Column.Title.Caption := '??' + Column.Title.Caption;
end
else
begin
TClientDataSet(DataSet).IndexName := '';
TClientDataSet(DataSet).IndexFieldNames := column.fieldname;
Column.Title.Caption := '??' + Column.Title.Caption;
end;
end;
end;
//======================================================================
procedure WWGridTitleSort(Grid: TwwDBGrid; TitleName: String);
Type
TFieldTypeSet = set of TFieldType;
var
s, cFieldName: string;
i: integer;
DataSet: TDataSet;
aField: TField;
GridFieldTypeSet: TFieldTypeSet;
procedure SetTitle;
var
ii: integer;
cStr: string;
c: TwwColumn;
begin
for ii := 0 to Grid.DataSource.DataSet.FieldCount -1 do
begin
c := Grid.Columns[ii];
cStr := c.DisplayLabel;
if (pos('??', cStr) = 1) or (pos('??', cStr) = 1) then
begin
Delete(cStr, 1, 2);
c.DisplayLabel := cStr;
end;
end;
end;
begin
SetTitle;
DataSet := Grid.DataSource.DataSet;
aField := DataSet.FieldByName(TitleName);
GridFieldTypeSet := [ftString, ftSmallint, ftInteger, ftWord,
ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate,
ftTime, ftDateTime, ftBytes, ftVarBytes,
ftTypedBinary, ftFixedChar, ftWideString,
ftLargeint, ftVariant];
if not (aField.DataType in GridFieldTypeSet) then Exit; //摟P?_|r?q?t??
if aField.FieldKind = fkLookup then
cFieldName := aField.KeyFields
else if aField.FieldKind = fkCalculated then
cFieldName := aField.KeyFields
else
cFieldName := aField.FieldName;
//=================================AdoDataSet=====================
if DataSet is TCustomADODataSet then
begin
s := TCustomADODataSet(DataSet).Sort;
if s = '' then
begin
s := cFieldName;
aField.DisplayLabel := '??' + aField.DisplayLabel;
end
else
begin
if Pos(cFieldName, s) <> 0 then
begin
i := Pos('DESC', s);
if i <= 0 then
begin
s := s + ' DESC';
aField.DisplayLabel := '??' + aField.DisplayLabel;
end
else
begin
aField.DisplayLabel := '??' + aField.DisplayLabel;
Delete(s, i, 4);
end;
end
else
begin
s := cFieldName;
aField.DisplayLabel := '??' + aField.DisplayLabel;
end;
end;
TCustomADODataSet(DataSet).Sort := s;
end
//============================Clientdataset==========================
else if DataSet is TClientDataSet then
begin
if TClientDataSet(DataSet).indexfieldnames <> '' then
begin
i := TClientDataSet(DataSet).IndexDefs.IndexOf('i' + aField.FieldName);
if i = -1 then
begin
with TClientDataSet(DataSet).IndexDefs.AddIndexDef do
begin
Name := 'i' + aField.FieldName;
Fields := aField.FieldName;
DescFields := aField.FieldName;
end;
end;
TClientDataSet(DataSet).IndexFieldNames := '';
TClientDataSet(DataSet).IndexName := 'i' + aField.FieldName;
aField.DisplayLabel := '??' + aField.DisplayLabel;
end
else
begin
TClientDataSet(DataSet).IndexName := '';
TClientDataSet(DataSet).IndexFieldNames := aField.FieldName;
aField.DisplayLabel := '??' + aField.DisplayLabel;
end;
end;
end;
//======================================================================
]]>
{
Unsigned 64 bit Integer support for Delphi 6 and Kylix.
Copyright (c) 2002 by DelphiFactory Netherlands BV
This unit provides to routines to convert between strings and unsigned
64 bit integers.
UInt64 range: 0..18446744073709551615
Thanks to J.H.Plantenberg for the assembler part.
For comments mail to:
erwin@delphi-factory.com
}
interface
resourcestring
SInvalidUInt64 = '''%s'' is not a valid UInt64 value';
{ The UInt64 type is declared as a strong typed Int64, since both compilers
don't support unsigned 64 bit integers. This way you can at least do some
calculations. }
type
UInt64 = type Int64;
{ StrToUInt64 converts the given string to an unsigned 64 bit integer value.
If the string doesn't contain a valid value, an EConvertError exception is
raised. }
function StrToUInt64(const S: AnsiString): UInt64;
{ UInt64ToStr converts the given value to its decimal string representation. }
function UInt64ToStr(Value: UInt64): string;
implementation
// For speed we are going to use the fact that long strings are
// guaranteed to be null-terminated:
{$R-} // Range checking must be disabled
{$B-} // Do not perform complete boolean expression evaluations
uses
SysUtils;
type
_UInt64 = packed record // Split the 64 bit into 2x32 bit
Lo, Hi : LongWord;
end;
procedure RaiseEConvertError(const S: AnsiString);
begin
// raise an exception explaining the input string was invalid
raise EConvertError.CreateResFmt(@SInvalidUInt64, [S]);
end;
function StrToUInt64(const S: AnsiString): UInt64;
var
I: LongWord;
Dig: Integer;
Digit : LongWord;
Hi,Lo : LongWord;
begin
// check if S is empty (is nil pointer)
if S = '' then
RaiseEConvertError(S);
// start at the first character
I := 1;
// trim leading spaces
while S[I] = ' ' do
Inc(I);
if S[I] = '-' then // check for minus sign
RaiseEConvertError(S);
if S[I] = '+' then // check for plus sign
Inc(I);
// Check for hexidecimal string id: '$' or '0x'
if (S[I] = '$') or ((S[I] = '0') and (Upcase(S[I+1]) = 'X')) then
begin
// trim leading zero (if '0x' hex marker)
if S[I] = '0' then
Inc(I);
// trim hex marker
Inc(I);
// Check if empty
if S[I] = #0 then
RaiseEConvertError(S);
// init loop
Dig := 0;
Result := 0;
// while not end of string
while S[I] <> #0 do
begin
// try character convert
case S[I] of
'0'..'9': Dig := Ord(S[I]) - Ord('0');
'A'..'F': Dig := Ord(S[I]) - (Ord('A') - 10);
'a'..'f': Dig := Ord(S[I]) - (Ord('a') - 10);
else
RaiseEConvertError(S)
end;
// still enough room in result?
if Result shr 60 > 0 then
RaiseEConvertError(S);
// shift converted digit into result
Result := Result shl 4 + Dig;
// next char
Inc(I);
end;
end
else begin // decimal unsigned 64 bit conversion
// check if not empty
if S[I] = #0 then
RaiseEConvertError(S);
Hi := 0;
Lo := 0;
while S[I] <> #0 do
begin
// Extract the digit from the string and convert it ASCII->Byte
Digit := Ord(S[I]) xor Ord('0');
// Some assembler to perform an unsigned 64 bit integer calculation.
// This asm code runs in D6 and Kylix (PIC code).
// HiLo := (HiLo*10)+Digit
asm
push esi // save register
// calculate: Hi * 10;
mov eax, Hi // Load Hi
mov ecx, 10 // multiplier is 10
mul ecx // EDX:EAX := EAX*ECX
or edx, edx // Overflow?
jnz @TooBig // yes -> bye bye
// calculate: Lo * 10
mov esi, eax // save Hi value
mov eax, Lo // load Lo
mul ecx // EDX:EAX := EAX*ECX
// Combine Hi, Lo, and overflow of Lo to form HiLo result
add edx, esi // EDX:EAX := HiLo*10
// HiLo := HiLo + Digit
add eax, Digit // EDX:EAX := HiLo+Digit
adc edx, 0 // check overflow
jc @TooBig // yes -> bye bye
// save HiLo
mov Hi, edx // Hi := EDX
mov Lo, eax // Lo := EAX
jmp @TheEnd // successfull finish
@TooBig:
mov Digit, 666 // something went wrong: invalidate Digit
@TheEnd:
pop esi // restore register
end;
// Check if digit was legal and if the previous calculation was a success
if not (Digit in [0..9]) then
RaiseEConvertError(S);
// proceed to the next digit
Inc(I);
end;
// Return HiLo as an unsigned 64 bit integer
_UInt64(Result).Lo := Lo;
_UInt64(Result).Hi := Hi;
end;
end;
function UInt64ToStr(Value: UInt64): string;
const
BiggestUInt64Str = '18446744073709551615';
MaxBCD = Length(BiggestUInt64Str);
type
TBCD = array[0..MaxBCD-1] of Integer; { Index 0 is highest BCD digit}
procedure AddBCD(var BCD : TBCD; Pos,Value : Integer);
begin
Inc(BCD[Pos], Value);
if BCD[Pos] > 9 then
begin
Dec(BCD[Pos],10);
AddBCD(BCD,Pos-1, 1);
end;
end;
procedure IncBCD(var A : TBCD; const B : TBCD);
var
I : Integer;
begin
for I := MaxBCD-1 downto 0 do
AddBCD(A, I, B[I]);
end;
var
ValueBCD : TBCD;
BitValue : TBCD;
Tmp : TBCD;
I : Integer;
Ofs : Integer;
begin
// default to zero
FillChar(ValueBCD, SizeOf(ValueBCD), 0);
// set bit value BCD. Lowest bit has value 1
FillChar(BitValue, SizeOf(BitValue), 0);
BitValue[MaxBCD-1] := 1;
// check if there are bits available
while Value <> 0 do
begin
// if current lowest bit is set
// Increment the BCD value with the current bit value
if Value and 1 <> 0 then
IncBCD(ValueBCD, BitValue);
// proceed to the next bit
Value := Value shr 1;
// Double the BitValue
Tmp := BitValue;
IncBCD(BitValue, Tmp);
end;
// Find highest non zero decimal
Ofs := 0;
while (Ofs < MaxBCD) and (ValueBCD[Ofs] = 0) do
Inc(Ofs);
// check if any non zero decimals present
if Ofs < MaxBCD then
begin
// convert BCD result to ASCII result
SetLength(Result, MaxBCD-Ofs);
I := Ofs;
Repeat
Result[I-Ofs+1] := Char(ValueBCD[I]+Ord('0'));
Inc(I);
until I > MaxBCD-1;
end
else
Result := '0'; // nothing set -> value is '0'
end;
end.
]]>
First off, let's say that we have a string that we need to replace all the spaces into something. We could use this:
StringReplace(Edit1.Text, ' ', '', [rfReplaceAll]);
This would go through Edit1.Text and replace all occurences of the space with nothing. It has only been since Delphi 4 that we have received this function, but below is the code to use in earlier versions.
function StringReplace(const S, OldPattern, NewPattern: string;
Flags: TReplaceFlags): string;
var
SearchStr, Patt, NewStr: string;
Offset: Integer;
begin
if rfIgnoreCase in Flags then
begin
SearchStr := AnsiUpperCase(S);
Patt := AnsiUpperCase(OldPattern);
end else
begin
SearchStr := S;
Patt := OldPattern;
end;
NewStr := S;
Result := '';
while SearchStr <> '' do
begin
Offset := AnsiPos(Patt, SearchStr);
if Offset = 0 then
begin
Result := Result + NewStr;
Break;
end;
Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
if not (rfReplaceAll in Flags) then
begin
Result := Result + NewStr;
Break;
end;
SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
end;
end;
I have seen many people trying to get different parts of a string to use, like the end of an email address.
Let's take for example that we want to get the first part of support@delphipages.com.
First of all we want to use the Copy function to copy the desired area, and the Pos function to find out just when the ampersand appears in the line of text.
Edit2.text := Copy(Edit1.Text, 1, Pos('@', Edit1.Text)-1);
If we wanted the last part of the email:
Edit2.text := Copy(Edit1.Text, Pos('@', Edit1.Text)+1, Length(Edit1.Text)-Pos('@', Edit1.Text));
These two problems are fairly simple, but what if you had a string like this:
10,10,100,45,T,support@delphipages.com,80,douglas,tietjen
I could run through a series of Copy and Pos and Delete functions to be able to get the email address, but it would sure look hectic and hard to figure out problems.
I also develop with Cold Fusion, and I found some useful commands, and so I recreated them for me in Delphi, and others have done similiar things.
First off I wrote a function called ListGetAt.
function ListGetAt(List: String; Position: Integer; Delimiter: String = ','): String;
function TForm1.ListGetAt(List: String; Position: Integer;
Delimiter: String): String;
var
i, NP: integer;
begin
NP := 0;
for i := 1 to Position do begin
List := Copy(List,NP,Length(List)-NP+1);
NP := Pos(Delimiter,List)+Length(Delimiter);
if i = Position then begin
if Pos(Delimiter, List) = 0 then break;
Delete(List, NP-Length(Delimiter), Length(List)-(NP-Length(Delimiter)-1));
end;
end;
Result := List;
end;
Now, anytime that I need to get a section of code I can call this function for quick and easy access. For example, now if I wanted the email address, I could write the following:
Edit2.Text := ListGetAt(Edit1.Text, 6, ',');
I would now have 'support@delphipages.com'.
If I just wanted the last part of the email, I could type this.
Edit2.Text := ListGetAt(ListGetAt(Edit1.Text, 6, ','), 2, '@');
Now suppose that the list of items were values that you wanted to change and store for later use. It would be quite hectic again to go through and find each part and update it's value. So I created another function called ListSetAt.
function ListSetAt(List: String; Position: Integer; Value: string; Delimiter: String = ','): String;
function TForm1.ListSetAt(List: String; Position: Integer; Value,
Delimiter: String): String;
var
i, NP: integer;
BegStr, EndStr: string;
begin
NP := 0;
BegStr := '';
EndStr := '';
for i := 1 to Position do begin
if i > 1 then
BegStr := BegStr+Copy(List, 0, Pos(Delimiter,List)+Length(Delimiter)-1);
List := Copy(List,NP,Length(List)-NP+Length(Delimiter));
NP := Pos(Delimiter,List)+Length(Delimiter);
if i = Position then begin
if Pos(Delimiter, List) = 0 then break;
EndStr := Copy(List, NP-Length(Delimiter), Length(List)-(NP-Length(Delimiter)-1));
end;
end;
Result := BegStr+Value+EndStr;
end;
Now if I was to update the email address, I could just type this.
Edit1.Text := ListSetAt(Edit1.Text, 6, 'email@email.com', ',');
It would now update just the sixth position. Now you could use it all sorts of ways. If I just wanted everything after the ampersand, then I could type this
ListGetAt(Edit1.Text, 2, '@');
It would give the result of: delphipages.com,80,douglas,tietjen
These functions are simple, for example, if you were to ListGetAt on Position 0 it would return the entire line back. If you did it on Position 20, it would return the last item in the list. In Cold Fusion they have a command called ListLen, so you can find out how many ListItems you are working with.
function ListLen(List: String; Delimiter: String=','): Integer;
function TForm1.ListLen(List: String; Delimiter: String): Integer;
begin
Result := 1;
While Pos(Delimiter, List) > 0 do begin
Delete(List, 1, Pos(Delimiter, List)+Length(Delimiter)-1);
Result := Result + 1;
end;
end;
]]>