I got some problems with the TImage component of loading bitmap from stream. When i call that my image loading like that.
Normal Window
Fullscreen Window
Okay, but when i build my codes on VCL Application mode its working good.
procedure SaveToStream(Stream: TStream; Bitm: TBitmap);
var
Surface: TBitmapSurface;
begin
Surface:= TBitmapSurface.Create;
try
Surface.Assign(Bitm);
TBitmapCodecManager.SaveToStream(Stream, Surface, '.bmp');
finally
Surface.Free;
end;
end;
Calling like that,
B := TBitmap.Create;
BS:= TMemoryStream.Create;
try
B := ParseData((FData)); // my image data is converting from TByteArray to Bitmap now. Its
working no problem.
SaveToStream(BS, B);
FrmScreenViewer.ImgScreen.Bitmap.LoadFromStream(BS);
//FrmScreenViewer.ImgScreen.Bitmap:= B; //I tryed without SaveToStream method but same
result.
finally
B.Free;
BS.Free;
end;
Are there some limitations on the FMX side? Why isn't working?
ParseData Function (I used RTC Framework and some variables are customizable like RTCByteArray)
function ParseData(Data: RtcByteArray): TBitmap;
var
B: TBitmap;
M: TRtcByteArrayStream;
begin
B := TBitmap.Create;
M := TRtcByteArrayStream.Create(Data);
try
B.LoadFromStream(M);
Result := B;
finally
M.Free;
end;
end;
Related
I am working my way through Barnes' book 'Programming in Ada 2012'. This is a code sample implementing a stack from section 12.5.
src/stacks.adb: (the main relevant file)
package body Stacks is
procedure Push(S: in out Stack; X: in Integer) is
begin
S := new Cell'(S,X);
end Push;
procedure Pop(S: in out Stack; X: in out Integer) is
begin
X := S.Value;
S := Stack(S.Next);
end Pop;
function "="(S, T: Stack) return Boolean is
SS: access Cell := S;
TT: access Cell := T;
begin
while SS /= null and TT /= null loop
if SS.Value /= TT.Value then
return false;
end if;
SS := SS.Next;
TT := TT.Next;
end loop;
return SS = TT; -- error: implicit conversion of stand-alone anonymous access object not allowed
end "=";
end Stacks;
I have added a comment containing the error that gnat gives me. Why am I not allowed to convert from one anonymous access Cell to another?
I can solve the problem by inverting the condition:
return not (SS /= TT);
It mystifies me as John Barnes states earlier that if you define a "=" operator returning a boolean, then the inverse "/=" is generated automatically for you, meaning the opposite.
Similarly, the loop condition can be inverted, in which case it fails to compile with the same message.
Finally, a side-note: the expected behaviour of the program, which it gives after changing to return not (SS /= TT) is to recurse infinitely and raise a storage_error due to stack overflow. The reason for that is better seen in this other SO question, and is not the subject of this question.
Why is the conversion disallowed by the compiler when I write "="?
Why is it different when I write "/=", which I thought would always be the inverse?
The other files needed in order to compile the example for yourself:
src/stacks.ads:
package Stacks is
type Stack is limited private;
procedure Push(S: in out Stack; X: in Integer);
procedure Pop(S: in out Stack; X: in out Integer);
function "="(S, T: Stack) return Boolean;
private
type Cell is
record
Next: access Cell;
Value: Integer;
end record;
type Stack is access all Cell;
end;
src/main.adb:
with Ada.Text_IO; use Ada.Text_IO;
with Stacks; use Stacks;
procedure Main is
A : Stack;
B : Stack;
begin
Push(A, 1);
Push(B, 1);
Push(A, 2);
Push(B, 2);
Push(A, 1);
Push(B, 1);
Push(A, 8);
Push(B, 8);
declare
Same : Boolean := A = B;
Text : String := (if Same then "They are the same" else "They are not the same");
begin
Put_Line(Text);
end;
end Main;
stacks.gpr:
project stacks is
for Source_Dirs use ("src");
for Object_Dir use "obj";
for Main use ("main.adb");
end stacks;
Makefile:
all:
gprbuild -d -p -g
clean:
rm -rf obj *.o *.ali
Or compile with gcc:
gcc -c src/*.adb
gnatbind main
gnatlink main
It gives the same results.
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'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.
Now I build a template for our invoice printer.
But I do really not know, why it crashes without any error.
My goal is to separate the String ItemName at the ';' and print each part into a new line to a Memo1.
procedure DetailBeforeGenerate;
var
s1: String;
s2: String;
wordcount: Integer;
notelength: Integer;
begin
s1 := plPrintInvLine['ItemName'];
notelength := Length(s1);
while notelength > 0 do
begin
notelength := Length(s1);
wordcount := Pos(';' , s1);
s2 := Copy(s1, 0, wordcount-1);
Memo1.Lines.Add(s2);
Delete(s1, 0, wordcount);
end;
end;
See comments below regarding accessing index[0] in a string and thanks to David Heffernen and Ken White. BUT:
Looks like you've got an infinite loop in your code:
notelength := Length(s1);
while notelength > 0 do
begin
notelength := Length(s1);
wordcount := Pos(';' , s1);
s2 := Copy(s1, 0, wordcount-1);
Memo1.Lines.Add(s2);
Delete(s1, 0, wordcount);
end;
Delete(s1, 0, wordcount); Has no effect! Try it in Delphi debugger. Result? notelength is never decremented so you'll loop forever. ' Delete(s1, 0, wordcount);' does not blow up but neither does it delete. Use Delete(s1,1, wordcount) instead.
Index[0] in Delphi strings does not contain your character data - it's 'not accessible' according to the compiler, if you try compiling myString[0];
Also: the way your code is written, you MUST terminate with ';' or a string such as this:
s1 := 'mikey;was;here;a'; will loop infinitely on the last string after ';' ('a')
I also use ReportBuilder templates, etc: In Delphi itself you will not be able to compile MyString[0], but the copy and delete methods are protected from this error, (as David explained) however it appears from what I saw in the debugger that 'Delete(s1, 0, wordcount)' will not throw an exception but fails to delete. So I would not expect RBuilder to be any better, and perhaps worse - copy() may also be failing on string[0] in RAP.
RAP is NOT Delphi - it is a Runtime scripting environment that runs in your template, based on Object Pascal, but it does not support everything, and you cannot always expect it to behave exactly like Delphi.
BTW - ReportBuilder is now up to version 14.0X - if possible you should upgrade - there have been a lot of improvements in the RAP environment. In a later version your code might work OK or you'll get back an error message from RAP.
Also: If you want to debug in RAP it's not so easy. But to give you a clue as to where the error might be occurring, put a text label on your report and after each line of your code add
mylabel.caption:='statementxxx ran';
or
mylabel.caption:= myVariable.value;
Etc. That will give you a little ad hoc tracer - maybe show you where/why you failed, etc.
For all searching people: I found the solution with the excellent help of this community!
The working code looks like this:
procedure DetailBeforeGenerate;
var
S1: String;
S2: String;
wordcount: Integer;
notelength: Integer;
begin
S1 := plPrintInvLine['ArtName'];
notelength := Length(S1);
while (notelength > 0) do
begin
wordcount := Pos(';',S1);
S2 := Copy(S1, 1, wordcount-1);
if ( Pos(' ',S2) = 1 ) then Delete(S2, 1, 1);
Memo1.Lines.Add(S2);
Delete(S1, 1, wordcount);
notelength := notelength - wordcount;
end;
end;