I am refactoring an old application to make it a bit more responsive and I have a form that is using devExpress components and it creates a custom grid using the CallbackCustomDrawPreviewCell, the problem is that this function is very slow it takes about 0.09s per call but it is call about 30 to 60 times each time the form is open so the form can take 2.8s to 5.6s to open.
I normally program with C# and Object-C/Swift where we can dispatch a block to be process in the background, but as far as my research go we don't have nothing similar in Delphi, it seems that normally in Delphi a new thread has to be a whole new and independent piece of code. Is my assumptions correct?
If so what is the best type of solution to improve speed in this kind of situation? (I am using Delphi XE)
(in case it helps: I also just bought AQTime to try help me figure out how to improve this but I had no luck so far with it, still need to dig into the manuals a little more. But it did help me find the problem in the speed in this particular callback)
Thanks in advance.
The function is:
procedure TtvdAvaOutageManagementForm.CallbackCustomDrawPreviewCell(Sender: TcxCustomTreeList; ACanvas: TcxCanvas;
AViewInfo: TcxTreeListEditCellViewInfo; var ADone: Boolean);
const
AlignFlag = DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX or DT_END_ELLIPSIS;
cnFontColor = clBlue;
var
AFaultId: variant;
aFault: TtvdFault;
aLocalities, aFaultLocalities: TStringList;
i: integer;
aLocality: string;
Rect: TRect;
size: TSize;
AText: string;
begin
{ colour the preview text blue }
ACanvas.Font.Color := cnFontColor;
AText := AViewInfo.DisplayValue;
aLocalities := TStringList.Create;
aFaultLocalities := TStringList.Create;
try
AFaultId := AViewInfo.Node.Values[FtvdTree.GetColumnByFieldName('FaultId').ItemIndex];
if (not VarIsNull(AFaultId)) then
begin
ACanvas.Brush.Color := COLOR_FAULT;
aFault := FtvdFaults.tvdGetFault(AFaultId);
if Assigned(aFault) then
begin
ACanvas.Brush.Color := aFault.tvdFaultColor;
ACanvas.Brush.Color := aFault.tvdFaultColor;
ACanvas.FillRect(AViewInfo.BoundsRect);
CopyRect(Rect, AViewInfo.BoundsRect);
InflateRect(Rect, -1, -1);
Inc(Rect.Left, FtvdTree.OptionsView.IndicatorWidth);
ACanvas.Font.Color := cnFontColor;
{ if all the localities are in the fault then bold the preview text,
else need to do it manually (i.e. only bold the localities that are
in the fault }
if aFault.tvdAllLocalities then
begin
ACanvas.Font.Style := [fsBold];
ACanvas.DrawTexT(AText, AViewInfo.BoundsRect, AlignFlag);
end
else
begin
CopyRect(Rect, AViewInfo.BoundsRect);
aLocalities.Text := StringReplace(AText, ', ', #13#10, [rfReplaceAll]);
aFaultLocalities.Text := StringReplace(aFault.tvdLocalities, ', ', #13#10, [rfReplaceAll]);
for i := 0 to aLocalities.Count - 1 do
begin
ACanvas.Font.Style := [];
{ draw a comma if this is not the first locality }
if i > 0 then
begin
size := ACanvas.TextExtent(',');
DrawText(ACanvas.Handle, ',', 1, Rect, DT_LEFT or DT_NOPREFIX);
Inc(Rect.Left, size.cx);
end;
aLocality := aLocalities[i];
if aFaultLocalities.IndexOf(aLocality) >= 0 then
begin
ACanvas.Font.Style := [fsBold];
end;
size := ACanvas.TextExtent(aLocality);
if (Rect.Left + size.cx) > Rect.Right then
begin
Rect.Left := AViewInfo.BoundsRect.Left;
Inc(Rect.Top, size.cy);
end;
{ draw the text item }
DrawText(ACanvas.Handle, pchar(aLocality), Length(aLocality), Rect, DT_LEFT or DT_NOPREFIX);
Inc(Rect.Left, size.cx);
end;
end;
ADone := true;
end;
end;
finally
aLocalities.Free;
aFaultLocalities.Free;
end;
end;
If you sum up my comments then it should be more or less this.
Try that at let us know how it worked out for you. Since I don't have a working example it might not be 100% correct.
procedure TtvdAvaOutageManagementForm.CallbackCustomDrawPreviewCell(Sender: TcxCustomTreeList; ACanvas: TcxCanvas;
AViewInfo: TcxTreeListEditCellViewInfo; var ADone: Boolean);
const
AlignFlag = DT_LEFT or DT_WORDBREAK or DT_EXPANDTABS or DT_NOPREFIX or DT_END_ELLIPSIS;
cnFontColor = clBlue;
var
AFaultId: variant;
aFault: TtvdFault;
aLocalities, aFaultLocalities: TStringList;
i: integer;
aLocality: string;
Rect: TRect;
size: TSize;
AText: string;
begin
{ colour the preview text blue }
ACanvas.Font.Color := cnFontColor;
AText := AViewInfo.DisplayValue;
aLocalities := TStringList.Create;
aFaultLocalities := TStringList.Create;
try
AFaultId := AViewInfo.Node.Values[FaultIdColumn.ItemIndex];
if not VarIsNull(AFaultId) then
begin
ACanvas.Brush.Color := COLOR_FAULT;
aFault := FtvdFaults.tvdGetFault(AFaultId);
if Assigned(aFault) then
begin
ACanvas.Brush.Color := aFault.tvdFaultColor;
ACanvas.Brush.Color := aFault.tvdFaultColor;
ACanvas.FillRect(AViewInfo.BoundsRect);
CopyRect(Rect, AViewInfo.BoundsRect);
InflateRect(Rect, -1, -1);
Inc(Rect.Left, FtvdTree.OptionsView.IndicatorWidth);
ACanvas.Font.Color := cnFontColor;
{ if all the localities are in the fault then bold the preview text,
else need to do it manually (i.e. only bold the localities that are
in the fault }
if aFault.tvdAllLocalities then
begin
ACanvas.Font.Style := [fsBold];
ACanvas.DrawTexT(AText, AViewInfo.BoundsRect, AlignFlag);
end
else
begin
CopyRect(Rect, AViewInfo.BoundsRect);
aLocalities.CommaText:= AText;
aFaultLocalities.CommaText := aFault.tvdLocalities;
aFaultLocalities.Sorted := True;
for i := 0 to aLocalities.Count - 1 do
begin
ACanvas.Font.Style := [];
{ draw a comma if this is not the first locality }
if i > 0 then
begin
size := ACanvas.TextExtent(',');
DrawText(ACanvas.Handle, ', ', 1, Rect, DT_LEFT or DT_NOPREFIX);
Inc(Rect.Left, size.cx);
end;
aLocality := aLocalities[i];
if aFaultLocalities.IndexOf(aLocality) >= 0 then
begin
ACanvas.Font.Style := [fsBold];
end;
size := ACanvas.TextExtent(aLocality);
if (Rect.Left + size.cx) > Rect.Right then
begin
Rect.Left := AViewInfo.BoundsRect.Left;
Inc(Rect.Top, size.cy);
end;
{ draw the text item }
DrawText(ACanvas.Handle, pchar(aLocality), Length(aLocality), Rect, DT_LEFT or DT_NOPREFIX);
Inc(Rect.Left, size.cx);
end;
end;
ADone := true;
end;
end;
finally
aLocalities.Free;
aFaultLocalities.Free;
end;
end;
Related
I got a code from List all physical printers using WMI query in Inno Setup and I want to add the results to a list box. I have tried to do it before asking, but I just can't add all items. This is an my code:
var
Query, AllPrinters: string;
WbemLocator, WbemServices, WbemObjectSet: Variant;
Printer: Variant;
I: Integer;
begin
WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
WbemServices := WbemLocator.ConnectServer('.', 'root\CIMV2');
Query := 'SELECT Name FROM Win32_Printer';
WbemObjectSet := WbemServices.ExecQuery(Query);
if not VarIsNull(WbemObjectSet) and (WbemObjectSet.Count > 0) then
begin
for I := 0 to WbemObjectSet.Count - 1 do
begin
Printer := WbemObjectSet.ItemIndex(I);
if not VarIsNull(Printer) then
begin
Log(Printer.Name);
AllPrinters := Printer.Name;
end;
end;
end;
end;
Then on a custom page do this:
ListBoxPrinters.Items.Add(AllPrinters);
You add the items (printers) to the list box the same way, the original code adds them to the log: in the loop!
for I := 0 to WbemObjectSet.Count - 1 do
begin
Printer := WbemObjectSet.ItemIndex(I);
if not VarIsNull(Printer) then
begin
ListBoxPrinters.Items.Add(Printer.Name);
end;
end;
Of course, you have to create the custom page with the ListBoxPrinters before iterating the printers.
If you cannot run the query after creating the page for whatever reason, you can store a printer list into TStringList.
var
Printers: TStringList;
Printers := TStringList.Create;
for I := 0 to WbemObjectSet.Count - 1 do
begin
Printer := WbemObjectSet.ItemIndex(I);
if not VarIsNull(Printer) then
begin
Printers.Add(Printer.Name);
end;
end;
And once you have the list box ready, you just copy the list over to the box:
ListBoxPrinters.Items.Assign(Printers);
You overwrite always with the next AllPrinters := Printer.Name; the previous value !
simple build the AllPrinters string like that
....
AllPrinters := '';
....
for I := 0 to WbemObjectSet.Count - 1 do
begin
Printer := WbemObjectSet.ItemIndex(I);
if not VarIsNull(Printer) then
begin
Log(Printer.Name);
AllPrinters := AllPrinters + Printer.Name + #13#10;
end;
end;
end;
and
ListBoxPrinters.Items.Text := AllPrinters;
i have a text file and 10 StringLists, i want to open the txt files in the 10 StringLists, for example the text file has 1000 line, i want the first 100 line in StringList1 and the second 100 in StringLists2 and so on, my idea is to get text file lines count and divide it by 10 then copy each 100 in the 10 StringLists
var
i, x :integer;
U : TStrings;
DatFile ,ExePath:string;
begin
U := TStringList.Create;
ExePath := ExtractFilePath(Application.ExeName);
DatFile := ExePath + 'Test.txt';
U.LoadFromFile(DatFile);
x := U.Count Div 10;
Edit1.Text := IntToStr(x);
/// Stoped here
end;
how to continue this?
You can use an array to hold the Memo pointers, and then loop through the lines of the file, calculating which array index to add each line to, eg:
var
i, LinesPerMemo, LinesAdded: integer;
U : TStrings;
DatFile: string;
Memos: array[0..9] of TMemo;
CurMemo: TMemo;
begin
Memos[0] := Memo1;
Memos[1] := Memo2;
Memos[2] := Memo3;
Memos[3] := Memo4;
Memos[4] := Memo5;
Memos[5] := Memo6;
Memos[6] := Memo7;
Memos[7] := Memo8;
Memos[8] := Memo9;
Memos[9] := Memo10;
DatFile := ExtractFilePath(Application.ExeName) + 'Test.txt';
U := TStringList.Create;
try
U.LoadFromFile(DatFile);
LinesPerMemo := U.Count div 10;
if (U.Count mod 10) <> 0 then
Inc(LinesPerMemo);
Edit1.Text := IntToStr(LinesPerMemo);
J := 0;
CurMemo := Memos[J];
try
LinesAdded := 0;
for I := 0 to U.Count-1 do
begin
CurMemo.Lines.Add(U[I]);
Inc(LinesAdded);
if (LinesAdded = LinesPerMemo) and (J < 9) then
begin
CurMemo.Lines.EndUpdate;
Inc(J);
CurMemo := Memos[J];
CurMemo.Lines.BeginUpdate;
LinesAdded := 0;
end;
finally
CurMemo.Lines.EndUpdate;
end;
end;
finally
U.Free;
end;
end;
Alternatively, use a temp TStringList to collect the lines for each Memo:
var
i, LinesPerMemo: integer;
U, Lines : TStrings;
DatFile: string;
Memos: array[0..9] of TMemo;
begin
Memos[0] := Memo1;
Memos[1] := Memo2;
Memos[2] := Memo3;
Memos[3] := Memo4;
Memos[4] := Memo5;
Memos[5] := Memo6;
Memos[6] := Memo7;
Memos[7] := Memo8;
Memos[8] := Memo9;
Memos[9] := Memo10;
DatFile := ExtractFilePath(Application.ExeName) + 'Test.txt';
U := TStringList.Create;
try
U.LoadFromFile(DatFile);
LinesPerMemo := U.Count div 10;
if (U.Count mod 10) <> 0 then
Inc(LinesPerMemo);
Edit1.Text := IntToStr(LinesPerMemo);
Lines := TStringList.Create;
try
J := 0;
for I := 0 to U.Count-1 do
begin
Lines.Add(U[I]);
if (Lines.Count = LinesPerMemo) and (J < 9) then
begin
Memos[J].Lines.Assign(Lines);
Inc(J);
Lines.Clear;
end;
end;
Memos[J].Lines.Assign(Lines);
finally
Lines.Free;
end;
finally
U.Free;
end;
end;
To speed up, you can use Texfile and Tstringstream with creating Tmemo if needed.
type
TForm1 = class(TForm)
Button1: TButton;
ScrollBox1: TScrollBox;
procedure Button1Click(Sender: TObject);
private
{ Déclarations privées }
function getNewMemo(const aStream : Tstream) : TMemo;
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
const nblines : Integer = 100;
var F : TextFile;
sLine, sfile : string;
cpt : Integer;
Memo : TMemo;
tmp : TStringStream;
begin
sfile := 'C:\TEMP\Test.txt';
tmp := TStringStream.Create;
AssignFile(F, sFile);
Reset(F);
try
LockWindowUpdate(ScrollBox1.Handle);
cpt := 0;
while not Eof(F) do begin
Readln(F, sLine);
Inc(cpt);
tmp.WriteString(sLine + #13);
if (cpt mod nbLines = 0) then begin
Memo := getNewMemo(tmp);
tmp.Clear;
end;
end;
if tmp.Size > 0 then begin
Memo := getNewMemo(tmp);
tmp.Clear;
end;
finally
CloseFile(F);
tmp.Free;
LockWindowUpdate(0);
end;
end;
function TForm1.getNewMemo(const aStream : Tstream): TMemo;
begin
Result := TMemo.Create(ScrollBox1);
Result.Parent := ScrollBox1;
Result.Top := High(integer);
Result.Align := alTop;
Result.Height := 150;
Result.ScrollBars := ssBoth;
if aStream <> nil then begin
aStream.Seek(0, soFromBeginning);
Result.Lines.LoadFromStream(aStream);
end;
end;
end.
I am trying to use multithreading in Delphi XE.
The task is following I have to create 4 threads. Each thread draw colored circle in Paintbox at predefined area, For example FIRST thread draw only red circles in first quoter of the Paintbox, the SECOND thread draw only yellow circles in the second quoter, and so on.
I have defined following class
const
NumberOfIterations = 100000;
NumberOfTreads = 4;
TCalcThread = class(TThread)
private
FIdx: Integer;
FHits: Cardinal;
V: array of Integer;
xPaintBox1: TPaintBox;
protected
procedure Execute; override;
public
constructor Create(Idx: Integer; vPaintBox: TPaintBox);
property Hits: Cardinal read FHits;
end;
In main code I do the following:
procedure TForm11.Button1Click(Sender: TObject);
var
thrarr: array[0..NumberOfTreads - 1] of TCalcThread;
hndarr: array[0..NumberOfTreads - 1] of THandle;
i, a, t: Integer;
x, y: Integer;
begin
caption := '';
PaintBox1.Canvas.Brush.Color := clWhite;
PaintBox1.Canvas.fillrect(PaintBox1.Canvas.ClipRect);
for i := 0 to NumberOfTreads - 1 do
begin
thrarr[i] := TCalcThread.Create(i, PaintBox1);
hndarr[i] := thrarr[i].Handle;
end;
WaitForMultipleObjects(NumberOfTreads, #hndarr, True, INFINITE);
for i := 0 to NumberOfTreads - 1 do
thrarr[i].Free;
end;
The thread Create and Execute methods are defined as following:
constructor TCalcThread.Create(Idx: Integer; vPaintBox: TPaintBox);
begin
FIdx := Idx;
FHits := 0;
xPaintBox1 := vPaintBox;
case FIdx of
0: xPaintBox1.Canvas.Pen.Color := clRed;
1: xPaintBox1.Canvas.Pen.Color := clYellow;
2: xPaintBox1.Canvas.Pen.Color := clBlue;
3: xPaintBox1.Canvas.Pen.Color := clMoneyGreen;
end;
xPaintBox1.Canvas.Brush.Color := xPaintBox1.Canvas.Pen.Color;
inherited Create(False);
end;
procedure TCalcThread.Execute;
var
i, start, finish: Integer;
x, y: Integer;
begin
start := (NumberOfIterations div NumberOfTreads) * FIdx;
finish := start + (NumberOfIterations div NumberOfTreads) - 1;
for i := start to finish do
begin
case FIdx of
0: begin
x := Random(200) + 1;
end;
1: begin
x := Random(200) + 201;
end;
2: begin
x := Random(200) + 401;
end;
3: begin
x := Random(200) + 601;
end;
end;
y := Random((xPaintBox1.height )) + 1;
xPaintBox1.Canvas.Ellipse(X - 5, Y - 5, X + 5, Y + 5);
end;
end;
As a result I am getting a few circles in three areas with the same color, and a lot of circles in one area (the same color). What I am doing wrong?
I wanted to know if anyone ones a way that I can export data from a DBGrid to Excel ? I am using Delphi 7 , Excel 2007 and ADO .
Any help will be appreciated.
If you want a fast export of raw data, just export your recordset (ADODataset.recordset) with something like that:
procedure ExportRecordsetToMSExcel(DestName: string; Data: _Recordset);
var
ovExcelApp: OleVariant;
ovExcelWorkbook: OleVariant;
ovWS: OleVariant;
ovRange: OleVariant;
begin
ovExcelApp := CreateOleObject('Excel.Application'); //If Excel isnt installed will raise an exception
try
ovExcelWorkbook := ovExcelApp.WorkBooks.Add;
ovWS := ovExcelWorkbook.Worksheets.Item[1]; // go to first worksheet
ovWS.Activate;
ovWS.Select;
ovRange := ovWS.Range['A1', 'A1']; //go to first cell
ovRange.Resize[Data.RecordCount, Data.Fields.Count];
ovRange.CopyFromRecordset(Data, Data.RecordCount, Data.Fields.Count); //this copy the entire recordset to the selected range in excel
ovWS.SaveAs(DestName, 1, '', '', False, False);
finally
ovExcelWorkbook.Close(SaveChanges := False);
ovWS := Unassigned;
ovExcelWorkbook := Unassigned;
ovExcelApp := Unassigned;
end;
end;
It is working by using Tfilestream component
procedure TForm2.ExportdatatoexcelClick(Sender: TObject);
var
Stream: TFileStream;
i: Integer;
OutLine,f: string;
sTemp,s: string;
begin
Stream := TFileStream.Create('D:\Yogesh Delphi\employee1.csv', fmCreate);
try
s := string(adotable1.Fields[0].FieldName);
for I := 1 to adotable1.FieldCount - 1 do
begin
s:= s+ ',' + string(adotable1.Fields[I].FieldName);
end;
s:= s+ #13#10;
stream.Write(s[1], Length(s) * SizeOf(Char));
{S := '';
for I := 0 to adotable1.FieldCount - 1 do
begin
S := (adotable1.Fields[I].FieldName);
outline := OutLine+S + ' ,';
end; }
while not adotable1.Eof do
begin
// You'll need to add your special handling here where OutLine is built
s:='';
OutLine := '';
for i := 0 to adotable1.FieldCount - 1 do
begin
sTemp := adotable1.Fields[i].AsString;
// Special handling to sTemp here
OutLine := OutLine + sTemp +',';
end;
// Remove final unnecessary ','
SetLength(OutLine, Length(OutLine) - 1);
// Write line to file
Stream.Write(OutLine[1], Length(OutLine) * SizeOf(Char));
// Write line ending
Stream.Write(sLineBreak, Length(sLineBreak));
adotable1.Next;
end;
finally
Stream.Free; // Saves the file
end;
showmessage('Records Successfully Exported.') ;
end;
{Yog}
How to create CustomPage in Inno Setup with Edit Boxes for Serial Number?
E.g. 6x5chars or 7x5chars?
Script should check if all boxes are filled before Next button become available.
It would be also good if there could be Copy/Paste function implemented that would allow to fill up all Edit Boxes if the clipboard content matches the serial number pattern.
Here is one approach that uses the custom page where the separate edit boxes are created. You only need to specify the value for the SC_EDITCOUNT constant where the number of edit boxes is defined and the SC_CHARCOUNT what is the number of characters that can be entered into these edit boxes. If you are in the first edit box you may paste the whole serial number if it's in the format by the pattern delimited by the - char (the TryPasteSerialNumber function here). To get the serial number from the edit boxes it's enough to call GetSerialNumber where you can specify also a delimiter for the output format (if needed).
[Setup]
AppName=Serial number project
AppVersion=1.0
DefaultDirName={pf}\Serial number project
[code]
function SetFocus(hWnd: HWND): HWND;
external 'SetFocus#user32.dll stdcall';
function OpenClipboard(hWndNewOwner: HWND): BOOL;
external 'OpenClipboard#user32.dll stdcall';
function GetClipboardData(uFormat: UINT): THandle;
external 'GetClipboardData#user32.dll stdcall';
function CloseClipboard: BOOL;
external 'CloseClipboard#user32.dll stdcall';
function GlobalLock(hMem: THandle): PAnsiChar;
external 'GlobalLock#kernel32.dll stdcall';
function GlobalUnlock(hMem: THandle): BOOL;
external 'GlobalUnlock#kernel32.dll stdcall';
var
SerialPage: TWizardPage;
SerialEdits: array of TEdit;
const
CF_TEXT = 1;
VK_BACK = 8;
SC_EDITCOUNT = 6;
SC_CHARCOUNT = 5;
SC_DELIMITER = '-';
function IsValidInput: Boolean;
var
I: Integer;
begin
Result := True;
for I := 0 to GetArrayLength(SerialEdits) - 1 do
if Length(SerialEdits[I].Text) < SC_CHARCOUNT then
begin
Result := False;
Break;
end;
end;
function GetClipboardText: string;
var
Data: THandle;
begin
Result := '';
if OpenClipboard(0) then
try
Data := GetClipboardData(CF_TEXT);
if Data <> 0 then
Result := String(GlobalLock(Data));
finally
if Data <> 0 then
GlobalUnlock(Data);
CloseClipboard;
end;
end;
function GetSerialNumber(ADelimiter: Char): string;
var
I: Integer;
begin
Result := '';
for I := 0 to GetArrayLength(SerialEdits) - 1 do
Result := Result + SerialEdits[I].Text + ADelimiter;
Delete(Result, Length(Result), 1);
end;
function TrySetSerialNumber(const ASerialNumber: string; ADelimiter: Char): Boolean;
var
I: Integer;
J: Integer;
begin
Result := False;
if Length(ASerialNumber) = ((SC_EDITCOUNT * SC_CHARCOUNT) + (SC_EDITCOUNT - 1)) then
begin
for I := 1 to SC_EDITCOUNT - 1 do
if ASerialNumber[(I * SC_CHARCOUNT) + I] <> ADelimiter then
Exit;
for I := 0 to GetArrayLength(SerialEdits) - 1 do
begin
J := (I * SC_CHARCOUNT) + I + 1;
SerialEdits[I].Text := Copy(ASerialNumber, J, SC_CHARCOUNT);
end;
Result := True;
end;
end;
function TryPasteSerialNumber: Boolean;
begin
Result := TrySetSerialNumber(GetClipboardText, SC_DELIMITER);
end;
procedure OnSerialEditChange(Sender: TObject);
begin
WizardForm.NextButton.Enabled := IsValidInput;
end;
procedure OnSerialEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Edit: TEdit;
EditIndex: Integer;
begin
Edit := TEdit(Sender);
EditIndex := Edit.TabOrder - SerialEdits[0].TabOrder;
if (EditIndex = 0) and (Key = Ord('V')) and (Shift = [ssCtrl]) then
begin
if TryPasteSerialNumber then
Key := 0;
end
else
if (Key >= 32) and (Key <= 255) then
begin
if Length(Edit.Text) = SC_CHARCOUNT - 1 then
begin
if EditIndex < GetArrayLength(SerialEdits) - 1 then
SetFocus(SerialEdits[EditIndex + 1].Handle)
else
SetFocus(WizardForm.NextButton.Handle);
end;
end
else
if Key = VK_BACK then
if (EditIndex > 0) and (Edit.Text = '') and (Edit.SelStart = 0) then
SetFocus(SerialEdits[EditIndex - 1].Handle);
end;
procedure CreateSerialNumberPage;
var
I: Integer;
Edit: TEdit;
DescLabel: TLabel;
EditWidth: Integer;
begin
SerialPage := CreateCustomPage(wpWelcome, 'Serial number validation',
'Enter the valid serial number');
DescLabel := TLabel.Create(SerialPage);
DescLabel.Top := 16;
DescLabel.Left := 0;
DescLabel.Parent := SerialPage.Surface;
DescLabel.Caption := 'Enter valid serial number and continue the installation...';
DescLabel.Font.Style := [fsBold];
SetArrayLength(SerialEdits, SC_EDITCOUNT);
EditWidth := (SerialPage.SurfaceWidth - ((SC_EDITCOUNT - 1) * 8)) div SC_EDITCOUNT;
for I := 0 to SC_EDITCOUNT - 1 do
begin
Edit := TEdit.Create(SerialPage);
Edit.Top := 40;
Edit.Left := I * (EditWidth + 8);
Edit.Width := EditWidth;
Edit.CharCase := ecUpperCase;
Edit.MaxLength := SC_CHARCOUNT;
Edit.Parent := SerialPage.Surface;
Edit.OnChange := #OnSerialEditChange;
Edit.OnKeyDown := #OnSerialEditKeyDown;
SerialEdits[I] := Edit;
end;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = SerialPage.ID then
WizardForm.NextButton.Enabled := IsValidInput;
end;
procedure InitializeWizard;
begin
CreateSerialNumberPage;
end;
And here is how it looks like:
You can make Inno prompt the user for a serial key by adding an CheckSerial() event function.
If you want more control over the page, you can use one of the stock pages (CreateInput...Page) or a custom page in the setup wizard using CreateCustomPage() and adding controls as you require.
See the codedlg.iss example included with Inno setup.
The simplest way to add a Serial key box, beneath the Name and Organisation text fields, is to add something like the following to your iss file.
[Code]
function CheckSerial(Serial: String): Boolean;
begin
// serial format is XXXX-XXXX-XXXX-XXXX
Serial := Trim(Serial);
if Length(Serial) = 19 then
result := true;
end;
This can be usefully combined with
[Setup]
DefaultUserInfoSerial={param:Serial}
which will fill in the serial if previously entered for the install.