I have a Edit1 where you can type numbers like 2 20 10 -3 and when you click the Button1 it brings out max and min numbers max = 20 min = -3.
Tried to make so when i bring out the numbers it swaps the min and max numbers in Edit1 like 2 -3 10 20 i tried it in my ways but the other entered numbers change place.
I tried many ways:
Edit4.Text:= (inttostr(min)+' '+ inttostr(max));
but it overwrite the other numbers.
Then i tried to use
maxnumb := Edit4
Edit4.Text := StringReplace(maxnumb, inttostr(max), inttostr(min),
[rfReplaceAll, rfIgnoreCase]);
Edit1.Text := StringReplace(maxnumb, inttostr(min), inttostr(max),
[rfReplaceAll, rfIgnoreCase]);
But it only swaped the 1st number and when i clicked the Button1 again it swaped the second number.
Code without the attempts to swap:
procedure TForm1.Button1Click(Sender: TObject);
var
oSL: TStringlist;
s, ss: string;
a: array [1 .. 15] of integer;
i, j, k, p, code: integer;
max, min: integer;
before, after: string;
begin
s := Edit1.Text;
s := concat(s, #32);
i := 0;
while Length(s) > 0 do
begin
i := i + 1;
p := pos(#32, s);
ss := copy(s, 1, p - 1);
Val(ss, k, code);
a[i] := k;
delete(s, 1, p);
end;
// Max
max := a[1];
For j := 1 to i do
if max < a[j] then
max := a[j];
// Min
min := a[1];
For j := 1 to i do
if min > a[j] then
min := a[j];
// Put out Max/Min
Edit3.Text := IntToStr(max);
Edit2.Text := IntToStr(min);
end;
uses
Types, StrUtils;
function Arrange(const AEditFrom, AEditTo: TEdit): Boolean;
var
_StrArr: TStringDynArray;
i: integer;
_IntArr: array of integer;
_IntValue: integer;
_Min: integer;
_Max: integer;
begin
Result := False;
if not Assigned(AEditFrom) then
Exit;
if not Assigned(AEditTo) then
Exit;
_StrArr := SplitString(AEditFrom.Text, ' ');
SetLength(_IntArr, Length(_StrArr));
for i := 0 to Length(_StrArr) - 1 do
begin
if not TryStrToInt(_StrArr[i], _IntValue) then
Exit;
_IntArr[i] := _IntValue;
end;
AEditTo.Clear;
_Min := _IntArr[0];
_Max := _IntArr[0];
for i := 0 to Length(_IntArr) - 1 do
begin
if _IntArr[i] > _Max then
_Max := _IntArr[i];
if _IntArr[i] < _Min then
_Min := _IntArr[i];
end;
AEditTo.Text := StringReplace(AEditFrom.Text, ' ' + IntToStr(_Min),
'...' + IntToStr(_Max), [rfReplaceAll, rfIgnoreCase]);
AEditTo.Text := StringReplace(AEditTo.Text, ' ' + IntToStr(_Max),
' ' + IntToStr(_Min), [rfReplaceAll, rfIgnoreCase]);
AEditTo.Text := StringReplace(AEditTo.Text, '...', ' ',
[rfReplaceAll, rfIgnoreCase]);
Result := True;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
if not Arrange(Edit1, Edit2) then
ShowMessage('Something went wrong. List contains not a integer?');
end;
Test: 2 20 10 -3, Result: 2 -3 10 20
Related
I created a procedure to update an SQLite DB. The procedure runs in a loop until the list is finished. The problem is, when I run the procedure, the program stops responding
How can I run this procedure in the background, without crashing the program?
procedure TForm1.domainupdate;
var
I, J, K, svr: integer ;
domain1, domain2: string ;
expiry: string;
sl: TStringList;
fs: TFormatSettings;
s: string;
dt: TDatetime;
ds : TFormatSettings;
memo : tmemo;
begin
DM.Qdomains.First;
while not DM.Qdomains.Eof do begin
for J := Length (DM.Qdomains.FieldByName('domain').AsString) downto 2 do begin
if DM.Qdomains.FieldByName('domain').AsString [J] = '.' then begin // search host.co.uk
if domain1 = '' then
domain1 := Copy (DM.Qdomains.FieldByName('domain').AsString, J + 1, 99) + IcsSpace
// found uk
else begin
domain2 := Copy (DM.Qdomains.FieldByName('domain').AsString, J + 1, 99) + IcsSpace ;
// found co.uk
Break ;
end;
end;
end;
FWhoisServers := TStringList.Create;
for I := 0 to Length(WhoisNames) - 1 do
FWhoisServers.add(WhoisNames[I]);
FHost := 'whois.ripe.net' ;
K := -1 ;
if FWhoisServers.Count > 0 then begin
for I := 0 to FWhoisServers.Count - 1 do
begin
if (Pos (domain1, FWhoisServers [I]) = 1) then K := I ;
if (Pos (domain2, FWhoisServers [I]) = 1) then
begin
K := I ;
break ;
end ;
end;
if K >= 0 then begin
J := Pos (IcsSpace, FWhoisServers [K]) ;
end;
end;
if K < 0 then begin
end;
IdWhois1.host := Copy (FWhoisServers [K], J + 1, 99) ;
Memo:=TMemo.Create(nil);
Memo.Visible:=false;
memo.Lines.text := IdWhois1.WhoIs(DM.Qdomains.FieldByName('domain').AsString);
begin
sl := TStringList.Create;
try
sl.Assign(Memo.Lines);
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
sl.NameValueSeparator := ':';
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
finally
sl.Free;
end;
if expiry = '' then
exit
else
s := expiry;
fs := TFormatSettings.Create;
fs.DateSeparator := '-';
fs.TimeSeparator := ':';
fs.shortdateformat := 'yyyy-mm-dd';
fs.ShortTimeFormat := 'hh:nn:ss';
dt := StrToDatetime(s, fs);
ds.DateSeparator := '/';
ds.TimeSeparator := ':';
ds.ShortDateFormat := 'dd/mm/yyyy';
ds.longtimeFormat := 'hh:mm:ss';
end;
end;
//********************************************************
//********************************************************
//if edit1.text <> '' then DM.Qdomains.Open;
DM.Qdomains.Edit;
DM.Qdomains.FieldByName('domain').AsString :=
DM.Qdomains.FieldByName('domain').AsString;
DM.Qdomains.FieldByName('expiry').AsString := datetimetostr(dt, ds);
DM.Qdomains.FieldByName('whois').AsString :=
IdWhois1.WhoIs(DM.Qdomains.FieldByName('domain').AsString);
DM.Qdomains.FieldByName('update').AsString := DatetimeToStr(now);
DM.Qdomains.Post;
DM.Qdomains.Next;
end;
Move the logic into a separate worker thread, synchronizing with the main UI thread only when absolutely needed (ie, to show the results). You need to do this anyway if you ever plan on running this code on Android, since you can't perform network operations on the main UI thread.
Also, get rid of the TMemo that the code is creating, it is not needed at all. All you are using it for is to parse the Whois result into a TStringList, which you can do directly. And, you are leaking the TMemo and never showing it to the user anyway.
Try something more like this:
procedure TForm1.DomainUpdate;
var
I, J, K: Integer;
domain, domain1, domain2, host, whois, expiry: string;
sl: TStringList;
fs, ds: TFormatSettings;
dt: TDatetime;
begin
// TODO: perform the DB query here instead of in the main thread...
DM.Qdomains.First;
while not DM.Qdomains.Eof do begin
domain := DM.Qdomains.FieldByName('domain').AsString;
domain1 := '';
domain2 := '';
for J := Length(domain) downto 2 do begin
if domain[J] = '.' then begin // search host.co.uk
if domain1 = '' then
domain1 := Copy(domain, J + 1, MaxInt) + IcsSpace
// found uk
else begin
domain2 := Copy(domain, J + 1, MaxInt) + IcsSpace;
// found co.uk
Break;
end;
end;
end;
FWhoisServers := TStringList.Create;
try
for I := 0 to Length(WhoisNames) - 1 do
FWhoisServers.Add(WhoisNames[I]);
host := 'whois.ripe.net';
K := -1;
if FWhoisServers.Count > 0 then begin
for I := 0 to FWhoisServers.Count - 1 do
begin
if (Pos(domain1, FWhoisServers[I]) = 1) then K := I;
if (Pos(domain2, FWhoisServers[I]) = 1) then
begin
K := I;
Break;
end;
end;
if K >= 0 then begin
J := Pos(IcsSpace, FWhoisServers[K]);
host := Copy(FWhoisServers[K], J + 1, MaxInt);
end;
end;
IdWhois1.Host := host;
finally
FWhoisServers.Free;
end;
expiry := '';
sl := TStringList.Create;
try
whois := IdWhois1.WhoIs(domain);
sl.Text := whois;
for I := 0 to sl.Count-1 do begin
sl[I] := TrimLeft(sl[I]);
end;
sl.NameValueSeparator := ':';
for I := Low(FieldNames) to High(FieldNames) do begin
expiry := Trim(sl.Values[FieldNames[I]]);
if expiry <> '' then
Break;
end;
finally
sl.Free;
end;
if expiry <> '' then begin
fs := TFormatSettings.Create;
fs.DateSeparator := '-';
fs.TimeSeparator := ':';
fs.ShortDateFormat := 'yyyy-mm-dd';
fs.ShortTimeFormat := 'hh:nn:ss';
dt := StrToDateTime(expiry, fs);
ds := TFormatSettings.Create;
ds.DateSeparator := '/';
ds.TimeSeparator := ':';
ds.ShortDateFormat := 'dd/mm/yyyy';
ds.LongTimeFormat := 'hh:mm:ss';
DM.Qdomains.Edit;
try
DM.Qdomains.FieldByName('domain').AsString := domain;
DM.Qdomains.FieldByName('expiry').AsString := DateTimeToStr(dt, ds);
DM.Qdomains.FieldByName('whois').AsString := whois;
DM.Qdomains.FieldByName('update').AsString := DateTimeToStr(Now);
DM.Qdomains.Post;
except
DM.Qdomains.Cancel;
raise;
end;
end;
DM.Qdomains.Next;
end;
end;
...
TThread.CreateAnonymousThread(DomainUpdate).Start;
I am trying to write code to calculate sum of all numbers from cells that form main diagonal of stringgrid but the result I get is just number I typed in bottom right cell. Here's my code:
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
begin
with StringGrid1 do
begin
RowCount := StrToInt(Edit1.Text);
ColCount := StrtoInt(Edit2.Text);
for i := 0 to RowCount - 1 do
Cells[0, i] := IntToStr(i);
for j := 0 to ColCount - 1 do
Cells[j, 0] := IntToStr(j);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
i, j, s, z, n: Integer;
begin
z := 0;
with StringGrid1 do
begin
for i := 1 to RowCount - 1 do
for j := 1 to ColCount - 1 do
s := StrToInt(Cells[j, i]);
for n := RowCount - 1 to ColCount - 1 do
if i = j then
z := z + s;
Label1.Caption := IntToStr(z);
end;
end;
end.
What am I missing ? Thanks in advance
Your are not summing up any values. If your columcount is equal to your rowcount, then your for loop will only run once, for your last item.
procedure TForm1.Button2Click(Sender: TObject);
var
i, j, s, z, n: integer;
begin
z:=0;
for i:=1 to StringGrid1.rowcount-1 do
for j:=1 to StringGrid1.colcount-1 do
if i=j then
begin
s:=strtoint(cells[j, i]);
z:=z+s;
end;
Label1.Caption:=inttostr(z);
end;
I'm doing a code on some kind of encoder/decoder, and can't figure out the strange behavior for more than 2 days now... I hope someone might understand and explain to me why is happening, whatever it is...
Here's the main code, which does the thing (I removed the form's info, buttons etc, just the core to avoid garbage)
unit Encoder;
//
interface
//
var
Enc : array [1..71] of Record
Char: Char;
Encr: string;
Enc: array [1..5] of Char;
end;
EncodeBuffer: TStringList;
implementation
{$R *.dfm}
procedure TEncrypter.Encode;
var
s, t, u, h, h2, h3, h4, h5: integer;
begin
s := EncodeBuffer.Count;
h := 0;
h2 := 1;
h3 := 2;
h4 := 3;
h5 := 4;
while h < s do
begin
t := EncodeBuffer.Strings[h].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h] := EncodeBuffer.Strings[h].Replace(EncodeBuffer.Strings[h].Chars[u], EncodeChar(EncodeBuffer.Strings[h].Chars[u], 1));
end;
end;
h := h + 5;
end;
while h2 < s do
begin
t := EncodeBuffer.Strings[h2].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h2] := EncodeBuffer.Strings[h2].Replace(EncodeBuffer.Strings[h2].Chars[u], EncodeChar(EncodeBuffer.Strings[h2].Chars[u], 2));
end;
end;
h2 := h2 + 5;
end;
while h3 < s do
begin
t := EncodeBuffer.Strings[h3].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h3] := EncodeBuffer.Strings[h3].Replace(EncodeBuffer.Strings[h3].Chars[u], EncodeChar(EncodeBuffer.Strings[h3].Chars[u], 3));
end;
end;
h3 := h3 + 5;
end;
while h4 < s do
begin
t := EncodeBuffer.Strings[h4].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h4] := EncodeBuffer.Strings[h4].Replace(EncodeBuffer.Strings[h4].Chars[u], EncodeChar(EncodeBuffer.Strings[h4].Chars[u], 4));
end;
end;
h4 := h4 + 5;
end;
while h5 < s do
begin
t := EncodeBuffer.Strings[h5].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h5] := EncodeBuffer.Strings[h5].Replace(EncodeBuffer.Strings[h5].Chars[u], EncodeChar(EncodeBuffer.Strings[h5].Chars[u], 5));
end;
end;
h5 := h5 + 5;
end;
end;
procedure TEncrypter.Decode;
var
s, t, u, h, h2, h3, h4, h5: integer;
begin
s := EncodeBuffer.Count;
h := 0;
h2 := 1;
h3 := 2;
h4 := 3;
h5 := 4;
while h < s do
begin
t := EncodeBuffer.Strings[h].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h] := EncodeBuffer.Strings[h].Replace(EncodeBuffer.Strings[h].Chars[u], DecodeChar(EncodeBuffer.Strings[h].Chars[u], 1));
end;
end;
h := h + 5;
end;
while h2 < s do
begin
t := EncodeBuffer.Strings[h2].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h2] := EncodeBuffer.Strings[h2].Replace(EncodeBuffer.Strings[h2].Chars[u], DecodeChar(EncodeBuffer.Strings[h2].Chars[u], 2));
end;
end;
h2 := h2 + 5;
end;
while h3 < s do
begin
t := EncodeBuffer.Strings[h3].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h3] := EncodeBuffer.Strings[h3].Replace(EncodeBuffer.Strings[h3].Chars[u], DecodeChar(EncodeBuffer.Strings[h3].Chars[u], 3));
end;
end;
h3 := h3 + 5;
end;
while h4 < s do
begin
t := EncodeBuffer.Strings[h4].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h4] := EncodeBuffer.Strings[h4].Replace(EncodeBuffer.Strings[h4].Chars[u], DecodeChar(EncodeBuffer.Strings[h4].Chars[u], 4));
end;
end;
h4 := h4 + 5;
end;
while h5 < s do
begin
t := EncodeBuffer.Strings[h5].Length;
if t > 0 then
begin
for u := 0 to t-1 do
begin
EncodeBuffer.Strings[h5] := EncodeBuffer.Strings[h5].Replace(EncodeBuffer.Strings[h5].Chars[u], DecodeChar(EncodeBuffer.Strings[h5].Chars[u], 5));
end;
end;
h5 := h5 + 5;
end;
end;
function TEncrypter.EncodeChar(Sign: Char; Encoder: integer) : Char;
var
t: integer;
begin
for t := 1 to 71 do
begin
if Sign = enc[t].Char then
begin
Result := enc[t].Enc[Encoder];
Break;
end
else
Result := Sign;
end;
end;
function TEncrypter.DecodeChar(Sign: Char; Encoder: integer) : Char;
var
t: integer;
begin
for t := 1 to 71 do
begin
if Sign = enc[t].Enc[Encoder] then
begin
Result := enc[t].Char;
Break;
end
else
Result := Sign;
end;
end;
I have an Enc array created on FormCreate event, which fills Enc[1 to 71].Char and Enc[1 to 71].Enc[1 to 5] with random char order;
The code is made (or at least should be) so that it uses different encode list from array for each 5th line (line 1 enc[x].enc[1], line 2 enc[x].enc[2], and then line 5 enc[x].enc[5], and line 6 back to enc[x].enc[1] and so on...)
If I encode 5 lines from Memo1, which are:
Memo1
Memo2
Memo3
Memo4
Memo5
I get some random words with 5 chars each, however when decoding it back, I get returned
Memo1
Memo2
memo3
Memo4
Memo5
(notice the lower m letter in 3rd line);
If I then encode this again, I get the exact same encoded stringlist as in the first case, only that here, the 3rd line's 3rd char! (wtf?) is changed with the same as the firstone is.
so, for Memo3 I get q7M0e, and for memo3 I get q7q0e, which makes no sense to me, as the position of a char should be the same, as far as I understand by the code.
Is there anything I'm missing here, noticable in the code above??
Comment if there's a need for me to paste the complete form's (unit's) code and exe example, I'll give it on a web and link to that...
Edit:
Here's the "key", by which I'm encoding/decoding: http://txt.do/128b
There are several problems with your approach.
One problem is with your use of String.Replace(), which replaces ALL occurrences of one Char with another Char. Once you replace a given Char, you can potentially replace that same index with a different value later on in your loops, thus trashing your data while you are looping.
Another problem is your decoding logic. You are allowing each un-encoded Char to be encoded with one of 5 different Chars. If those encoded Char values are duplicated at all across your Enc[1..71].Enc array for the same value of Encoder, you will not be able to know which Enc[1..71].Char to use for decoding. It is not enough that your arrays are simply random, but they also need to be unique for the same value of Encoder.
Also, your loops are redundant and overly complicated. They can be greatly simplified.
Try something more like this instead:
function TEncrypter.EncodeChar(Sign: Char; Encoder: integer) : Char;
var
t: integer;
begin
for t := 1 to 71 do
begin
if Sign = Enc[t].Char then
begin
Result := Enc[t].Enc[Encoder];
Exit;
end;
end;
Result := Sign;
end;
function TEncrypter.DecodeChar(Sign: Char; Encoder: integer) : Char;
var
t: integer;
begin
for t := 1 to 71 do
begin
if Sign = Enc[t].Enc[Encoder] then
begin
Result := Enc[t].Char;
Exit;
end;
end;
Result := Sign;
end;
procedure TEncrypter.Encode;
var
t, u, h: integer;
s: String;
begin
for h := 0 to EncodeBuffer.Count-1 do
begin
s := EncodeBuffer.Strings[h];
t := Length(s);
if t > 0 then
begin
for u := 0 to t-1 do
begin
s[u+1] := EncodeChar(s[u+1], (h mod 5) + 1);
end;
EncodeBuffer.Strings[h] := s;
end;
end;
end;
procedure TEncrypter.Decode;
var
t, u, h: integer;
s: String;
begin
for h := 0 to EncodeBuffer.Count-1 do
begin
s := EncodeBuffer.Strings[h];
t := Length(s);
if t > 0 then
begin
for u := 0 to t-1 do
begin
s[u+1] := DecodeChar(s[u+1], (h mod 5) + 1);
end;
EncodeBuffer.Strings[h] := s;
end;
end;
end;
// FormCreate
var
I, J, K, L: Integer;
Temp: Array[1..71] of Char;
NumInTemp: Integer;
begin
...
// initialize Enc[].Char as needed...
for I := 1 to 71 do
begin
Enc[I].Char := ...;
end;
// uniquely initialize each Enc[].Enc array for one value of Encoder...
for I := 1 to 5 do
begin
for J := 1 to 71 do
Temp[J] := ...; // must be unique for this iteration of I...
NumInTemp := 71;
// randomly assign Temp array to Enc[I].Enc array
for J := 1 to 71 do
begin
K := 1 + Random(NumInTemp);
Enc[J].Enc[I] := Temp[K];
for L := K+1 to NumInTemp do
Temp[L-1] := Temp[L];
Dec(NumInTemp);
end;
end;
...
end;
If you then expand your arrays to allow all printable ASCII characters, not just 71 of them, then the code gets a little simpler:
var
Enc : array [32..126] of Record
Char: Char;
Encr: string;
Enc: array [1..5] of Char;
end;
EncodeBuffer: TStringList;
function TEncrypter.EncodeChar(Sign: Char; Encoder: integer) : Char;
var
t: integer;
begin
if (Sign >= #32) and (Sign <= #126) then
Result := Enc[Ord(Sign)].Enc[Encoder]
else
Result := Sign;
end;
function TEncrypter.DecodeChar(Sign: Char; Encoder: integer) : Char;
var
t: integer;
begin
for t := Low(Enc) to High(Enc) do
begin
if Sign = Enc[t].Enc[Encoder] then
begin
Result := Enc[t].Char;
Exit;
end;
end;
Result := Sign;
end;
procedure TEncrypter.Encode;
var
u, h: integer;
s: String;
begin
for h := 0 to EncodeBuffer.Count-1 do
begin
s := EncodeBuffer.Strings[h];
for u := Low(s) to High(s) do
s[u] := EncodeChar(s[u], (h mod 5) + 1);
EncodeBuffer.Strings[h] := s;
end;
end;
procedure TEncrypter.Decode;
var
u, h: integer;
s: String;
begin
for h := 0 to EncodeBuffer.Count-1 do
begin
s := EncodeBuffer.Strings[h];
for u := Low(s) to High(s) do
s[u] := DecodeChar(s[u], (h mod 5) + 1);
EncodeBuffer.Strings[h] := s;
end;
end;
// FormCreate
var
I, J, K, L: Integer;
Temp: Array[32..126] of Char;
NumInTemp: Integer;
begin
...
for I := Low(Enc) to High(Enc) do
Enc[I].Char := Char(I);
for I := 1 to 5 do
begin
for J := Low(Temp) to High(Temp) do
Temp[J] := Char(J);
NumInTemp := Length(Temp);
for J := Low(Enc) to High(Enc) do
begin
K := Low(Temp) + Random(NumInTemp);
Enc[J].Enc[I] := Temp[K];
for L := K+1 to (Low(Temp)+NumInTemp) do
Temp[L-1] := Temp[L];
Dec(NumInTemp);
end;
end;
end;
And if you set up a separate decoder table instead of using Enc[].Enc, you can simplify TEncrypter.DecodeChar() to a similar lookup that TEncrypter.EncodeChar() uses, without having to use a loop at all. I will leave that as an exercise for you.
Let's say I start with a string "abc".
I want to replace all "a" with "c", replace all "b" with "Q", and replace all "c" with "7".
Perhaps I would write:
S := 'abc';
S := S . Replace ( 'a', 'c' );
S := S . Replace ( 'b', 'Q' );
S := S . Replace ( 'c', '7' );
The result is '7Q7'. Oops! Why wasn't "a" replaced with "c"?
Well, it was.
After the first call to Replace, S was 'cbc'.
After the second call, S was 'cQc'.
The last call replaced both 'c's with '7'.
I imagine you are doing the same sort of thing here.
I couldn't give you the specific results of your code character for character unless we saw how you were populating the Enc structure.
I have a TDBGrid. It works, but the columns shown are very large.
How can I set an "auto-fix column width"?
The needed Columnwidth is depended of the settings of the Grids canvas and the mamimum length of the displaytext of each field.
procedure FitGrid(Grid: TDBGrid);
const
C_Add=3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: Array of Integer;
begin
ds := Grid.DataSource.DataSet;
if Assigned(ds) then
begin
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
while not ds.Eof do
begin
for I := 0 to Grid.Columns.Count - 1 do
begin
if Assigned(Grid.Columns[i].Field) then
begin
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName).DisplayText);
if a[i] < w then
a[i] := w ;
end;
end;
ds.Next;
end;
for I := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := a[i] + C_Add;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
FitGrid(DBgrid1)
end;
Minor modification of bummi's answer to insure that Title Row (Row 0) is not truncated, and excess space will be allocated on each column
procedure FitGrid(Grid: TDBGrid);
const
C_Add = 3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: array of Integer;
begin
ds := Grid.DataSource.DataSet;
if not Assigned(ds) then
exit;
if Grid.Columns.Count = 0 then
exit;
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
for i := 0 to Grid.Columns.Count - 1 do
if Assigned(Grid.Columns[i].Field) then
a[i] := Grid.Canvas.TextWidth(Grid.Columns[i].FieldName);
while not ds.Eof do
begin
for i := 0 to Grid.Columns.Count - 1 do
begin
if not Assigned(Grid.Columns[i].Field) then
continue;
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName).DisplayText);
if a[i] < w then
a[i] := w;
end;
ds.Next;
end;
w := 0;
for i := 0 to Grid.Columns.Count - 1 do
begin
Grid.Columns[i].Width := a[i] + C_Add;
inc(w, a[i] + C_Add);
end;
w := (Grid.ClientWidth - w - 20) div (Grid.Columns.Count);
if w > 0 then
for i := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := Grid.Columns[i].Width + w;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
Minor modification of bummi's answer to insure that Title Row (Row 0) is not truncated
procedure FitGrid(Grid: TDBGrid);
const
C_Add=3;
var
ds: TDataSet;
bm: TBookmark;
i: Integer;
w: Integer;
a: Array of Integer;
begin
ds := Grid.DataSource.DataSet;
if Assigned(ds) then
begin
ds.DisableControls;
bm := ds.GetBookmark;
try
ds.First;
SetLength(a, Grid.Columns.Count);
while not ds.Eof do
begin
for I := 0 to Grid.Columns.Count - 1 do
begin
if Assigned(Grid.Columns[i].Field) then
begin
w := Grid.Canvas.TextWidth(ds.FieldByName(Grid.Columns[i].Field.FieldName.).DisplayText);
if a[i] < w then
a[i] := w ;
end;
end;
ds.Next;
end;
//if fieldwidth is smaller than Row 0 (field names) fix
for I := 0 to Grid.Columns.Count - 1 do
begin
w := Grid.Canvas.TextWidth(Grid.Columns[i].Field.FieldName);
if a[i] < w then
a[i] := w ;
end;
for I := 0 to Grid.Columns.Count - 1 do
Grid.Columns[i].Width := a[i] + C_Add;
ds.GotoBookmark(bm);
finally
ds.FreeBookmark(bm);
ds.EnableControls;
end;
end;
end;
Minor modification of bummi's, TheSteven's and Jens' answers to insure that Title Row (Row 0) is not truncated, and excess space will be allocated on each column, and take visibility of columns into account.
procedure FitGrid(const Grid: TDBGrid; const CoverWhiteSpace: Boolean = True);
const
C_Add=3;
var
DS: TDataSet;
BM: TBookmark;
I, W, VisibleColumnsCount: Integer;
A: array of Integer;
VisibleColumns: array of TColumn;
begin
DS := Grid.DataSource.DataSet;
if Assigned(DS) then
begin
VisibleColumnsCount := 0;
SetLength(VisibleColumns, Grid.Columns.Count);
for I := 0 to Grid.Columns.Count - 1 do
if Assigned(Grid.Columns[I].Field) and (Grid.Columns[I].Visible) then
begin
VisibleColumns[VisibleColumnsCount] := Grid.Columns[I];
Inc(VisibleColumnsCount);
end;
SetLength(VisibleColumns, VisibleColumnsCount);
DS.DisableControls;
BM := DS.GetBookmark;
try
DS.First;
SetLength(A, VisibleColumnsCount);
while not DS.Eof do
begin
for I := 0 to VisibleColumnsCount - 1 do
begin
W := Grid.Canvas.TextWidth(DS.FieldByName(VisibleColumns[I].Field.FieldName).DisplayText);
if A[I] < W then
A[I] := W;
end;
DS.Next;
end;
//if fieldwidth is smaller than Row 0 (field names) fix
for I := 0 to VisibleColumnsCount - 1 do
begin
W := Grid.Canvas.TextWidth(VisibleColumns[I].Field.FieldName);
if A[I] < W then
A[I] := W;
end;
W := 0;
if CoverWhiteSpace then
begin
for I := 0 to VisibleColumnsCount - 1 do
Inc(W, A[I] + C_Add);
W := (Grid.ClientWidth - W - 20) div VisibleColumnsCount;
if W < 0 then
W := 0;
end;
for I := 0 to VisibleColumnsCount - 1 do
VisibleColumns[I].Width := A[I] + C_Add + W;
DS.GotoBookmark(BM);
finally
DS.FreeBookmark(BM);
DS.EnableControls;
end;
end;
end;
I found 'Columns' in the properties of my TDBGrid and new window is opened. In that window I add new FieldNames - you can choose columnNames only from the result of your SQL string of your TADOQuery and then when you click to the exact column you can find 'Width' in the properties of selected column so change it whatever you like. It works for me.
I'm afraid the last adaptation of the code is no correct.
I would rather write something like :
const
C_Add=20;
//.....
Sup := 0;
if CoverWhiteSpace then
sup :=C_Add;
for I := 0 to VisibleColumnsCount - 1 do
VisibleColumns[I].Width := A[I] + sup;
DS.GotoBookmark(BM);
How i can extract the file name from a Download Link using Delphi
Example
http://pj-mirror01.mozilla.org/pub/mozilla.org/firefox/releases/3.6/win32/es-CL/Firefox%20Setup%203.6.exe
The result must be
Firefox Setup 3.6.exe
Try this
function GetURLFilename(const FilePath:String;Const Delimiter:String='/'):String;
var I: Integer;
begin
I := LastDelimiter(Delimiter, FILEPATH);
Result := Copy(FILEPATH, I + 1, MaxInt);
Result := UrlDecode(Result);
end;
URlDecode was copied from http://www.torry.net/dpfl/dzurl.html and looks like
function UrlDecode(const EncodedStr: String): String;
var
I: Integer;
begin
Result := '';
if Length(EncodedStr) > 0 then
begin
I := 1;
while I <= Length(EncodedStr) do
begin
if EncodedStr[I] = '%' then
begin
Result := Result + Chr(HexToInt(EncodedStr[I+1]
+ EncodedStr[I+2]));
I := Succ(Succ(I));
end
else if EncodedStr[I] = '+' then
Result := Result + ' '
else
Result := Result + EncodedStr[I];
I := Succ(I);
end;
end;
end;
function HexToInt(HexStr: String): Int64;
var RetVar : Int64;
i : byte;
begin
HexStr := UpperCase(HexStr);
if HexStr[length(HexStr)] = 'H' then
Delete(HexStr,length(HexStr),1);
RetVar := 0;
for i := 1 to length(HexStr) do begin
RetVar := RetVar shl 4;
if HexStr[i] in ['0'..'9'] then
RetVar := RetVar + (byte(HexStr[i]) - 48)
else
if HexStr[i] in ['A'..'F'] then
RetVar := RetVar + (byte(HexStr[i]) - 55)
else begin
Retvar := 0;
break;
end;
end;
Result := RetVar;
end;