Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2704
  • Last Modified:

Resize TShockwaveFlash control in Delphi

This seems to be a notorious "feature" in TShockwaveFlash and/or Delphi: it's impossible to resize the control and have it accommodate to its new size.
Well, I've come to some kind of code that does the trick, but it's quite ugly:

  for I := 1 to 5 do
  begin
    FF.Perform(CM_UIDEACTIVATE, 0, 0);
    FF.StopPlay;
    FF.Play;
    FF.Perform(CM_UIACTIVATE, 0, 0);
    Sleep(100);
    Application.ProcessMessages;
  end;

and it doesn't always work. I need the code for an embedded OLE object, and I need to capture the control surface right after the resize, so I need to know WHEN the control is ready to be captured.
Also, code that clears and restores the Movie property doesn't work for me, because it doesn't reload the movie immediately, but after some time (checking the ReadyState after that won't do either)

I'm sending code and pas/dpr files for demo that demonstrates the problem. It saves the control image to file "control.bmp" after pressing the Grow/Shrink buttons, which change control size.
So, I need a modification of the ResizeFlash procedure, which won't call Sleep, Application.ProcessMessages, etc. and will leave the control in a state ready to capture its surface accommodated to new dimensions.
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, ShockwaveFlashObjects_TLB, StdCtrls, Buttons;
 
type
  TForm1 = class(TForm)
    bbGrow: TBitBtn;
    bbShrink: TBitBtn;
    FF: TShockwaveFlash;
    procedure bbGrowClick(Sender: TObject);
    procedure bbShrinkClick(Sender: TObject);
  private
    procedure ResizeFlash;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure PaintControl(AControl: TWinControl);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Width := AControl.Width;
    Bmp.Height := AControl.Height;
    AControl.PaintTo(Bmp.Canvas, 0, 0);
    Bmp.SaveToFile(ExtractFilePath(Application.ExeName) + 'control.bmp');
  finally
    Bmp.Free;
  end;
end;
 
procedure TForm1.bbGrowClick(Sender: TObject);
begin
  FF.SetBounds(0, 0, FF.Width + 50, FF.Height + 50);
  ResizeFlash;
  PaintControl(FF);
end;
 
procedure TForm1.bbShrinkClick(Sender: TObject);
begin
  FF.SetBounds(0, 0, FF.Width - 50, FF.Height - 50);
  ResizeFlash;
  PaintControl(FF);  
end;
 
procedure TForm1.ResizeFlash;
var
  I: Integer;
begin
  for I := 1 to 5 do
  begin
    FF.Perform(CM_UIDEACTIVATE, 0, 0);
 
    FF.StopPlay;
    FF.Play;
 
    FF.Perform(CM_UIACTIVATE, 0, 0);
 
    Sleep(100);
    Application.ProcessMessages;
  end;
 
end;
 
end.

Open in new window

EE-Flash-Demo.rar.txt
0
richyt
Asked:
richyt
  • 8
  • 6
1 Solution
 
Eddie ShipmanAll-around developerCommented:
Try this:

procedure TForm1.bbGrowClick(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  FF.SetBounds(0, 0, FF.Width + 50, FF.Height + 50);
  FF.GotoFrame(1);
  FF.SetFocus;
  LockWindowUpdate(0);
  PaintControl(FF);
  FF.Play;
end;
 
procedure TForm1.bbShrinkClick(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  FF.SetBounds(0, 0, FF.Width - 50, FF.Height - 50);
  FF.GotoFrame(1);
  FF.SetFocus;
  LockWindowUpdate(0);
  PaintControl(FF);
  FF.Play;
end;

Open in new window

0
 
Eddie ShipmanAll-around developerCommented:
BTW, Can you zip and post your SWF?
0
 
richytAuthor Commented:
Hello, Eddie
Thank you for your reply!
This code works in general, but unfortunately not for the case with OLE.
That is, I have the Flash control inside a Panel which has Parent = nil and ParentWindow set to the Ole container. I've changed the main form a little to illustrate this. If you comment the 2 lines in the OnCreate event, all is fine, but this is not the Ole case. Hope you can figure sth. out. I've also uploaded the swf file, but you can test using any. Pls rename the attachment to rar - they have such crappy uploading engine - PAS files are not allowed!

Regards, Alex
EE-Flash-Demo.txt
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
Eddie ShipmanAll-around developerCommented:
Well, first off, why are you setting the Panel's parent to nil?
Looks like everything works to me if you don't do that.

BTW, you didn't resize the panel in the Shrink.

The code below worked just fine for me. It even created different size BMPs

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, ShockwaveFlashObjects_TLB, StdCtrls, Buttons, ExtCtrls;
 
type
  TForm1 = class(TForm)
    bbGrow: TBitBtn;
    bbShrink: TBitBtn;
    FF: TShockwaveFlash;
    Panel: TPanel;
    procedure bbGrowClick(Sender: TObject);
    procedure bbShrinkClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure PaintControl(AControl: TWinControl);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Width := AControl.Width;
    Bmp.Height := AControl.Height;
    AControl.PaintTo(Bmp.Canvas, 0, 0);
    Bmp.SaveToFile(ExtractFilePath(Application.ExeName) + 'control.bmp');
  finally
    Bmp.Free;
  end;
end;
 
procedure TForm1.bbGrowClick(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  Panel.SetBounds(Panel.Left, Panel.Top, Panel.Width + 50, Panel.Height + 50);
  FF.GotoFrame(1);
  FF.SetFocus;
  LockWindowUpdate(0);
  PaintControl(FF);
  FF.Play;
end;
 
procedure TForm1.bbShrinkClick(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  Panel.SetBounds(Panel.Left, Panel.Top, Panel.Width - 50, Panel.Height - 50);
  FF.GotoFrame(1);
  FF.SetFocus;
  LockWindowUpdate(0);
  PaintControl(FF);
  FF.Play;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Panel.Parent := Form1;
  Panel.ParentWindow := Handle;
  FF.Movie := ExtractFilePath(Application.ExeName) + 'game.swf';
  FF.Play;
end;
 
end.

Open in new window

0
 
richytAuthor Commented:
I need to set the Parent property to nil, so that the ParentWindow property takes effect, that's the way all OLE objects work! In which case, unfortunately, your code still doesn't work.
0
 
Eddie ShipmanAll-around developerCommented:
I still don't understand what the hell OLE has to do with this project.
Can you explain it?
0
 
richytAuthor Commented:
As I said in my 1st post, " I need the code for an embedded OLE object..."
i.e. the Flash control resides inside a panel, which is inside an OLE container (say Word, Excel, etc.), and as such it has ParentWindow set to that container and Parent = nil
0
 
Eddie ShipmanAll-around developerCommented:
Why is the flash control on a panel, then? Can't you place it directly on the form's surface?
0
 
richytAuthor Commented:
For ease of use (program logic, etc.) - I need to display it in editor form also (which is a Delphi TMainForm). You can try using the flash control directly and setting its Parent to nil and ParentWindow to sth. If it works, maybe it will work on panel also.
0
 
Eddie ShipmanAll-around developerCommented:
Well, if I don't use the Panel, it still works just like it should. I don't know how to create this OLE object you are speaking of to test it.
0
 
Eddie ShipmanAll-around developerCommented:
Try this and see if it works for you:
procedure TForm1.bbGrowClick(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  FF.Parent := nil;
  FF.Perform(CM_UIDEACTIVATE, 0, 0);
  FF.SetBounds(FF.Left, FF.Top, FF.Width + 50, FF.Height + 50);
  FF.ParentWindow := Handle;
  FF.GotoFrame(1);
  FF.SetFocus;
  FF.Scale := 'ShowAll';
  LockWindowUpdate(0);
  FF.Perform(CM_UIACTIVATE, 0, 0);
  PaintControl(FF);
  FF.Play;
end;
 
procedure TForm1.bbShrinkClick(Sender: TObject);
begin
  LockWindowUpdate(Handle);
  FF.Parent := nil;
  FF.Perform(CM_UIDEACTIVATE, 0, 0);
  FF.SetBounds(FF.Left, FF.Top, FF.Width - 50, FF.Height - 50);
  FF.ParentWindow := Handle;
  FF.GotoFrame(1);
  FF.SetFocus;
  FF.Scale := 'ShowAll';
  LockWindowUpdate(0);
  FF.Perform(CM_UIACTIVATE, 0, 0);
  PaintControl(FF);
  FF.Play;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  FF.Parent := nil;
  FF.ParentWindow := Handle;
  FF.Movie := ExtractFilePath(Application.ExeName) + 'game.swf';
  FF.Play;
end;

Open in new window

1
 
richytAuthor Commented:
yes, this code works in the demo, but not in the project. I'll check what's causing this behaviour in the OLE project and will let you know if this code's ok
0
 
richytAuthor Commented:
Yes, this code with some modifications works for my flash movie (it's a very weird movie as it seems) The key point seems to be the call to GotoFrame(1)
Thank you very much for your help, Eddie, and sorry if I wasted a little more of your time
Best regards, Alex
0
 
Eddie ShipmanAll-around developerCommented:
Glad to be of assistance...
0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 8
  • 6
Tackle projects and never again get stuck behind a technical roadblock.
Join Now