RTFormwork/项目代码/RTBasicsV1/A00通用窗体/U_PictureList.pas
“ddf” 61630656e9 1
2024-07-07 09:35:27 +08:00

230 lines
5.9 KiB
ObjectPascal
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit U_PictureList;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase,
IdFTP, Winapi.UrlMon, Winapi.ShellAPI;
type
TfrmPictureList = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
CoName: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column1: TcxGridDBColumn;
v1Column4: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
ToolButton2: TToolButton;
IdFTP1: TIdFTP;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure CoNameChange(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
private
procedure InitGrid();
{ Private declarations }
public
FWBID: string;
{ Public declarations }
end;
var
frmPictureList: TfrmPictureList;
implementation
uses
U_DataLink, U_RTFun, U_CompanySel;
{$R *.dfm}
procedure TfrmPictureList.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʧ<EFBFBD>ܣ<EFBFBD>', '<27><>ʾ<EFBFBD><CABE>Ϣ');
end;
end;
procedure TfrmPictureList.CoNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmPictureList.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CoName.SetFocus;
Action := cahide;
end;
procedure TfrmPictureList.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select * from TP_File A');
sql.Add('where isnull(WBID,'''')<>'''' and WBID=' + quotedstr(Trim(FWBID)));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmPictureList.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('ͼƬ<CDBC>б<EFBFBD>', TV1, '<27>Զ<EFBFBD><D4B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
end;
procedure TfrmPictureList.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmPictureList.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('ͼƬ<CDBC>б<EFBFBD>', TV1, '<27>Զ<EFBFBD><D4B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
end;
procedure TfrmPictureList.ToolButton1Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmPictureList.ToolButton2Click(Sender: TObject);
var
IdFTP1: TIdFTP;
FPath, FFName, fPdfFilePath, fPdfFilePath1: string;
FInt: integer;
begin
if CDS_1.IsEmpty then
Exit;
fPdfFilePath := ExtractFilePath(Application.ExeName) + '\Picture';
if not DirectoryExists(PChar(fPdfFilePath)) then
CreateDirectory(pchar(fPdfFilePath), nil);
fPdfFilePath := fPdfFilePath + '\' + FWBID;
if not DirectoryExists(pchar(fPdfFilePath)) then
CreateDirectory(pchar(fPdfFilePath), nil);
with ADOQueryTemp do
begin
close;
sql.Clear;
sql.Add('select * from TP_File A');
sql.Add('where isnull(WBID,'''')<>'''' and WBID=' + quotedstr(Trim(FWBID)));
open;
end;
ADOQueryTemp.First;
while not ADOQueryTemp.Eof do
begin
if Trim(ADOQueryTemp.FieldByName('URL').AsString) <> '' then
begin
fPdfFilePath1 := fPdfFilePath + '\' + trim(Trim(ADOQueryTemp.FieldByName('FileName').AsString));
UrlDownloadToFile(nil, PChar(Trim(ADOQueryTemp.FieldByName('URL').AsString)), PChar(fPdfFilePath1), 0, nil);
end;
ADOQueryTemp.Next;
end;
ShellExecute(Handle, 'open', PChar(fPdfFilePath + '\' + trim(CDS_1.FieldByName('FileName').AsString)), '', '', SW_SHOWNORMAL);
end;
procedure TfrmPictureList.Tv1CellDblClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean);
begin
ToolButton2.Click;
end;
procedure TfrmPictureList.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmPictureList.FormDestroy(Sender: TObject);
begin
inherited;
frmPictureList := nil;
end;
end.