Delphi - OleContainer - PowerPoint - AutoPlay - delphi

Good afternoon :-), in my application I use OleContainer to view presentation from Microsoft Powerpoint.
This code I use to load and run presentation file:
with oleContainer do begin
Parent := mediaPanel; Left := 0; Top := 0;
Width := mediaPanel.Width; Height := mediaPanel.Height;
CreateObjectFromFile('C:\Users\Nanik\Desktop\Present.ppt', false);
Iconic := false; Visible := true; Run;
end;
The presentation was created as autoplay slideshow (in Microsoft PowerPoint working), but in my application presentation was still on first slide. Run command isn't right?

You do not need a OleContainer to run the presentation inside a container in your application. Put a panel container to run the presentation in your form and try this routine:
procedure TForm2.Button3Click(Sender: TObject);
const
ppShowTypeSpeaker = 1;
ppShowTypeInWindow = 1000;
SHOW_FILE = 'C:\Users\jcastillo\Documents\test.pps';
var
oPPTApp: OleVariant;
oPPTPres: OleVariant;
screenClasshWnd: HWND;
pWidth, pHeight: Integer;
function PixelsToPoints(Val: Integer; Vert: Boolean): Integer;
begin
if Vert then
Result := Trunc(Val * 0.75)
else
Result := Trunc(Val * 0.75);
end;
begin
oPPTApp := CreateOleObject('PowerPoint.Application');
oPPTPres := oPPTApp.Presentations.Open(SHOW_FILE, True, True, False);
pWidth := PixelsToPoints(Panel1.Width, False);
pHeight := PixelsToPoints(Panel1.Height, True);
oPPTPres.SlideShowSettings.ShowType := ppShowTypeSpeaker;
oPPTPres.SlideShowSettings.Run.Width := pWidth;
oPPTPres.SlideShowSettings.Run.Height := pHeight;
screenClasshWnd := FindWindow('screenClass', nil);
Windows.SetParent(screenClasshWnd, Panel1.Handle);
end;
I do not have documentation at hand, but my thought is Run.Width and Run.Height must be provided in points, not in pixels. My poor man solution to convert pixels to points is here, and it works for me in my tests here... to find the correct way to convert in your environment is up to you.
Is supposed you can get the Handle of the presentation window from the oPPTPres.SlideShowSettings.Run.HWND property, but that does not work here for me, hence the FindWindow call.

Run is a method of TOleContainer, it is not a method specific to any kind of OLE object, say, a power point presentation or a bitmap image.. Documentation states "Call Run to ensure that the server application is running..".
You need to call object specific methods to operate on them, see PowerPoint Object Model Reference. Sample code:
procedure TForm1.Button1Click(Sender: TObject);
const
ppAdvanceOnTime = $00000002;
var
P: OleVariant;
S: OleVariant;
i: Integer;
begin
P := OleContainer1.OleObject.Application.Presentations.Item(1);
// below block would not be necessary for a slide show (i.e. a *.pps)
for i := 1 to P.Slides.Count do begin
P.Slides.Item(i).SlideShowTransition.AdvanceOnTime := True;
P.Slides.Item(i).SlideShowTransition.AdvanceTime := 1;
end;
S := P.SlideShowSettings;
S.AdvanceMode := ppAdvanceOnTime;
S.Run;
end;
Though the above will run the presentation as a slide show, it is probably not what you'd want because it runs in full screen. I have no idea how to run it in the container window..

Related

Delphi FMX Programmatically using TListview

Good day
I am trying to build an application which requires me to display multiple images in groups with selectable sizes.  The images consist of a bitmap and a text field.  My idea is to put the image groups in a TListview (Which I hope can display horizontally) and then add these listview groups into a TFlowlayout to manage the screen layout.
However, I simply do not get it right to create a TListview item programmatically to display the image.  I have tried to create a TListItemImage as well as simply adding a TListViewItem but neither worked in that I could see anything on the screen.
I am including my test code (Note it pulls images from a folder for testing).  The commented out sections will probably indicate some of the experiments that I tried.
I will probably also struggle to add the TListviews to the TFlowlayout.  Some advice will be much appreciated.  The idea is that the application will run on both Android mobile as well as desktops.
function TForm1.BuildGrpObj(GroupSize, CurrPicIdx: integer): boolean;
var
aPicObj : TListViewitem;
k: Integer;
aPicObjImg: TListItemImage;
// aPicObjImg: TListViewItem;
FName: string;
begin
for k := 0 to GroupSize-1 do
begin
aPicObj := Listview1.Items.Add;
aPicObj.Text := 'Picture: ' + inttostr(CurrPicIdx + k);
aPicObjImg := TListItemImage.Create(aPicObj);
// aPicObjImg := Listview1.Items.Add;
FName := LList[CurrPicIdx + k];
// aPicObjImg.Bitmap := TBitmap.Create;
aPicObjImg.Bitmap.LoadFromFile(FName);
aPicObjImg.Align := TListItemAlign.Center;
aPicObjImg.VertAlign := TListItemAlign.Center;
aPicObjImg.PlaceOffset.X := 0;
aPicObjImg.PlaceOffset.Y := 0;
aPicObjImg.Width := 40;
aPicObjImg.Height := 40;
aPicObjImg.invalidate;
end;
result := true;
end;

Get text from terminal window using WM_GETTEXT

I'm trying to get text from terminal window.
https://www.attachmate.com/products/extra/
it looks like below:
I'm using WM_GETTEXT to get text from this terminal window. As you can see above, the window has text (in green) but i'm not able to get anything, even after trying out all windows and child windows under this applications.
the code i use is:
function TForm1.fn_get_text(): string;
var
NpWnd, NpEdit: HWnd;
Buffer: string;
BufLen: Integer;
begin
Memo1.Clear;
NpWnd := FindWindow('#32769', nil);
if NpWnd <> 0 then
begin
//NpEdit := FindWindowEx(NpWnd, 0, 'Afx:400000:202b:10003:6:0', nil);
//if NpEdit <> 0 then
//begin
BufLen := SendMessage(NpWnd, WM_GETTEXTLENGTH, 0, 0);
SetLength(Buffer, BufLen + 1);
SendMessage(NpWnd, WM_GETTEXT, BufLen, LParam(PChar(Buffer)));
Memo1.Lines.Text := Buffer;
//end;
end;
end;
I used Winspy++ to get all window classes. In Win spy++, different window classes look like below:
I tried all window classes under Extra.exe . But nothing seems to be able to get me the text from terminal window. Could anyone please provide me some tips to identify the issue?

LoadIconWithScaleDown always fails

I am trying to play with the LoadIconWithScaleDown API.
I am using Delphi 2007, I wrote a simple sample program where upon a button click I call COMMCTRL.LoadIconWithScaleDown. I tried various combinations, with instance zero, with instance set to hInstance, for the second parameter, I tried to pass the current module name, MAKEINTRESOURCE( IDI_APPLICATION), ... Always no luck, I always get a return value of -2147467263. Any idea what I am doing wrong?
Edited upon David's suggestion to show how I tried to call the API.
procedure TForm31.Button1Click(Sender: TObject);
var moduleName : string;
var moduleNameW : widestring;
var retVal : HRESULT;
var iconHandle : HICON;
begin
iconHandle := 0;
SetLength( moduleName, 1024);
WINDOWS.GetModuleFileName(
hInstance,
PCHAR(moduleName),
LENGTH(moduleName));
moduleNameW := moduleName;
retVal := COMMCTRL.LoadIconWithScaleDown(
HINSTANCE,
PWidechar(moduleNameW),
image1.width,
image1.height,
iconHandle);
end;
This an excellent demonstration of why you should NOT use WinAPI functions without reading and understanding the documentation.
The documentation for LoadIconWithScaleDown clearly explains what the parameters are and how to use them. There is zero reason to use GetModuleFileName, and the parameter where you're passing it in is wrong anyway, which the documentation clearly states.
Here are examples for using the function both ways, first to load an icon from an external disk file and then to load from an icon resource in your application. It was compiled and tested under Delphi 10 Seattle and works, provided the file or resource exist where you're using it.
uses
CommCtrl;
var
hIco: HICON;
Ico: TIcon;
NewWidth, NewHeight: Integer;
begin
NewWidth := 16;
NewHeight := 16;
if Succeeded(LoadIconWithScaleDown(0,
'C:\Images\SomeFile.ico',
NewWidth, NewHeight, hIco)) then
begin
Ico := TIcon.Create;
Ico.Handle := hIco;
// Do whatever with the icon. Clean up is left to you
end;
if Succeeded(LoadIconWithScaleDown(hInstance,
'MYRESOURCENAME',
NewWidth, NewHeight, hIco)) then
begin
// See code above
end;
end;
(And no, the issue was not that you needed to call InitCommonControlsEx first. Including CommCtrl does the necessary initialization for you.)

How do I get the Control that is under the cursor in Delphi?

I need the opposite information that the question "How to get cursor position on a control?" asks.
Given the current cursor position, how can I find the form (in my application) and the control that the cursor is currently over? I need the handle to it so that I can use Windows.SetFocus(Handle).
For reference, I'm using Delphi 2009.
I experienced some problems with suggested solutions (Delphi XE6/Windows 8.1/x64):
FindVCLWindow doesn't search disabled controls (Enabled=False).
TWinControl.ControlAtPos doesn't search controls if they are disabled
indirectly (for example if Button.Enabled=True, but Button.Parent.Enabled=False).
In my case it was a problem, because i need to find any visible control under the mouse cursor, so i have to use my own implementation of function FindControlAtPos:
function FindSubcontrolAtPos(AControl: TControl; AScreenPos, AClientPos: TPoint): TControl;
var
i: Integer;
C: TControl;
begin
Result := nil;
C := AControl;
if (C=nil) or not C.Visible or not TRect.Create(C.Left, C.Top, C.Left+C.Width, C.Top+C.Height).Contains(AClientPos) then
Exit;
Result := AControl;
if AControl is TWinControl then
for i := 0 to TWinControl(AControl).ControlCount-1 do
begin
C := FindSubcontrolAtPos(TWinControl(AControl).Controls[i], AScreenPos, AControl.ScreenToClient(AScreenPos));
if C<>nil then
Result := C;
end;
end;
function FindControlAtPos(AScreenPos: TPoint): TControl;
var
i: Integer;
f,m: TForm;
p: TPoint;
r: TRect;
begin
Result := nil;
for i := Screen.FormCount-1 downto 0 do
begin
f := Screen.Forms[i];
if f.Visible and (f.Parent=nil) and (f.FormStyle<>fsMDIChild) and
TRect.Create(f.Left, f.Top, f.Left+f.Width, f.Top+f.Height).Contains(AScreenPos)
then
Result := f;
end;
Result := FindSubcontrolAtPos(Result, AScreenPos, AScreenPos);
if (Result is TForm) and (TForm(Result).ClientHandle<>0) then
begin
WinAPI.Windows.GetWindowRect(TForm(Result).ClientHandle, r);
p := TPoint.Create(AScreenPos.X-r.Left, AScreenPos.Y-r.Top);
m := nil;
for i := TForm(Result).MDIChildCount-1 downto 0 do
begin
f := TForm(Result).MDIChildren[i];
if TRect.Create(f.Left, f.Top, f.Left+f.Width, f.Top+f.Height).Contains(p) then
m := f;
end;
if m<>nil then
Result := FindSubcontrolAtPos(m, AScreenPos, p);
end;
end;
I think FindVCLWindow will meet your needs. Once you have the windowed control under the cursor you can walk the parent chain to find the form on which the window lives.
If you want to know the control inside a form that is at a certain x,y coordinate
Use
function TWinControl.ControlAtPos(const Pos: TPoint; AllowDisabled: Boolean;
AllowWinControls: Boolean = False; AllLevels: Boolean = False): TControl;
Given the fact that you seem only interested in forms inside your application, you can just query all forms.
Once you get a non-nil result, you can query the control for its Handle, with code like the following
Pseudo code
function HandleOfControlAtCursor: THandle;
const
AllowDisabled = true;
AllowWinControls = true;
AllLevels = true;
var
CursorPos: TPoint
FormPos: TPoint;
TestForm: TForm;
ControlAtCursor: TControl;
begin
Result:= THandle(0);
GetCursorPos(CursorPos);
for each form in my application do begin
TestForm:= Form_to_test;
FormPos:= TestForm.ScreenToClient(CursorPos);
ControlAtCursor:= TestForm.ControlAtPos(FormPos, AllowDisabled,
AllowWinControls, AllLevels);
if Assigned(ControlAtCursor) then break;
end; {for each}
//Break re-enters here
if Assigned(ControlAtCursor) then begin
while not(ControlAtCursor is TWinControl) do
ControlAtCursor:= ControlAtCursor.Parent;
Result:= ControlAtCursor.Handle;
end; {if}
end;
This also allows you to exclude certain forms from consideration should you so desire. If you're looking for simplicity I'd go with David and use FindVCLWindow.
P.S. Personally I'd use a goto rather than a break, because with a goto it's instantly clear where the break re-enters, but in this case it's not a big issue because there are no statements in between the break and the re-entry point.

Remove and Replace a visual component at runtime

Is it possible to, for instance, replace and free a TEdit with a subclassed component instantiated (conditionally) at runtime? If so, how and when it should be done? I've tried to set the parent to nil and to call free() in the form constructor and AfterConstruction methods but in both cases I got a runtime error.
Being more specific, I got an Access violation error (EAccessViolation). It seems François is right when he says that freeing components at frame costruction messes with Form controls housekeeping.
This more generic routine works either with a Form or Frame (updated to use a subclass for the new control):
function ReplaceControlEx(AControl: TControl; const AControlClass: TControlClass; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
begin
Result := nil;
Exit;
end;
Result := AControlClass.Create(AControl.Owner);
CloneProperties(AControl, Result);// copy all properties to new control
// Result.Left := AControl.Left; // or copy some properties manually...
// Result.Top := AControl.Top;
Result.Name := ANewName;
Result.Parent := AControl.Parent; // needed for the InsertControl & RemoveControl magic
if IsFreed then
FreeAndNil(AControl);
end;
function ReplaceControl(AControl: TControl; const ANewName: string; const IsFreed : Boolean = True): TControl;
begin
if AControl = nil then
Result := nil
else
Result := ReplaceControlEx(AControl, TControlClass(AControl.ClassType), ANewName, IsFreed);
end;
using this routine to pass the properties to the new control
procedure CloneProperties(const Source: TControl; const Dest: TControl);
var
ms: TMemoryStream;
OldName: string;
begin
OldName := Source.Name;
Source.Name := ''; // needed to avoid Name collision
try
ms := TMemoryStream.Create;
try
ms.WriteComponent(Source);
ms.Position := 0;
ms.ReadComponent(Dest);
finally
ms.Free;
end;
finally
Source.Name := OldName;
end;
end;
use it like:
procedure TFrame1.AfterConstruction;
var
I: Integer;
NewEdit: TMyEdit;
begin
inherited;
NewEdit := ReplaceControlEx(Edit1, TMyEdit, 'Edit2') as TMyEdit;
if Assigned(NewEdit) then
begin
NewEdit.Text := 'My Brand New Edit';
NewEdit.Author := 'Myself';
end;
for I:=0 to ControlCount-1 do
begin
ShowMessage(Controls[I].Name);
end;
end;
CAUTION: If you are doing this inside the AfterConstruction of the Frame, beware that the hosting Form construction is not finished yet.
Freeing Controls there, might cause a lot of problems as you're messing up with Form controls housekeeping.
See what you get if you try to read the new Edit Caption to display in the ShowMessage...
In that case you would want to use
...ReplaceControl(Edit1, 'Edit2', False)
and then do a
...FreeAndNil(Edit1)
later.
You have to call RemoveControl of the TEdit's parent to remove the control. Use InsertControl to add the new control.
var Edit2: TEdit;
begin
Edit2 := TEdit.Create(self);
Edit2.Left := Edit1.Left;
Edit2.Top := Edit2.Top;
Edit1.Parent.Insertcontrol(Edit2);
TWinControl(Edit1.parent).RemoveControl(Edit1);
Edit1.Free;
end;
Replace TEdit.Create to the class you want to use, and copy all properties you need like I did with Left and Top.
You can actually use RTTI (look in the TypInfo unit) to clone all the matching properties. I wrote code for this a while back, but I can't find it now. I'll keep looking.

Resources