how to fixed a number of dynamic buttons in 1 row? - delphi

i have create 7 dynamic buttons in a scroll box. Each row need to have 2 buttons (number of buttons may change) only, but the result of the code below shows the first row with 2 buttons but all the rest in 2nd row, how should i fixed it to 2 buttons 1 row?
procedure TForm1.CreateDynamicBtn2;
var
abtn: TBitBtn;
i, j, iNum, iCount : integer;
begin
if ScrollBox2.ControlCount > 0 then begin
for j := ScrollBox2.ControlCount - 1 downto 0 do begin
with ScrollBox2.Controls[j] AS TBitBtn do begin
Free;
end;
end;
end;
iCount := 0;
for i := 0 to 6 do begin
iNum := i + 1;
abtn := TBitBtn.Create(self);
abtn.Parent := ScrollBox2;
abtn.Visible := True;
abtn.Caption := 'dynamic' + IntToStr(i);
if iNum*abtn.Width > (iCount+2)*abtn.Width then begin
iCount := iCount + 1;
abtn.Left := (iCount * abtn.Width) - abtn.Width;
abtn.Top := abtn.Height;
end else begin
abtn.Left := i * abtn.Width;
abtn.Top := 0;
end;
end;
end;

Because you are making things way too complicated?
abtn.Left := (i mod 2) * abtn.Width;
abtn.Top := Trunc((i div 2)) * abtn.Height;
Should do the trick nicely.

Related

creating a pause menu in delphi

Background: I have created a maze game that is playable, however when the maze gets bigger there are more chances to go wrong and takes ages to reach the start of the maze again, I've been told that's really annoying.
Question: I want to create a pause game function that when the user presses the button key a menu pops up that allows the user to be able to either return to main menu or restart the maze.
I have very little knowledge on where to start this in the code as I don't want to mess up anything that has already been added.
I've added the draw maze //creates the maze,
initialise visited and walk // removes the walls of the maze,
Form key down//moves the player
and Timer//collision detection procedures below.
hopefully someone can help?
Many Thanks.
`procedure TfrmMazeDesign.draw_maze(square_size: integer);
var
row, col : integer;
begin
// setup default walls as "WWWW" wall on all four sides.
SetLength(Shapes,height+3, width+3, 2 ) ;
for row := 1 to height do
begin
for col := 1 to width+2 do
begin
Shapes[row,col,0]:= TShape.Create(Self);
Shapes[row,col,0].Parent := Self;
with Shapes[row,col,0] do
begin
Width := 5;
Height := square_size;
Left := 100+ ((col-1) * square_size);
Top := 50+ ((row-1) * square_size);
Brush.Color := RGB(255, 255,25);
Shape := stRectangle;
end;
end;
end;
for row := 1 to height+1 do
begin
for col := 1 to width+1 do
begin
Shapes[row,col,1]:= TShape.Create(Self);
Shapes[row,col,1].Parent := Self;
with Shapes[row,col,1] do
begin
Width := square_size;
Height := 5;
Left := 100+ ((col-1) * square_size);
Top := 50+ ((row-1) * square_size);
Brush.Color := RGB(255, 255,25);
Shape := stRectangle;
end;
end;
end;
end;
procedure TfrmMazeDesign.initialise_visited(var visited: Tvisited);
var
row, col: integer;
begin
for row := 0 to height+2 do
for col := 0 to width+2 do
if (col = 0) or (row = 0) or (row = height+1) or (col= width+2) then
visited[row,col] := True
else
visited[row,col] := False;
end;
procedure TFrmMazeDesign.walk(visited: Tvisited; x: integer; y:integer);
var
xx,yy, counter, ran_direction: integer;
direction: Tstringlist; // 1= Up, 2= right, 3 = down, 4 = left
text: string;
begin
visited[x,y] := True;
direction := TStringlist.Create;
direction.Add('1');
direction.Add('2');
direction.Add('3');
direction.Add('4');
for counter := direction.Count - 1 downto 0 do
direction.Exchange(counter, Random(counter+1));
for counter := 0 to direction.Count-1 do
begin
ran_direction := StrtoInt(direction[counter]);
if ran_direction= 1 then
begin
xx := x-1;
yy := y
end;
if ran_direction = 2 then
begin
xx := x+1;
yy := y
end;
if ran_direction = 3 then
begin
xx := x;
yy := y-1
end;
if ran_direction= 4 then
begin
xx := x;
yy := y+1
end;
if visited[xx,yy] = False then
begin
if xx = x then
shapes[x,Max(yy,y),0].visible := False;
if yy = y then
shapes[Max(xx,x),y,1].visible := False;
walk (visited, xx,yy)
end;
end;
end;
procedure TfrmMazeDesign.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
VK_UP:
direction := 1;
VK_DOWN:
direction := 2;
VK_LEFT:
direction := 3;
VK_RIGHT:
direction := 4;
end;
end;
procedure TfrmMazeDesign.FormOpen(Sender: TObject);
var
block_height: integer;
xx,yy: integer;
visited: Tvisited;
monster, monster2: TMonster;
Shape_height : integer;
Shape_Width : integer;
imgfinish_height : integer;
maze_width : integer;
begin
width := frmdifficulty.ScrollBar1.Position;
height := frmdifficulty.ScrollBar1.Position;
maze_width := 650;
block_height := maze_width div width;
Shape_height := round( block_height * 0.5);
imgfinish_height := round(block_height * 0.5);
draw_maze(block_height);
SetLength(visited, height+10, width+10) ;
initialise_visited(visited);
walk(visited,3,3);
ShpUser.height := Shape_height;
ShpUser.Width := Shape_height;
imgfinish.width := Shape_height;
imgfinish.height := shape_height;
ShpUser.Shape := UShapeEditor.frmShape.shpShape.Shape;
ShpUser.Brush.color := UShapeEditor.frmShape.shpShape.Brush.color;
FDateTimeTo := StrToDateTime(FormatDateTime('dd' + FormatSettings.DateSeparator + 'mm' +
FormatSettings.DateSeparator + 'yyyy', Now)); Incsecond(time,120);
Timer1.Enabled := True;
monster := TMonster.Create(Self);
monster.Parent := Self;
monster.SetSizes(width, height, shape_height, 55+ maze_width + 10,665);
monster.start;
monster2 := TMonster.Create(Self);
monster2.Parent := Self;
monster2.SetSizes(width, height, shape_height, 50+ maze_width + 10,565);
monster2.start;
end;
procedure TfrmMazeDesign.Timer1Timer(Sender: TObject);
var IntersectionRect: TRect;
collision, test_collision : boolean;
up : boolean;
right : boolean;
max_width, max_height : integer;
xx, yy : integer ;
aRect1: TRect;
buttonSelected : Integer;
collisionend: boolean;
frmMazeDesign: TfrmMazeDesign;
row, col, hoz_vert : integer;
begin
hoz_vert := 0;
xx := 0;
yy := 0;
case direction of
1:begin //Up
yy := -3;
end;
2: begin //down
yy := + 3;
end;
3: begin //left
xx := -3;
end;
4: begin //right
xx := + 3;
end;
end;
repeat
if hoz_Vert = 0 then begin
max_width := width +3;
max_height := Height+1;
end else begin
max_width := width+2;
max_height := Height+2;
end;
row := 1;
repeat
col := 1;
repeat
aRect1 := Rect(ShpUser.Left+xx, ShpUser.Top+yy, ShpUser.Left+ShpUser.width+xx, ShpUser.top+ ShpUser.Height+yy);
if Shapes[row,col,hoz_vert].visible = True then
collision := IntersectRect(IntersectionRect, aRect1, Shapes[row,col,hoz_vert].BoundsRect) ;
col := col + 1;
until (collision) or (col = max_width);
row := row + 1 ;
until (collision) or (row = max_height);
hoz_vert := hoz_vert +1;
until (collision) or (hoz_vert = 2);
if (collision = False) and (direction <> 0) then begin
ShpUser.Top := ShpUser.Top + yy;
ShpUser.Left := ShpUser.Left + xx;
end;
if IntersectRect(IntersectionRect, imgfinish.BoundsRect, Shpuser.BoundsRect) then
begin
Collisionend := true;
if collisionend = true then
frmfinish.Show;
direction:= 0;
end;`
This is relatively straightforward to add to your program, which is already event driven. In summary you need to do the following:
Add a Boolean flag, perhaps named Paused, set to False when the game starts.
When the user presses the pause button, set the Paused flag to True.
When the user presses the resume button, set the Paused flag to False.
In the time event handler, check the Paused flag before updating the positions. If the Paused flag is True, then simply exit from the timer event handler before doing anything else.

stack overflow when press button delphi

I'm build an application that reducing the pixels width.
When I'm pressing the button of that application two or three times, Message will appear and say stack overflow.
Here's the Message :
Error Line on my application
Here's my code :
procedure TForm1.cariThin();
var
baris_gbr, kolom_gbr, x, y, a, b, i, j, p1, p2, n : integer;
imgval : array [0..500,0..500] of integer;
mark : array [0..500,0..500] of integer;
nb : array [1..9] of integer;
hasdelete: boolean;
R, G, BL, AB : integer;
begin
Image3.Width := Image1.Width;
Image3.Height := Image1.Height;
baris_gbr := Image1.Picture.Height;
kolom_gbr := Image1.Picture.Width;
For kolom_gbr:= 0 To image1.Width - 1 Do
Begin
For baris_gbr:= 0 To image1.Height - 1 Do
Begin
R:= GetRValue(image1.Canvas.Pixels[kolom_gbr, baris_gbr]);
G:= GetGValue(image1.Canvas.Pixels[kolom_gbr, baris_gbr]);
BL:= GetBValue(image1.Canvas.Pixels[kolom_gbr, baris_gbr]);
AB:= (R + G + BL) Div 3;
if (AB > 200) then
begin
Image1.Canvas.Pixels[kolom_gbr, baris_gbr] := rgb(255,255,255);
end
else
begin
Image1.Canvas.Pixels[kolom_gbr, baris_gbr] := rgb(0,0,0);
end;
End;
End;
for y := 0 to baris_gbr-1 do
begin
for x := 0 to kolom_gbr-1 do
begin
if (Image1.canvas.pixels[x,y] = clBlack) then
begin
imgval[x,y] := 1;
end
else
begin
imgval[x,y] := 0;
end;
end;
end;
hasdelete := True;
while (hasdelete) do
begin
hasdelete := False;
for y := 0 to baris_gbr-1 do
begin
for x := 0 to kolom_gbr-1 do
begin
if (imgval[x,y] = 1) then
begin
for n:=1 to 8 do
begin
nb[n] := 0;
nb[1] := imgval[x,y];
nb[2] := imgval[x,y-1];
nb[3] := imgval[x+1,y-1];
nb[4] := imgval[x+1,y];
nb[5] := imgval[x+1,y+1];
nb[6] := imgval[x,y+1];
nb[7] := imgval[x-1,y+1];
nb[8] := imgval[x-1,y];
nb[9] := imgval[x-1,y-1];
a := 0;
end;
for i:= 2 to 8 do
begin
if ((nb[i] = 0) AND (nb[i+1] = 1)) then
begin
inc(a);
end;
end;
if ((nb[9] = 0) AND (nb[2] = 1)) then
begin
inc(a);
end;
b := nb[2] + nb[3] + nb[4] + nb[5] + nb[6] + nb[7] + nb[8] + nb[9];
p1 := nb[2] * nb[4] * nb[6];
p2 := nb[4] * nb[6] * nb[8];
if ((a = 1) AND ((b>=2) AND (b <= 6)) AND (p1 = 0) AND (p2 = 0)) then
begin
mark[x,y] := 0;
hasdelete := true;
end
else
begin
mark[x,y] := 1;
end
end
else
begin
mark[x,y] := 0;
end;
end;
end;
for y:=0 to baris_gbr-1 do
begin
for x:=0 to kolom_gbr-1 do
begin
imgval[x,y] := mark[x,y];
end;
end;
end;
end;
Why my application keep says overflow? is there any solution to fix it? or can we can exception handler? thanks
EDIT
Now my pplication says access violation.
It raised error in this line : nb[7] := imgval[x-1,y+1];
why it exactly happened?
var
imgval : array [0..500,0..500] of integer;
mark : array [0..500,0..500] of integer;
These variables are located on the stack and are huge. They have size 501*501*4 = 1,004,004. The default stack size is 1MB. These large arrays are the reason for your stack overflow.
You will need to use dynamically allocated arrays instead. Or avoid the need to store 2D arrays that contain information for each pixel and instead process the image in smaller sub-blocks. I've no idea whether or not that is possible because I've no idea what the code is trying to do. That's for you to work out.
Of course, one advantage of using dynamically allocated arrays is that you don't need to run the gauntlet of a buffer overrun, as you currently do. If either dimension of the image exceeds 501 then you have overrun the buffer. I do hope that you have enabled range checking in the compiler options.
for y := 0 to baris_gbr-1 do
and
for x := 0 to kolom_gbr-1 do
cannot be correct. The baris_gbr and kolom_gbr variables are not initialised since they were most recently used as loop variables. So, as well as turning on range checking, you'll want to turn on hints and warnings, and then heed them.

Dynamically created buttons with equal alignment

I am a newbie to this Delphi. I have been given an assignment that to create buttons dynamically. But the problem is that all buttons have to be aligned in a manner that it should fit inside the whole screen. i.e, if 10 buttons created the whole screen should be filled. Or if 9 is given 9 should be present and filled in the screen. Is it possible to do that? I tried and searched everywhere. But was helpless.
Please help me if its possible. A good example is also appreciated since I mentioned earlier I am really new to this. The code I did follows here.
procedure TfrmMovieList.PnlMovieClick(Sender: TObject);
begin
for i := 0 to 9 do
begin
B := TButton.Create(Self);
B.Caption := Format('Button %d', [i]);
B.Parent := Panel1;
B.Height := 23;
B.Width := 100;
B.Left := 10;
B.Top := 10 + i * 25;
end;
end;
This looks workable to me:
procedure TForm1.CreateButtons(aButtonsCount, aColCount: Integer; aDestParent: TWinControl);
var
rowCount, row, col, itemWidth, itemHeight: Integer;
item: TButton;
begin
if aColCount>aButtonsCount then
aColCount := aButtonsCount;
rowCount := Ceil(aButtonsCount / aColCount);
itemHeight := aDestParent.Height div rowCount;
itemWidth := aDestParent.Width div aColCount;
for row := 0 to rowCount-1 do begin
for col := 0 to aColCount-1 do begin
item := TButton.Create(Self);
item.Caption := Format('Button %d', [(row*aColCount)+col+1]);
item.Left := itemWidth*col;
item.Top := itemHeight*row;
item.Width := itemWidth;
item.Height := itemHeight;
item.Parent := aDestParent;
Dec(aButtonsCount);
if aButtonsCount=0 then
Break;
end; // for cols
end; // for rows
end;
An example of usage is:
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateButtons(10, 4, Panel1);
end;
The function Ceil requires the uses of unit Math.
The method receives the count of buttons and the numbers of columns to calculate the number of rows. It also receives the destination parent where the buttons will be located.

Create run time TTabItem , firemonkey

Seems like i need some help with a project.
I have a routine , that constructs run time multiple TabItems on to a page control in firemonkey, and i want to have a close button on the tab.
The new tab has a checkbox for the close button loading from the styler of the tabitems.
The page has a default tab, and within some button, i am adding run time the new tab items.
I have managed to apply the event for closing the default tab page, but doesn't work within the run time created tab pages. Any help would be appreciated.
This is the piece of code for the runtime tabitems
procedure TForm1.Button1Click(Sender: TObject);
var
t : TTabItem;
o : TFmxObject;
i : Integer;
c : TControl;
begin
t := TTabItem.Create(pgeControl);
t.Parent := pgeControl;
o := FindBinding('imgCloseTabPage');
if o<>nil then
begin
for i := 0 to ComponentCount - 1 do
begin
if Components[i] is TCheckBox then
begin
TCheckBox(Components[i]).OnClick := CheckBox1Click;
end;
end;
end;
if pgeControl.TabCount - 1 <= nTab then
begin
nTab := nTab + 1;
t.Index := nTab
end
else
begin
t.Index := pgeControl.TabCount - 1;
nTab := pgeControl.TabCount - 1;
end;
t.Tag := nTab;
t.Text := 'Some text...' + ' ' + IntToStr(nTab);
t.Name := 'tabPatient' + IntToStr(nTab);
t.Height := 35;
t.Width := 250;
t.Margins.Top := 0;
t.Margins.Left := 0;
t.Margins.Bottom := 0;
t.Margins.Right := 0;
t.Padding.Top := -5;
t.Padding.Left := 0;
t.Padding.Bottom := 0;
t.Padding.Right := 0;
t.TextAlign := TTextAlign.taLeading;
t.Width := (Length(t.Text) * 6 ) + 60;
t.Font.Size := 15;
t.StyleLookup := 'tabMainStyle1';
l := TLayout.Create(t);
l.Parent := t;
l.Align := TAlignLayout.alClient;
l.Margins.Top := -5;
l.Margins.Left := 5;
l.Margins.Right := 5;
l.Margins.Bottom := 5;
l.Padding.Top := 0;
l.Padding.Left := 0;
l.Padding.Bottom := 0;
l.Padding.Right := 0;
pgeControl.ActiveTab := pgeControl.Tabs[pgeControl.TabCount - 1];
end;
You shoud call FindBinding after having applyed the custom style. Currently you call this before, so it can't find the object. Additionally there was a mistake when you was looking for the object.
so put this
o := t.FindBinding('imgCloseTabPage');
if o<>nil then
begin
if o is TCheckBox then
TCheckBox(o).OnClick := CheckBox1Click;
end;
after
t.StyleLookup := 'tabMainStyle1';
and the event should assigned.

how to wordwrap the button text?

i have created dynamic button with code below, the button caption is too long so i have to change the size of the caption to fit the button width but the wordwrap seen to be not function at all.
var
Reg: TRegistry;
lstKey, lstSubKey : TStringList;
sKeyName, sSubKeyName : string;
i, j, iSize, iSize2, iTop, iSpace, iComp : integer;
begin
lstKey := TStringList.Create;
lstSubKey := TStringList.Create;
lstBtnName := TStringList.Create;
Reg := TRegIniFile.Create;
try
Reg.OpenKeyReadOnly('registryPath');
Reg.GetKeyNames(lstSubKey); // get registry key
Reg.CloseKey;
iSize := 5;
iSize2 := 5;
iTop := 5;
iSpace := 5;
if ScrollBox1.ControlCount > 0 then begin
for j := ScrollBox1.ControlCount - 1 downto 0 do begin
with ScrollBox1.Controls[j] AS TBitBtn do begin
Free;
end;
end;
end;
for i := 0 to lstSubKey.Count - 1 do begin
with TBitBtn.Create(self) do begin // create dynamic buttons
Parent := ScrollBox1;
Height := 50;
Width := 50;
if iSize > ((Width + iSpace) * 3) then begin //2nd row, 3 btns in 1 row
Left := iSize2;
iSize2 := iSize2 + Width + iSpace;
Top := iTop + Height + iSpace;
end else begin //1st row
Left := iSize;
iSize := iSize + Width + iSpace;
Top := iTop;
end;
Caption := lstSubKey.Strings[i];
WordWrap := TRUE;
end;
end;
finally
lstKey.Free;
lstSubKey.Free;
Reg.Free;
end;
end;
Using #13 in caption can split the caption string to next row.
eg. Caption := 'Stock ID : Bread ' + #13 + 'Price : RM1.00';
Works for me with a simple example of three lstSubKey entries:
'Short'
'Medium Length'
'Longer'
However, if I remove the space between "Medium" and "Length", and make the 2nd item:
'MediumLength'
Then it does not wrap, but this is to be expected because there is no word break in the string on which the string can be broken in order to be wrapped.

Resources