I want realize the flip animation effect using Embarcadero XE6 for develope FireMonkey Mobile Application for IPhone and Android
i have founded the effect into Embarcadero XE6 for Delphi:
Playing card flip animation
It's possible convert the source code from Delphi to FireMonkey Mobile?
Yes, it is possable. But nothing automatic that i know of. You would have to manually do it.
Look at the firemonkey help
http://docwiki.embarcadero.com/CodeExamples/XE3/en/FMX.MetropolisUIFlipViewDemo_Sample
and what it looks like..
http://www.youtube.com/watch?v=SxhAvw37lEw
This piece of code may give you a headstart for a 3D-cardflip using Firemonkey.
procedure TFormMain.Flip( aTabControl: TTabControl; aFront, aBack: TTabItem; aBkColor: TAlphaColor; aDirection: TFlipDirection ) ;
var
Viewport: TViewport3D;
R: TRectangle3D;
bmpFront: TBitmap;
bmpBack: TBitmap;
matFront: TTextureMaterialSource;
matBack: TTextureMaterialSource;
Depth: extended;
Angle: extended;
begin
// Create a viewport and let it overlap aControl
Viewport := TViewport3D.Create(nil);
Viewport.BoundsRect := aTabControl.BoundsRect;
Viewport.Position.X := aTabControl.Position.X;
Viewport.Position.Y := aTabControl.Position.Y;
Viewport.Color := aBkColor;
Viewport.Parent := Self;
// Create a flat 3d-rectangle and let it fully contain the Viewport
R := TRectangle3D.Create(Viewport);
R.Parent := Viewport;
R.Projection := TProjection.Screen;
R.Width := Viewport.Width;
R.Height := Viewport.Height;
R.Depth := 0;
// Create a texture for the front and the back
matFront := TTextureMaterialSource.Create(Viewport);
aTabControl.ActiveTab := aFront;
matFront.Texture := aTabControl.MakeScreenshot;
R.MaterialSource := matFront;
matBack := TTextureMaterialSource.Create(Viewport);
aTabControl.ActiveTab := aBack;
matBack.Texture := aTabControl.MakeScreenshot;
matBack.Texture.FlipHorizontal;
R.MaterialBackSource := matBack;
// Do the flip
Depth := 10;
R.Position.Z := Depth;
case aDirection of
fdNormal : Angle := 180;
fdReverse: Angle := -180;
end;
R.AnimateFloatWait( 'Position.Z', Depth, 0.1, TAnimationType.InOut, TInterpolationType.Linear );
R.AnimateFloatWait( 'RotationAngle.Y', Angle, 0.5,
TAnimationType(cbAnimationType.ItemIndex), {best is In}
TInterpolationType(cbInterpolationType.ItemIndex) ); {best is Back}
R.AnimateFloatWait( 'Position.Z', 0, 0.1, TAnimationType.InOut, TInterpolationType.Linear);
// Clear viewport and its children
Viewport.DisposeOf;
end;
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 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 using TChart with a set of TFastLineSeries, created at run time.
Is it possible to use for a half of series the left axis as Y-axis, for another half - the right one, with individual min/max for each axis?
I don't see properties that can assign axes to series or vice versa.
procedure TForm1.FormShow(Sender: TObject);
var
sv: TSoundingVol;
i: Integer;
serT0, serT05, serUllage, serVCG: TChartSeries;
begin
sv := TSoundingVol.Create();
try
Chart1.ClearChart();
Chart1.View3D := False;
Chart1.Legend.CheckBoxes := True;
Chart1.Axes.Bottom.Title.Text := 'Sounding, m';
Chart1.Axes.Left.Title.Text := 'Volume, m³';
serT0 := TFastLineSeries.Create(Chart1);
serT0.Title := 'At Trim 0 m';
serT05 := TFastLineSeries.Create(Chart1);
serT05.Title := 'At Trim +0,5 m (by bow)';
//Following series should use the right axis and own scaling
serUllage := TFastLineSeries.Create(Chart1);
serUllage.Title := 'Ullage (m)';
serVCG := TFastLineSeries.Create(Chart1);
serVCG.Title := 'VCG (Vertical Center of Gravity)';
for i := Low(SB505Data) to High(SB505Data) do begin
sv.Load(SB505Data[i]);
serT0.AddXY(sv.Sounding, sv.AtTrim0);
serT05.AddXY(sv.Sounding, sv.AtTrim0_5);
serUllage.AddXY(sv.Sounding, sv.Ullage);
serVCG.AddXY(sv.Sounding, sv.VCG);
end;
Chart1.AddSeries(serT0);
Chart1.AddSeries(serT05);
Chart1.AddSeries(serUllage);
Chart1.AddSeries(serVCG);
finally
sv.Free();
end;
end;
On a per series basis you can set which Vertical Axis to use.
serUllage.VertAxis := aRightAxis;
serVCG.VertAxis := aRightAxis;
Example of two differently scaled axis used at once.
The individual min/max for each axis is done by:
Chart1.RightAxis.SetMinMax(0, 100);
Chart1.LeftAxis.SetMinMax(10, 8000);
with legend checkboxes you can select each either:
Chart1.Legend.CheckBoxes:= True;
Full example at: http://www.softwareschule.ch/examples/json5.txt
I'm trying to create an animated GIF from a series of arbitrary non-paletted images. In order to create a paletted image, I need to come up with a palette somehow.
// RGBA, etc. images from somewhere else
var frames []image.Image
outGif := &gif.GIF{}
for _, simage := range frames {
// TODO: Convert image to paletted image
// bounds := simage.Bounds()
// palettedImage := image.NewPaletted(bounds, ...)
// Add new frame to animated GIF
outGif.Image = append(outGif.Image, palettedImage)
outGif.Delay = append(outGif.Delay, 0)
}
gif.EncodeAll(w, outGif)
Is there an easy way in golang stdlib to accomplish this?
It seems an automatic way of intelligently generating palettes is missing from the golang stdlib (correct me if I'm wrong here). But there seems to be a stub for providing your own Quantizer, which led me to the gogif project. (Which was the apparent source of image.Gif.)
I was able to borrow the MedianCutQuantizer from that project, defined here:
https://github.com/andybons/gogif/blob/master/mediancut.go
Which results in the following:
var subimages []image.Image // RGBA, etc. images from somewhere else
outGif := &gif.GIF{}
for _, simage := range subimages {
bounds := simage.Bounds()
palettedImage := image.NewPaletted(bounds, nil)
quantizer := gogif.MedianCutQuantizer{NumColor: 64}
quantizer.Quantize(palettedImage, bounds, simage, image.ZP)
// Add new frame to animated GIF
outGif.Image = append(outGif.Image, palettedImage)
outGif.Delay = append(outGif.Delay, 0)
}
gif.EncodeAll(w, outGif)
Instead of generating your own palette, you can also use on of the predefined (https://golang.org/pkg/image/color/palette/)
...
palettedImage := image.NewPaletted(bounds, palette.Plan9)
draw.Draw(palettedImage, palettedImage.Rect, simage, bounds.Min, draw.Over)
...
How do I take a picture from a TImageList and put it into a TImage (or return it as a TGraphic)?
The important point is that a TImageList can contain 32-bpp alpha blended images. The goal is to get one of these alpha-blended images and place it in a TImage. This means at some point i would likely require a TGraphic. Although, strictly speaking, my question is about placing an image from an ImageList into an Image. If that can be accomplished without an intermedate TGraphic then that is also fine.
What do we want?
We want the guts of a function:
procedure GetImageListImageIntoImage(SourceImageList: TCustomImageList;
ImageIndex: Integer; TargetImage: TImage);
begin
//TODO: Figure this out.
//Neither SourceImageList.GetIcon nor SourceImageList.GetBitmap preserve the alpha channel
end;
There can also be another useful intermediate helper function:
function ImageListGetGraphic(ImageList: TCustomImageList; ImageIndex: Integer): TGraphic;
var
// ico: TIcon;
bmp: TBitmap;
begin
{Doesn't work; loses alpha channel.
Windows Icon format can support 32bpp alpha bitmaps. But it just doesn't work here
ico := TIcon.Create;
ImageList.GetIcon(ImageIndex, ico, dsTransparent, itImage);
Result := ico;
}
{Doesn't work; loses alpha channel.
Windows does support 32bpp alpha bitmaps. But it just doesn't work here
bmp := TBitmap.Create;
bmp.PixelFormat := pf32bit;
Imagelist.GetBitmap(ImageIndex, bmp);
Result := bmp;
}
end;
Letting us convert the original procedure to:
procedure GetImageListImageIntoImage(SourceImageList: TCustomImageList; ImageIndex: Integer; TargetImage: TImage);
var
g: TGraphic;
begin
g := ImageListGetGraphic(SourceImageList, ImageIndex);
TargetImage.Picture.Graphic := g; //Assignment of TGraphic does a copy
g.Free;
end;
I also some random things:
Image1.Picture := TPicture(ImageList1.Components[0]);
but that does not compile.
P.S. I have Delphi 2010
ImageList1.GetBitmap(0, Image1.Picture.Bitmap);
Routine to get a transparent graphic out of an ImageList:
function ImageListGetGraphic(ImageList: TCustomImageList; ImageIndex: Integer): TGraphic;
var
ico: HICON;
// png: TPngImage;
// icon: TIcon;
// bmp: TBitmap;
wicbmp: IWICBitmap;
wi: TWicImage;
begin
{ //Works. Uses our own better Wic library.
ico := ImageList_GetIcon(ImageList.Handle, ImageIndex, ILD_NORMAL);
Result := TWicGraphic.FromHICON(ico);
DestroyIcon(ico);}
//Works, uses the built-in Delphi TWicImage (careful of VCL bugs)
ico := ImageList_GetIcon(ImageList.Handle, ImageIndex, ILD_NORMAL);
wi := TWICImage.Create; //Due to a bug in the VCL, you must construct the TWicImage before trying to access the Wic ImagingFactory
OleCheck(TWicImage.ImagingFactory.CreateBitmapFromHICON(ico, wicbmp));
wi.Handle := wicbmp;
Result := wi;
{ //Doesn't work, loses alpha channel
icon := TIcon.Create;
ImageList.GetIcon(ImageIndex, icon, dsTransparent, itImage);
Result := icon;
}
{ //Doesn't work, loses alpha channel
bmp := TBitmap.Create;
bmp.PixelFormat := pf32bit;
Imagelist.GetBitmap(ImageIndex, bmp);
Result := bmp;
}
{ //Fails: cannot assign a TIcon to a TPngImage
icon := TIcon.Create;
ImageList.GetIcon(ImageIndex, icon, ImgList.dsNormal, itImage);
png := TPngImage.Create;
png.Assign(icon);
Result := png;
icon.Free;
}
{ //Working failure; doesn't support stretched drawing (e.g. TImage.Stretch = true)
icon := TIcon.Create;
ImageList.GetIcon(ImageIndex, icon, ImgList.dsNormal, itImage);
Result := ico;
}
end;
Sample usage:
g: TGraphic;
g := ImageListGetGraphic(ImageList1, 7);
Image1.Picture.Graphic := g;
g.Free;
Note: Any code released into public domain. No attribution required.