In my Firebird database I have a Blob field that contain a Bitmap. I'll have to load and display in a TImage located on my Form. Subsequently I'll have to save in the same field the image selected by a OpenDialog.
Procedure LoadBitmapFromBlob(Bitmap: TBitmap; Blob: TBlobField);
var
ms, ms2: TMemoryStream;
begin
ms := TMemoryStream.Create;
try
Blob.SaveToStream(ms);
ms.Position := 0;
Bitmap.LoadFromStream(ms);
finally
ms.Free;
end;
end;
example usage
procedure TForm4.Button1Click(Sender: TObject);
var
bmp: TBitmap;
begin
bmp := TBitmap.Create;
try
LoadBitmapFromBlob(bmp, TBlobField(Dataset.FieldByName('Image')));
Image1.Picture.Assign(bmp);
bmp.SaveToFile(OpenDialog.FileName);
finally
bmp.Free;
end;
end;
Related
How to resize a TWICImage without losing transparency? I use the JclGraphics.Resize() method whose parameter is a TBitmap. Transparency is lost in the TBitmap.Assign() method.
In this case, the image is of the type icon. But in another case, it may be a different type of image.
uses
jclGraphics, ShellApi, UrlMon;
procedure ResizeImageStream(AStream: TMemoryStream; AWidth, AHeight: Integer);
var
WicImage: TWicImage;
Bitmap1: TBitmap;
begin
WicImage := TWicImage.Create;
try
WicImage.LoadFromStream(AStream);
if ((WicImage.Width > 32) or (WicImage.Height > 32)) then begin
Bitmap1 := TBitmap.Create;
try
Bitmap1.Assign(WicImage);
Bitmap1.Transparent := True;
Bitmap1.TransparentColor := clBlack;
Stretch(AWidth, AHeight, rfMitchell, 0, Bitmap1);
WicImage.Assign(Bitmap1);
AStream.Clear;
WicImage.SaveToStream(AStream);
finally
FreeAndNil(Bitmap1);
end;
end;
finally
WicImage.Free;
end;
end;
procedure ResizeImageFile(AFileNameSrc, AFileNameDsc: String; AWidth, AHeight: Integer);
var
Stream: TMemoryStream;
begin
Stream := TMemoryStream.Create;
try
Stream.LoadFromFile(AFileNameSrc);
ResizeImageStream(stream, AWidth, AHeight);
if FileExists(AFileNameDsc) then
DeleteFile(AFileNameDsc);
Stream.SaveToFile(AFileNameDsc);
finally
Stream.Free;
end;
end;
procedure TForm4.FormCreate(Sender: TObject);
begin
URLDownloadToFile(nil, PChar('https://www.shell.cz/apps/settings/wcm/designs/shell-rio/clientlibs/themes/theme-shell/resources/favicon/favicon.ico'),
PChar('C:\p\favicon.ico'), 0, nil);
ResizeImageFile('C:\p\favicon.ico', 'C:\p\favicon_32.ico', 32, 32);
end;
The WIC API has its own built-in resizing capabilities, you don't need to convert the TWICImage to a TBitmap at all. For example:
var
WicImage: TWICImage;
Scale: IWICBitmapScaler;
WicBitmap: IWICBitmap;
begin
WicImage := TWICImage.Create;
try
WicImage.LoadFromStream(Stream);
OleCheck(WicImage.ImagingFactory.CreateBitmapScaler(Scale));
OleCheck(Scale.Initialize(WicImage.Handle, 32, 32, WICBitmapInterpolationModeFant));
OleCheck(WicImage.ImagingFactory.CreateBitmapFromSourceRect(Scale, 0, 0, 32, 32, WicBitmap));
WicImage.Handle := WicBitmap;
Stream.Clear;
WicImage.SaveToStream(Stream);
finally
WicImage.Free;
end;
end;
I've got a project at schools which requires to write datas from a .txt file to a "memobox" in Lazarus freepascal.
There are datas in order like this.
Budapest tomato 23
Dublin tv 45
Rosslare projector 43
etc.
I have to read these datas from a .txt file and then write them into a memobox in Lazarus freepascal.
If I am not mistaken I have already copyed the datas from the .txt file but I have no idea how to write them.
I've already written this code:
type
cityname:integer;
product:string;
quantity:integer;
var
Form1: TForm1;
ceg:array[1..5] of rektip;
db:integer;
implementation
procedure TForm1.Button1Click(Sender: TObject);
var f:textfile; i:integer; a:char;
begin
assignfile(f,'termek.txt');
reset(f);
readln(f,db);
While not eof(f) do
begin
readln(f,ceg[i].varosnev,a,ceg[i].termek,a,ceg[i].darabszam);
end;
db:=1;
closefile(f);
end;
procedure TForm1.Button2Click(Sender: TObject);
var i:integer;
begin
For i:=1 to db do
Memo1.lines.add(ceg[i].varosnev,ceg[i].termek,IntToStr(ceg[i].darabszam));
end;
end;
I would like to know how to fix it.
The code you posted is incomplete, so I assume:
type
rektip = record
varosnev: string;
termek: string;
darabszam: Integer;
end;
There is a lot wrong with your approach:
readln(f,db);
While not eof(f) do
begin
readln(f,ceg[i].varosnev,a,ceg[i].termek,a,ceg[i].darabszam);
end;
db:=1;
closefile(f);
end;
You are not initializing nor updating i, so you are reading all data into the same record, and you don't even know which one (i could be 100 and you'd be writing the data to somewhere unknown -- there is no ceg[100]). That results in undefined behaviour (and that can be a crash too).
Do something like:
var
ceg: array of rektip;
...
begin
AssignFile(f, 'termek.txt');
Reset(f);
Readln(f, db);
if db = 0 then
Exit;
SetLength(ceg, db);
i := 0;
while not eof(f) do
begin
Readln(f, ceg[i].varosnev, ceg[i].termek, ceg[i].darabszam);
Inc(i);
if i > High(ceg) then
Break;
end;
SetLength(ceg, i); // remove any empty slots.
CloseFile(f);
end;
Now you can put them into the TMemo:
for i := Low(ceg) to High(ceg) do
begin
Memo1.Lines.Add(Format('%s %s %d', [ceg[i].varosnev, ceg[i].termek, ceg[i].darabszam]));
end;
Note that the code above, reading from the file, assumes the file looks like:
3
Budapest tomato 23
Dublin tv 45
Rosslare projector 43
i.e. each "record" is on a line of its own and the first line contains the number of records.
I need to re-order a TObjectList, according to some rules. How can I achieve this?
So I add panels to a ScrollBox dinamically.
When I add them, I also add them to the ObjectList in the order that they are added at runtime, for future use. Then I can re-organize the panels in the scrollBox by drag/drop.
I want the ObjectList to mirror the same order that is set at runtime by drag/drop.
Here is my code:
var
MainForm: TMainForm;
PanelList,PanelListTMP:TObjectList;
implementation
...
procedure TMainForm.FormCreate(Sender: TObject);
begin
PanelList:=TObjectList.Create;
PanelListTMP:=TObjectList.Create;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
AddPanel('0');
AddPanel('1');
AddPanel('2');
AddPanel('3');
AddPanel('4');
end;
procedure TMainForm.Addpanel(what:string);
var
pan:TPanel;
bv:TShape;
begin
pan:=TPanel.Create(self);
pan.Parent:=TheContainer;
pan.Height:=50;
pan.BevelOuter:=bvNone;
pan.BorderStyle:=bsNone;
pan.Ctl3D:=false;
pan.Name:='LayerPan'+what;
pan.Caption:=what;
pan.Align:=alBottom;
pan.OnMouseDown:=panMouseDown;
end;
procedure TMainForm.panMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
var
i:integer;
idu:String;
panui:TPanel;
begin
panui:=Sender as TPanel;
panui.ParentColor:=false;
panui.BringToFront;
// DRAG DROP STUFF
ReleaseCapture;
panui.Perform(wm_nclbuttondown,HTCAPTION,0);
for i := 0 to MainForm.ComponentCount - 1 do
begin
if MainForm.Components[i] is TWinControl then
if TWinControl(MainForm.Components[i]) is TPanel then
if (TWinControl(MainForm.Components[i]) as TPanel).Parent=MainForm.TheContainer then
begin
(TWinControl(MainForm.Components[i]) as TPanel).Align:=alBottom;
end;
end;
TheContainer.ScrollInView(panui);
ReOrderPanels;
end;
Procedure TMainForm.ReOrderPanels;
begin
end;
What should I do in the ReOrderPanels procedure?
I was thinking about feeding the panels of the ScrollBox from bottom to top into a new TObjectList (PanelListTMP), clear the PanelList and re-add them from the PanelListTMP, but when I do that, I get an error: Access Violation, and EInvalidPointer - Invalid Pointer Operation
So this is what I thought:
procedure TMainForm.ReOrderPanels;
var
ctrl:TControl;
pos:TPoint;
pan:TPanel;
bad:boolean;
ord,i:integer;
begin
memo2.Lines.Add('*** new order START');
panelListTMP.Clear;
// scroll top
TheContainer.VertScrollBar.Position := 0;
// scroll down
TheContainer.VertScrollBar.Position := TheContainer.VertScrollBar.Range;
// get panel
Pos:=TheContainer.ClientOrigin;
Pos.Y:=Pos.Y+TheContainer.Height-5;
ctrl := FindVCLWindow(pos) ;
if ctrl is TPanel then
if TPanel(ctrl).Parent = TheContainer then
begin
pan:=(ctrl as TPanel);
panelListTMP.Add(pan);
end;
ord:=1;
bad:=false;
repeat
repeat
Pos.Y:=pos.Y-1;
until (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos)<>pan);
if (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos).Name<>'LayerPan') then
begin
pan:=FindVCLWindow(pos) as TPanel;
containeru.VertScrollBar.Position := 0;
containeru.ScrollInView(pan);
ord:=ord+1;
panelListTMP.Add(pan);
end
else
bad:=true;
until bad=true;
// and now I do the swap between the ObjectLists...
panelList.Clear;
for i:=0 to PanelListTMP.Count-1 do
begin
(PanelListTMP.Items[i] as TPanel).Parent:=containeru;
panelList.Add(PanelListTMP.Items[i]);
end;
end;
So I assume that because the ObjectList is storing pointers to the actual objects, then when I clear the initial ObjectList, the actual objects are freed, so the second ObjectList contains a list of pointers that are no longer viable...
But then how can I achieve what I want?
So on ButtonClick, I get a ObjectList that contains panels in the following order:
PanelList[0] - Panel0
PanelList[1] - Panel1
PanelList[2] - Panel2
PanelList[3] - Panel3
PanelList[4] - Panel4
After I drag - drop panels inside the ScrollBox, I can end up with an order like this (in the ScrollBox)
Panel3
panel1
Panel4
Panel2
Panel0
But in the ObjectList, the order is the same as before...
Again, I want to be able to have the ObjectList ordered according to the order of the panels from the scrollBox.
In the re-order procedure I actually get all the panels in the desired order.
I just need to have them in the same order in my ObjectList.
Is there any other way of doing this? Other that with me creating a new class that would hold an index beside a TPanel and use that in the ObjectList to maintain the order?
TObjectList has an OwnsObjects property that is True by default. Make sure to set it to False since you don't want the list to auto-free the objects as they are owned by the Form.
As for the actual sorting of the TObjectList, consider using its Sort() or SortList() method for that. After you have repositioned the Panels as desired within their container, call Sort() or SortList(). The sorting callback you provide will be given two object pointers at a time while the sorting is iterating the list. Use the current positions of the objects relative to each other to tell the list what order they should appear in.
Try something like this:
var
MainForm: TMainForm;
PanelList: TObjectList;
implementation
...
procedure TMainForm.FormCreate(Sender: TObject);
begin
PanelList := TObjectList.Create(False);
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
PanelList.Free;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
AddPanel('0');
AddPanel('1');
AddPanel('2');
AddPanel('3');
AddPanel('4');
end;
procedure TMainForm.Addpanel(what: string);
var
pan: TPanel;
bv: TShape;
begin
pan := TPanel.Create(Self);
try
pan.Parent := TheContainer;
pan.Height := 50;
pan.BevelOuter := bvNone;
pan.BorderStyle := bsNone;
pan.Ctl3D := false;
pan.Name := 'LayerPan'+what;
pan.Caption := what;
pan.Align := alBottom;
pan.OnMouseDown := panMouseDown;
PanelList.Add(pan);
except
pan.Free;
raise;
end;
end;
procedure TMainForm.panMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
i: integer;
idu: String;
panui, pan: TPanel;
tmpList: TObjectList;
begin
panui := Sender as TPanel;
panui.ParentColor := false;
panui.BringToFront;
// DRAG DROP STUFF
ReleaseCapture;
panui.Perform(WM_NCLBUTTONDOWN, HTCAPTION, 0);
tmpList := TObjectList.Create(False);
try
for i := 0 to TheContainer.ControlCount - 1 do
begin
if TheContainer.Controls[i] is TPanel then
tmpList.Add(TPanel(TheContainer.Controls[i]));
end;
for i := 0 to tmpList.Count - 1 do
TPanel(tmpList[i]).Align := alBottom;
finally
tmpList.Free;
end;
TheContainer.ScrollInView(panui);
ReOrderPanels;
end;
function SortPanels(Item1, Item2: Pointer): Integer;
begin
Result := TPanel(Item2).Top - TPanel(Item1).Top;
end;
procedure TMainForm.ReOrderPanels;
begin
PanelList.Sort(SortPanels);
// Alternatively:
{
PanelList.SortList(
function(Item1, Item2: Pointer): Integer;
begin
Result := TPanel(Item2).Top - TPanel(Item1).Top;
end
);
}
end;
I think I found my answer using a temporary ObjectList and Extract(Object)
My code that seems to work is:
procedure TMainForm.ReOrderPanels;
var
ctrl:TControl;
pos:TPoint;
pan,panx:TPanel;
bad:boolean;
ord,i:integer;
begin
panelListTMP.Clear;
panelList.OwnsObjects:=false;
// scroll top
TheContainer.VertScrollBar.Position := 0;
// scroll down
TheContainer.VertScrollBar.Position := TheContainer.VertScrollBar.Range;
// get panel
Pos:=TheContainer.ClientOrigin;
Pos.Y:=Pos.Y+TheContainer.Height-5;
ctrl := FindVCLWindow(pos) ;
if ctrl is TPanel then
if TPanel(ctrl).Parent = TheContainer then
begin
pan:=(ctrl as TPanel);
panelListTMP.Add(PanelList.Extract(pan) as TPanel);
end;
ord:=1;
bad:=false;
repeat
repeat
Pos.Y:=pos.Y-1;
until (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos)<>pan);
if (FindVCLWindow(pos) is TPanel)and(FindVCLWindow(pos).Name<>'LayerPan') then
begin
pan:=FindVCLWindow(pos) as TPanel;
TheContainer.VertScrollBar.Position := 0;
TheContainer.ScrollInView(pan);
ord:=ord+1;
panelListTMP.Add(PanelList.Extract(pan) as TPanel);
end
else
bad:=true;
until bad=true;
panelList.Clear;
panelListTMP.OwnsObjects:=false;
i:=0;
while (PanelListTMP.Count<>0) do
panelList.Add(PanelListTMP.Extract(PanelListTMP.Items[i]) as TPanel);
panelList.OwnsObjects:=true;
panelListTmp.Clear;
end;
This does not display the image:
Button to send a picture:
procedure TForm1.Button3Click(Sender: TObject);
var
ms :TMemoryStream;
begin
try
ms := TMemoryStream.Create;
IdTCPClient2.Host:=Edit1.Text;
IdTCPClient2.Connect;
Image1.Bitmap.SaveToStream(ms);
ms.Position := 0;
IdTCPClient2.IOHandler.LargeStream := true;
IdTCPClient2.IOHandler.Write(ms,0,True);
finally
IdTCPClient2.Disconnect;
end;
ms.Free;
end;
and the server executes
procedure TForm1.IdTCPServer2Execute(AContext: TIdContext);
var
ms:TMemoryStream;
size : Integer;
begin
ms := TFileStream.Create;
try
ms.Position:= 0;
AContext.Connection.IOHandler.LargeStream:=true;
AContext.Connection.IOHandler.ReadStream(ms);
ms.Position:=0;
Image2.Bitmap.LoadFromStream(ms);
finally
ms.Free;
end;
end;
What is wrong?
OnExecute is called in the context of a worker thread. You have to synchronize with the main thread in order to update UI controls. For example:
procedure TForm1.IdTCPServer2Execute(AContext: TIdContext);
var
ms:TMemoryStream;
begin
ms := TMemoryStream.Create;
try
AContext.Connection.IOHandler.LargeStream:=true;
AContext.Connection.IOHandler.ReadStream(ms);
ms.Position := 0;
TThread.Synchronize(nil,
procedure
begin
Image2.Bitmap.LoadFromStream(ms);
end
);
finally
ms.Free;
end;
end;
I've found this great component and installed it, it's running great, but I have a slight problem with it. Which unfortunately I don't know how to do it myself.
Can someone help me add a new feature to this component . That would allow it take Images from ImageList ? I would fill up ImageList dynamicaly during my execution time.
Right now I'm doing the following to show a preview of the TILE :
procedure TTools.Preview_ImageExecute(Sender: TObject);
var image_temp : TBitmap;
begin
image_temp := TBitmap.Create;
LoadBitMap(ComboBox1.Text,image_temp,Main.ASDb1);
Image1.Picture.Bitmap:=image_temp;
image_temp.Free;
end;
Would like to use this somehow with the Image Grid... it should somehow allow me to load all my tiles.. I would use a For loop to fill it up...
Meanwhile I was playing with ListBox, and managed to do this :
procedure TTools.Lst1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var CenterText : integer;
begin
Lst1.Canvas.FillRect(Rect);
Il1.Draw(lst1.Canvas,rect.Left +4, rect.Top +4, Index);
Centertext := (rect.Bottom - rect.Top -lst1.Canvas.TextHeight(text)) div 2;
Lst1.Canvas.TextOut(rect.left + il1.width + 8, rect.Top + CenterText, lst1.Items.Strings[index]);
end;
procedure TTools.Lst1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
Height := IL1.Height+4;
end;
procedure TTools.Button4Click(Sender: TObject);
var i : integer;
image_temp : TBitmap;
begin
image_temp := TBitmap.Create;
for i:=0 to Main.Images.Count-1 do
begin
Lst1.Items.Add(Main.Images.Item[i].Name);
LoadBitMap(Main.Images.Item[i].Name,image_temp,Main.ASDb1);
IL1.AddMasked(image_temp, clNone);
end;
Image_temp.Free;
end;
This works, if I have 0 Columns, but I cant get it working with say 4 columns , can someone help ?
Greetings
Robert
Never Mind ... I solved it like this :
procedure TTools.Button4Click(Sender: TObject);
var i : integer;
image_temp : TBitmap;
begin
image_temp := TBitmap.Create;
for i:=0 to Main.Images.Count-1 do
begin
LoadBitMap(Main.Images.Item[i].Name,image_temp,Main.ASDb1);
ListView1.Items.Add.Caption:=Main.Images.Item[i].Name;
ListView1.Items.Item[i].ImageIndex:=i;
IL1.AddMasked(image_temp, clNone);
end;
Image_temp.Free;
end;
This load's the image names as well as the images from my Asphyre Image list...