{ Copyright (C) 2001-2003 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 fsframeunit; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, Jpeg, DXDraws, FastDIB, fsDcAvi, fsformunit, ExtCtrls, DIB, Filez, ExtDlgs, C2PhotoShopHost, Buttons, StdCtrls, ComCtrls; type TFastDIBList = TList; Tfsframe = class(TFsForm) d1: TDXDraw; PopupMenu1: TPopupMenu; Mi11: TMenuItem; Mi12: TMenuItem; MiMute: TMenuItem; dDib: TDXDIB; MiBorders: TMenuItem; MiStayOnTop: TMenuItem; dirBuffer: TScanDir; PanelMute: TPanel; MiMouseTrack: TMenuItem; MiBufferImages: TMenuItem; opd1: TOpenPictureDialog; MiSaveFrame: TMenuItem; Mi176x144: TMenuItem; MiHideCursor: TMenuItem; framepsh: TC2PhotoShopHost; MiUndock: TMenuItem; svd1: TSaveDialog; dirUse: TScanDir; LabelFoo: TLabel; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Mi11Click(Sender: TObject); procedure Mi12Click(Sender: TObject); procedure MiMuteClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure MiBordersClick(Sender: TObject); procedure MiStayOnTopClick(Sender: TObject); procedure dirBufferHandleFile(const SearchRec: TSearchRec; const FullPath: String); procedure d1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure d1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure d1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure MiMouseTrackClick(Sender: TObject); procedure MiBufferImagesClick(Sender: TObject); procedure PopupMenu1Popup(Sender: TObject); procedure MiSaveFrameClick(Sender: TObject); procedure Mi176x144Click(Sender: TObject); procedure MiHideCursorClick(Sender: TObject); procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure MiUndockClick(Sender: TObject); procedure dirUseHandleFile(const SearchRec: TSearchRec; const FullPath: String); protected fx1, fx2: TFastDIB; private { Private declarations } AutoFlip, Smooth: Boolean; picBuf: TFastDIBList; picIndex: Integer; AutoSend: Boolean; AutoSend_Address: String; AutoSend_jpegqualitynet: Integer; AutoSend_sendjpg: Boolean; MouseTrack: Boolean; // report mouse x y MouseRect: Boolean; // report dragged rectangle FHideCursor: Boolean; // hide cursor in this frame jpgquality: Integer; jpegqualitynet: Integer; prevtop: Integer; prevmute: Boolean; filelist: TStringList; filelistIndex: Integer; lastdockedtitle: String; // title of last dock-command procedure ClearPicBuf; procedure StayOnTop(const Yes: Boolean); function Getnextfilename(const dir, ext: String): String; procedure _prefx; procedure _postfx(const f: TFastDIB); procedure _postavi; procedure SendMouseTrack(const X, Y: Integer); procedure SendMouseRect(const x1, y1, x2, y2: Integer); function GetDocked: Boolean; procedure SetHideCursor(const Value: Boolean); procedure NewButton(const receivename: String; const x, y: Integer; const buttoncaption: String); public { Public declarations } avi: TDcAviPlayer; NameTag: String; doRedock: Boolean; procedure Borders(const Yes: Boolean); procedure Parse(const S: String); override; procedure FlipRequest; procedure AutoSendRequest; procedure HandleDroppedFile(const S: String); property Docked: Boolean read GetDocked; property HideCursor: Boolean read FHideCursor write SetHideCursor; end; var fsframe: Tfsframe; function FindFrame(const S: String): TFsFrame; implementation {$R *.DFM} uses ShellApi, FastFX, FastFiles, mainunit, effectsunit, fsspeedbutton, Strz, FileCtrl, pshostunit; function FindFrame(const S: String): TFsFrame; begin Result := TFsFrame(main.FindComponent(main.CompName(S))); end; { Tfsframe } procedure Tfsframe._prefx; begin dDib.DIB.Assign( d1.Surface ); fx1.LoadFromHandle( dDib.DIB.Handle ); end; procedure Tfsframe._postfx(const f: TFastDIB); begin f.Draw(d1.Surface.Canvas.Handle, 0, 0); d1.Surface.Canvas.Release; FlipRequest; end; procedure Tfsframe._postavi; begin d1.SetSize(avi.Width, avi.Height); avi.DrawFrameToDC(d1.Surface.Canvas.Handle); d1.Surface.Canvas.Release; FlipRequest; end; procedure Tfsframe.Parse(const S: String); var fs, s1, Ext: String; i, o, u, x, y: Integer; fpic: TFastDIB; savejpg, sendjpg: Boolean; R: TRect; begin if S='' then Exit; if (doRedock or ((ParentWindow>0) and not IsWindow(ParentWindow))) and (LastDockedTitle<>'') then begin // Attempt to redock fs.frame doRedock := False; ParentWindow := 0; x := Left; y := Top; Parse('DOCK '+LastDockedTitle); Left := x; Top := y; if S='REDOCK' then Exit; end; s1 := UpperCase(ExtractWord(1, S, [' '])); Ext := UpperCase(ExtractFileExt(S)); if s1='SAVE' then begin // SAVE