program CircleMoving;
uses SwinGame, sgTypes;
procedure Main();
var
x, y, CIRCLE_RADIUS: Single; screenColour: Color;
begin
OpenGraphicsWindow('Character Moving', 800, 600);
Delay(5000);
x := 400;
y := 300;
CIRCLE_RADIUS := 150;
screenColour := ColorWhite;
repeat
clearScreen(screenColour);
fillCircle(ColorGreen, x, y, CIRCLE_RADIUS);
RefreshScreen(60);
Processevents();
if KeyDown(LeftKey) and (x - CIRCLE_RADIUS < ScreenWidth()) then
begin
x := x - 1;
end;
if KeyDown(RightKey) and (x + CIRCLE_RADIUS < ScreenWidth()) then
begin
x := x + 1;
end;
if KeyDown(UpKey) and (y - CIRCLE_RADIUS < ScreenHeight()) then
begin
y := y - 1;
end;
if KeyDown(DownKey) and (y + CIRCLE_RADIUS < ScreenHeight()) then
begin
y := y + 1;
end;
until WindowCloseRequested();
end;
begin
Main();
end.
At the moment when I run the code it works other then when I move the circle to the left and up it goes off the window, I do not want this to happen. I want it to be restricted so the circle will stop and wont go any further once it hits the edge. I want it to be the same on all side so when I move the circle in any direction it will stop at the edge of the window. Moving the circle to the right and down works but left and up does not. I believe the problem is at the if statements starting at line 22. How do I change my code to fix this?
Related
uses GraphABC;
var
x, y, a: integer;
procedure treug(x, y, a, b: integer);
begin
x := 0;
y := 20;
line(x, y, x+a, y);
line(x, y, x, y+b);
line(x+a, y, x, y+b);
end;
begin
writeln('Enter the length of the catheter');
read(a);
while y < 480 do
begin
y := y+1;
treug(x, y, a, a);
end;
end.
Outputs only one triangle, and not the desired number up to the vertical border.
I expected one vertical row of right triangles (x and y are the coordinates of the right angle) to the lower border of the graphic window.
uses GraphABC;
var
x, y, a: integer;
procedure treug(x, y, a, b: integer);
begin
line(x, y, x+a, y);
line(x, y, x, y+b);
line(x+a, y, x, y+b);
end;
begin
writeln('Enter the length of the catheter');
read(a);
x := 0; // <-- initialize your x and y here
y := 20;
while y < 480 do
begin
y := y+1; // (see note below)
treug(x, y, a, a);
end;
end.
Remember, you have two sets x and y variables:
The global ones declared in the main program (and now properly initialized in the main program)
The ones local to the treug() procedure.
Things may have the same name and not be the same thing. If it helps, you can think of the global x as GraphABC.x and the local x as GraphABC.treug.x.
BTW, you probably want to increment y by something more than 1 each time through the loop, otherwise it’ll look just like a single triangle has been smeared down the display. (You might want to increment by b.)
There are 2 codes in Delphi 7. I need to make forms for them so that all variables are written to the form by the crawler himself, and not by the programmer through the code.
I tried to create a form from scratch. I tried to build it on a ready-made code. Unfortunately, my knowledge of programming in Delphi 7 is too small to understand the documentation for forms written in a rather complex language.
FIRST:
program p1;
{$APPTYPE CONSOLE}
uses
SysUtils, Math, Windows;
var
x, z: integer;
var
RES,s, sp, p, ps, y: real;
begin
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
x := 1;
y := 2.25;
z := 3;
ps := 1;
for x := 1 to 7 do
begin
sp := 0;
for z := 3 to 10 do
begin
s := Arctan(y / z + x / y) / power(abs(y - x - z), 1 / 3);
sp := sp + s;
//Writeln('Сумма ', sp:0:3);
end;
p := (power(2.3, 4 / x) * abs(y - x)) / (sqrt(sqr(x) + sqr(y) + 1.5)) + sp;
ps := ps * p;
//Writeln('Произведение ', ps:0:3);
end;
RES := ps;
Writeln(RES:0:3);
Readln;
end.
SECOND:
program p2;
{$APPTYPE CONSOLE}
uses
SysUtils, Math, Windows;
const
H = 0.4;
Xmin = -3;
Xmax = 2.9;
var
x, y, W: real;
begin
SetConsoleCP(1251);
SetConsoleOutputCP(1251);
x := Xmin;
while (x < Xmax) do
begin
if (x > 0.1) and (x < 2) then begin
W := power(x, 1 / 3) + ln(x);
y := ((ln(sqr(W) + W + 1)) * cos(4 * x)) / (exp(-2) + 2);
end
else if (x <= 0.1) then begin
W := sqr(sin(x)) + 4 * x;
y := ((ln(sqr(W) + W + 1)) * cos(4 * x)) / (exp(-2) + 2);
end
else begin
W := 2.6 * sqr(x) - 3.7;
y := ((ln(sqr(W) + W + 1)) * cos(4 * x)) / (exp(-2) + 2);
end;
x := x + H;
Write('X= ', x:0:3);
Write(' ');
Writeln('Y= ', y:0:3);
end;
Readln;
end.
File > New > Forms Application
That will create a new GUI (not Console) project with a blank Form. Design the Form with UI controls and event handlers as needed, and then copy/paste your code above into the generated code as needed.
I need a code to go from decimal to binary numbers, but my program shows them invert, example: needs to show 1011000 but it brings out 0001101.
+ I cant use massives and array in this program.
var
x,y,i:longint;
BEGIN
readln(y);
repeat
x:= y mod 2;
y:= y div 2;
write(x);
until y = 0;
END.
I think you can use recursion function. For example:
procedure dec2bin(y)
BEGIN
x := y mod 2;
y := y mod 2;
if y > 1 then
dec2bin(y)
end
write(x)
END
BEGIN
readln(y);
dec2bin(y)
END.
I'm not sure in correct syntax because I working with Pascal long time ago. But I think you can understand my idea and make this.
This should answer what you are looking for
function decimalToBinary(a:LongInt):String;
var d:Integer;
str:String;
Begin
str:='';
while a>0 do begin
d:=a mod 2;
str:=concat(IntToStr(d),str);
a:=a div 2;
end;
decimalToBinary:=str;
End;
This is my code. It works!
program convert;
var
number : integer;
procedure dec2bin(x : integer);
begin
// general case
if (x > 1) then dec2bin(x div 2);
// to print the result
if (x mod 2 = 0) then write('0')
else write('1');
end;
begin
write('Decimal: '); readln(number);
write('Binary : ');
dec2bin(number);
end.
I'm trying to implement A* path finding algorithm (now it's Dijkstra's algorithm i.e without heuristic) using this article Link. But I can't figure out what's wrong in my code (it finds incorrect path).
instead of the empty begin ... end; it should be this step:
If it is on the open list already, check to see if this path to that
square is better, using G cost as the measure. A lower G cost means
that this is a better path. If so, change the parent of the square to
the current square, and recalculate the G and F scores of the square.
but I think it is not important because there is no diagonal movement.
uses
crt;
const
MAXX = 20;
MAXY = 25;
type
TArr = array [0..MAXY, 0..MAXX] of integer;
TCell = record
x: integer;
y: integer;
end;
TListCell = record
x: integer;
y: integer;
G: integer;
parent: TCell;
end;
TListArr = array [1..10000] of TListCell;
TList = record
arr: TListArr;
len: integer;
end;
var
i, j, minind, ind, c: integer;
start, finish: TCell;
current: TListCell;
field: TArr;
opened, closed: TList;
procedure ShowField;
var
i, j: integer;
begin
textcolor(15);
for i := 0 to MAXX do
begin
for j := 0 to MAXY do
begin
case field[j, i] of
99: textcolor(8); // not walkable
71: textcolor(14); // walkable
11: textcolor(10); // start
21: textcolor(12); // finish
15: textcolor(2); // path
14: textcolor(5);
16: textcolor(6);
end;
write(field[j, i], ' ');
end;
writeln;
end;
textcolor(15);
end;
procedure AddClosed(a: TListCell);
begin
closed.arr[closed.len + 1] := a;
inc(closed.len);
end;
procedure AddOpened(x, y, G: integer);
begin
opened.arr[opened.len + 1].x := x;
opened.arr[opened.len + 1].y := y;
opened.arr[opened.len + 1].G := G;
inc(opened.len);
end;
procedure DelOpened(n: integer);
var
i: integer;
begin
AddClosed(opened.arr[n]);
for i := n to opened.len - 1 do
opened.arr[i] := opened.arr[i + 1];
dec(opened.len);
end;
procedure SetParent(var a: TListCell; parx, pary: integer);
begin
a.parent.x := parx;
a.parent.y := pary;
end;
function GetMin(var a: TList): integer;
var
i, min, mini: integer;
begin
min := MaxInt;
mini := 0;
for i := 1 to a.len do
if a.arr[i].G < min then
begin
min := a.arr[i].G;
mini := i;
end;
GetMin := mini;
end;
function FindCell(a: TList; x, y: integer): integer;
var
i: integer;
begin
FindCell := 0;
for i := 1 to a.len do
if (a.arr[i].x = x) and (a.arr[i].y = y) then
begin
FindCell := i;
break;
end;
end;
procedure ProcessNeighbourCell(x, y: integer);
begin
if (field[current.x + x, current.y + y] <> 99) then // if walkable
if (FindCell(closed, current.x + x, current.y + y) <= 0) then // and not visited before
if (FindCell(opened, current.x + x, current.y + y) <= 0) then // and not added to list already
begin
AddOpened(current.x + x, current.y + y, current.G + 10);
SetParent(opened.arr[opened.len], current.x, current.y);
// field[opened.arr[opened.len].x, opened.arr[opened.len].y]:=16;
end
else
begin
end;
end;
begin
randomize;
for i := 0 to MAXX do
for j := 0 to MAXY do
field[j, i] := 99;
for i := 1 to MAXX - 1 do
for j := 1 to MAXY - 1 do
if random(5) mod 5 = 0 then
field[j, i] := 99
else field[j, i] := 71;
// start and finish positions coordinates
start.x := 5;
start.y := 3;
finish.x := 19;
finish.y := 16;
field[start.x, start.y] := 11;
field[finish.x, finish.y] := 21;
ShowField;
writeln;
opened.len := 0;
closed.len := 0;
AddOpened(start.x, start.y, 0);
SetParent(opened.arr[opened.len], -1, -1);
current.x := start.x;
current.y := start.y;
repeat
minind := GetMin(opened);
current.x := opened.arr[minind].x;
current.y := opened.arr[minind].y;
current.G := opened.arr[minind].G;
DelOpened(minind);
ProcessNeighbourCell(1, 0); // look at the cell to the right
ProcessNeighbourCell(-1, 0); // look at the cell to the left
ProcessNeighbourCell(0, 1); // look at the cell above
ProcessNeighbourCell(0, -1); // look at the cell below
if (FindCell(opened, finish.x, finish.y) > 0) then
break;
until opened.len = 0;
// count and mark path
c := 0;
while ((current.x <> start.x) or (current.y <> start.y)) do
begin
field[current.x, current.y] := 15;
ind := FindCell(closed, current.x, current.y);
current.x := closed.arr[ind].parent.x;
current.y := closed.arr[ind].parent.y;
inc(c);
end;
ShowField;
writeln(c);
readln;
end.
Edit Feb 1 '12: updated code, also fixed path marking (there should be or instead and), looks like it works now :)
You should rewrite the program to use a loop instead of cut-and-paste to visit each neighbor. If you do that you will avoid bugs like the following:
if (field[current.x, current.y - 1] <> 99) then
if (FindCell(closed, current.x, current.y - 1) <= 0) then
if (FindCell(opened, current.x + 1, current.y) <= 0) then
(See the inconsistent current.x + 1, current.y in the last line.)
With respect to the loop, I was thinking of something like this (pseudo-Python):
neighbor_offsets = [(0, 1), (0, -1), (1, 0), (-1, 0)]
for offset in neighbor_offsets:
neighbor = current + offset
if is_walkable(neighbor) and not is_visited(neighbor):
# Open 'neighbor' with 'current' as parent:
open(neighbor, current)
# Perhaps check if the goal is reached:
if neighbor == finish:
goal_reached = True
break
If you don't write a loop but just refactor to
ProcessCell(x+1, y);
ProcessCell(x-1, y);
ProcessCell(x, y-1);
ProcessCell(x, y-1);
then that's a great improvement too.
Youre posting quite a lot of code, have you tried narrow it down where it fails?
Have you compared your code with the pseudocode on wikipedia?
Also remember that dijkstra is just A* with a heuristic of 0.
Edit:
The article you linked (which I now realize is the very same I used to learn the A*, funny) contains illustrated steps. I would suggest that you recreate that map/grid and run your implementation on it. Then step through the images:
Are the eight initial neighbors added to the open list? Do they have the correct parent?
Is the correct open node picked as next to be scanned according to the heuristic?
Is the list of closed nodes correct?
And so on...
I have a procedure to auto-resize a column in a grid to accommodate for the largest string in that column. However when there's over 2,000 records in the grid, it takes a little too much time. Any tips on speeding this up?
//lstSKU = grid
procedure TfrmExcel.ResizeCol(const ACol: Integer);
var
M: Integer;
X: Integer;
S: String;
R: TRect;
begin
M:= 20;
lstSKU.Canvas.Font.Assign(lstSKU.Font);
for X:= 1 to lstSKU.RowCount - 1 do begin
S:= lstSKU.Cells[ACol, X];
R:= Rect(0, 0, 20, 20);
DrawText(lstSKU.Canvas.Handle, PChar(S), Length(S), R,
DT_LEFT or DT_VCENTER or DT_CALCRECT);
if R.Right > M then
M:= R.Right;
end;
M:= M + 15;
lstSKU.ColWidths[ACol]:= M;
end;
Is this a standard TStringGrid/TDrawGrid?
You can iterate through using Canvas.TextWidth(S) instead to measure the content width of each cell, save the largest, add any padding, and then set the Grid.ColWidths[Col] := M;. This will trigger a single redraw if needed. (Basically what you're doing, without repeating the drawing operation 2001 times.)
procedure TfrmExcel.ResizeCol(const ACol: Integer);
var
M, T: Integer;
X: Integer;
S: String;
begin
M := 20;
for X := 1 to lstSKU.RowCount - 1 do
begin
S:= lstSKU.Cells[ACol, X];
T := lstSKU.Canvas.TextWidth(S);
if T > M then
M := T;
end;
M := M + 15;
lstSKU.ColWidths[ACol] := M;
end;
If you want to set both width and height of the cell to accomodate larger fonts or something, use TextExtent instead of TextWidth; TextExtent returns a TSize, from which you can read Width and Height.
Although already answered, I'm posting the final code, which you can use with any string grid (TStringGrid). It resized 3,000 records with 27 columns in 2.3 seconds, as opposed to the prior 6.4 average.
//AGrid = Grid containing column to be resized
//ACol = Column index of grid to be resized
//AMin = Minimum column width
procedure ResizeCol(AGrid: TStringGrid; const ACol, AMin: Integer);
var
M, T: Integer; //M=Maximum Width; T=Current Text
X: Integer; //X=Loop Counter
begin
M:= AMin; //Begin with minimum width
AGrid.Canvas.Font.Assign(AGrid.Font);
for X:= 1 to AGrid.RowCount - 1 do begin
T:= AGrid.Canvas.TextWidth(AGrid.Cells[ACol, X]);
if T > M then M:= T;
end;
AGrid.ColWidths[ACol]:= M + AMin;
end;