AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Ersatz für Sleep?

Ein Thema von PeterPanino · begonnen am 9. Mär 2016 · letzter Beitrag vom 10. Mär 2016
 
PeterPanino

Registriert seit: 4. Sep 2004
1.472 Beiträge
 
Delphi 10.4 Sydney
 
#1

Ersatz für Sleep?

  Alt 9. Mär 2016, 19:17
Delphi-Version: 10 Seattle
Hallo und schönen Abend!

Ich verwende diesen Code, um den Windows CHM-Viewer in mein Programm einzubetten und eine CHM-Datei darin anzuzeigen:

Formular-Definition:
Delphi-Quellcode:
object Form1: TForm1
  Left = 1838
  Top = 468
  Caption = 'Form1'
  ClientHeight = 681
  ClientWidth = 656
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  DesignSize = (
    656
    681)
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 24
    Top = 24
    Width = 177
    Height = 25
    Caption = 'Embed Viewer App'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Panel1: TPanel
    Left = 8
    Top = 64
    Width = 640
    Height = 609
    Anchors = [akLeft, akTop, akRight, akBottom]
    TabOrder = 1
    OnResize = Panel1Resize
    ExplicitWidth = 448
    ExplicitHeight = 321
  end
  object Button2: TButton
    Left = 216
    Top = 24
    Width = 177
    Height = 25
    Caption = 'Release Viewer App'
    TabOrder = 2
    OnClick = Button2Click
  end
end
Form-Unit:
Delphi-Quellcode:
unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Panel1Resize(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    FAppWnd: DWORD;
    procedure PADoEmbeddApp(APanel: TPanel; const AAppToExec, AParam: string);
    procedure PADoReleaseEmbeddedApp;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  Winapi.ShellAPI;

procedure TForm1.PADoEmbeddApp(APanel: TPanel; const AAppToExec, AParam: string);
// App starten und einbetten
// uses Winapi.ShellAPI;
var
  ExecuteFile: string;
  SEInfo: TShellExecuteInfo;
  RetryCount: Integer;
begin
  FillChar(SEInfo, SizeOf(SEInfo), 0);
  SEInfo.cbSize := SizeOf(TShellExecuteInfo);
  with SEInfo do
  begin
    fMask := SEE_MASK_NOCLOSEPROCESS;
    Wnd := APanel.Handle;
    lpFile := PChar(AAppToExec);
    lpParameters := PChar(AParam);
    nShow := SW_HIDE;
  end;

  if ShellExecuteEx(@SEInfo) then // wenn Programm erfolgreich gestartet wurde
  begin
    RetryCount := 0;
    repeat
      FAppWnd := FindWindow(PChar('HH Parent'), nil);
      Sleep(100);
      Inc(RetryCount);
    until (FAppWnd <> 0) or (RetryCount > 10);

    if FAppWnd <> 0 then // wenn das Fenster der ViewerApp gefunden wurde
    begin
      Winapi.Windows.SetParent(FAppWnd, SEInfo.Wnd);
      SetWindowLong(FAppWnd, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE)
        and not WS_BORDER
        and not WS_THICKFRAME
        and not WS_DLGFRAME
        );

      SetWindowPos(FAppWnd, 0, 0, 0, APanel.Width, APanel.Height, SWP_ASYNCWINDOWPOS);

      Sleep(1000); // das Gelbe vom Ei?

      APanel.Repaint;
      Application.ProcessMessages;

      ShowWindow(FAppWnd, SW_SHOWMAXIMIZED);
    end;
  end;
end;

procedure TForm1.PADoReleaseEmbeddedApp;
// Eingebettetes Programm beenden
begin
  if FAppWnd <> 0 then
  begin
    PostMessage(FAppWnd, WM_Close, 0, 0);
    FAppWnd := 0;
  end;
end;

procedure TForm1.Panel1Resize(Sender: TObject);
// Größe von Embedded App zusammen mit Fenster verändern
begin
  if IsWindow(FAppWnd) then
    SetWindowPos(FAppWnd, 0, 0, 0, Panel1.Width, Panel1.Height, SWP_ASYNCWINDOWPOS);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  PADoEmbeddApp(Panel1, 'hh.exe', 'R:\Example.chm');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  PADoReleaseEmbeddedApp;
end;

end.
Das funktioniert auch sehr gut. Nur stört mich das Sleep(1000); nach SetWindowPos. Oder auch das Sleep(100); in der repeat-Schleife davor. Gibt es dafür keine elegantere Lösung?
  Mit Zitat antworten Zitat
 

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 13:36 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz