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;
Related
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
In the following tFDMemTable I try to sum value of records whose ID field starting letter A. A1, A2 and the result should be 4.
type
TForm1 = class(TForm)
FDMemTable1: TFDMemTable;
DBGrid1: TDBGrid;
DataSource1: TDataSource;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
_FieldDef: TFieldDef;
begin
_FieldDef := FDMemTable1.FieldDefs.AddFieldDef;
_FieldDef.Name := 'ID';
_FieldDef.DataType := ftString;
_FieldDef.Size := 5;
_FieldDef := FDMemTable1.FieldDefs.AddFieldDef;
_FieldDef.Name :='value';
_FieldDef.DataType := ftInteger;
FDMemTable1.CreateDataSet;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'A1';
FDMemTable1.FieldValues['value'] := 1;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'B1';
FDMemTable1.FieldValues['value'] := 2;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'A2';
FDMemTable1.FieldValues['value'] := 3;
FDMemTable1.Append;
FDMemTable1.FieldValues['ID'] := 'B2';
FDMemTable1.FieldValues['value'] := 4;
end;
I wrote the following code but it changes tDBGrid as filtered. What I want is just an internal process that tDBGrid should stay without any change.
procedure TForm1.Button1Click(Sender: TObject);
var
_ValueSum: Integer;
i: Integer;
begin
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
FDMemTable1.Filtered := True;
_ValueSum := 0;
FDMemTable1.FindFirst;
for i := 0 to FDMemTable1.RecordCount - 1 do
begin
_ValueSum := _ValueSum + FDMemTable1.FieldValues['value'];
FDMemTable1.FindNext;
end;
Button1.Caption := IntToStr(_ValueSum);
end;
I know tDataSet.Locate doesn't allow NEXT SEARCH that I tried a primitive way like this. It works fine but seems a little stupid.
procedure TForm1.Button2Click(Sender: TObject);
var
_ValueSum: Integer;
i: Integer;
begin
_ValueSum := 0;
FDMemTable1.First;
for i := 0 to FDMemTable1.RecordCount do
begin
if Copy(FDMemTable1.FieldValues['ID'], 1, 1) = 'A' then
begin
_ValueSum := _ValueSum + FDMemTable1.FieldValues['value'];
end;
FDMemTable1.FindNext;
end;
Button2.Caption := IntToStr(_ValueSum);
end;
When I disconnect tFDMemTable and tDBGrid or set inactive before filtering to hold the last grid status, the grid changes to blank one. Is the last code the best solution or is there any better way which shows not filtered result while the filtering is working?
There are several things which, if not "wrong", are not quite right with your code.
You should be using Next, not FindNext to move to the next row in the dataset. Next moves to the next row in the dataset, whereas FindNext moves to the next row which matches search criteria you have already set up e.g. using DataSet.SetKey; ... - read the online help for FindKey usage.
You should NOT be trying to traverse the dataset using a For loop; use a While not FDMemData.Eof do loop. Eof stands for 'End of file' and returns true once the dataset is on its last row.
You should be calling FDMemTable1.DisableControls before the loop and FDMemTable1.EnableControls after it. This prevents db-aware controls like your DBGrid from updating inside the loop, which would otherwise slow the loop down as the grid is updating.
Unless you have a very good reason not to, ALWAYS clear a dataset filter in the same method as you set it, otherwise you can get some very confusing errors if you forget the filter is active.
Try to avoid using RecordCount when you don't absolutely need to. Depending on the RDMS you are using, it can cause a lot of avoidable processing overhead on the server and maybe the network (because with some server types it will cause the entire dataset to be retrieved to the client).
Change your first loop to
procedure TForm1.Button1Click(Sender: TObject);
var
_ValueSum : Integer;
begin
_ValueSum := 0;
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
try
FDMemTable1.DisableControls;
FDMemTable1.First;
while not FDMemTable1.Eof do begin
_ValueSum:= _ValueSum + FDMemTable1.FieldByName('Value').AsInteger;
FDMemTable1.Next;
end
finally
FDMemTable1.Filter := '';
FDMemTable1.Filtered := False;
FDMemTable1.EnableControls;
end;
Button1.Caption := IntToStr(_ValueSum);
end;
If you do that, you don't need your Button2Click method at all.
As noted in a comment, you can use a TBookMark to record your position in the dataset before the loop and return to it afterwards, as in
var
_ValueSum : Integer;
BM : TBookMark;
begin
_ValueSum := 0;
BM := FDMemTable.GetBookMark;
FDMemTable1.Filter := 'ID like ' + QuotedStr('A%');
try
[etc]
finally
FDMemTable1.Filter := '';
FDMemTable1.Filtered := False;
FDMemTable1.GotoBookMark(BM);
FDMemTable1.FeeBookMark(BM);
FDMemTable1.EnableControls;
end;
By the way, you can save yourself some typing and get more concise code by using the InsertRecord method as in
FDMemTable1.InsertRecord(['A1', 1]);
FDMemTable1.InsertRecord(['B1', 2]);
FDMemTable1.InsertRecord(['A2', 3]);
FDMemTable1.InsertRecord(['B2', 4]);
Btw#2: The time to use FindKey is after you've set up a key to find, using by calling SetKey than then setting the key value(s).
For ordinary navigation of a dataset, use the standard navigation methods, e.g. Next, Prior, First, Last, MoveBy etc.
FireDAC has another interesting option - Aggregates:
procedure TForm1.Button1Click(Sender: TObject);
begin
FDMemTable1.Aggregates.Clear;
with FDMemTable1.Aggregates.Add do
begin
Name := 'SUM';
Expression := 'sum(iif(ID like ''A%'', value, 0))';
Active := True;
end;
FDMemTable1.AggregatesActive := True;
FDMemTable1.Refresh;
Button1.Caption := VarToStr(FDMemTable1.Aggregates[0].Value));
end;
I need to get the number of displayed lines in TMemo (this include the lines that was wrapped because WordWrap is set to true). I need this to auto adjust the height of the Tmemo to it's content.
lines.count of course don't care about wrapped lines so i can't use it. strangely TextPosToPos also don't care about wrapped lines so i can't use it too ...
I m under firemonkey and delphi Berlin
Edit after I learned about ContentsBounds. My original (and obsolete) answer is still visible in the revisions.
Why do you need the number of displayed lines to adjust the height of the TMemo? This resizes the TMemo to its content:
Memo1.Height := Memo1.ContentBounds.Height + 5; // Small const to allow for rendering margins
It also takes word-wrap into consideration.
I don't know why using ContentBounds is "not really ideal". Here's how I do it:
uses
FMX.TextLayout, FMX.Graphics;
function MeasureTextHeight(const AFont: TFont; const AText: string): Single;
var
LLayout: TTextLayout;
begin
LLayout := TTextLayoutManager.DefaultTextLayout.Create;
try
LLayout.BeginUpdate;
try
LLayout.WordWrap := False;
LLayout.Font.Assign(AFont);
LLayout.Text := AText;
finally
LLayout.EndUpdate;
end;
Result := LLayout.TextHeight;
finally
LLayout.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
LTextHeight: Single;
LLines: Integer;
begin
LTextHeight := MeasureTextHeight(Memo1.TextSettings.Font, Memo1.Text);
LLines := Round(Memo1.ContentBounds.Height / LTextHeight);
end;
This is the rough way i use to calculate the number of lines an TMemo (styled) under firemonkey :
type
_TStyledMemoProtectedAccess = class(TStyledMemo);
procedure TALStyledMemo.OnApplyStyleLookupImpl(sender: Tobject);
Var I, j, k, l: integer;
begin
// TALStyledMemo
// TStyledMemo
// TLayout
// TActiveStyleObject
// TLayout
// TScrollBar
// TScrollBar
// TLayout
// TSmallScrollBar
// TSmallScrollBar
// TScrollContent
for I := 0 to controls.Count - 1 do begin
if (controls[i] is TStyledMemo) then begin // << TStyledMemo
fStyledMemo := TStyledMemo(controls[i]);
end;
end;
end;
function TALStyledMemo.getLineHeight: Single;
begin
if fStyledMemo <> nil then result := _TStyledMemoProtectedAccess(fStyledMemo).GetLineHeight
else result := 0;
end;
function TALStyledMemo.getLineCount: integer;
var aLineHeight: Single;
begin
aLineHeight := getLineHeight;
if compareValue(aLineHeight, 0, Tepsilon.Position) > 0 then result := round(ContentBounds.Height / aLineHeight)
else result := 0;
end;
Im going through one of my old exam papers, preparing for my finals, and for the love of life, I cant figure out how to do this!
The program was working earlier, but it wasn't sorting the array. Now Im getting an error saying EAccess violation with message: access violation at address 00404BDE
Here's my code (its kind of long, maybe you can help me spot my error) :
private
{ Private declarations }
iCount : Integer;
arrDams : array [1..200] of string;
Procedure List;
procedure Display;
procedure Sort;
procedure Search (sDam : String);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Display; //Display with Numbers
var
k : Integer;
begin
for K := 1 to 200 do
begin
RedOut.Lines.Add (IntToStr(k) + '.) ' + (arrDams[k]));
end;
end;
procedure TForm1.FormCreate(Sender: TObject); // Create
begin
//
end;
procedure TForm1.List; // TextFile to array
var
MyFile : TextFile;
k : Integer;
begin
If FileExists('Dams.txt') <> True
then Application.Terminate;
AssignFile (MyFile, 'Dams.txt');
Reset(MyFile);
For K := 1 to 200 do
begin
Readln(MyFile, arrDams[k])
end;
end;
procedure TForm1.Search(sDam: String); // Search
begin
end;
procedure TForm1.Sort; // Sort;
var
K,L : byte;
sKeep : string;
begin
for k := 1 to iCount -1 do
begin
for l := k + 1 to iCount do
begin
if arrDams[k] > arrDams[L] then
begin
sKeep := arrDams[k];
arrDams[k] := arrDams[L];
arrDams[L] := sKeep
end;
end;
end;
end;
procedure TForm1.btnListClick(Sender: TObject);
begin
List;
Display;
end;
procedure TForm1.btnDisplayClick(Sender: TObject);
begin
display;
sort;
end; //<---------- ERROR OVER HERE!
end.
Theres 3 buttons at the top of the form, namely Show list, Make new textfile with list and Sort list alphabetically. The button Im working on is to sort the list. This question paper says I must make a sort procedure and must be called when the Sort Button is clicked.
Thanks for any advice/help
P.S.
Can you please point me to a link where they explain Selection Sorting in depth - the logic isn't with me on this..
You don't initialize iCount. So it is 0. Therefore iCount-1 is -1. However, you use Byte, an unsigned type, for your loop variable. Now, -1 when interpreted as an unsigned Byte is 255. If you follow this all through it means that you access the array out of bounds. In fact what happens is that the inner loop executes exactly once with a value of l equal to 0 and k equal to 255.
Were you to enable the range checking compiler option, you would have encountered a runtime error as soon as you run off the end of the array.
Presumably you want to initialize iCount to some value. I cannot tell what, but you will know.
Beyond that, stop using unsigned types for loop variables. Replace Byte with Integer.
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;