Group_99/D7szChenfeng
5
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

合同加字段

Browse Source
This commit is contained in:
DESKTOP-E401PHE\Administrator 2025-07-29 17:14:41 +08:00
parent 7cf37d83fd
commit 836e44ad27
18 changed files with 529 additions and 299 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
合同管理(ContractManagement.dll)/U_ConInPutNX.dfm
View File

@ -1,6 +1,6 @@
object frmConInPutNX: TfrmConInPutNX object frmConInPutNX: TfrmConInPutNX
Left = 115 Left = 498
Top = 25 Top = 151
Width = 1293 Width = 1293
Height = 795 Height = 795
Caption = #20869#38144#21512#21516#24405#20837 Caption = #20869#38144#21512#21516#24405#20837
@ -175,7 +175,7 @@ object frmConInPutNX: TfrmConInPutNX
end end
object Label17: TLabel object Label17: TLabel
Left = 308 Left = 308
Top = 61 Top = 62
Width = 65 Width = 65
Height = 12 Height = 12
Caption = #20379#26041#22320#22336#65306 Caption = #20379#26041#22320#22336#65306
@ -201,7 +201,7 @@ object frmConInPutNX: TfrmConInPutNX
end end
object Label19: TLabel object Label19: TLabel
Left = 295 Left = 295
Top = 86 Top = 88
Width = 78 Width = 78
Height = 12 Height = 12
Caption = #20379#26041#24320#25143#34892#65306 Caption = #20379#26041#24320#25143#34892#65306
@ -214,7 +214,7 @@ object frmConInPutNX: TfrmConInPutNX
end end
object Label21: TLabel object Label21: TLabel
Left = 308 Left = 308
Top = 112 Top = 113
Width = 65 Width = 65
Height = 12 Height = 12
Caption = #38656#26041#22320#22336#65306 Caption = #38656#26041#22320#22336#65306
@ -227,7 +227,7 @@ object frmConInPutNX: TfrmConInPutNX
end end
object Label8: TLabel object Label8: TLabel
Left = 570 Left = 570
Top = 61 Top = 62
Width = 65 Width = 65
Height = 12 Height = 12
Caption = #20379#26041#30005#35805#65306 Caption = #20379#26041#30005#35805#65306
@ -240,7 +240,7 @@ object frmConInPutNX: TfrmConInPutNX
end end
object Label23: TLabel object Label23: TLabel
Left = 570 Left = 570
Top = 86 Top = 88
Width = 65 Width = 65
Height = 12 Height = 12
Caption = #20379#26041#34892#21495#65306 Caption = #20379#26041#34892#21495#65306
@ -279,7 +279,7 @@ object frmConInPutNX: TfrmConInPutNX
end end
object Label22: TLabel object Label22: TLabel
Left = 570 Left = 570
Top = 112 Top = 113
Width = 65 Width = 65
Height = 12 Height = 12
Caption = #38656#26041#30005#35805#65306 Caption = #38656#26041#30005#35805#65306
@ -331,7 +331,7 @@ object frmConInPutNX: TfrmConInPutNX
end end
object Label35: TLabel object Label35: TLabel
Left = 38 Left = 38
Top = 139 Top = 137
Width = 65 Width = 65
Height = 12 Height = 12
Caption = #38656#26041#36134#21495#65306 Caption = #38656#26041#36134#21495#65306
@ -384,6 +384,58 @@ object frmConInPutNX: TfrmConInPutNX
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
end end
object Label11: TLabel
Left = 833
Top = 62
Width = 65
Height = 12
Caption = #20132#36135#22320#28857#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label12: TLabel
Left = 833
Top = 88
Width = 65
Height = 12
Caption = #20184#27454#26041#24335#65306
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label13: TLabel
Left = 833
Top = 113
Width = 65
Height = 12
Caption = #23450#37329#26399#38480#65306
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Label15: TLabel
Left = 833
Top = 137
Width = 65
Height = 12
Caption = #23614#27454#26399#38480#65306
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object ConDate: TDateTimePicker object ConDate: TDateTimePicker
Tag = 2 Tag = 2
Left = 636 Left = 636
@ -446,7 +498,7 @@ object frmConInPutNX: TfrmConInPutNX
object SellAddress: TEdit object SellAddress: TEdit
Tag = 2 Tag = 2
Left = 371 Left = 371
Top = 60 Top = 59
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 6 TabOrder = 6
@ -454,7 +506,7 @@ object frmConInPutNX: TfrmConInPutNX
object SellBankName: TEdit object SellBankName: TEdit
Tag = 2 Tag = 2
Left = 371 Left = 371
Top = 86 Top = 85
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 9 TabOrder = 9
@ -462,7 +514,7 @@ object frmConInPutNX: TfrmConInPutNX
object BuyAddress: TEdit object BuyAddress: TEdit
Tag = 2 Tag = 2
Left = 371 Left = 371
Top = 111 Top = 110
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 11 TabOrder = 11
@ -470,7 +522,7 @@ object frmConInPutNX: TfrmConInPutNX
object SellTel: TEdit object SellTel: TEdit
Tag = 2 Tag = 2
Left = 636 Left = 636
Top = 61 Top = 59
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 7 TabOrder = 7
@ -478,7 +530,7 @@ object frmConInPutNX: TfrmConInPutNX
object SellFax: TEdit object SellFax: TEdit
Tag = 2 Tag = 2
Left = 636 Left = 636
Top = 87 Top = 85
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 10 TabOrder = 10
@ -486,7 +538,7 @@ object frmConInPutNX: TfrmConInPutNX
object BuyTel: TEdit object BuyTel: TEdit
Tag = 2 Tag = 2
Left = 636 Left = 636
Top = 112 Top = 110
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 12 TabOrder = 12
@ -494,7 +546,7 @@ object frmConInPutNX: TfrmConInPutNX
object BuyFax: TEdit object BuyFax: TEdit
Tag = 2 Tag = 2
Left = 636 Left = 636
Top = 137 Top = 134
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 15 TabOrder = 15
@ -510,7 +562,7 @@ object frmConInPutNX: TfrmConInPutNX
object BuyBankName: TEdit object BuyBankName: TEdit
Tag = 2 Tag = 2
Left = 371 Left = 371
Top = 137 Top = 134
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 14 TabOrder = 14
@ -562,7 +614,7 @@ object frmConInPutNX: TfrmConInPutNX
object BuyBankNo: TEdit object BuyBankNo: TEdit
Tag = 2 Tag = 2
Left = 105 Left = 105
Top = 137 Top = 134
Width = 150 Width = 150
Height = 18 Height = 18
TabOrder = 13 TabOrder = 13
@ -580,8 +632,8 @@ object frmConInPutNX: TfrmConInPutNX
end end
object TsNote: TEdit object TsNote: TEdit
Tag = 1 Tag = 1
Left = 1004 Left = 1108
Top = 124 Top = 4
Width = 150 Width = 150
Height = 18 Height = 18
TabStop = False TabStop = False
@ -591,7 +643,7 @@ object frmConInPutNX: TfrmConInPutNX
object BuyName: TBtnEditC object BuyName: TBtnEditC
Tag = 2 Tag = 2
Left = 105 Left = 105
Top = 110 Top = 109
Width = 150 Width = 150
Height = 20 Height = 20
ReadOnly = True ReadOnly = True
@ -627,6 +679,44 @@ object frmConInPutNX: TfrmConInPutNX
#20869#38144 #20869#38144
#22806#38144) #22806#38144)
end end
object BtnEditC1: TBtnEditC
Tag = 2
Left = 892
Top = 58
Width = 150
Height = 20
Hint = 'jiaohuodidian/'#20132#36135#22320#28857
TabOrder = 24
OnBtnUpClick = BtnEditC1BtnUpClick
OnBtnDnClick = BuyNameBtnDnClick
end
object BtnEditC2: TBtnEditC
Tag = 2
Left = 892
Top = 84
Width = 150
Height = 20
Hint = 'PayMent/'#20184#27454#26041#24335
TabOrder = 25
OnBtnUpClick = SellBankNoBtnUpClick
OnBtnDnClick = BuyNameBtnDnClick
end
object begfkts: TEdit
Tag = 2
Left = 892
Top = 110
Width = 150
Height = 18
TabOrder = 26
end
object endfkts: TEdit
Tag = 2
Left = 892
Top = 134
Width = 150
Height = 18
TabOrder = 27
end
end end
object ToolBar2: TToolBar object ToolBar2: TToolBar
Left = 0 Left = 0
@ -950,39 +1040,41 @@ object frmConInPutNX: TfrmConInPutNX
Connection = DataLink_ContractManagement.ADOLink Connection = DataLink_ContractManagement.ADOLink
LockType = ltReadOnly LockType = ltReadOnly
Parameters = <> Parameters = <>
Left = 1000 Left = 546
Top = 181 Top = 337
end end
object ADOCmd: TADOQuery object ADOCmd: TADOQuery
Connection = DataLink_ContractManagement.ADOLink Connection = DataLink_ContractManagement.ADOLink
Parameters = <> Parameters = <>
Left = 948 Left = 464
Top = 181 Top = 337
end end
object DataSource1: TDataSource object DataSource1: TDataSource
DataSet = Order_Sub DataSet = Order_Sub
Left = 568 Left = 546
Top = 440 Top = 399
end end
object Order_Sub: TClientDataSet object Order_Sub: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 500 Left = 710
Top = 448 Top = 337
end end
object CDS_Type: TClientDataSet object CDS_Type: TClientDataSet
Aggregates = <> Aggregates = <>
Params = <> Params = <>
Left = 320 Left = 628
Top = 436 Top = 337
end end
object cxGridPopupMenu2: TcxGridPopupMenu object cxGridPopupMenu2: TcxGridPopupMenu
Grid = cxGrid1 Grid = cxGrid1
PopupMenus = <> PopupMenus = <>
Left = 840 Left = 792
Top = 144 Top = 337
end end
object cxStyleRepository1: TcxStyleRepository object cxStyleRepository1: TcxStyleRepository
Left = 464
Top = 399
PixelsPerInch = 96 PixelsPerInch = 96
object cxStyle1: TcxStyle object cxStyle1: TcxStyle
AssignedValues = [svFont] AssignedValues = [svFont]

48
合同管理(ContractManagement.dll)/U_ConInPutNX.pas
View File

@ -11,7 +11,19 @@ uses
StdCtrls, ToolWin, DBClient, ADODB, ExtCtrls, BtnEdit, cxCalendar, StrUtils, StdCtrls, ToolWin, DBClient, ADODB, ExtCtrls, BtnEdit, cxCalendar, StrUtils,
cxDropDownEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxImage, cxBlobEdit, cxDropDownEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxImage, cxBlobEdit,
cxImageComboBox, ImgList, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, cxImageComboBox, ImgList, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator,
dxSkinsCore, dxSkinsDefaultPainters, dxSkinscxPCPainter; dxSkinsCore, dxSkinsDefaultPainters, dxSkinscxPCPainter, dxSkinBlack,
dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom,
dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy,
dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian,
dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray,
dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringTime, dxSkinStardust,
dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinValentine, dxSkinVS2010,
dxSkinWhiteprint, dxSkinXmas2008Blue;
type type
TfrmConInPutNX = class(TForm) TfrmConInPutNX = class(TForm)
@ -104,6 +116,14 @@ type
Tv1Column3: TcxGridDBColumn; Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn; Tv1Column4: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn; Tv1Column5: TcxGridDBColumn;
Label11: TLabel;
BtnEditC1: TBtnEditC;
Label12: TLabel;
BtnEditC2: TBtnEditC;
Label13: TLabel;
begfkts: TEdit;
Label15: TLabel;
endfkts: TEdit;
procedure TBCloseClick(Sender: TObject); procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure TBSaveClick(Sender: TObject); procedure TBSaveClick(Sender: TObject);
@ -127,6 +147,7 @@ type
procedure v1PRTPricePropertiesEditValueChanged(Sender: TObject); procedure v1PRTPricePropertiesEditValueChanged(Sender: TObject);
procedure TSBtnUpClick(Sender: TObject); procedure TSBtnUpClick(Sender: TObject);
procedure v1Column10PropertiesEditValueChanged(Sender: TObject); procedure v1Column10PropertiesEditValueChanged(Sender: TObject);
procedure BtnEditC1BtnUpClick(Sender: TObject);
private private
fuserName: string; fuserName: string;
procedure InitData(); procedure InitData();
@ -1028,5 +1049,30 @@ begin
end; end;
end; end;
procedure TfrmConInPutNX.BtnEditC1BtnUpClick(Sender: TObject);
var
fsj: string;
FWZ: Integer;
begin
fsj := Trim(TEdit(Sender).Hint);
FWZ := Pos('/', fsj);
try
frmZDYHelp := TfrmZDYHelp.Create(Application);
with frmZDYHelp do
begin
flag := Copy(fsj, 1, FWZ - 1);
flagname := Copy(fsj, FWZ + 1, Length(fsj) - FWZ);
if ShowModal = 1 then
begin
SellBankNo.Text := Trim(ClientDataSet1.fieldbyname('ZDYName').AsString);
SellBankName.Text := Trim(ClientDataSet1.fieldbyname('Note').AsString);
end;
end;
finally
frmZDYHelp.Free;
end;
end;
end. end.

37
合同管理(ContractManagement.dll)/U_ContractListNX.dfm
View File

@ -20,7 +20,7 @@ object frmContractListNX: TfrmContractListNX
object ToolBar1: TToolBar object ToolBar1: TToolBar
Left = 0 Left = 0
Top = 0 Top = 0
Width = 1365 Width = 1373
Height = 62 Height = 62
AutoSize = True AutoSize = True
ButtonHeight = 30 ButtonHeight = 30
@ -205,7 +205,7 @@ object frmContractListNX: TfrmContractListNX
object cxGrid1: TcxGrid object cxGrid1: TcxGrid
Left = 0 Left = 0
Top = 139 Top = 139
Width = 1365 Width = 1373
Height = 362 Height = 362
Align = alTop Align = alTop
TabOrder = 3 TabOrder = 3
@ -454,7 +454,7 @@ object frmContractListNX: TfrmContractListNX
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Top = 62 Top = 62
Width = 1365 Width = 1373
Height = 43 Height = 43
Align = alTop Align = alTop
BevelInner = bvRaised BevelInner = bvRaised
@ -681,7 +681,7 @@ object frmContractListNX: TfrmContractListNX
object cxTabControl1: TcxTabControl object cxTabControl1: TcxTabControl
Left = 0 Left = 0
Top = 105 Top = 105
Width = 1365 Width = 1373
Height = 34 Height = 34
Align = alTop Align = alTop
Font.Charset = GB2312_CHARSET Font.Charset = GB2312_CHARSET
@ -702,14 +702,14 @@ object frmContractListNX: TfrmContractListNX
#20840#37096) #20840#37096)
OnChange = cxTabControl1Change OnChange = cxTabControl1Change
ClientRectBottom = 34 ClientRectBottom = 34
ClientRectRight = 1365 ClientRectRight = 1373
ClientRectTop = 26 ClientRectTop = 26
end end
object cxGrid2: TcxGrid object cxGrid2: TcxGrid
Left = 0 Left = 0
Top = 509 Top = 509
Width = 1365 Width = 1373
Height = 192 Height = 200
Align = alClient Align = alClient
TabOrder = 4 TabOrder = 4
object Tv2: TcxGridDBTableView object Tv2: TcxGridDBTableView
@ -1011,6 +1011,27 @@ object frmContractListNX: TfrmContractListNX
HeaderAlignmentHorz = taCenter HeaderAlignmentHorz = taCenter
Width = 69 Width = 69
end end
object Tv2Column9: TcxGridDBColumn
Caption = #29983#20135#31867#22411
DataBinding.FieldName = 'ordtype'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 55
end
object Tv2Column10: TcxGridDBColumn
Caption = #32463#36724#26469#28304
DataBinding.FieldName = 'jcfactoryname'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 55
end
object Tv2Column11: TcxGridDBColumn
Caption = #22791#27880'2'
DataBinding.FieldName = 'P_Note2'
HeaderAlignmentHorz = taCenter
Options.Editing = False
Width = 55
end
end end
object cxGridLevel1: TcxGridLevel object cxGridLevel1: TcxGridLevel
GridView = Tv2 GridView = Tv2
@ -1019,7 +1040,7 @@ object frmContractListNX: TfrmContractListNX
object cxSplitter2: TcxSplitter object cxSplitter2: TcxSplitter
Left = 0 Left = 0
Top = 501 Top = 501
Width = 1365 Width = 1373
Height = 8 Height = 8
HotZoneClassName = 'TcxMediaPlayer9Style' HotZoneClassName = 'TcxMediaPlayer9Style'
AlignSplitter = salTop AlignSplitter = salTop

25
合同管理(ContractManagement.dll)/U_ContractListNX.pas
View File

@ -15,18 +15,16 @@ uses
dxBarBuiltInMenu, dxSkinsCore, dxSkinsDefaultPainters, dxSkinscxPCPainter, dxBarBuiltInMenu, dxSkinsCore, dxSkinsDefaultPainters, dxSkinscxPCPainter,
dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee,
dxSkinDarkRoom, dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDarkRoom, dxSkinDarkSide, dxSkinDevExpressDarkStyle,
dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans, dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast,
dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky,
dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis, dxSkinMcSkin, dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins,
dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black, dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink, dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue, dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin, dxSkinSeven,
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver,
dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld,
dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue;
dxSkinTheAsphaltWorld, dxSkinValentine, dxSkinVS2010, dxSkinWhiteprint,
dxSkinXmas2008Blue;
type type
TfrmContractListNX = class(TForm) TfrmContractListNX = class(TForm)
@ -146,6 +144,9 @@ type
Tv2Column8: TcxGridDBColumn; Tv2Column8: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn; Tv1Column4: TcxGridDBColumn;
cxSplitter2: TcxSplitter; cxSplitter2: TcxSplitter;
Tv2Column9: TcxGridDBColumn;
Tv2Column10: TcxGridDBColumn;
Tv2Column11: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject); procedure TBCloseClick(Sender: TObject);

55
样品(YPGL.dll)/U_CPManage.dfm
View File

@ -1,6 +1,6 @@
object frmCPManage: TfrmCPManage object frmCPManage: TfrmCPManage
Left = 151 Left = 410
Top = 139 Top = 194
Width = 1358 Width = 1358
Height = 664 Height = 664
Caption = #20135#21697#26723#26696 Caption = #20135#21697#26723#26696
@ -19,7 +19,7 @@ object frmCPManage: TfrmCPManage
object ToolBar1: TToolBar object ToolBar1: TToolBar
Left = 0 Left = 0
Top = 0 Top = 0
Width = 1342 Width = 1350
Height = 31 Height = 31
ButtonHeight = 30 ButtonHeight = 30
ButtonWidth = 83 ButtonWidth = 83
@ -134,7 +134,7 @@ object frmCPManage: TfrmCPManage
end end
object ComboBox1: TComboBox object ComboBox1: TComboBox
Left = 794 Left = 794
Top = 1 Top = 0
Width = 112 Width = 112
Height = 27 Height = 27
Style = csDropDownList Style = csDropDownList
@ -181,14 +181,14 @@ object frmCPManage: TfrmCPManage
Left = 220 Left = 220
Top = 105 Top = 105
Width = 8 Width = 8
Height = 521 Height = 528
HotZoneClassName = 'TcxMediaPlayer9Style' HotZoneClassName = 'TcxMediaPlayer9Style'
Control = Panel5 Control = Panel5
end end
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Top = 31 Top = 31
Width = 1342 Width = 1350
Height = 74 Height = 74
Align = alTop Align = alTop
BevelInner = bvRaised BevelInner = bvRaised
@ -394,7 +394,7 @@ object frmCPManage: TfrmCPManage
Left = 0 Left = 0
Top = 105 Top = 105
Width = 220 Width = 220
Height = 521 Height = 528
Align = alLeft Align = alLeft
BevelInner = bvRaised BevelInner = bvRaised
BevelOuter = bvLowered BevelOuter = bvLowered
@ -403,15 +403,15 @@ object frmCPManage: TfrmCPManage
Left = 2 Left = 2
Top = 2 Top = 2
Width = 216 Width = 216
Height = 517 Height = 524
Align = alClient Align = alClient
Bands = < Bands = <
item item
end> end>
BufferedPaint = False
DataController.DataSource = DataSource1 DataController.DataSource = DataSource1
DataController.ParentField = 'CPParent' DataController.ParentField = 'CPParent'
DataController.KeyField = 'CPID' DataController.KeyField = 'CPID'
Navigator.Buttons.CustomButtons = <>
OptionsBehavior.ExpandOnDblClick = False OptionsBehavior.ExpandOnDblClick = False
OptionsSelection.CellSelect = False OptionsSelection.CellSelect = False
OptionsView.CellAutoHeight = True OptionsView.CellAutoHeight = True
@ -425,17 +425,19 @@ object frmCPManage: TfrmCPManage
object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn
DataBinding.FieldName = 'CPName' DataBinding.FieldName = 'CPName'
Width = 210 Width = 210
Position.ColIndex = 1 Position.ColIndex = 0
Position.RowIndex = 0 Position.RowIndex = 0
Position.BandIndex = 0 Position.BandIndex = 0
Summary.FooterSummaryItems = <>
Summary.GroupFooterSummaryItems = <>
end end
end end
end end
object Panel3: TPanel object Panel3: TPanel
Left = 228 Left = 228
Top = 105 Top = 105
Width = 1114 Width = 1122
Height = 521 Height = 528
Align = alClient Align = alClient
BevelInner = bvRaised BevelInner = bvRaised
BevelOuter = bvLowered BevelOuter = bvLowered
@ -444,15 +446,15 @@ object frmCPManage: TfrmCPManage
object cxGrid1: TcxGrid object cxGrid1: TcxGrid
Left = 2 Left = 2
Top = 32 Top = 32
Width = 1110 Width = 1118
Height = 292 Height = 299
Align = alClient Align = alClient
PopupMenu = PopupMenu1 PopupMenu = PopupMenu1
TabOrder = 0 TabOrder = 0
object Tv1: TcxGridDBTableView object Tv1: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False Navigator.Buttons.CustomButtons = <>
NavigatorButtons.Delete.Enabled = False Navigator.Buttons.Delete.Enabled = False
NavigatorButtons.Delete.Visible = False Navigator.Buttons.Delete.Visible = False
OnCellClick = Tv1CellClick OnCellClick = Tv1CellClick
OnCellDblClick = Tv1CellDblClick OnCellDblClick = Tv1CellDblClick
DataController.DataSource = DataSource2 DataController.DataSource = DataSource2
@ -568,8 +570,8 @@ object frmCPManage: TfrmCPManage
end end
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
Left = 2 Left = 2
Top = 324 Top = 331
Width = 1110 Width = 1118
Height = 195 Height = 195
Align = alBottom Align = alBottom
Caption = #26679#21697#32553#30053#22270#65288#21452#20987#22270#29255#26597#30475#21407#22270#65289 Caption = #26679#21697#32553#30053#22270#65288#21452#20987#22270#29255#26597#30475#21407#22270#65289
@ -577,7 +579,7 @@ object frmCPManage: TfrmCPManage
object ScrollBox1: TScrollBox object ScrollBox1: TScrollBox
Left = 2 Left = 2
Top = 14 Top = 14
Width = 1106 Width = 1114
Height = 179 Height = 179
Align = alClient Align = alClient
BevelInner = bvLowered BevelInner = bvLowered
@ -588,7 +590,7 @@ object frmCPManage: TfrmCPManage
object Panel7: TPanel object Panel7: TPanel
Left = 2 Left = 2
Top = 2 Top = 2
Width = 1110 Width = 1118
Height = 30 Height = 30
Align = alTop Align = alTop
BevelOuter = bvNone BevelOuter = bvNone
@ -613,10 +615,11 @@ object frmCPManage: TfrmCPManage
Font.Name = #23435#20307 Font.Name = #23435#20307
Font.Style = [fsBold] Font.Style = [fsBold]
ParentFont = False ParentFont = False
Style = 3
TabIndex = 0
TabOrder = 0 TabOrder = 0
Tabs.Strings = ( Properties.CustomButtons.Buttons = <>
Properties.Style = 3
Properties.TabIndex = 0
Properties.Tabs.Strings = (
#26410#23457#26680 #26410#23457#26680
#24050#23457#26680 #24050#23457#26680
#20840#37096) #20840#37096)
@ -629,14 +632,14 @@ object frmCPManage: TfrmCPManage
object Panel4: TPanel object Panel4: TPanel
Left = 253 Left = 253
Top = 0 Top = 0
Width = 857 Width = 865
Height = 30 Height = 30
Align = alClient Align = alClient
AutoSize = True AutoSize = True
BorderStyle = bsSingle BorderStyle = bsSingle
TabOrder = 1 TabOrder = 1
DesignSize = ( DesignSize = (
853 861
26) 26)
object Label14: TLabel object Label14: TLabel
Left = 25 Left = 25

17
样品(YPGL.dll)/U_CPManage.pas
View File

@ -12,7 +12,22 @@ uses
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common, cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection, RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, jpeg, U_SLT, ComObj, Menus, IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, jpeg, U_SLT, ComObj, Menus,
cxPC, Math; cxPC, Math, cxLookAndFeels, cxLookAndFeelPainters, dxSkinsCore,
dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee,
dxSkinDarkRoom, dxSkinDarkSide, dxSkinDevExpressDarkStyle,
dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans,
dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky,
dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin,
dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus,
dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008,
dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine,
dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, cxTLdxBarBuiltInMenu,
dxSkinscxPCPainter, cxNavigator, dxBarBuiltInMenu;
type type
FdDy = record FdDy = record

1
样品(YPGL.dll)/U_DataLink.dfm
View File

@ -24,6 +24,7 @@ object DataLink_YPGL: TDataLink_YPGL
object ThreeColorBase: TcxStyleRepository object ThreeColorBase: TcxStyleRepository
Left = 139 Left = 139
Top = 80 Top = 80
PixelsPerInch = 96
object SHuangSe: TcxStyle object SHuangSe: TcxStyle
AssignedValues = [svColor, svFont, svTextColor] AssignedValues = [svColor, svFont, svTextColor]
Color = 4707838 Color = 4707838

15
样品(YPGL.dll)/U_DataLink.pas
View File

@ -4,7 +4,20 @@ interface
uses uses
SysUtils, Classes, DB, ADODB, ImgList, Controls, cxStyles, cxLookAndFeels, SysUtils, Classes, DB, ADODB, ImgList, Controls, cxStyles, cxLookAndFeels,
Windows,Messages,forms,OleCtnrs,DateUtils; Windows,Messages,forms,OleCtnrs,DateUtils, dxSkinsCore, dxSkinBlack,
dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee, dxSkinDarkRoom,
dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle,
dxSkinFoggy, dxSkinGlassOceans, dxSkinHighContrast, dxSkiniMaginary,
dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin,
dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins,
dxSkinOffice2007Black, dxSkinOffice2007Blue, dxSkinOffice2007Green,
dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black,
dxSkinOffice2010Blue, dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin,
dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus,
dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008,
dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine,
dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, cxClasses;
var var
DConString:String; {全局连接字符串} DConString:String; {全局连接字符串}
server, dtbase, user, pswd: String; {数据库连接参数} server, dtbase, user, pswd: String; {数据库连接参数}

12
样品(YPGL.dll)/U_FileUp.dfm
View File

@ -18,12 +18,12 @@ object frmFileUp: TfrmFileUp
object cxGrid7: TcxGrid object cxGrid7: TcxGrid
Left = 0 Left = 0
Top = 41 Top = 41
Width = 581 Width = 589
Height = 362 Height = 369
Align = alClient Align = alClient
TabOrder = 0 TabOrder = 0
object TV7: TcxGridDBTableView object TV7: TcxGridDBTableView
NavigatorButtons.ConfirmDelete = False Navigator.Buttons.CustomButtons = <>
DataController.DataSource = DataSource1 DataController.DataSource = DataSource1
DataController.Summary.DefaultGroupSummaryItems = <> DataController.Summary.DefaultGroupSummaryItems = <>
DataController.Summary.FooterSummaryItems = <> DataController.Summary.FooterSummaryItems = <>
@ -67,10 +67,10 @@ object frmFileUp: TfrmFileUp
Visible = False Visible = False
end end
object ToolBar6: TToolBar object ToolBar6: TToolBar
Left = 581 Left = 589
Top = 41 Top = 41
Width = 63 Width = 63
Height = 362 Height = 369
Align = alRight Align = alRight
AutoSize = True AutoSize = True
ButtonHeight = 30 ButtonHeight = 30
@ -103,7 +103,7 @@ object frmFileUp: TfrmFileUp
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Top = 0 Top = 0
Width = 644 Width = 652
Height = 41 Height = 41
Align = alTop Align = alTop
BevelInner = bvRaised BevelInner = bvRaised

17
样品(YPGL.dll)/U_FileUp.pas
View File

@ -9,7 +9,22 @@ uses
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses,
cxControls, cxGridCustomView, cxGrid, IdBaseComponent, IdComponent, cxControls, cxGridCustomView, cxGrid, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP, StdCtrls, ADODB, jpeg, BtnEdit, IniFiles, IdTCPConnection, IdTCPClient, IdFTP, StdCtrls, ADODB, jpeg, BtnEdit, IniFiles,
strutils; strutils, cxLookAndFeels, cxLookAndFeelPainters, dxSkinsCore,
dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee,
dxSkinDarkRoom, dxSkinDarkSide, dxSkinDevExpressDarkStyle,
dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans,
dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky,
dxSkinLondonLiquidSky, dxSkinMcSkin, dxSkinMetropolis,
dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black,
dxSkinOffice2007Blue, dxSkinOffice2007Green, dxSkinOffice2007Pink,
dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
dxSkinOffice2010Silver, dxSkinOffice2013DarkGray,
dxSkinOffice2013LightGray, dxSkinOffice2013White, dxSkinPumpkin,
dxSkinSeven, dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus,
dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008,
dxSkinTheAsphaltWorld, dxSkinsDefaultPainters, dxSkinValentine,
dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, dxSkinscxPCPainter,
cxNavigator;
type type
TfrmFileUp = class(TForm) TfrmFileUp = class(TForm)

3
样品(YPGL.dll)/U_GetDllForm.pas
View File

@ -70,7 +70,7 @@ begin
user := 'longfengsa'; user := 'longfengsa';
DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server; DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server;
DConString := DataBaseStr; // DConString := DataBaseStr;
// DParameters1:='¸ßȨÏÞ'; // DParameters1:='¸ßȨÏÞ';
if not ConnData() then if not ConnData() then
begin begin
@ -253,6 +253,7 @@ end;
initialization initialization
OldDllApp := Application; OldDllApp := Application;
finalization finalization
DataLink_YPGL.Free; DataLink_YPGL.Free;
Application := OldDllApp; Application := OldDllApp;

8
梭织计划单(ShuttleSchedule.dll)/ProjectGroup1.bpg
View File

@ -9,15 +9,15 @@ MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**
DCC = $(ROOT)\bin\dcc32.exe $** DCC = $(ROOT)\bin\dcc32.exe $**
BRCC = $(ROOT)\bin\brcc32.exe $** BRCC = $(ROOT)\bin\brcc32.exe $**
#------------------------------------------------------------------------------ #------------------------------------------------------------------------------
PROJECTS = testDll.exe ProductPrice.dll PROJECTS = ShuttleSchedule.dll testDll.exe
#------------------------------------------------------------------------------ #------------------------------------------------------------------------------
default: $(PROJECTS) default: $(PROJECTS)
#------------------------------------------------------------------------------ #------------------------------------------------------------------------------
ShuttleSchedule.dll: ShuttleSchedule.dpr
$(DCC)
testDll.exe: testDll.dpr testDll.exe: testDll.dpr
$(DCC) $(DCC)
ProductPrice.dll: ProductPrice.dpr
$(DCC)

2
梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dof
View File

@ -101,7 +101,7 @@ DebugSourceDirs=
UsePackages=0 UsePackages=0
[Parameters] [Parameters]
RunParams= RunParams=
HostApplication=D:\Dp7Repo\淃커덜쯤\냈료\虔廉셕뺍데(ShuttleSchedule.dll)\testDll.exe HostApplication=E:\淃커栗죕\02_虔廉낍\냈료\D7szChenfeng\虔廉셕뺍데(ShuttleSchedule.dll)\testDll.exe
Launcher= Launcher=
UseLauncher=0 UseLauncher=0
DebugCWD= DebugCWD=

2
梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dpr
View File

@ -20,7 +20,7 @@ uses
U_ColumnBandSet in '..\Z99Dependency\ThreeFun\Form\U_ColumnBandSet.pas' {frmColumnBandSet}, U_ColumnBandSet in '..\Z99Dependency\ThreeFun\Form\U_ColumnBandSet.pas' {frmColumnBandSet},
U_SelPrintFieldNew in '..\Z99Dependency\ThreeFun\Form\U_SelPrintFieldNew.pas' {frmSelPrintFieldNew}, U_SelPrintFieldNew in '..\Z99Dependency\ThreeFun\Form\U_SelPrintFieldNew.pas' {frmSelPrintFieldNew},
U_CompressionFun in '..\Z99Dependency\ThreeFun\Fun\U_CompressionFun.pas', U_CompressionFun in '..\Z99Dependency\ThreeFun\Fun\U_CompressionFun.pas',
U_Fun10 in '..\Z99Dependency\RTFunAndForm\Fun\U_Fun10.pas'; U_Fun10 in '..\Z99Dependency\ThreeFun\Fun\U_Fun10.pas';
{$R *.res} {$R *.res}

19
梭织计划单(ShuttleSchedule.dll)/U_GetDllForm.pas
View File

@ -68,17 +68,22 @@ begin
SetLength(dtbase, 255); SetLength(dtbase, 255);
SetLength(user, 255); SetLength(user, 255);
SetLength(pswd, 255); SetLength(pswd, 255);
if Trim(DataBaseStr) = '' then
server := '101.132.143.144,7781'; begin
dtbase := 'chenfengdata'; server := '101.132.143.144,7781';
user := 'rtsa'; dtbase := 'chenfengdata';
pswd := 'rightsoft@5740'; user := 'rtsa';
pswd := 'rightsoft@5740';
// server := '.'; // server := '.';
// dtbase := 'yiduidata'; // dtbase := 'yiduidata';
// user := 'sa'; // user := 'sa';
// pswd := 'rightsoft'; // pswd := 'rightsoft';
DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server; DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server;
DConString := DataBaseStr; end
else
begin
DConString := DataBaseStr;
end;
if not ConnData() then if not ConnData() then
begin begin

34
梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYInPut.dfm
View File

@ -1,6 +1,6 @@
object frmClothGYInPut: TfrmClothGYInPut object frmClothGYInPut: TfrmClothGYInPut
Left = 244 Left = 693
Top = 110 Top = 403
Width = 1425 Width = 1425
Height = 809 Height = 809
Align = alClient Align = alClient
@ -19,7 +19,7 @@ object frmClothGYInPut: TfrmClothGYInPut
object ToolBar1: TToolBar object ToolBar1: TToolBar
Left = 0 Left = 0
Top = 0 Top = 0
Width = 1409 Width = 1417
Height = 29 Height = 29
ButtonHeight = 30 ButtonHeight = 30
ButtonWidth = 59 ButtonWidth = 59
@ -57,7 +57,7 @@ object frmClothGYInPut: TfrmClothGYInPut
object ScrollBox1: TScrollBox object ScrollBox1: TScrollBox
Left = 0 Left = 0
Top = 29 Top = 29
Width = 1409 Width = 1417
Height = 416 Height = 416
Align = alTop Align = alTop
BevelInner = bvNone BevelInner = bvNone
@ -782,8 +782,8 @@ object frmClothGYInPut: TfrmClothGYInPut
object cxPageControl1: TcxPageControl object cxPageControl1: TcxPageControl
Left = 0 Left = 0
Top = 474 Top = 474
Width = 1409 Width = 1417
Height = 296 Height = 304
Align = alClient Align = alClient
Font.Charset = GB2312_CHARSET Font.Charset = GB2312_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -796,8 +796,8 @@ object frmClothGYInPut: TfrmClothGYInPut
Properties.CustomButtons.Buttons = <> Properties.CustomButtons.Buttons = <>
Properties.Style = 9 Properties.Style = 9
OnChange = cxPageControl1Change OnChange = cxPageControl1Change
ClientRectBottom = 296 ClientRectBottom = 304
ClientRectRight = 1409 ClientRectRight = 1417
ClientRectTop = 23 ClientRectTop = 23
object cxTabSheet1: TcxTabSheet object cxTabSheet1: TcxTabSheet
Caption = #32463#19997#32452#21512 Caption = #32463#19997#32452#21512
@ -805,8 +805,8 @@ object frmClothGYInPut: TfrmClothGYInPut
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
Left = 980 Left = 980
Top = 0 Top = 0
Width = 429 Width = 437
Height = 273 Height = 281
Align = alClient Align = alClient
Caption = #32463#25490#21015 Caption = #32463#25490#21015
Font.Charset = GB2312_CHARSET Font.Charset = GB2312_CHARSET
@ -820,8 +820,8 @@ object frmClothGYInPut: TfrmClothGYInPut
Tag = 2 Tag = 2
Left = 2 Left = 2
Top = 31 Top = 31
Width = 425 Width = 433
Height = 240 Height = 248
Align = alClient Align = alClient
Font.Charset = GB2312_CHARSET Font.Charset = GB2312_CHARSET
Font.Color = clWindowText Font.Color = clWindowText
@ -836,7 +836,7 @@ object frmClothGYInPut: TfrmClothGYInPut
Left = 0 Left = 0
Top = 0 Top = 0
Width = 980 Width = 980
Height = 273 Height = 281
Align = alLeft Align = alLeft
TabOrder = 1 TabOrder = 1
object TV1: TcxGridDBTableView object TV1: TcxGridDBTableView
@ -2183,7 +2183,7 @@ object frmClothGYInPut: TfrmClothGYInPut
Style.BorderStyle = ebsSingle Style.BorderStyle = ebsSingle
TabOrder = 0 TabOrder = 0
OnDblClick = Picture4DblClick OnDblClick = Picture4DblClick
Height = 269 Height = 277
Width = 561 Width = 561
end end
object Button1: TButton object Button1: TButton
@ -2203,10 +2203,10 @@ object frmClothGYInPut: TfrmClothGYInPut
end end
object YWBian: TMemo object YWBian: TMemo
Tag = 2 Tag = 2
Left = 865 Left = 873
Top = 0 Top = 0
Width = 540 Width = 540
Height = 269 Height = 277
Align = alRight Align = alRight
TabOrder = 2 TabOrder = 2
end end
@ -2216,7 +2216,7 @@ object frmClothGYInPut: TfrmClothGYInPut
object ToolBar2: TToolBar object ToolBar2: TToolBar
Left = 0 Left = 0
Top = 445 Top = 445
Width = 1409 Width = 1417
Height = 29 Height = 29
ButtonHeight = 30 ButtonHeight = 30
ButtonWidth = 59 ButtonWidth = 59

16
梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYList.dfm
View File

@ -1,6 +1,6 @@
object frmShuttleClothGYList: TfrmShuttleClothGYList object frmShuttleClothGYList: TfrmShuttleClothGYList
Left = 147 Left = 528
Top = 106 Top = 203
Width = 1377 Width = 1377
Height = 581 Height = 581
Caption = #26797#32455#32455#36896#21333 Caption = #26797#32455#32455#36896#21333
@ -33,7 +33,7 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList
object ToolBar1: TToolBar object ToolBar1: TToolBar
Left = 0 Left = 0
Top = 0 Top = 0
Width = 1361 Width = 1369
AutoSize = True AutoSize = True
ButtonHeight = 30 ButtonHeight = 30
ButtonWidth = 83 ButtonWidth = 83
@ -165,7 +165,7 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList
object Panel1: TPanel object Panel1: TPanel
Left = 0 Left = 0
Top = 32 Top = 32
Width = 1361 Width = 1369
Height = 73 Height = 73
Align = alTop Align = alTop
BevelInner = bvRaised BevelInner = bvRaised
@ -318,7 +318,7 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList
object cxTabControl1: TcxTabControl object cxTabControl1: TcxTabControl
Left = 0 Left = 0
Top = 105 Top = 105
Width = 1361 Width = 1369
Height = 22 Height = 22
Align = alTop Align = alTop
TabOrder = 2 TabOrder = 2
@ -330,14 +330,14 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList
#24050#21024#38500#25968#25454) #24050#21024#38500#25968#25454)
OnChange = cxTabControl1Change OnChange = cxTabControl1Change
ClientRectBottom = 22 ClientRectBottom = 22
ClientRectRight = 1361 ClientRectRight = 1369
ClientRectTop = 19 ClientRectTop = 19
end end
object cxGrid4: TcxGrid object cxGrid4: TcxGrid
Left = 0 Left = 0
Top = 127 Top = 127
Width = 1361 Width = 1369
Height = 415 Height = 423
Align = alClient Align = alClient
TabOrder = 3 TabOrder = 3
object Tv3: TcxGridDBTableView object Tv3: TcxGridDBTableView

359
梭织计划单(ShuttleSchedule.dll)/getpic.pas
View File

@ -3,8 +3,8 @@ unit getpic;
interface interface
uses uses
Windows, Messages, SysUtils, strUtils,Variants, Classes, Graphics, Controls, Forms, Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls,
Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs,
DelphiTwain, Buttons, StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, DelphiTwain, Buttons, StdCtrls, DB, ADODB, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdFTP; IdTCPConnection, IdTCPClient, IdFTP;
@ -23,17 +23,12 @@ type
adoqueryImage: TADOQuery; adoqueryImage: TADOQuery;
IdFTP1: TIdFTP; IdFTP1: TIdFTP;
SpeedButton5: TSpeedButton; SpeedButton5: TSpeedButton;
procedure TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
procedure TwainTwainAcquire(Sender: TObject; const Index: Integer;
Image: TBitmap; var Cancel: Boolean);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Shift: TShiftState; X, Y: Integer); procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject);
@ -43,21 +38,21 @@ type
procedure Initimage(); procedure Initimage();
procedure SpeedButton5Click(Sender: TObject); procedure SpeedButton5Click(Sender: TObject);
private private
hWndC : THandle; hWndC: THandle;
CapturingAVI : bool; CapturingAVI: bool;
{ Private declarations } { Private declarations }
ClickPos: TPoint; ClickPos: TPoint;
SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer; SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
procedure CreThumb(Width, Height: Integer); procedure CreThumb(Width, Height: Integer);
function SaveImage():Boolean; function SaveImage(): Boolean;
public public
FilePath:string; FilePath: string;
FileName:string; FileName: string;
FTFType:string; FTFType: string;
pat1:string; pat1: string;
pic1:string; pic1: string;
fkeyNo:string; fkeyNo: string;
fFlileFlag:string; fFlileFlag: string;
{ Public declarations } { Public declarations }
MyJpeg: TJPEGImage; MyJpeg: TJPEGImage;
// JPStream: TMemoryStream; // JPStream: TMemoryStream;
@ -67,44 +62,73 @@ var
FormGetPic: TFormGetPic; FormGetPic: TFormGetPic;
implementation implementation
uses U_DataLink,U_Fun10;
const WM_CAP_START = WM_USER; uses
const WM_CAP_STOP = WM_CAP_START + 68; U_DataLink, U_Fun10;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; const
const WM_CAP_SAVEDIB = WM_CAP_START + 25; WM_CAP_START = WM_USER;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62; const
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20; WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+ 63 ;
const WM_CAP_SET_OVERLAY =WM_CAP_START+ 51 ; const
const WM_CAP_SET_PREVIEW =WM_CAP_START+ 50 ; WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2; const
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3; WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+ 53 ; const
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+ 52 ; WM_CAP_SAVEDIB = WM_CAP_START + 25;
function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint; const
x : integer; WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
y : integer;
nWidth : integer; const
nHeight : integer; WM_CAP_SEQUENCE = WM_CAP_START + 62;
ParentWin : HWND;
nId : integer): HWND; const
STDCALL EXTERNAL 'AVICAP32.DLL'; WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const
WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63;
const
WM_CAP_SET_OVERLAY = WM_CAP_START + 51;
const
WM_CAP_SET_PREVIEW = WM_CAP_START + 50;
const
WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6;
const
WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;
const
WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;
const
WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;
const
WM_CAP_SET_SCALE = WM_CAP_START + 53;
const
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
function capCreateCaptureWindowA(lpszWindowName: PCHAR; dwStyle: longint; x: integer; y: integer; nWidth: integer; nHeight: integer; ParentWin: HWND; nId: integer): HWND; stdcall external 'AVICAP32.DLL';
{$R *.dfm} {$R *.dfm}
procedure TFormGetPic.Initimage(); procedure TFormGetPic.Initimage();
var var
jpg:TJpegImage; jpg: TJpegImage;
myStream: TADOBlobStream; myStream: TADOBlobStream;
sFieldName:string; sFieldName: string;
JPStream: TMemoryStream; JPStream: TMemoryStream;
begin begin
jpg:=TJpegImage.Create(); jpg := TJpegImage.Create();
JPStream := TMemoryStream.Create; JPStream := TMemoryStream.Create;
try try
@ -112,48 +136,49 @@ begin
begin begin
close; close;
sql.Clear; sql.Clear;
sql.Add('select * from TP_File where WBID='+quotedstr(trim(fkeyNo))); sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo)));
open; open;
IF not IsEmpty then if not IsEmpty then
begin begin
IF not fieldbyname(pic1).IsNull then if not fieldbyname(pic1).IsNull then
begin begin
myStream:=tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname(pic1)),bmread); myStream := tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname(pic1)), bmread);
jpg.LoadFromStream(myStream); jpg.LoadFromStream(myStream);
Image2.Picture.Assign(jpg); Image2.Picture.Assign(jpg);
myStream.Free; myStream.Free;
try try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','服务器地址','127.0.0.1'); IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three'; IdFTP1.Username := 'three';
IdFTP1.Password := '641010'; IdFTP1.Password := '641010';
IdFTP1.Connect(); IdFTP1.Connect();
except except
; ;
end; end;
JPStream.Clear; JPStream.Clear;
if IdFTP1.Connected then if IdFTP1.Connected then
begin begin
try try
IdFTP1.Get(fFlileFlag+'\'+ Trim(fieldbyname(pat1).AsString), JPStream); IdFTP1.Get(fFlileFlag + '\' + Trim(fieldbyname(pat1).AsString), JPStream);
except except
Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING); Application.MessageBox('客户图样文件不存在', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING);
IdFTP1.Quit; IdFTP1.Quit;
Exit; Exit;
end; end;
end
else
begin
Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
if IdFTP1.Connected then IdFTP1.Quit; if IdFTP1.Connected then
JPStream.Position := 0; IdFTP1.Quit;
jpg.LoadFromStream(JPStream); JPStream.Position := 0;
Image1.Picture.Assign(jpg); jpg.LoadFromStream(JPStream);
Image1.Picture.Assign(jpg);
end; end;
end; end;
end; end;
@ -163,30 +188,31 @@ begin
end; end;
end; end;
function TFormGetPic.SaveImage():Boolean; function TFormGetPic.SaveImage(): Boolean;
var var
myStream: TADOBlobStream; myStream: TADOBlobStream;
maxNo:string; maxNo: string;
fNewFileName:string; fNewFileName: string;
begin begin
fNewFileName:=formatdatetime('yyyyMMddhhnnsszzz',now())+ExtractFileExt(FilePath); fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath);
IF fkeyNO='' then fkeyNO:=fNewFileName; if fkeyNO = '' then
result:=false; fkeyNO := fNewFileName;
result := false;
try try
with adoqueryImage do with adoqueryImage do
begin begin
close; close;
sql.Clear; sql.Clear;
sql.Add('select * from TP_File where WBID='+quotedstr(trim(fkeyNo))); sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo)));
sql.Add('and TFType='+quotedstr(trim(FTFType))); sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open; open;
if RecordCount<=0 then if RecordCount <= 0 then
begin begin
Append; Append;
if GetLSNo(ADOQuery1,maxNo,'FJ','TP_File',4,1)=False then if GetLSNo(ADOQuery1, maxNo, 'FJ', 'TP_File', 4, 1) = False then
begin begin
Application.MessageBox('取最大号失败！','提示',0); Application.MessageBox('取最大号失败！', '提示', 0);
Exit; Exit;
end; end;
fieldByName('TFID').AsString := maxNo; fieldByName('TFID').AsString := maxNo;
fieldByName('WBID').AsString := fkeyNO; fieldByName('WBID').AsString := fkeyNO;
@ -195,9 +221,9 @@ begin
begin begin
edit; edit;
end; end;
fieldByName(pat1).AsString :=trim(fNewFileName); fieldByName(pat1).AsString := trim(fNewFileName);
fieldByName('Filler').AsString :=trim(dName); fieldByName('Filler').AsString := trim(dName);
fieldByName('TFType').AsString :=trim(FTFType); fieldByName('TFType').AsString := trim(FTFType);
myStream := TADOBlobStream.Create(TBlobField(FieldByName(pic1)), bmWrite); myStream := TADOBlobStream.Create(TBlobField(FieldByName(pic1)), bmWrite);
MyJpeg.Assign(Image2.Picture.Graphic); MyJpeg.Assign(Image2.Picture.Graphic);
MyJpeg.SaveToStream(myStream); MyJpeg.SaveToStream(myStream);
@ -208,30 +234,26 @@ begin
if FilePath <> '' then if FilePath <> '' then
begin begin
try try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','服务器地址','127.0.0.1'); IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three'; IdFTP1.Username := 'three';
IdFTP1.Password := '641010'; IdFTP1.Password := '641010';
IdFTP1.Connect(); IdFTP1.Connect();
IdFTP1.Put(FilePath, fFlileFlag+'\' + Trim(fNewFileName)); IdFTP1.Put(FilePath, fFlileFlag + '\' + Trim(fNewFileName));
IdFTP1.Quit; IdFTP1.Quit;
except except
IdFTP1.Quit; IdFTP1.Quit;
Application.MessageBox('上传客户图样文件失败，请检查文件服务器！', '提示', MB_ICONWARNING); Application.MessageBox('上传客户图样文件失败，请检查文件服务器！', '提示', MB_ICONWARNING);
end; end;
end; end;
IdFTP1.Quit; IdFTP1.Quit;
result:=true; result := true;
except except
myStream.Free; myStream.Free;
end; end;
end; end;
procedure TFormGetPic.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
procedure TFormGetPic.TwainTwainAcquire(Sender: TObject;
const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin begin
Image1.Picture.Assign(Image); Image1.Picture.Assign(Image);
Cancel := TRUE; Cancel := TRUE;
@ -297,18 +319,18 @@ var
begin begin
Bitmap := TBitmap.Create; Bitmap := TBitmap.Create;
try try
Ratio := Image1.Picture.Graphic.Width/Image1.Picture.Graphic.Height; Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.Height;
if Ratio > 1.333 then if Ratio > 1.333 then
begin begin
AHeight := Round(Width/Ratio); AHeight := Round(Width / Ratio);
AHeightOffset := (Height-AHeight) div 2; AHeightOffset := (Height - AHeight) div 2;
AWidth := Width; AWidth := Width;
AWidthOffset := 0; AWidthOffset := 0;
end end
else else
begin begin
AWidth := Round(Height*Ratio); AWidth := Round(Height * Ratio);
AWidthOffset := (Width-AWidth) div 2; AWidthOffset := (Width - AWidth) div 2;
AHeight := Height; AHeight := Height;
AHeightOffset := 0; AHeightOffset := 0;
end; end;
@ -317,10 +339,10 @@ begin
Bitmap.Canvas.Brush.Color := clBtnFace; Bitmap.Canvas.Brush.Color := clBtnFace;
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height)); Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
// StretchDraw original image // StretchDraw original image
ARect := Rect(AWidthOffset, AHeightOffset, AWidth+AWidthOffset, AHeight+AHeightOffset); ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic); Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic);
// Assign back to the Jpeg, and save to the file // Assign back to the Jpeg, and save to the file
Image2.Picture.Assign(BitMap); Image2.Picture.Assign(Bitmap);
// MyJpeg1.Assign(Image2.Picture.Graphic); // MyJpeg1.Assign(Image2.Picture.Graphic);
finally finally
Bitmap.Free; Bitmap.Free;
@ -339,15 +361,13 @@ begin
MyJpeg.Free; MyJpeg.Free;
end; end;
procedure TFormGetPic.Image1MouseDown(Sender: TObject; procedure TFormGetPic.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin begin
ClickPos.x := X; ClickPos.x := X;
ClickPos.y := Y; ClickPos.y := Y;
end; end;
procedure TFormGetPic.Image1MouseMove(Sender: TObject; Shift: TShiftState; procedure TFormGetPic.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
X, Y: Integer);
var var
NewPos: TPoint; NewPos: TPoint;
begin begin
@ -355,14 +375,16 @@ begin
if ssLeft in Shift then if ssLeft in Shift then
begin begin
{Calculate new position} {Calculate new position}
NewPos.X := Image1.Left + x - ClickPos.x; NewPos.X := Image1.Left + X - ClickPos.x;
NewPos.Y := Image1.Top + y - ClickPos.y; NewPos.Y := Image1.Top + Y - ClickPos.y;
if NewPos.x + Image1.Width < ScrollBox1.Width then if NewPos.x + Image1.Width < ScrollBox1.Width then
NewPos.x := ScrollBox1.Width - Image1.Width; NewPos.x := ScrollBox1.Width - Image1.Width;
if NewPos.y + Image1.Height < ScrollBox1.Height then if NewPos.y + Image1.Height < ScrollBox1.Height then
NewPos.y := ScrollBox1.Height - Image1.Height; NewPos.y := ScrollBox1.Height - Image1.Height;
if NewPos.X > 0 then NewPos.X := 0; if NewPos.X > 0 then
if NewPos.Y > 0 then NewPos.Y := 0; NewPos.X := 0;
if NewPos.Y > 0 then
NewPos.Y := 0;
Image1.Top := NewPos.Y; Image1.Top := NewPos.Y;
Image1.Left := NewPos.X; Image1.Left := NewPos.X;
@ -376,8 +398,8 @@ begin
Image1.Top := 0; Image1.Top := 0;
Image1.Left := 0; Image1.Left := 0;
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName); Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
FilePath:=OpenPictureDialog1.FileName; FilePath := OpenPictureDialog1.FileName;
FileName:=ExtractFileName(FilePath); FileName := ExtractFileName(FilePath);
// CreThumb(240, 180); // CreThumb(240, 180);
CreThumb(400, 300); CreThumb(400, 300);
SpeedButton2.Enabled := TRUE; SpeedButton2.Enabled := TRUE;
@ -387,13 +409,13 @@ end;
procedure TFormGetPic.SpeedButton2Click(Sender: TObject); procedure TFormGetPic.SpeedButton2Click(Sender: TObject);
begin begin
IF SaveImage() then if SaveImage() then
begin begin
ModalResult := 1; ModalResult := 1;
end end
else else
begin begin
application.MessageBox('数据保存失败！','提示信息',0) application.MessageBox('数据保存失败！', '提示信息', 0)
end; end;
// JPStream := TMemoryStream.Create; // JPStream := TMemoryStream.Create;
// MyJPeg.Assign(Image1.Picture.Graphic); // MyJPeg.Assign(Image1.Picture.Graphic);
@ -410,14 +432,7 @@ procedure TFormGetPic.Button1Click(Sender: TObject);
begin begin
hWndC := 0; hWndC := 0;
try try
hWndC := capCreateCaptureWindowA('My Own Capture Window', hWndC := capCreateCaptureWindowA('My Own Capture Window', WS_CHILD or WS_VISIBLE, ScrollBox1.Left, ScrollBox1.Top, ScrollBox1.Width, ScrollBox1.Height, FormGetPic.Handle, 0);
WS_CHILD or WS_VISIBLE ,
ScrollBox1.Left,
ScrollBox1.Top,
ScrollBox1.Width,
ScrollBox1.Height,
FormGetPic.Handle,
0);
if hWndC <> 0 then if hWndC <> 0 then
begin begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0); SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
@ -430,11 +445,10 @@ begin
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0); SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0); SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end end
else else
begin begin
application.MessageBox('连接摄像头失败！','错误信息',MB_ICONERROR); application.MessageBox('连接摄像头失败！', '错误信息', MB_ICONERROR);
end; end;
except except
end; end;
@ -443,73 +457,75 @@ end;
procedure TFormGetPic.Button2Click(Sender: TObject); procedure TFormGetPic.Button2Click(Sender: TObject);
var var
sFieldName:string; sFieldName: string;
MBMP:TBitmap; MBMP: TBitmap;
MJPG:TJpegImage; MJPG: TJpegImage;
begin begin
sFieldName:='D:\抓图'; sFieldName := 'D:\抓图';
if not DirectoryExists(pchar(sFieldName)) then if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName),nil); CreateDirectory(pchar(sFieldName), nil);
sFieldName:=sFieldName+'\'+formatdateTime('yyyyMMddhhnnss',SGetServerDateTime(ADOQuery1)); sFieldName := sFieldName + '\' + formatdateTime('yyyyMMddhhnnss', SGetServerDateTime(ADOQuery1));
FileName:=ExtractFileName(sFieldName); FileName := ExtractFileName(sFieldName);
if hWndC <> 0 then if hWndC <> 0 then
begin begin
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(sFieldName+'.BMP'))); SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(pchar(sFieldName + '.BMP')));
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0); SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0; hWndC := 0;
application.ProcessMessages; application.ProcessMessages;
try try
MBMP:= TBitmap.Create; MBMP := TBitmap.Create;
MJPG:= TJpegImage.Create; MJPG := TJpegImage.Create;
MBMP.LoadFromFile(pchar(sFieldName+'.BMP')); MBMP.LoadFromFile(pchar(sFieldName + '.BMP'));
MJPG.assign(MBMP); MJPG.assign(MBMP);
Image1.Picture.Bitmap.Assign(MJPG); Image1.Picture.Bitmap.Assign(MJPG);
application.ProcessMessages; application.ProcessMessages;
MJPG.SaveToFile(pchar(sFieldName+'.JPG')); MJPG.SaveToFile(pchar(sFieldName + '.JPG'));
CreThumb(240, 180); CreThumb(240, 180);
finally finally
MBMP.Free; MBMP.Free;
MJPG.Free; MJPG.Free;
if Fileexists(pchar(sFieldName+'.BMP')) then DeleteFile(pchar(sFieldName+'.BMP')); if Fileexists(pchar(sFieldName + '.BMP')) then
FilePath:=sFieldName+'.JPG'; DeleteFile(pchar(sFieldName + '.BMP'));
FileName:=ExtractFileName(FilePath); FilePath := sFieldName + '.JPG';
FileName := ExtractFileName(FilePath);
end; end;
SpeedButton2.Enabled:=true; SpeedButton2.Enabled := true;
end; end;
end; end;
procedure TFormGetPic.SpeedButton4Click(Sender: TObject); procedure TFormGetPic.SpeedButton4Click(Sender: TObject);
var var
MJPG:TJpegImage; MJPG: TJpegImage;
pathFile:string; pathFile: string;
begin begin
if Image1.Picture.Graphic=nil then exit; if Image1.Picture.Graphic = nil then
exit;
MJPG:= TJpegImage.Create; MJPG := TJpegImage.Create;
try try
SaveDialog1.FileName:=FileName; SaveDialog1.FileName := FileName;
if SaveDialog1.Execute then if SaveDialog1.Execute then
begin begin
if SaveDialog1.FileName<>'' then if SaveDialog1.FileName <> '' then
begin begin
pathFile:=trim(SaveDialog1.FileName); pathFile := trim(SaveDialog1.FileName);
IF (RightStr(UPPERCASE(pathFile),4)<>'.JPG') and (RightStr(UPPERCASE(pathFile),5)<>'.JPEG') then if (RightStr(UPPERCASE(pathFile), 4) <> '.JPG') and (RightStr(UPPERCASE(pathFile), 5) <> '.JPEG') then
begin begin
pathFile:=pathFile+'.JPG'; pathFile := pathFile + '.JPG';
end; end;
MJPG.Assign(Image1.Picture.Graphic); MJPG.Assign(Image1.Picture.Graphic);
if fileexists(pathFile) then if fileexists(pathFile) then
begin begin
if application.MessageBox(pchar('文件['+trim(pathFile)+']已存在，是否要替换它？'),'提示信息',MB_YESNO+mb_iconinformation+MB_DEFBUTTON2)=idyes then if application.MessageBox(pchar('文件[' + trim(pathFile) + ']已存在，是否要替换它？'), '提示信息', MB_YESNO + mb_iconinformation + MB_DEFBUTTON2) = idyes then
MJPG.SaveToFile(pathFile); MJPG.SaveToFile(pathFile);
end end
else else
MJPG.SaveToFile(pathFile); MJPG.SaveToFile(pathFile);
end; end;
end; end;
@ -526,13 +542,13 @@ begin
begin begin
close; close;
sql.Clear; sql.Clear;
sql.Add('select * from TP_File where WBID='+quotedstr(trim(fkeyNo))); sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo)));
open; open;
if RecordCount>0 then if RecordCount > 0 then
begin begin
edit; edit;
fieldByName(pat1).Value:=null; fieldByName(pat1).Value := null;
FieldByName(pic1).Value:=null; FieldByName(pic1).Value := null;
post; post;
Image1.Picture.Assign(nil); Image1.Picture.Assign(nil);
Image2.Picture.Assign(nil); Image2.Picture.Assign(nil);
@ -543,3 +559,4 @@ begin
end; end;
end. end.