unit DProgCustomCttSch; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.Imaging.pngimage, System.ImageList, Vcl.ImgList, PngImageList, ThdSchFileScan; const WM_CLOSE_CTTSCH = WM_USER + 6587; type TDlgProgCustomCttSch = class(TForm) tProg: TTimer; imgBack: TImage; lbTitle: TLabel; imgClose: TImage; imgBtnList2: TPngImageList; lbMsg: TLabel; pg: TProgressBar; lbWorkTime: TLabel; lbPercent: TLabel; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; lbTotalFile: TLabel; lbTotalDir: TLabel; lbTgFile: TLabel; lbProcFile: TLabel; Shape1: TShape; procedure tProgTimer(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure imgCloseMouseLeave(Sender: TObject); procedure imgCloseMouseEnter(Sender: TObject); procedure imgCloseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure imgCloseClick(Sender: TObject); procedure imgBackMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } bCompleted_: Boolean; ThdCttSch_: TThdSchFileScan; procedure SetImgBtn(nImgIdx: Integer); function ProcessClose: Boolean; public { Public declarations } Constructor Create(aOwner: TComponent; aThdCttSch: TThdSchFileScan); procedure CreateParams(var Params: TCreateParams); override; // 작업표시줄에 표시 procedure process_WM_SYSCOMMAND(var msg: TWMSysCommand); Message WM_SYSCOMMAND; end; var DlgProgCustomCttSch: TDlgProgCustomCttSch; implementation uses Tocsg.Thread, Tocsg.DateTime, Tocsg.Strings, Tocsg.Exception, GlobalDefine, Tocsg.Path, DeCrmHeMain; resourcestring RS_Q_Stop = '검사를 중지하시겠습니까?'; RS_Scanning = '검사중 .. "%s"'; RS_FindingTarget = '검사 대상 파일을 찾고 있습니다...'; RS_CompleteScan = '검사를 완료했습니다.'; RS_MsgStopScan = '검사가 중단되었습니다.'; RS_MsgFailScan = '검사를 실패했습니다.'; {$R *.dfm} Constructor TDlgProgCustomCttSch.Create(aOwner: TComponent; aThdCttSch: TThdSchFileScan); begin Inherited Create(aOwner); pg.Position := 0; pg.Style := pbstMarquee; bCompleted_ := false; SetImgBtn(0); ThdCttSch_ := aThdCttSch; ASSERT(ThdCttSch_ <> nil); tProg.Enabled := true; end; procedure TDlgProgCustomCttSch.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.ExStyle := WS_EX_APPWINDOW; end; procedure TDlgProgCustomCttSch.FormClose(Sender: TObject; var Action: TCloseAction); begin tProg.Enabled := false; if Owner <> nil then SendMessage(TForm(Owner).Handle, WM_CLOSE_CTTSCH, 0, 0); Action := TCloseAction.caFree; end; function TDlgProgCustomCttSch.ProcessClose: Boolean; begin Result := true; if tProg.Enabled then begin if MessageBox(Handle, PChar(RS_Q_Stop), PChar(Caption), MB_ICONQUESTION or MB_YESNO) = IDNO then begin Result := false; exit; end; // tProg.Enabled := false; // gMgSvc.StopCampaignTask; Close; end; end; procedure TDlgProgCustomCttSch.imgBackMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ReleaseCapture; SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0); end; procedure TDlgProgCustomCttSch.imgCloseClick(Sender: TObject); begin if ProcessClose then Close; end; procedure TDlgProgCustomCttSch.imgCloseMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin SetImgBtn(2); end; procedure TDlgProgCustomCttSch.imgCloseMouseEnter(Sender: TObject); begin SetImgBtn(1); end; procedure TDlgProgCustomCttSch.imgCloseMouseLeave(Sender: TObject); begin SetImgBtn(0); end; procedure TDlgProgCustomCttSch.SetImgBtn(nImgIdx: Integer); begin imgBtnList2.GetIcon(nImgIdx, imgClose.Picture.Icon); imgClose.Repaint end; procedure TDlgProgCustomCttSch.tProgTimer(Sender: TObject); function IsWorking: Boolean; begin try Result := ThdCttSch_ <> nil; if Result then case ThdCttSch_.WorkState of tsInit, tsWorking, tsCompleted: ; else Result := false; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. IsWorking()'); end; end; procedure StopWork; begin tProg.Enabled := false; if gMain <> nil then gMain.UpdateCttSchRstButton; // Close; end; var WorkState: TTgThreadState; begin if IsWorking then begin try WorkState := ThdCttSch_.WorkState; case WorkState of tsInit : ; tsWorking : begin var sProcFile := ThdCttSch_.ProcSchFile; if sProcFile <> '' then begin if pg.Style <> pbstNormal then pg.Style := pbstNormal; pg.Position := (ThdCttSch_.ProcTgFileCount * 100) div ThdCttSch_.TotalTgFileCount; lbMsg.Caption := Format(RS_Scanning, [ThdCttSch_.ProcSchFile]) end else lbMsg.Caption := RS_FindingTarget; end; tsCompleted : begin if pg.Style <> pbstNormal then pg.Style := pbstNormal; pg.Position := pg.Max; lbMsg.Caption := RS_CompleteScan; end; tsStop : lbMsg.Caption := RS_MsgStopScan; tsFail : lbMsg.Caption := RS_MsgFailScan; end; lbPercent.Caption := Format('%d%% Completed', [pg.Position]); lbWorkTime.Caption := ConvSecBetweenToProgTime(ThdCttSch_.BeginDT, Now); with ThdCttSch_ do begin lbTotalFile.Caption := InsertPointComma(TotalFileCount, 3); lbTotalDir.Caption := InsertPointComma(TotalDirCount, 3); lbTgFile.Caption := InsertPointComma(TotalTgFileCount, 3); lbProcFile.Caption := InsertPointComma(ProcTgFileCount, 3); end; case WorkState of tsCompleted, tsStop, tsFail: StopWork; end; except on E: Exception do ETgException.TraceException(Self, E, 'Fail .. tProgTimer()'); end; end else StopWork; Application.ProcessMessages; end; procedure TDlgProgCustomCttSch.process_WM_SYSCOMMAND(var msg: TWMSysCommand); begin if msg.CmdType = SC_CLOSE then begin if not ProcessClose then exit; end; Inherited; end; end.