The progressbar being updated is shown in Windows. In OSX the progressbar is shown but without see the progressbar shifting.
See code below.
procedure TForm1.Button1Click(Sender: TObject);
var
m : TMemoryStream;
begin
IdHTTP1.OnWork:= HttpWork;
m := TMemoryStream.Create;
IdHTTP1.Get('http://www.example.com/pictures.zip', m);
m.SaveToFile('/users/demo/pictures.zip');
m.Free;
end;
procedure TForm1.HttpWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
var
Http: TIdHTTP;
ContentLength: Int64;
Percent: Integer;
begin
Http := TIdHTTP(ASender);
ContentLength := Http.Response.ContentLength;
Percent := 100 * AWorkCount div ContentLength;
ProgressBar1.Value := Percent;
end;
How can the progressbar be updated in OSX?
Here's what I have in my code, and it works on both Windows and Mac:
Percent := 100 * AWorkCount div ContentLength;
frmDownloadProgress.ProgressBar1.Value := Percent;
Application.ProcessMessages;
Application.ProcessMessages is the key for updating the progress bar if the TIdHTTP component is on the main thread.
Related
This is my code that works except for the icon
procedure TForm1.FormCreate(Sender: TObject);
var item : TMenuItemInfo;
begin
with item do
begin
cbSize := SizeOf(MenuItemInfo);
fMask := MIIM_TYPE or MIIM_ID;
fType := MFT_STRING;
wID := 180;
dwTypeData := PChar('Test');
cch := 4;
hbmpItem := Image1.Picture.Bitmap.Handle; //Image1 is TImage
end;
InsertMenuItem(GetSystemMenu(Handle, FALSE),0,true,item);
end;
A couple of issues:
You don't clear the TMenuItemInfo instance before use. Unassigned fields may contain invalid or erroneous data when the call is made.
Use
ZeroMemory(#item, SizeOf(item));
at the beginning of the procedure.
The combination of fMask and fType members you have is incorrect.
Use the following instead
fMask := MIIM_STRING or MIIM_BITMAP or MIIM_ID;
// fType := MFT_STRING;
That is, don't assign fType
Here is a sample snip of a test, where a TImage holds the image depicting a number 2 on orange background. That is added as icon to the new menu item. (Which is your question)
Adding test code as requested:
// Note! Your `Image1` must have a bitmap loaded
procedure TForm39.AddSystemMenuItem;
var
item : TMenuItemInfo;
begin
ZeroMemory(#item, SizeOf(item));
with item do
begin
cbSize := SizeOf(MenuItemInfo);
fMask := MIIM_STRING or MIIM_BITMAP or MIIM_ID;
// fType := MFT_STRING;
wID := 180;
dwTypeData := PChar('Test');
cch := 4;
hbmpItem := Image1.Picture.Bitmap.Handle; //Image1 is TImage
end;
if not InsertMenuItem(GetSystemMenu(Handle, FALSE),0,true,item) then
ShowMessage('Failed');
end;
procedure TForm39.Button1Click(Sender: TObject);
begin
AddSystemMenuItem;
end;
I try to find an example on how to retrieve the application version and build nr so I can display it in the help box of an OSX application.
Trivial on Windows but on Mac its not.
Hope you can help!
Edward
I use this code that I have written. Simply call:
osxNSBundle.BundleVersion()
Here is the code:
uses
Macapi.Foundation,
Macapi.Helpers;
osxNSBundle = class
private
class function MainBundle: NSBundle;
public
class function BundlePath: string;
class function BundleVersionStr: string;
class procedure BundleVersion(var aMajor,aMinor,aBuild: integer);
end;
implementation
class function osxNSBundle.MainBundle: NSBundle;
begin
result := TNSBundle.Wrap(TNSBundle.OCClass.mainBundle);
end;
class function osxNSBundle.BundlePath: string;
begin
result := NSStrToStr(MainBundle.bundlePath);
end;
class function osxNSBundle.BundleVersionStr: string;
begin
Result := NSStrToStr(TNSString.Wrap(MainBundle.objectForInfoDictionaryKey(StrToNSStr('CFBundleVersion'))));
end;
class procedure osxNSBundle.BundleVersion(var aMajor,aMinor,aBuild: integer);
var lStrArray: TArray<string>;
i: Integer;
begin
aMajor := 0; aMinor := 0; aBuild := 0;
lStrArray := BundleVersionStr.Split(['.']);
if Length(lStrArray)>=3 then
begin
aMajor := lStrArray[0].ToInteger;
aMinor := lStrArray[1].ToInteger;
aBuild := lStrArray[2].ToInteger;
end;
end;
I am currently making a little Program in Delphi 10.3 Community Version 26.0.34749.6593. No additional components.
Essentially I draw on TPaintBox which is fitted in a Panel. Everything works fine so far, but when the objects are repainted via "PaintBox1.Repaint" the Objects got the wrong BrushStyle (bsSolid when they should have bsClear e.g.) Of course I tried to pin it down, but I got no luck. But I found out that at the following Point something doesn't work:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
i: Integer;
fig : ^TFigure;
apen: TPenStyle;
abrush: TBrushStyle;
color1,color2: TColor;
begin
aPen := PaintBox1.Canvas.Pen.Style;
aBrush := bsStyle;
color1 := PaintBox1.Canvas.Brush.Color;
color2 := PaintBox1.Canvas.Pen.Color;
for I:=0 to List.Count-1 do
begin
fig := List.Items[i];
case fig.Typ of
f_Kreis : begin
with Paintbox1.Canvas do
begin
pen.Style := fig.Pen;
Brush.Style := fig.Brush;
pen.Color := fig.PenColor;
brush.Color := fig.BrushColor;
Ellipse(fig.X,fig.Y,fig.X2,fig.Y2);
end;
end;
f_Rechteck : begin
with PaintBox1.Canvas do
begin
Pen.Style := fig.Pen;
Brush.Style := fig.Brush;
Pen.Color := fig.PenColor;
Brush.Color := fig.BrushColor;
Rectangle(fig.X,fig.Y,fig.X2,fig.Y2);
end;
end;
f_Line : begin
with PaintBox1.Canvas do
begin
pen.Style := fig.Pen;
brush.Style := fig.Brush;
pen.Color := fig.PenColor;
brush.Color := fig.BrushColor;
MoveTo(fig.X,Fig.Y);
LineTo(fig.X2,fig.Y2);
end;
end;
end;
end;
PaintBox1.Canvas.Pen.Style := aPen;
bsStyle := aBrush;
PaintBox1.Canvas.Brush.Color := color1;
PaintBox1.Canvas.Pen.Color := color2;
end;
So when the "Brush.Style := fig.Brush;"-Line is called, nothing happens. I went step by step and after these Line "Brush.Style" is still "bsSolid" even when "fig.Brush" is "bsClear"
For explanation: TFigure is my own class. It houses information about a drawing, such as a rectangle. It is the parent class.
Do I miss something. I really am out of Ideas. Can anyone tell me, why nothing happens?
Edit:
For testing I added the lines:
if Brush.Style <> fig.Brush then
ShowMessage('Warnung!');
under
Brush.Style := fig.Brush;
and it actually wont set it on false, though Brush.Style is bsSolid and fig.Brush is bsClear.
You have declared fig : ^TFigure;, but class instances are already references (pointers). Thus you are creating a pointer to reference, and using that pointer as if it were the reference.
Remove the pointer operator and declare
fig: TFigure;
I can't verify whether there are other errors in your code
i am asking about the possibility of compressing TIdMemoryBufferStream Using TIdCompressorZLib how can it be done properly using the following code
procedure TClientThread.SendBuffer(Buffer: TIdBytes; BufferSize: Cardinal);
Var
Strm: TIdMemoryBufferStream;
IdCompressorZLib : TIdCompressorZLib;
begin
Strm := TIdMemoryBufferStream.Create(PByte(Buffer), BufferSize);
IdCompressorZLib := TIdCompressorZLib.Create(nil);
try
// then can't figure what the right process to do
FTCP.Socket.WriteLn('Stream');
FTCP.Socket.LargeStream := True;
FTCP.Socket.Write(Strm, 0, True);
finally
FreeAndNil(Strm);
FreeAndNil(IdCompressorZLib);
end;
end;
i am not sure about the right process that needs to be done
as example should i create another variable as StrmB then calling the compress to it ?
The TIdCompressorZLib component is intended to be used only with the Compressor property of the TIdHTTP and TIdFTP components.
For general purpose compression over a TCP connection, you can assign a TIdCompressionIntercept component to the TCP connection's IOHandler.Intercept property, eg:
var
Compressor : TIdCompressionIntercept;
begin
Compressor := TIdCompressionIntercept.Create(nil);
try
Compressor.CompressionLevel := 9;
FTCP.Socket.Intercept := Compressor;
try
// any data written here will be compressed....
finally
FTCP.Socket.Intercept := nil;
end;
finally
Compressor.Free;
end;
end;
However, since you are sending the byte size of the compressed data (by setting the AWriteByteCount parameter to True in TIdIOHandler.Write(TStream)), that will not work with the compression intercept.
Indy's IdZLib unit has a TCompressionStream class, and various ...CompressStream/Ex() functions, that you can use instead, eg:
procedure TClientThread.SendBuffer(Buffer: TIdBytes; BufferSize: Cardinal);
var
Strm: TMemoryStream;
Compressor : TCompressionStream;
begin
Strm := TMemoryStream.Create;
try
Compressor := TCompressionStream.Create(clMax, Strm, False);
try
WriteTIdBytesToStream(Compressor, Buffer, BufferSize);
finally
Compressor.Free;
end;
FTCP.Socket.WriteLn('Stream');
FTCP.Socket.LargeStream := True;
FTCP.Socket.Write(Strm, 0, True);
finally
Strm.Free;
end;
end;
Or:
procedure TClientThread.SendBuffer(Buffer: TIdBytes; BufferSize: Cardinal);
var
InStrm: TIdMemoryBufferStream;
OutStrm: TMemoryStream;
begin
OutStrm := TMemoryStream.Create;
try
InStrm := TIdMemoryBufferStream.Create(PByte(Buffer), BufferSize);
try
CompressStreamEx(InStrm, OutStrm, clMax, zsZLib);
finally
InStrm.Free;
end;
FTCP.Socket.WriteLn('Stream');
FTCP.Socket.LargeStream := True;
FTCP.Socket.Write(OutStrm, 0, True);
finally
OutStrm.Free;
end;
end;
Delphi 2010
I'm Transferring Image via custom TCP Socket control uses UTF-8
Client Side
var
TSS: TStringStream;
STR :String;
JPG:TJPEGImage;
BMP:TBitmap;
begin
Try
BMP.LoadFromFile('C:\1.bmp');
JPG.Assign(BMP);
JPG.CompressionQuality:=80;
JPG.Compress;
TSS:=TStringStream.Create;
JPG.SaveToStream(TSS);
STR:=TSS.DataString;
MyTCPSocket.SendString(STR);
finally
BMP.free;
JPG.free;
TSS.free;
end;
end;
Server Side
Var
TSS: TStringStream;
TSS:=TStringStream.Create;
TSS.WriteString(STR);
TSS.SaveToFile('C:\2.jpg');
This code working on the same pc great.
The problem when I send the image to other pc that uses different encoding
it receive the image but I see many wrong characters in the data "?????"
I think when TStringStream writes the bytes to the file it fails to convert the unicode characters to bytes so it appears like "?"
Any idea is much appreciated
You are trying to send binary data as if it were UTF-8 encoded text. It is not, so do not try to do that! Send the binary data in its original binary form, eg:
var
MS: TMemoryStream;
JPG: TJPEGImage;
BMP: TBitmap;
begin
MS := TMemoryStream.Create;
try
JPG := TJPEGImage.Create;
try
BMP := TBitmap.Create;
try
BMP.LoadFromFile('C:\1.bmp');
JPG.Assign(BMP);
finally
BMP.Free;
end;
JPG.CompressionQuality := 80;
JPG.Compress;
JPG.SaveToStream(MS);
finally
JPG.Free;
end;
MS.Position := 0;
MyTCPSocket.SendStream(MS);
finally
MS.free;
end;
end;
var
MS: TMemoryStream;
begin
MS := TMemoryStream.Create;
try
MyTCPSocket.ReadStream(MS);
MS.Position := 0;
MS.SaveToFile('C:\2.jpg');
finally
MS.Free;
end;
end;
If you must send binary data as text, you need to encode the data using a real binary-to-text encoding algorithm, such as base64 or yEnc, not UTF-8 (which is designed for only encoding Unicode text, not binary data), eg:
// TIdEncoderMIME and TIdDecoderMIME are part of Indy,
// which ships with Delphi, but you can use whatever
// you want...
uses
..., IdCoderMIME;
var
S: String;
MS: TMemoryStream;
JPG: TJPEGImage;
BMP: TBitmap;
begin
MS := TMemoryStream.Create;
try
JPG := TJPEGImage.Create;
try
BMP := TBitmap.Create;
try
BMP.LoadFromFile('C:\1.bmp');
JPG.Assign(BMP);
finally
BMP.Free;
end;
JPG.CompressionQuality := 80;
JPG.Compress;
JPG.SaveToStream(MS);
finally
JPG.Free;
end;
MS.Position := 0;
S := TIdEncoderMIME.EncodeStream(MS);
finally
MS.free;
end;
MyTCPSocket.SendString(S);
end;
uses
..., IdCoderMIME;
var
S: string;
MS: TMemoryStream;
begin
S := MyTCPSocket.ReadString;
MS := TMemoryStream.Create;
try
TIdDecoderMIME.DecodeStream(S, MS);
MS.Position := 0;
MS.SaveToFile('C:\2.jpg');
finally
MS.Free;
end;
end;