Thema: Delphi Programm schliesst einfach so

Einzelnen Beitrag anzeigen

hedie

Registriert seit: 12. Dez 2005
Ort: Schweiz
1.024 Beiträge
 
Delphi XE6 Starter
 
#3

Re: Programm schliesst einfach so

  Alt 20. Apr 2007, 17:00
Was noch zu sagen sein sollte ist...

Das Programm wird Angezeigt für etwa 2 - 3 Sekunden (variiert merkwürdigerweise)
und erst danach schliesst es sich

so der quellcode...

zusammenfalten · markieren
Delphi-Quellcode:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg, OleCtrls, SHDocVw, StdCtrls, XPMan, MSHTML, ComCtrls,
  Menus, inifiles, ShellAPI, ActiveX;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Image1: TImage;
    WebBrowser1: TWebBrowser;
    Edit1: TEdit;
    Panel2: TPanel;
    XPManifest1: TXPManifest;
    StatusBar1: TStatusBar;
    Image2: TImage;
    Image3: TImage;
    Timer1: TTimer;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    Bearbeiten1: TMenuItem;
    Asnicht1: TMenuItem;
    Favoriten1: TMenuItem;
    Extras1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    Einstellungen1: TMenuItem;
    N3: TMenuItem;
    Einklappen1: TMenuItem;
    Download1: TMenuItem;
    About1: TMenuItem;
    Image4: TImage;
    Image5: TImage;
    N4: TMenuItem;
    Beenden1: TMenuItem;
    Updates1: TMenuItem;
    Hinzufgen1: TMenuItem;
    ffnen1: TMenuItem;
    Entfernen1: TMenuItem;
    N5: TMenuItem;
    HideTaskleiste1: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure Edit1DblClick(Sender: TObject);
    procedure Entfernen1Click(Sender: TObject);
    procedure ffnen1Click(Sender: TObject);
    procedure Hinzufgen1Click(Sender: TObject);
    procedure Updates1Click(Sender: TObject);
    procedure Beenden1Click(Sender: TObject);
    procedure Image5Click(Sender: TObject);
    procedure Image4Click(Sender: TObject);
    procedure WebBrowser1NavigateError(ASender: TObject; const pDisp: IDispatch;
      var URL, Frame, StatusCode: OleVariant; var Cancel: WordBool);
    procedure About1Click(Sender: TObject);
    procedure Image3Click(Sender: TObject);
    procedure Image2Click(Sender: TObject);
    procedure Einklappen1Click(Sender: TObject);
    procedure Einstellungen1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure WebBrowser1DocumentComplete(ASender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure Panel4MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Panel2Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure HideTaskleiste1Click(Sender: TObject);
  private
     hi:bool;
     hi2:bool;
     counter:integer;
     ExtParam:bool;
     FOleInPlaceActiveObject: IOleInPlaceActiveObject;
     procedure MsgHandler(var Msg: TMsg; var Handled: Boolean);
  public
    ini:TIniFile;
    version:string;
    PStatus:String;
    Serial:string;
    VPL:String;
  end;

var
  Form1: TForm1;

implementation

uses About, Favoriten;

{$R *.dfm}

procedure TForm1.MsgHandler(var Msg: TMsg; var Handled: Boolean);
const
  StdKeys = [VK_BACK, VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT];
var IOIPAO: IOleInPlaceActiveObject;
  Dispatch: IDispatch;
begin
  if WebBrowser1 = nil then
  begin
    Handled := False;
    Exit;
  end;
  Handled := (IsDialogMessage(WebBrowser1.Handle, Msg) = True);
  if (Handled) and (not WebBrowser1.Busy) then
  begin
    if FOleInPlaceActiveObject = nil then
    begin
      Dispatch := WebBrowser1.Application;
      if Dispatch <> nil then
      begin
        Dispatch.QueryInterface(IOleInPlaceActiveObject, IOIPAO);
        if IOIPAO <> nil then FOleInPlaceActiveObject := IOIPAO;
      end;
    end;
    if FOleInPlaceActiveObject <> nil then
      if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
        (Msg.wParam in StdKeys) then
        //nothing - do not pass on Backspace, Left, Right, Up, Down arrows
      else FOleInPlaceActiveObject.TranslateAccelerator(Msg);
  end;
end;

procedure startup();
begin
if Form1.extparam = false then begin
Form1.ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'siexdata.six');
Form1.ini.ReadString('Main','sid','freeshare.ath.cx');
Form1.ini.Free;
end;
end;

procedure navigate(URL:String);
begin
Form1.WebBrowser1.Navigate(URL);
end;

procedure TForm1.About1Click(Sender: TObject);
begin
Form5.Showmodal;
end;

procedure TForm1.Beenden1Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.Edit1DblClick(Sender: TObject);
begin
Edit1.SelectAll;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then begin
  key := #0;
    navigate(Edit1.Text);
  end;
end;

procedure TForm1.Einklappen1Click(Sender: TObject);
begin
Panel1.Top := 0;
Panel1.Left := 0;
Panel1.Anchors := [akLeft,akTop,akRight];
Panel1.Width := Form1.Width -8;
Image1.Width := Form1.Width -8;
hi := false;
hi2 := false;
Webbrowser1.SetFocus;
end;

procedure TForm1.Einstellungen1Click(Sender: TObject);
var
sid:String;
begin
ini:=TIniFile.create(ExtractFilePath(ParamStr(0))+'siexdata.six');
sid := ini.ReadString('Main',sid,'freeshare.ath.cx');
ini.Free;
ShellExecute(Handle,'open', 'siexse.exe',pchar(sid), nil, SW_SHOWdefault) ;
end;

procedure TForm1.Entfernen1Click(Sender: TObject);
var
pos:integer;
begin
pos := Form4.ListBox1.Items.IndexOf(Webbrowser1.LocationURL);
if pos > -1 then Form4.ListBox1.Items.Delete(pos);
end;

procedure TForm1.ffnen1Click(Sender: TObject);
begin
Form4.Show;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := MsgHandler;
if paramstr(1) = '' then begin
Webbrowser1.Navigate('siexnet.com');
extparam := true;
end
else
Webbrowser1.Navigate(paramstr(1));

///////////////Minimiert Starten///////////
{
Panel1.Top := -58;
Webbrowser1.Height := Webbrowser1.Height + 60;
Webbrowser1.Top := Webbrowser1.Top -59;
}
////////////////////////////////////////////
panel1.DoubleBuffered := true;
Webbrowser1.DoubleBuffered := true;
hi := true; ///////////////Bei Minimiert Start müssen beide False sein!!!!!
hi2 := false;
////////////////////////////////VersionsInformations/////////////////
PStatus := ('Beta');
Version := ('0.0.1.9');
VPL := '0019';
/////////////////////////////////////////////////////////////////////
startup();
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FOleInPlaceActiveObject := nil;
end;

procedure TForm1.HideTaskleiste1Click(Sender: TObject);
begin
  ShowWindow( Application.Handle, SW_HIDE );
  SetWindowLong( Application.Handle, GWL_EXSTYLE,
                 GetWindowLong(Application.Handle, GWL_EXSTYLE) or
                 WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
  ShowWindow( Application.Handle, SW_SHOW );

end;

procedure TForm1.Hinzufgen1Click(Sender: TObject);
begin
Favoriten.Form4.Add := True;
Form4.URL := Webbrowser1.LocationURL;
Form4.Show;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    ReleaseCapture;
  if Sender is TImage then
    TWinControl(TImage(Sender).Parent).Perform(WM_SYSCOMMAND, $F012, 0)
  else
    TWinControl(Sender).Perform(WM_SYSCOMMAND, $F012, 0);
        Panel1.Anchors := [akLeft,akTop];
    Panel1.Width := 585;
    Webbrowser1.Top := 0;
    if hi2 = false then begin
Webbrowser1.Height := Webbrowser1.Height + 59;
hi2 := true;
Webbrowser1.SetFocus;
    end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if hi = false then begin
webbrowser1.Top := 60;
webbrowser1.Height := Webbrowser1.Height - 59;
Panel1.Top := 0;
hi := true;
end;
end;

procedure TForm1.Image2Click(Sender: TObject);
begin
try
Webbrowser1.GoBack;
except

end;
end;

procedure TForm1.Image3Click(Sender: TObject);
begin
try
Webbrowser1.GoForward;
except

end;
end;

procedure TForm1.Image4Click(Sender: TObject);
begin
Webbrowser1.Refresh;
end;

procedure TForm1.Image5Click(Sender: TObject);
begin
Webbrowser1.Stop;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // Mausereignisse abfangen
  ReleaseCapture;
  // mit TWinCotrol verschieben, $F012 verschiebt den Button
  TWinControl(Sender).Perform(WM_SYSCOMMAND, $F012, 0);
    Panel1.Anchors := [akLeft,akTop];
    Panel1.Width := 585;
    Webbrowser1.Top := 0;
    if hi2 = false then begin
Webbrowser1.Height := Webbrowser1.Height + 60;
hi2 := true;
Webbrowser1.SetFocus;
    end;
    end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if hi = false then begin
webbrowser1.Top := 60;
webbrowser1.Height := Webbrowser1.Height - 59;
Panel1.Top := 0;
hi := true;
end;
end;

procedure TForm1.Panel2Click(Sender: TObject);
begin
navigate(Edit1.Text);
end;

procedure TForm1.Panel4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  // Mausereignisse abfangen
  ReleaseCapture;
  // mit TWinCotrol verschieben, $F012 verschiebt den Button
  TWinControl(Sender).Perform(WM_SYSCOMMAND, $F012, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
counter := counter +1;
end;

procedure TForm1.Updates1Click(Sender: TObject);
begin
ShellExecute(Handle,'open', 'siexup.exe',pchar(version+' '+PStatus+' - '+VPL),nil, SW_SHOWdefault) ;
end;

procedure TForm1.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
Application.Title := 'SIEX - ' + Form1.WebBrowser1.LocationName;
Form1.Caption := 'SIEX - ' + Form1.WebBrowser1.LocationName;
Edit1.Text := Webbrowser1.LocationURL;
end;

procedure TForm1.WebBrowser1NavigateError(ASender: TObject;
  const pDisp: IDispatch; var URL, Frame, StatusCode: OleVariant;
  var Cancel: WordBool);
begin
Navigate('file:///'+ExtractFilePath(ParamStr(0))+'data/404.html');
end;

procedure TForm1.WebBrowser1NewWindow2(ASender: TObject; var ppDisp: IDispatch;
  var Cancel: WordBool);
  var
    NewWindow: TForm1;
begin
//
{
    if cancel=false then
    begin
      NewWindow:=TForm1.Create(self);
      URL:=((TWebbrowser(ASender).document as IHTMLDocument2).activeElement as IHTMLElement).getAttribute('href', 0);
      NewWindow.Show;
      NewWindow.webbrowser1.Navigate(url);
    end;
}
//NewWindow := ShellExecute(Handle,'open', 'SIEX.exe',Webbrowser1, nil, SW_SHOWdefault);
NewWindow := Form1.Create(Self);
NewWindow.Show;
ppDisp := NewWindow.webbrowser1.DefaultDispatch;
ppDisp:=WebBrowser1.Application;
end;

initialization
  OleInitialize(nil);

finalization
  OleUninitialize

end.
Claudio
Tu was du nicht lassen kannst
- http://endasmedia.ch
  Mit Zitat antworten Zitat