I use Borland Pascal 7.0, and I would like to make a slots game (If 3 random numbers are the same, you win). The problem is that when I click on the start (Inditas) button on the menu, the procedure executes many times until I release the mouse button. I was told that I should check if the mouse button is released before executing the procedure once. How can I do that? Here's what the menu looks like:
procedure eger;
begin;
mouseinit;
mouseon;
menu;
repeat
getmouse(m);
if (m.left) and (m.x>60) AND (m.x<130) and (m.y>120) and (m.y<150) then
teglalap(90,90,300,300,blue);
if (m.left) and (m.x>60) AND (m.x<130) and (m.y>160) and (m.y<190) then
jatek(a,b,c,coin,coins);
until ((m.left) and (m.x>60) AND (m.x<130) and (m.y>240) and (m.y<270));
end;
Thanks, Robert
In case the mouse unit doesn't provide a way to wait for a mouse click, or something similar,
you can simulate a "button released" behavior with a couple of flag variables.
Example:
button_down := false; // 1
repeat
button_released := false; // 2
getmouse(m);
// 3
If m.left and not button_down Then button_down := true;
If not m.left and button_down Then
Begin
button_released = true;
button_down := false;
End;
//
if button_released and ... then ...
if button_released and ... then ...
until (...);
(I don't know what m.left is but I assume it indicates whether the left button is down or not)
Related
I want every time the series Ctrl GUpEnter and Ctrl GDownEnter are pressed, it will Send !wi afterward. Normal hotkeys work:
~^PgUp::
~^PgDn::Send !wi
But this doesn't work, although ~^g down enter isn't an invalid hotkey:
~^PgUp::
~^PgDn::
::~^g down enter::
::~^g up enter::Send !wi
Also, since I don't know many times Up and Down will be pressed before Enter, is there a way to make it skips the middle keys?
Try:
~^PgUp::
~^PgDn::Send !wi
~^g::
Input, key, V L1, {Enter}
if (ErrorLevel == "EndKey:Enter")
Send {Enter}!wi
return
A simple solution is to set a boolean flag when ^g is pressed. Then check this flag when enter is pressed and fire !wi if it is set. This however require that the flag is reset - so if some other key can end the sequence, it must be also reset by those keys (see bottom section of code for examples).
await := 0
~^g::
await := 1 ; set flag
tooltip %await%
return
~enter::
if (await = 1) {
await := 0 ; reset flag
sleep 300 ; safety pause
send !wi
tooltip %await%
}
return
; note: the 'await' flag must be reset if other
; key can end the sequence.
; here for example escape or mouse click
~esc::
await := 0
tooltip %await%
return
~lbutton::
await := 0
tooltip %await%
return
I'm trying to close all the forms that related to client once he disconnected form the server
This action will be on the server side.
I have ( the known for me at run time ) partial unique caption for each client for example
Form caption 1:
ServiceA - ClientABC
Form caption 2:
ServiceB - ClientABC
What i already know is the - ClientABC part only.
So when the client ClientABC disconnected form my server i want to close all the related opened form in the server side.
procedure TIdServer.ClientRemove(const AContext: TIdContext);
var
sTitle: string;
function CloseChildForm(Wnd: HWND; Param: LPARAM): BOOL; stdcall;
begin
if Pos(sTitle, _GetWindowTitle(Wnd)) <> 0 then
PostMessage(Wnd, WM_CLOSE, 0, 0);
Result := True;
end;
begin
sTitle := TMyContext(AContext).Uniquename {ClientABC}
if Assigned(FListView) then begin
TThread.Queue(nil,
procedure
var
i: Integer;
begin
EnumWindows(#CloseChildForm, 0);
.......
end;
end
);
end;
end;
My problem is the string sTitle inside the CloseChildForm function always empty.
I call ClientRemove on the IdServerDisconnect procedure
procedure TIdServer.IdServerDisconnect(AContext: TIdContext);
begin
TMyContext(AContext).Queue.Clear;
........
ClientRemove(AContext);
end;
Can anyone tell me what wrong please ?
There are quite a few things wrong here:
You must not use a nested function as your callback. That is not allowed by the language and your code only compiles because the RTL declaration of EnumWindows uses an untyped pointer for the callback parameter.
Asynchronous execution with TThread.Queue means that the enclosing stack frame can be finished before the call to EnumWindows completes.
You are in danger of closing windows that do not belong in your process.
Were I faced with this problem I would solve it using Screen.Forms[]. Something like this:
for i := Screen.FormCount-1 downto 0 do
if CaptionMatches(Screen.Forms[i]) then
Screen.Forms[i].Close;
This is just an outline. I'm sure you can understand the concept. The key point is not to use EnumWindows and instead use the VCL's own mechanism to enumerate your forms.
I want to be able to press key and run an infinite loop, and be able to press the same key to stop the loop. In a simple case I want the script to click indefinitely:
XButton2::
if (Doing = 0)
{
Doing := 1
While Doing = 1
{
Click
}
return
} else {
Doing := 0
}
Unfortunately this doesn't work - XButton2 does not respond any more because it is running a script. I can switch Doing := 0 by other key but I want for it to be the same XButton2. Any simple way of doing this? I would avoid complicated solutions.
Use a timed subroutine. That's how you'd start/stop a loop in ahk usually.
For example:
clicking := false
label_click:
click
return
XButton2::
clicking := !clicking
if(clicking)
setTimer, label_click, 1 ; click once every millisecond (approx.)
else
setTimer, label_click, off
return
That is how I usually do it, though I'd love to see a more compact version.
I'm Trying to do, in delphi, that when you press a button, I display a drop-down panel with options like this:
Does anyone know how to make this effect with VCL?
Now I have a form with 2 panels, the main is always showing and has a side button, and when I press the button the side panel is shown, but I would like to make the effect.
Thank you
I dont know your application in detail, with the transparency and other things. However, I think you will have to animate your panels/windows in some sort of loop on your own. I dont know of any VCL function for that.
Here is an example which animates a Window (its quick and dirty though):
Code:
procedure TForm1.Button1Click(Sender: TObject);
var
I, X: Integer;
begin
Form2.Width := 1;
Form2.Height := Form1.Height;
Form2.Left := Form1.Left + Form1.Width;
Form2.Top := Form1.Top;
Form2.Show;
Timer1.Enabled := true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if I < 500 then
begin
I := I + 1;
Form2.Width := I;
end
else
begin
Timer1.Enabled := false;
end;
end;
Not perfect, but hopefully good enough to give you an idea.
Andy
you can use TJvRollOut from Jedi JVCL.
It acts like a panel which colapse and expand. Also you can take a look at Delphi: sliding (animated) panel and
Hide, Slide And Fade Away Controls On A Delphi Form
Finally, I managed to make the effect. I put a panel and I have added a picture. then I used animatedwindows in buton click process.
procedure TFTelefonoSIP.Button1Click(Sender: TObject);
begin
if GDPanelLlamadasHidden = False then
begin
AnimateWindow(Panel1.Handle, 200, AW_SLIDE or AW_HOR_POSITIVE or AW_HIDE);
GDPanelLlamadasHidden := True;
end
else
begin
AnimateWindow(Panel1.Handle, 200, AW_SLIDE or AW_HOR_NEGATIVE or AW_ACTIVATE);
GDPanelLlamadasHidden := False;
end;
end;
But the effect is not quite what I wanted, sometimes the image shows a flash, not very aesthetic.
you should enable the "Double Buffered" property at the application form's... this should prevent the flashing..
1.The particles seems to have an excess y-direction movement, but i didn't add a background gravity for them.
2.The particles seems to move too fast when they're getting closer and closer, (because I don't know how to handle the issue of collision?)
I calculate the location by adding the corresponding force it experienced , how can i know if they collided with other? for example:
stage 1
particle1 [1,1]
particle2 [1,9]
stage 2
particle1 [9,9]
particle2 [1,9]
If I plot a graph of the path belonging to each particle, I can see if the graph of paths intercept with other, but the path intercept doesn't 100% means they'll collide, as they can have different speed.
I've tried to debug but just cannot find out where is going wrong.
in version 0 they tend to fail down (not my wish)
in version 1 they tend to fail to the right (i swap the x y) (simplified version)
here is the url of the bin and source (in pascal): stack_exchange_particle_gravity_collision.zip
here is the source code of version 0 in case you do not want to download the zip:
program ParticlesV0;
uses
graph;
const
pi=3.14159265358979;
n=500;
defaultSpeed=1;
defaultRadius=2;
defaultDensity=1e4;
energyLoss=0.50;
dotStyle=1;
backGroundLevel=0;
type
ParticleType=record
x,y,dr,dd,dx,dy,dfr,dfd:real;
color:word;
radius,mass:real;
end;
var
gd,gm:smallint;
PathToDriver:string;
l:longint;
particle:array[1..n]of ParticleType;
////////////////////////////////////////////////////////////////
procedure backGround(i:smallint);
var
y:smallint;
s,t:string;
w,ori:word;
begin
ori:=GetColor;
SetColor(10);
while i>0 do begin
for y:=0 to (GetMaxY div 10) do begin
s:='';
for w:=0 to 255 do begin
str(random(10),t);
s:=s+t;
end;
OutTextXY(5,y*10,s);
end;
dec(i);
end;
SetColor(ori);
end;
procedure line(x1,y1,x2,y2:smallint);
var
x,y:smallint;
begin
x:=getx;
y:=gety;
moveto(x1,y1);
lineto(x2,y2);
moveto(x,y);
end;
function rx(x:real):real;
begin
rx:=x+(GetMaxX div 2);
end;
function ry(y:real):real;
begin
ry:=y+(GetMaxY div 2);
end;
function s(r:real):smallint;
begin
s:=round(r);
end;
function distance(p1,p2:ParticleType):real;
var
x,y:real;
begin
x:=p1.x-p2.x;
y:=p1.y-p2.y;
distance:=sqrt(x*x+y*y);
end;
function degree(p1,p2:ParticleType):real;
var
x,y,d:real;
begin
x:=p2.x-p1.x;
y:=p2.y-p1.y;
if x0 then d:=arctan(y/x)
else if (yGetMaxX) then begin
dx:=-dx;
x:=GetMaxX-(x-GetMaxX);
end;
if (xGetMaxY) then begin
dy:=-dy;
y:=GetMaxY-(y-GetMaxY);
end;
if (y0) then begin
tfr:=G*p.mass*particle[l].mass/sqr(r);
tfd:=degree(p,particle[l]);
tdx:=tfr*cos(tfd);
tdy:=tfr*sin(tfd);
dx:=dx+tdx;
dy:=dy+tdy;
// tdx:=
end;
p.dx:=p.dx+dx;
p.dy:=p.dy+dy;
end;
end;
//++++++++++++++++++++++++++++++//
////////////////////////////////////////////////////////////////
begin
gd:=detect; { highest possible resolution }
gm:=0; { not needed, auto detection }
PathToDriver:=' '; { path to BGI fonts, drivers aren't needed }
InitGraph(gd,gm,PathToDriver);
if (GraphResult=grok) then begin
writeln('gd ',gd);
writeln('GetMaxX ',GetMaxX);
writeln('GetMaxY ',GetMaxY);
writeln('GetMaxColor ',GetMaxColor);
backGround(backGroundLevel);
line(0, 0, GetMaxX, GetMaxY);
SetFillStyle(HatchFill,13);
FillEllipse(s(rx(0)),s(ry(0)),10,10);
for l:=1 to n do initp(particle[l]);
repeat
for l:=1 to n do begin
calp(particle[l]);
movep(particle[l]);
end;
until false;
readln;
CloseGraph; { restores the old graphics mode }
end else writeln('Graphic not supported.');
readln;
end.
sorry for the poor formatting
If you want to remove a particle when it get too close, this line should do the job:
procedure calp(var p:ParticleType);
...
e:=*put a number here witch scales with mass or something esle, you can even use defaultradius constant*;
if (r>e) then begin
...
else mass:=0 <- this now means it won't pull others particles, and won't be pulled either, ideally now you need to check everywhere for 0-os, alternatively
you can place the particle randomly on the screen again, but it can cause some funny stuff, becouse of leftover vectors.