The code below goes through the entire contents of Memo1, and exit when Label2 = Edit1. So far so good, I would like to know how I do so when I click Button1 again after the exit, it continues from the line below Memo1 and not from the beginning again.
procedure TForm1.Button1Click(Sender: TObject);
var i: Integer;
begin
for i := 0 to Memo1.Lines.Count - 1 do
begin
Label2.Caption := Memo1.Lines.Strings[i];
Sleep(2500);
if Trim(Label2.Caption) = (Edit1.Text) then
begin
messageBeep(0);
exit;
end;
end;
Declare a variable in your form class named FCurrentLine of type Integer
Change your loop to read for i := FCurrentLine to ...
When you exit the loop set FCurrentLine := i + 1
Related
Hi I have a menu in which I have a print part for the memo and now I don't know how to when I click that part to run this print code I found.
How to link or possibly insert this part of the
PrintTStrings procedure (Lst: TStrings);
in the part that is the menu of the procedure
TForm1.MenuItemPrintClick (Sender: TObject);
begin
end;
procedure TForm1.MenuItemPrinter(Sender: TObject);
begin
end;
procedure PrintTStrings(Lst : TStrings) ;
var
I,
Line : Integer;
begin
I := 0;
Line := 0 ;
Printer.BeginDoc ;
for I := 0 to Lst.Count - 1 do begin
Printer.Canvas.TextOut(0, Line, Lst[I]);
{Font.Height is calculated as -Font.Size * 72 / Font.PixelsPerInch which returns
a negative number. So Abs() is applied to the Height to make it a non-negative
value}
Line := Line + Abs(Printer.Canvas.Font.Height);
if (Line >= Printer.PageHeight) then
Printer.NewPage;
end;
Printer.EndDoc;
end;
You have to declare the PrintStrings procedure before you can use it. The proper way would be to make PrintTStrings a method of your form by declaring it in the private section of the form declaration:
type
TForm1 = class(TForm)
// Items you've dropped on the form, and methods assigned to event handlers
private
procedure PrintTStrings(Lst: TStrings);
end;
You can then just call it directly from the menu item's OnClick event:
procedure TForm1.MenuItemPrinter(Sender: TObject);
begin
PrintTStrings(PrinterMemo.Lines);
end;
If for some reason you can't make it a form method, you can just rearrange your code:
procedure PrintTStrings(Lst : TStrings) ;
var
I,
Line : Integer;
begin
I := 0;
Line := 0 ;
Printer.BeginDoc ;
for I := 0 to Lst.Count - 1 do begin
Printer.Canvas.TextOut(0, Line, Lst[I]);
{Font.Height is calculated as -Font.Size * 72 / Font.PixelsPerInch which returns
a negative number. So Abs() is applied to the Height to make it a non-negative
value}
Line := Line + Abs(Printer.Canvas.Font.Height);
if (Line >= Printer.PageHeight) then
Printer.NewPage;
end;
Printer.EndDoc;
end;
procedure TForm1.MenuItemPrinter(Sender: TObject);
begin
PrintTStrings(PrinterMemo.Lines);
end;
I am currently doing a school project, I am making a Credit Card machine. I need the 'Enter Button' to
run different code when it is clicked. The first click must get the card number from an edit ps... (I clear the edit once the card number has been retrieved), and the second click must get the pin from the same edit.
How would I do this?
procedure TfrmMainMenu.btbtnEnterClick(Sender: TObject);
var
sCvv,sPin:string;
begin
iCount2:=0;
sCardNumber:=lbledtCardInfo.Text;
if (Length(sCardNumber)<>16) AND (iCount2=0) then
begin
ShowMessage('Card number has to 16 digits,please try again!!');
end
else
begin
Inc(iCount2);
lbledtCardInfo.clear;
lbledtCardInfo.EditLabel.Caption:='Enter Pin' ;
btbtnEnter.Enabled:=false;
end; //if
if iCount2=2 then
begin
btbtnEnter.Enabled:=true;
sPin:=lbledtCardInfo.Text;
ShowMessage(sPin);//returns a blank
end;
You could try to do everything in a single event handler. There are several different ways to handle that. However, a different solution would be to use separate event handlers for each task, and then each task can assign a new handler for the next click to perform, eg:
procedure TfrmMainMenu.FormCreate(Sender: TObject);
begin
// you can set this at design-time if desired...
btbtnEnter.OnClick := GetCCNumber;
end;
procedure TfrmMainMenu.GetCCNumber(Sender: TObject);
begin
sCardNumber := lbledtCardInfo.Text;
if Length(sCardNumber) <> 16 then
begin
ShowMessage('Card number has to 16 digits,please try again!!');
Exit;
end;
lbledtCardInfo.Clear;
lbledtCardInfo.EditLabel.Caption := 'Enter Pin' ;
btbtnEnter.OnClick := GetCCPin;
end;
procedure TfrmMainMenu.GetCCPin(Sender: TObject);
var
sPin: string;
begin
sPin := lbledtCardInfo.Text;
if Length(sPin) <> 4 then
begin
ShowMessage('Card Pin has to 4 digits,please try again!!');
Exit;
end;
ShowMessage(sPin);
...
lbledtCardInfo.Clear;
lbledtCardInfo.EditLabel.Caption := 'Enter Number' ;
btbtnEnter.OnClick := GetCCNumber;
end;
A variation of this would be to create multiple buttons that overlap each other in the UI, and then you can toggle their Visible property back and forth as needed, eg:
procedure TfrmMainMenu.FormCreate(Sender: TObject);
begin
// you can set this at design-time if desired...
btbtnCCPinEnter.Visible := False;
btbtnCCNumEnter.Visible := True;
end;
procedure TfrmMainMenu.btbtnCCNumEnterClick(Sender: TObject);
begin
sCardNumber := lbledtCardInfo.Text;
if Length(sCardNumber) <> 16 then
begin
ShowMessage('Card number has to 16 digits,please try again!!');
Exit;
end;
lbledtCardInfo.Clear;
lbledtCardInfo.EditLabel.Caption := 'Enter Pin' ;
btbtnCCNumEnter.Visible := False;
btbtnCCPinEnter.Visible := True;
end;
procedure TfrmMainMenu.btbtnCCPinEnterClick(Sender: TObject);
var
sPin: string;
begin
sPin := lbledtCardInfo.Text;
if Length(sPin) <> 4 then
begin
ShowMessage('Card Pin has to 4 digits,please try again!!');
Exit;
end;
ShowMessage(sPin);
...
lbledtCardInfo.Clear;
lbledtCardInfo.EditLabel.Caption := 'Enter Number' ;
btbtnCCPinEnter.Visible := False;
btbtnCCNumEnter.Visible := True;
end;
Notice that you test iCount2 = 0 immediately after setting iCount2 := 0. Thus, that test will always be True. Furthermore, the later test iCount2 = 2 will always be False because the value starts at 0 and you only have one Inc in between.
Instead try the following.
Add two string fields FCardNumber and FPin to your form class:
private
FCardNumber: string;
FPin: string;
Also create an enumerated type TEntryStage = (esCardNumber, esPin) and add a field of this type. This will make your code look like this:
private
type
TEntryStage = (esCardNumber, esPin);
var
FCardNumber: string;
FPin: string;
FEntryStage: TEntryStage;
In Delphi, class fields (class member variables) are always initialized, so FEntryStage will be esCardNumber (=TEntryStage(0)) when the form is newly created.
Add a TLabeledEdit (I see you use those) and a TButton; name them eInput and btnNext, respectively. Let the labeled edit's caption be Card number: and the caption of the button be Next.
Now add the following OnClick handler to the button:
procedure TForm1.btnNextClick(Sender: TObject);
begin
case FEntryStage of
esCardNumber:
begin
// Save card number
FCardNumber := eInput.Text;
// Prepare for the next stage
eInput.Clear;
eInput.EditLabel.Caption := 'Pin:';
FEntryStage := esPin;
end;
esPin:
begin
// Save pin
FPin := eInput.Text;
// Just do something with the data
ShowMessageFmt('Card number: %s'#13#10'Pin: %s', [FCardNumber, FPin]);
end;
end;
end;
You might notice that you cannot trigger the Next button using Enter, which is very annoying. To fix this, do
procedure TForm1.eInputEnter(Sender: TObject);
begin
btnNext.Default := True;
end;
procedure TForm1.eInputExit(Sender: TObject);
begin
btnNext.Default := False;
end;
Much better!
I have form with enabled / disabled controls to indicate form is in busy or idle state.
I need to enable only ONE control (a button, but could be else), when it was disabled to abort some process. I change the button caption to 'ABORT'.
I click button A, i change the caption of button A to 'ABORT'. All other control will be disabled, but i want a button with caption 'ABORT' is still enabled.
procedure F1.FormBusy (sender);
var
a: Integer;
begin
for a := 0 to TabSheet1.ControlCount - 1 do
begin
TabSheet1.Controls[a].Enabled := False;
(* if TabSheet1.Controls[a] caption := 'ABORT' then
TabSheet1.Controls[a].Enabled := True
< how to do this ? *)
end;
end;
Usage example :
procedure F1.LB1Click(sender: TObject);
begin
FormBusy(sender);
try
// do something
finally
FormIdle(sender);
end;
end;
Rather than trying to find the button by its Caption property, why not access it directly from the array?
for a := 0 to TabSheet1.ControlCount - 1 do
begin
TabSheet1.Controls[a].Enabled := TabSheet1.Controls[a] = Button1;
end;
Each TControl will be disabled except for Button1 which will be enabled.
You can define another method to assign busy parameter :
procedure F1.MAJIHM(const isBusy : Boolean);
var a: Integer;
begin
for a := 0 to TabSheet1.ControlCount - 1 do
begin
TabSheet1.Controls[a].Enabled := isBusy;
end;
btnABORT.enabled := not isBusy;
end;
procedure F1.FormBusy (sender);
begin
MAJIHM(True);
end;
procedure F1.FormIdle (sender);
begin
MAJIHM(False);
end;
You said:
I click button A, i change the caption of button A to 'ABORT'. All
other control will be disabled, but i want a button with caption
'ABORT' is still enabled.
And from your usage example it is clear that you pass that button to F1.FormBusy() where you can refer to it as the sender parameter:
procedure F1.FormBusy(sender: TObject);
var
a: Integer;
begin
for a := 0 to TabSheet1.ControlCount - 1 do
TabSheet1.Controls[a].Enabled := TabSheet1.Controls[a] = sender;
end;
In the FormIdle() function you simply enable all controls.
I have a function to update a cxGrid made with help from answers to Loop through records on a cxgrid and update a field/column
But it is sometimes acting a bit strange. If I open the form with the cxGrid and click the columnheader without doing anything else, the records are updateted OK. But if the 'selectorbar' is moved away from the top, the record marked is not updated.
I am sure it is a property that needs to be changed, but which one.
The variable fSelected is set to False at FormShow and is ther so that the user can unselect records as well.
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
BookMark : TBookMark;
Contact: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
BookMark := qryContacts.GetBookmark;
qryContacts.DisableControls;
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
Contact := grdContactsView1.DataController.Values[Index, 4];
if grdContactsView1.DataController.LocateByKey(Contact) then
begin
qryContacts.Edit;
qryContacts.FieldByName('fldcontact_selected').AsBoolean := fSelected;
qryContacts.Post;
end;
end;
finally
qryContacts.EnableControls;
qryContacts.GotoBookmark(BookMark);
qryContacts.FreeBookmark(BookMark);
end;
Screen.Cursor := crDefault;
end;
end;
Delphi XE7, DevExpress 14.2.2, UniDAC 5.5.12 for DB access
Comment:
I have ended up with the following solution based on the answer and input from MartynA
procedure TfrmContactsSelect.colContactSelectedHeaderClick(Sender: TObject);
var
i: Integer;
Index: Integer;
MarkedRecord: variant;
CurrentRecord: variant;
begin
if fMulti = True then
begin
Screen.Cursor := crHourGlass;
fSelected := not fSelected;
Index := grdContactsView1.DataController.FocusedRecordIndex;
MarkedRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
try
for i := 0 to grdContactsView1.DataController.FilteredRecordCount - 1 do
begin
Index := grdContactsView1.DataController.FilteredRecordIndex[i];
CurrentRecord := grdContactsView1.DataController.Values[Index, colContactGuid.ID];
if grdContactsView1.DataController.LocateByKey(CurrentRecord) then
begin
grdContactsView1.DataController.Edit;
grdContactsView1.DataController.SetEditValue(colContactSelected.ID, fSelected, evsText);
grdContactsView1.DataController.Post;
end;
end;
finally
grdContactsView1.DataController.LocateByKey(MarkedRecord);
end;
Screen.Cursor := crDefault;
end;
end;
I can reproduce your problem using the sample project I posted in my answer to your other q.
Try this: Add a TMemo to your form, and inside the 'if grdContactsView1.DataController.LocateByKey(Contact) then' block, write the value of a row-unique datafield and the Selected datafield value to the memo.
Then, what I get when some row other than the top row is selected is that one row is listed twice in the memo, with Selected both false and true, and one of the rows in the filter isn't listed at all, which I think accounts for the behaviour you're seeing. If I then comment out the .Edit .. .Post lines, it correctly lists all the rows in the filter.
So evidently doing the Selected field changes inside a block which iterated the FilteredRecordIndex property of the DBTableView is what's causing the problem.
Personally, I find that it goes a bit against the grain to modify dataset rows in code via a DB-aware control (because you usually end up fighting the DB-awareness of the control), but in this case, it's straightforward to do the processing via the DBTableView of the cxGrid.
procedure TForm1.ProcessFilteredRecords;
var
PrevV,
V : Variant;
i,
Index: Integer;
S : String;
begin
// First, pick up a reference to the current record
// so that we can return to it afterwards
Index := cxGrid1DBTableView1.DataController.FocusedRecordIndex;
PrevV := cxGrid1DBTableView1.DataController.Values[Index, 0];
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
cxGrid1DBTableView1.DataController.Edit;
// 2 is the index of my Selected column in the grid
if cxGrid1DBTableView1.DataController.SetEditValue(2, True, evsText) then
Caption := 'OK'
else
Caption := 'Failed';
cxGrid1DBTableView1.DataController.Post;
end;
end;
finally
if cxGrid1DBTableView1.DataController.LocateByKey(PrevV) then
Caption := 'OK'
else
Caption := 'Failed';
end;
end;
Another way to avoid the problem is to change the Selected states in two steps:
Iterate the FilteredRecordIndex to build a list of rows to change - in your case this would be a list of guids
Then, iterate the list of rows and update their Selected states.
Code:
procedure TForm1.ProcessFilteredRecords;
var
V : Variant;
i,
Index: Integer;
BM : TBookMark;
S : String;
TL : TStringList;
begin
Memo1.Lines.Clear;
TL := TStringList.Create;
try
for i := 0 to cxGrid1DBTableView1.DataController.FilteredRecordCount - 1 do begin
Index := cxGrid1DBTableView1.DataController.FilteredRecordIndex[i];
V := cxGrid1DBTableView1.DataController.Values[Index, 0];
if cxGrid1DBTableView1.DataController.LocateByKey(V) then begin
if CDS1.FieldByName('Selected').AsBoolean then
S := 'True'
else
S := 'False';
S := CDS1.FieldByName('Name').AsString + ' ' + S;
Memo1.Lines.Add(S);
TL.Add(CDS1.FieldByName('Guid').AsString);
end;
end;
try
BM := CDS1.GetBookMark;
CDS1.DisableControls;
for i := 0 to TL.Count - 1 do begin
if CDS1.Locate('guid', TL[i], []) then begin
CDS1.Edit;
CDS1.FieldByName('Selected').AsBoolean := True;
CDS1.Post;
end
end;
finally
CDS1.EnableControls;
CDS1.GotoBookmark(BM);
CDS1.FreeBookmark(BM);
end;
finally
TL.Free;
end;
end;
Like you, I was expecting that changing a property or two of the cxGrid might avoid the problem without any code, but I haven't been able to find anything which does.
I have an application that when run at home works fine, however when ran on school computers(Windows XP) i get the following message. (This is recompiling it, not just running the .exe)- In Delphi 2005
First chance exception at $7C81EB33. Exception class EAccessViolation with message 'Access violation at address 0045E5E2 in module 'Project2.exe'. Read of address 00000198'. Process Project2.exe (440)
Code: Ignoring unneeded stuff.
Image1: TImage; // Image(all the way to 72)
Timer1: TTimer; Timer2: TTimer;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure SomeOtherProcedure(Sender: TImage);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
left : integer;
top : integer;
gap : integer;
type
coordinates = record
row : integer ;
col : integer;
end;
var
picarray : array[0..5,0..5] of timage;
thiscover, midcover, lastcover : timage;
imageindex : array[0..5,0..5] of integer;
picloc: array[0..3] of coordinates;
clickcount, pairsfound, attemptcount : integer;
implementation
{$R *.lfm}
procedure initialise();
var
i, j, whichcol, whichrow : integer;
begin
for i := 0 to 5 do
for j := 0 to 5 do
imageindex[i,j] := -1; // not used
randomize;
for i := 0 to 11 do
for j := 1 to 3 do
begin
repeat
begin
whichcol := random(6) ;
whichrow := random(6) ;
end;
until imageindex[whichcol, whichrow] = -1;
picarray[whichcol, whichrow].Picture.LoadFromFile('C:\Users\Hayden\Pictures\'+ inttostr(I+1) +'.jpg');
imageindex[whichcol, whichrow] := I ;
end;
clickcount := 0 ; //
pairsfound := 0 ;
attemptcount := 0 ;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
cpic : tcomponent;
whichcol: integer;
whichrow : integer;
begin
gap := image2.left - image1.left;
top := image1.Top;
left := image1.left;
for cpic in form1 do
begin
if (cpic.ClassType = timage) and (cpic.Tag = 10) then
begin
whichcol := (timage(cpic).left - left) div gap;
whichrow := (timage(cpic).Top - top) div gap;
picarray[whichcol, whichrow] := timage(cpic) ;
end;
end;
initialise;
end;
Line >>> picarray[whichcol, whichrow].Picture.LoadFromFile('C:\Users\Hayden\Pictures\'+ inttostr(I+1) +'.jpg');
seems to cause the error. And if it is a coding error, what is the correct way to do this?
First, I'm going to clean up your code a little, because as it stands, it's very difficult to figure what's going on. I highly recommend you get into the habit of taking a few minutes to keep your code clearly formatted - it will save you hours of debugging.
I've applied only the following simple changes: Indentation, Blank lines, and liberal use of begin .. end;
var
picarray : array[0..5,0..5] of timage;
thiscover, midcover, lastcover : timage;
imageindex : array[0..5,0..5] of integer;
picloc: array[0..3] of coordinates;
clickcount, pairsfound, attemptcount : integer;
implementation
{$R *.lfm}
procedure initialise();
var
i, j, whichcol, whichrow : integer;
begin
for i := 0 to 5 do
begin
for j := 0 to 5 do
begin
//It's clear you're initialising the 36 entries of imageindex to -1
imageindex[i,j] := -1; // not used
end;
end;
randomize;
for i := 0 to 11 do
begin
for j := 1 to 3 do
begin
//This loop also runs 36 times, so it fills the whole of imageindex with new values
//It also loads all 36 entries of picarray with an image specfied by the current value of i
//The approach is dangerous because it depends on the 'loop sizes' matching,
//there are much safer ways of doing this, but it works
repeat
begin //This being one of the only 2 begin..end's you provided inside this is routine is pointless because repeat..until implies it.
whichcol := random(6) ;
whichrow := random(6) ;
end;
until imageindex[whichcol, whichrow] = -1;
//This line itself will throw an access violation if picarray[whichcol, whichrow] doesn't
//contain a valid TImage instance... we have to check other code to confirm that possibility
picarray[whichcol, whichrow].Picture.LoadFromFile('C:\Users\Hayden\Pictures\' + inttostr(I+1) + '.jpg');
imageindex[whichcol, whichrow] := I ;
end;
end;
clickcount := 0 ; //
pairsfound := 0 ;
attemptcount := 0 ;
end;
Moving on to the next piece of code:
procedure TForm1.FormCreate(Sender: TObject);
var
cpic : tcomponent;
whichcol: integer;
whichrow : integer;
begin
gap := image2.left - image1.left;
top := image1.Top;
left := image1.left;
for cpic in form1 do
begin
//This loop attempts to assign existing TImage instances to picarray
//However, the way you're going about it is extremely dangerous and unreliable.
//You're trying to use the position of a component on the form to determine its
//position in the array.
//There are many things that could go wrong here, but since this seems to be a
//homework excercise, I'll just point you in the right direction - you need
//to debug this code.
if (cpic.ClassType = timage) and (cpic.Tag = 10) then
begin
whichcol := (timage(cpic).left - left) div gap;
whichrow := (timage(cpic).Top - top) div gap;
picarray[whichcol, whichrow] := timage(cpic) ;
end;
end;
//Here you call initialise, which as I said before, will
//cause an Access Violation if picarray is not correctly 'set up'
//The previous code in this method certainly has a bug which is
//preventing one or more picarray entries from being assigned a
//valid TImage instance.
//You could write a simple for I := 0 to 5, for J := 0 to 5 loop
//here to check each of picarray entries and pinpoint which is
//incorrect to aid your debugging of the pevious loop.
initialise;
end;
The critical section is the initialization of picarray. You can't be sure that every array element is assigned with a TImage component. If at least one Image has a wrong left or top you have a double assignment to one element and another is left nil. This will result in an Access Violation when you use it for the first time e.g. in picarray[whichcol, whichrow].Picture.LoadFromFile.
I would recommend to redesign the picarray initalization with for loops for every dimension. To get the correct TImage I would name them like 'Image_2_3' and get the instances in the loop by name.
you can check if the file exists and try to catch the exception to display a meaningful message
try
if FileExists('C:\Users\Hayden\Pictures\'+ inttostr(I+1) +'.jpg') then
picarray[whichcol, whichrow].Picture.LoadFromFile('C:\Users\Hayden\Pictures\'+ inttostr(I+1) +'.jpg');
else
ShowMessage("File not found");
except
on E : Exception do
ShowMessage(E.ClassName+' error raised, with message : '+E.Message);
end;