From 4d64e4cd434426234a5c313c151cd79b6afc299e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juha=20Vehvil=C3=A4inen?= Date: Sat, 6 Jul 2002 17:50:18 +0000 Subject: *** empty log message *** svn path=/trunk/Framestein/; revision=27 --- Source/mainunit.pas | 903 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 903 insertions(+) create mode 100644 Source/mainunit.pas (limited to 'Source/mainunit.pas') diff --git a/Source/mainunit.pas b/Source/mainunit.pas new file mode 100644 index 0000000..ebf3f46 --- /dev/null +++ b/Source/mainunit.pas @@ -0,0 +1,903 @@ +{ Copyright (C) 2001-2002 Juha Vehviläinen + This program is free software; you can redistribute it and/or + modify it under the terms of the GNU General Public License + as published by the Free Software Foundation; either version 2 + of the License, or (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details.} + +unit mainunit; + +interface + +uses + Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, + StdCtrls, ScktComp, + pluginunit, fsformunit, fsframeunit, + FastDIB, + ExtCtrls, Menus, C2PhotoShopHost, Filez, ComCtrls; + +type + Tmain = class(TFsForm) + ss1: TServerSocket; + ImageLogo: TImage; + PopupMenu1: TPopupMenu; + MiConfig: TMenuItem; + MiReset: TMenuItem; + MiReloadPlugins: TMenuItem; + ssfs: TServerSocket; + csfs: TClientSocket; + MiLog: TMenuItem; + csToPd: TClientSocket; + MiExit: TMenuItem; + REConsole: TRichEdit; + procedure ss1ClientRead(Sender: TObject; Socket: TCustomWinSocket); + procedure FormCreate(Sender: TObject); + procedure ss1ClientError(Sender: TObject; Socket: TCustomWinSocket; + ErrorEvent: TErrorEvent; var ErrorCode: Integer); + procedure ss1ClientDisconnect(Sender: TObject; + Socket: TCustomWinSocket); + procedure MiConfigClick(Sender: TObject); + procedure ss1ClientConnect(Sender: TObject; Socket: TCustomWinSocket); + procedure MiResetClick(Sender: TObject); + procedure FormDestroy(Sender: TObject); + procedure MiReloadPluginsClick(Sender: TObject); + procedure ssfsClientRead(Sender: TObject; Socket: TCustomWinSocket); + procedure csfsError(Sender: TObject; Socket: TCustomWinSocket; + ErrorEvent: TErrorEvent; var ErrorCode: Integer); + procedure csfsDisconnect(Sender: TObject; Socket: TCustomWinSocket); + procedure ssfsClientError(Sender: TObject; Socket: TCustomWinSocket; + ErrorEvent: TErrorEvent; var ErrorCode: Integer); + procedure csfsConnect(Sender: TObject; Socket: TCustomWinSocket); + procedure ssfsClientConnect(Sender: TObject; Socket: TCustomWinSocket); + procedure ssfsClientDisconnect(Sender: TObject; + Socket: TCustomWinSocket); + procedure MiLogClick(Sender: TObject); + procedure csToPdError(Sender: TObject; Socket: TCustomWinSocket; + ErrorEvent: TErrorEvent; var ErrorCode: Integer); + procedure csToPdConnect(Sender: TObject; Socket: TCustomWinSocket); + procedure csToPdDisconnect(Sender: TObject; Socket: TCustomWinSocket); + procedure MiExitClick(Sender: TObject); + procedure ImageLogoDblClick(Sender: TObject); + procedure FormClose(Sender: TObject; var Action: TCloseAction); + private + { Private declarations } + SocketMem: Pointer; + fbmp: TFastDIB; + procedure LoadRegSettings; + procedure ParsePrim(const S: String); + procedure FreeIfCompExists(const S: String); + function GetFrameByTag(const tag: String): TFsFrame; + function ItemCount( const ClassName: String ): Integer; + procedure Reset; + procedure minimizeall; + procedure ExceptionHandler(Sender: TObject; E: Exception); + procedure DropFileHandler(const h: HWND; const DroppedFileName: String); + procedure AppMessage(var Msg: Tmsg; var Handled: Boolean); + public + { Public declarations } + RunConfig: Boolean; + PdHost: String; // Host running PD + PDReceivePort: Integer; // data from PD + PDSendPort: Integer; // data to PD + FSPort: Integer; // Framestein connections + EnableFSConns: Boolean; + DockMain: Boolean; + logstate: Boolean; + Plugins: TPlugins; + SearchPath: TStringList; + + function CompName(const S: String): String; + procedure Parse(const S: String); override; + procedure Post(const S: String); + procedure SendFrame(const f: TFsFrame; + const NameTag: String; const bmp: TFastDIB; + const quality: Integer; const sendjpg: Boolean ); + procedure SendReturnValues(const S: String); + procedure SendReturnValuesString( + const PdName: String; const S: String); + function FileExistsInSearchPath(var S: String): Boolean; // modifying S allowed! + end; + +const + STARTMSG = 'Framestein 0.30 running...'; + MCAPTION = 'Framestein 0.30'; + SocketBufferSize = 100000; + +var + main: Tmain; + DockTitle: String; + DockHandle: HWND; + +function WinEnumerator(h: HWND; i: LongInt): BOOL; stdcall; +function WinEnumerator_Exact(h: HWND; i: LongInt): BOOL; stdcall; +function WinEnumerator_SubStr(h: HWND; i: LongInt): BOOL; stdcall; + +implementation + +{$R *.DFM} + +uses + Registry, DirectX, DxDraws, ShellApi, + fscopyunit, fstextunit, fsdrawunit, fsbrowserunit, + fsinfounit, fsaviunit, + fastfiles, + Strz, logunit, configureunit; + +function WinEnumerator(h: HWND; i: LongInt): BOOL; stdcall; +var + Title: array[0..255] of Char; +begin + Result := True; + if GetWindowText(h, Title, SizeOf(Title))>0 then begin + if UpperCase(DockTitle)= + Copy(UpperCase(StrPas(@Title)), 1, Length(DockTitle)) then begin + DockHandle := h; + Result := False; // stop enumerating + end; + end; +end; + +function WinEnumerator_SubStr(h: HWND; i: LongInt): BOOL; stdcall; +var + Title: array[0..255] of Char; +begin + Result := True; + if GetWindowText(h, Title, SizeOf(Title))>0 then begin + if Pos(UpperCase(DockTitle), UpperCase(StrPas(@Title)))>0 then begin + DockHandle := h; + Result := False; // stop enumerating + end; + end; +end; + +function WinEnumerator_Exact(h: HWND; i: LongInt): BOOL; stdcall; +var + Title: array[0..255] of Char; +begin + Result := True; + if GetWindowText(h, Title, SizeOf(Title))>0 then begin + if UpperCase(DockTitle)= + UpperCase(StrPas(@Title)) then begin + DockHandle := h; + Result := False; // stop enumerating + end; + end; +end; + +{ TForm1 } + +function Tmain.ItemCount( const ClassName: String ): Integer; +var + i, count: Integer; +begin + count:=0; + if ComponentCount>0 then + for i:=1 to ComponentCount-1 do + if UpperCase(Components[i].ClassName)=UpperCase(ClassName) then + Inc(count); + Result := count; +end; + +function Tmain.CompName(const S: String): String; +var + St: String; + a: Integer; +begin + St := S; + if Length(St)>0 then + for a:=Length(St) downto 1 do + if St[a] in ['-','.',',',#10,#13] then + Delete(St, a, 1); + + if Length(St)>0 then + for a:=1 to Length(St) do + if St[a] in ['0'..'9'] then + St[a] := Char(Ord('A')+(Ord(St[a])-Ord('0'))); + + Result := St; +end; + +procedure Tmain.ParsePrim(const S: String); +var + s1, s2, s_args: String; + i: Integer; + fsframe: TFsFrame; + fscopy: TFsCopy; + fstext: TFsText; + fsdraw: TFsDraw; + fsbrowser: TFsBrowser; + fsinfo: TFsInfo; + fsavi: TFsAvi; + f: TFsForm; +begin + if logstate then + log.add(s); + + s1 := UpperCase(ExtractWord(1, S, [' '])); + s_args := Copy(S, Length(s1)+2, 255); + + f := TFsForm(FindComponent(CompName(s1))); + if f<>nil then begin + f.Parse(s_args); + Exit; + end; + + s2 := ExtractWord(2, S, [' ']); + + if S1='RESET' then begin + Reset; + end else + if S1='FRAME' then begin + FreeIfCompExists(CompName(s2)); + fsframe := TFsFrame.Create(Self); + fsframe.PdName := s2; + fsframe.Name := CompName(s2); + fsframe.Caption := s2; + i := ItemCount('TFsFrame')-1; + fsframe.Left := fsframe.Width*(i div 4); + fsframe.Top := fsframe.Height*(i mod 4); + fsframe.Show; + end else + if S1='COPY' then begin + FreeIfCompExists(CompName(s2)); + fscopy := TFsCopy.Create(Self); + fscopy.Name := CompName(s2); + fscopy.Caption := s2; + end else + if S1='TEXT' then begin + FreeIfCompExists(CompName(s2)); + fstext := TFsText.Create(Self); + fstext.Name := CompName(s2); + fstext.Caption := s2; + end else + if S1='DRAW' then begin + FreeIfCompExists(CompName(s2)); + fsdraw := TFsDraw.Create(Self); + fsdraw.Name := CompName(s2); + fsdraw.Caption := s2; + end else + if S1='BROWSER' then begin + FreeIfCompExists(CompName(s2)); + fsbrowser := TFsBrowser.Create(Self); + fsbrowser.PdName := s2; + fsbrowser.Name := CompName(s2); + fsbrowser.Caption := s2; + i := ItemCount('TFsBrowser')-1; + fsbrowser.Left := fsbrowser.Width*(i div 4); + fsbrowser.Top := fsbrowser.Height*(i mod 4); + fsbrowser.Show; + end else + if S1='INFO' then begin + FreeIfCompExists(CompName(s2)); + fsinfo := TFsInfo.Create(Self); + fsinfo.Name := CompName(s2); + fsinfo.Caption := s2; + end else + if S1='AVI' then begin + FreeIfCompExists(CompName(s2)); + fsavi := TFsAvi.Create(Self); + fsavi.PdName := s2; + fsavi.Name := CompName(s2); + fsavi.Caption := s2; + end else + if S1='MINIMIZEALL' then begin + minimizeall; + end else + if s1='PATH' then begin + SearchPath.Add(Copy(S, Length(s1)+2, 255)); + end else +end; + +procedure Tmain.Parse(const S: String); + + function ComponentCreator(const Str: String): Boolean; + var + s1: String; + begin + s1 := UpperCase(ExtractWord(1, Str, [' '])); + Result := + (s1='RESET') or + (s1='FRAME') or + (s1='COPY') or + (s1='TEXT') or + (s1='DRAW') or + (s1='BROWSER') or + (s1='INFO') or + (s1='AVI'); + end; + +var + i, c: Integer; + Str: String; +begin + if Pos(';', S)=0 then + ParsePrim(S) + else begin + c := WordCount(S, [';']); + // first commands that create fs.* objects + for i:=1 to c do begin + Str := ExtractWord(i, S, [';']); + if ComponentCreator(Str) then + ParsePrim(Str); + end; + // all the rest + for i:=1 to c do begin + Str := ExtractWord(i, S, [';']); + if not ComponentCreator(Str) then + ParsePrim(Str); + end; + end; +end; + +procedure Tmain.ss1ClientRead(Sender: TObject; Socket: TCustomWinSocket); +var + S: String; +begin + S := socket.ReceiveText; + while Pos(#10, S)>0 do + Delete(S, Pos(#10, S), 1); + Parse(S); +end; + +procedure Tmain.FreeIfCompExists(const S: String); +var + c: TComponent; +begin + c := FindComponent(S); + if c<>nil then + c.Free; +end; + +procedure Tmain.FormCreate(Sender: TObject); +begin + Randomize; + RunConfig:=False; + PdHost := 'localhost'; + PDReceivePort := 6001; + PDSendPort := 6002; + FSPort := 6010; + EnableFSConns := False; + DockMain := True; + LoadRegSettings; + if not RunConfig then begin + ss1.Port := PDReceivePort; + ss1.Active := True; + csToPd.Host := PdHost; + csToPd.Port := PdSendPort; + csToPd.Active := True; + ssfs.Port := FSPort; + ssfs.Active := EnableFSConns; + end; + + main.Post(STARTMSG); + Caption := MCAPTION; + + Plugins := TPlugins.Create(Self); + Plugins.Load; + + SocketMem := AllocMem(SocketBufferSize); + fBmp := TFastDIB.Create; + logstate := False; + + SearchPath := TStringList.Create; + SearchPath.Add(ExtractFilePath(Application.ExeName)); + + Application.OnException := ExceptionHandler; + Application.OnMessage := AppMessage; +end; + +procedure Tmain.FormDestroy(Sender: TObject); +begin + Plugins.Free; + SearchPath.Free; + FreeMem(SocketMem); + fBmp.Free; +end; + +procedure Tmain.ss1ClientConnect(Sender: TObject; + Socket: TCustomWinSocket); +begin + Post('Connected on port '+IntToStr(PDReceivePort)); + if not csToPd.Active then + csToPd.Active := True; + +// just a crazy idea + if DockMain then begin + DockTitle := 'pd'; + DockHandle:=0; + EnumWindows(@WinEnumerator_Exact, 0); + if DockHandle>0 then begin + ParentWindow := DockHandle; + BorderStyle := bsNone; + Left := 4; + Top := 120; + Width := 40; + Height := 40; + BringToFront; + end; + end; +end; + +procedure Tmain.ss1ClientDisconnect(Sender: TObject; + Socket: TCustomWinSocket); +begin + Post('Disconnected'); + csToPd.Active := False; + Reset; +end; + +procedure Tmain.csToPdConnect(Sender: TObject; Socket: TCustomWinSocket); +begin + Post('Connected on port '+IntToStr(PDSendPort)); +end; + +procedure Tmain.csToPdDisconnect(Sender: TObject; + Socket: TCustomWinSocket); +begin + Post('Disconnected'); +end; + +procedure Tmain.ss1ClientError(Sender: TObject; Socket: TCustomWinSocket; + ErrorEvent: TErrorEvent; var ErrorCode: Integer); +begin + Post('Disconnected'); + ErrorCode := 0; +end; + +procedure Tmain.LoadRegSettings; +var + Reg: TRegistry; +begin + Reg := TRegistry.Create; + try + Reg.RootKey := HKEY_CURRENT_USER; + if Reg.OpenKey('\Software\Framestein', True) then begin + PdHost := Reg.ReadString('PdHost'); + PDReceivePort := Reg.ReadInteger('PDReceivePort'); + PDSendPort := Reg.ReadInteger('PDSendPort'); + FSPort := Reg.ReadInteger('FSPort'); + EnableFSConns := Reg.ReadBool('EnableFSConns'); + DockMain := Reg.ReadBool('DockMain'); + end; + except + RunConfig := True; + end; + Reg.CloseKey; + Reg.Free; +end; + +procedure Tmain.MiConfigClick(Sender: TObject); +begin + configure.Execute; +end; + +procedure Tmain.Post(const S: String); +begin +// Writeln(TimeToStr(Time), ' ', S); + REConsole.Lines.Add(TimeToStr(Time)+' '+S); +end; + +procedure Tmain.Reset; +var + i: Integer; +begin + if ComponentCount=0 then Exit; + for i:=ComponentCount-1 downto 0 do + if Components[i] is TfsForm then + Components[i].Free; +end; + +procedure Tmain.MiResetClick(Sender: TObject); +begin + Reset; +end; + +procedure Tmain.MiReloadPluginsClick(Sender: TObject); +begin + Plugins.Reload; +end; + +function Tmain.GetFrameByTag(const tag: String): TFsFrame; +var + i: Integer; + fsframe: TFsFrame; + + function makenew: TfsFrame; + begin + FreeIfCompExists(CompName(tag)); + fsframe := TFsFrame.Create(Self); + fsframe.Name := CompName(tag); + fsframe.Caption := tag; + fsframe.NameTag := tag; + fsframe.Show; + Result := fsframe; + end; + +begin + if ComponentCount=0 then begin + Result := makenew; + Exit; + end; + for i:=ComponentCount-1 downto 0 do + if Components[i] is TfsFrame then begin + fsframe := Components[i] as TfsFrame; + if fsframe.NameTag = tag then begin + Result := fsframe; + Exit; + end; + end; + Result := makenew; +end; + +const + fsframeHeader = '!FS'; + fsframeHeaderLen = 27; + +procedure Tmain.SendFrame(const F: TFsFrame; + const NameTag: String; const bmp: TFastDIB; + const quality: Integer; const sendjpg: Boolean ); + + function Header(const _size: Integer): String; + var + s, s2: String; + begin + s2 := Copy(IntToStr(f.d1.Surface.Width), 1, 4); + while Length(s2)<4 do s2:='0'+s2; + s := fsframeHeader+s2; + s2 := Copy(IntToStr(f.d1.Surface.Height), 1, 4); + while Length(s2)<4 do s2:='0'+s2; + s := s+s2; + s2 := Copy(IntToStr(_size), 1, 7); + while Length(s2)<7 do s2:='0'+s2; + s := s+s2; + s2 := Copy(NameTag, 1, 8); + while Length(s2)<8 do s2:=s2+' '; + s := s+s2; + if sendjpg then s:=s+'1' else s:=s+'0'; + Result := s; + end; + +var + sd: TDDSurfaceDesc; + jSize, dSize: Integer; + JP: Pointer; +begin + if not csfs.Active then begin + Post('send: not connected'); + Exit; + end; + if sendjpg then begin + JP := AllocMem(bmp.Size); + jSize := SaveJPGMem(bmp, JP, bmp.Size, quality); + while csfs.Socket.SendText(Header(jSize))=-1 do + Application.HandleMessage; + while csfs.Socket.SendBuf(JP^, jSize)=-1 do + Application.HandleMessage; + FreeMem(JP); + end else begin + f.d1.Surface.Lock(sd); + dSize := sd.lPitch*f.d1.Surface.Height+f.d1.Surface.Width; + while csfs.Socket.SendText(Header(dSize))=-1 do + Application.HandleMessage; + while csfs.Socket.SendBuf(sd.lpSurface^, dSize)=-1 do + Application.HandleMessage; + f.d1.Surface.UnLock; + end; +end; + +// TODO: this procedure is more confusing than it needs to be +procedure Tmain.ssfsClientRead(Sender: TObject; Socket: TCustomWinSocket); +const + Receiving: Boolean = False; + Recd: Integer = 0; + fWidth: Integer = 0; + fHeight: Integer = 0; + fSize: Integer = 0; + fJpg: Boolean = True; + nametag: String = ''; + Buf: Pointer = nil; + BufPos: Integer = 0; +var + read: Integer; + tp: Pointer; + s: String; + f: TFsFrame; + sd: TDDSurfaceDesc; + temp: array[0..255] of Char; + + // header was received, extract data about incoming frame + procedure GetHeader; + var + i: Integer; + begin + S := StrPas(StrLCopy(tp, PChar(SocketMem), fsframeHeaderLen)); + fWidth := MyStrToInt(Copy(S, 4, 4)); + fHeight := MyStrToInt(Copy(S, 8, 4)); + fSize := MyStrToInt(Copy(S, 12, 7)); + nametag := Trim(Copy(S, 19, 8)); + fJpg := Boolean(S[27]='1'); +{ Post('Width: '+IntToStr(fWidth)+' Height: '+ + IntToStr(fHeight)+' Size: '+IntToStr(fSize)+ + ' nametag: '+nametag+' jpg: '+IntToStr(Integer(fJpg))); +} + Receiving := True; + Recd := 0; + Buf := AllocMem(fSize); + BufPos := 0; + if read>fsframeHeaderLen then begin + i := read-fsframeHeaderLen; + if fSizefWidth) or (f.d1.Surface.Height<>fHeight) then + f.d1.SetSize(fWidth, fHeight); + + if fJpg then begin + LoadJPGMem(fBmp, Buf, fSize, False); + fBmp.Draw(f.d1.Surface.Canvas.Handle, 0, 0); + f.d1.Surface.Canvas.Release; + end else begin + f.d1.Surface.Lock(sd); + Move(Buf^, sd.lpSurface^, fSize); + f.d1.Surface.UnLock; + end; + f.FlipRequest; + FreeMem(Buf); + Receiving := False; + + if BufPos>fSize then begin + // read: bytes read from socket + // bufpos: amount of total data from this and previous reads + // fsize: bytes needed for this frame + // bufpos - fsize: bytes read belonging to next frame + // read - (bufpos - fsize): offset for the next frame + offset := read - (BufPos - fSize); + read := (BufPos - fSize); + Move(Pointer(Integer(SocketMem)+offset)^, SocketMem^, read); + Result := True; + end; + end; + +begin + tp := @temp; + read := Socket.ReceiveBuf(SocketMem^, 100000); + + while True do begin +// Post('read '+IntToStr(read)); + if Receiving then begin + Inc(Recd, read); + + if BufPos+read > fSize then + Move(SocketMem^, Pointer(Integer(Buf)+BufPos)^, fSize-BufPos) + else + Move(SocketMem^, Pointer(Integer(Buf)+BufPos)^, read); + + Inc(BufPos, read); + + if Recd>=fSize then + if DoFrame then + Continue; + Exit; + end; + if (StrLComp(PChar(SocketMem), fsframeHeader, Length(fsframeHeader))=0) then begin + GetHeader; + if Recd>=fSize then + if DoFrame then + Continue; + end; + Break; + end; +end; + +procedure Tmain.csfsError(Sender: TObject; Socket: TCustomWinSocket; + ErrorEvent: TErrorEvent; var ErrorCode: Integer); +begin + ErrorCode := 0; +end; + +procedure Tmain.ssfsClientError(Sender: TObject; Socket: TCustomWinSocket; + ErrorEvent: TErrorEvent; var ErrorCode: Integer); +begin + ErrorCode := 0; +end; + +procedure Tmain.csToPdError(Sender: TObject; Socket: TCustomWinSocket; + ErrorEvent: TErrorEvent; var ErrorCode: Integer); +begin + ErrorCode := 0; +end; + +procedure Tmain.csfsConnect(Sender: TObject; Socket: TCustomWinSocket); +begin + Post('connected '+csfs.Host+' '+IntToStr(csfs.Port)); +end; + +procedure Tmain.csfsDisconnect(Sender: TObject; Socket: TCustomWinSocket); +begin + Post('disconnected '+csfs.Host+' '+IntToStr(csfs.Port)); +end; + +procedure Tmain.ssfsClientConnect(Sender: TObject; + Socket: TCustomWinSocket); +begin + Post('Connection from '+Socket.RemoteAddress); +end; + +procedure Tmain.ssfsClientDisconnect(Sender: TObject; + Socket: TCustomWinSocket); +begin + Post('Disconnected '+Socket.RemoteAddress); +end; + +procedure Tmain.MiLogClick(Sender: TObject); +begin + MiLog.Checked := not MiLog.Checked; + log.Visible := MiLog.Checked; + logstate := log.Visible; +end; + +procedure Tmain.SendReturnValues(const S: String); +var + i, c: Integer; + s2: String; +begin + if not csToPd.Active then Exit; + c := WordCount(S, [';']); + for i:=1 to c do begin + s2 := ExtractWord(i, S, [';']); + if Pos('=', s2)>0 then begin + csToPd.Socket.SendText( + ExtractWord(1, s2, ['='])+' '+ + ExtractWord(2, s2, ['='])+';' + ); + end; + end; +end; + +procedure Tmain.SendReturnValuesString( + const PdName: String; const S: String); +var + St: String; + i: Integer; +begin + St := S; + for i:=1 to Length(St) do begin + if St[i]='\' then St[i]:='/'; + SendReturnValues(PdName+'='+Long2Str(Ord(St[i]))); + end; + SendReturnValues(PdName+'=0'); +end; + +procedure Tmain.ExceptionHandler(Sender: TObject; E: Exception); +var + i: Integer; + f: TFsFrame; +begin + if Pos('1400', E.Message)>0 then begin // invalid window handle + // check any fs.frames with invalid window handles + // (due to closing a patch with docked fs.frames) + if ComponentCount=0 then Exit; + for i:=ComponentCount-1 downto 0 do + if Components[i] is TFsFrame then begin + f := Components[i] as TFsFrame; + if (f.ParentWindow>0) and + not IsWindow(f.ParentWindow) then begin +// Q: close or undock fs.frame? +// A: this will not happed immediately when a patch is closed, +// so closing the frame is more intuitive than popping it up +// after a while. + f.Free; +{ f.ParentWindow := 0; + f.Borders(True);} + end; + end else + end else + ShowMessage(E.Message); +end; + +procedure Tmain.DropFileHandler(const h: HWND; const DroppedFileName: String); +var + i: Integer; + f: TFsFrame; +begin + if ComponentCount=0 then Exit; + for i:=ComponentCount-1 downto 0 do + if Components[i] is TFsFrame then begin + f := Components[i] as TFsFrame; + if f.Handle=h then begin + f.HandleDroppedFile(DroppedFileName); + Break; + end; + end; +end; + +procedure Tmain.AppMessage(var Msg: Tmsg; var Handled: Boolean); +const + BufferLength : word = 255; +var + DroppedFilename : string; + FileIndex : Longword; + QtyDroppedFiles : word; + pDroppedFilename : array [0..255] of Char; +// DroppedFileLength : word; +begin + if Msg.Message = WM_DROPFILES then begin + FileIndex := $FFFFFFFF; + QtyDroppedFiles := DragQueryFile(Msg.WParam, FileIndex, + pDroppedFilename, BufferLength); + for FileIndex := 0 to (QtyDroppedFiles - 1) do begin +// DroppedFileLength := + DragQueryFile(Msg.WParam, FileIndex, + pDroppedFilename, BufferLength); + DroppedFilename := StrPas(pDroppedFilename); + DropFileHandler(msg.HWND, DroppedFilename); + end; + DragFinish(Msg.WParam); + Handled := True; + end; +end; + +procedure Tmain.minimizeall; +var + i: Integer; +begin + if ComponentCount=0 then Exit; + for i:=ComponentCount-1 downto 0 do + if Components[i] is TfsForm then + TForm(Components[i]).WindowState := wsMinimized; +end; + +procedure Tmain.MiExitClick(Sender: TObject); +begin + Application.Terminate; +end; + +function Tmain.FileExistsInSearchPath(var S: String): Boolean; +var + i: Integer; + filestr: String; +begin + Result := FileExists(S); + if not Result and (SearchPath.Count>0) then begin + filestr := ExtractFileName(S); + for i:=0 to SearchPath.Count-1 do begin + if FileExists(SearchPath.Strings[i]+'\'+filestr) then begin + S := SearchPath.Strings[i]+'\'+filestr; + Result := True; + Exit; + end; + end; + end; +end; + +procedure Tmain.ImageLogoDblClick(Sender: TObject); +begin + Reset; +end; + +procedure Tmain.FormClose(Sender: TObject; var Action: TCloseAction); +begin + if main.ParentWindow<>0 then begin + main.ParentWindow:=0; + end; +end; + +end. + -- cgit v1.2.1