diff --git a/合同管理(ContractManagement.dll)/U_ConInPutNX.dfm b/合同管理(ContractManagement.dll)/U_ConInPutNX.dfm index 156b500..b306838 100644 --- a/合同管理(ContractManagement.dll)/U_ConInPutNX.dfm +++ b/合同管理(ContractManagement.dll)/U_ConInPutNX.dfm @@ -1,6 +1,6 @@ object frmConInPutNX: TfrmConInPutNX - Left = 115 - Top = 25 + Left = 498 + Top = 151 Width = 1293 Height = 795 Caption = #20869#38144#21512#21516#24405#20837 @@ -175,7 +175,7 @@ object frmConInPutNX: TfrmConInPutNX end object Label17: TLabel Left = 308 - Top = 61 + Top = 62 Width = 65 Height = 12 Caption = #20379#26041#22320#22336#65306 @@ -201,7 +201,7 @@ object frmConInPutNX: TfrmConInPutNX end object Label19: TLabel Left = 295 - Top = 86 + Top = 88 Width = 78 Height = 12 Caption = #20379#26041#24320#25143#34892#65306 @@ -214,7 +214,7 @@ object frmConInPutNX: TfrmConInPutNX end object Label21: TLabel Left = 308 - Top = 112 + Top = 113 Width = 65 Height = 12 Caption = #38656#26041#22320#22336#65306 @@ -227,7 +227,7 @@ object frmConInPutNX: TfrmConInPutNX end object Label8: TLabel Left = 570 - Top = 61 + Top = 62 Width = 65 Height = 12 Caption = #20379#26041#30005#35805#65306 @@ -240,7 +240,7 @@ object frmConInPutNX: TfrmConInPutNX end object Label23: TLabel Left = 570 - Top = 86 + Top = 88 Width = 65 Height = 12 Caption = #20379#26041#34892#21495#65306 @@ -279,7 +279,7 @@ object frmConInPutNX: TfrmConInPutNX end object Label22: TLabel Left = 570 - Top = 112 + Top = 113 Width = 65 Height = 12 Caption = #38656#26041#30005#35805#65306 @@ -331,7 +331,7 @@ object frmConInPutNX: TfrmConInPutNX end object Label35: TLabel Left = 38 - Top = 139 + Top = 137 Width = 65 Height = 12 Caption = #38656#26041#36134#21495#65306 @@ -384,6 +384,58 @@ object frmConInPutNX: TfrmConInPutNX Font.Style = [fsBold] ParentFont = False 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 Tag = 2 Left = 636 @@ -446,7 +498,7 @@ object frmConInPutNX: TfrmConInPutNX object SellAddress: TEdit Tag = 2 Left = 371 - Top = 60 + Top = 59 Width = 150 Height = 18 TabOrder = 6 @@ -454,7 +506,7 @@ object frmConInPutNX: TfrmConInPutNX object SellBankName: TEdit Tag = 2 Left = 371 - Top = 86 + Top = 85 Width = 150 Height = 18 TabOrder = 9 @@ -462,7 +514,7 @@ object frmConInPutNX: TfrmConInPutNX object BuyAddress: TEdit Tag = 2 Left = 371 - Top = 111 + Top = 110 Width = 150 Height = 18 TabOrder = 11 @@ -470,7 +522,7 @@ object frmConInPutNX: TfrmConInPutNX object SellTel: TEdit Tag = 2 Left = 636 - Top = 61 + Top = 59 Width = 150 Height = 18 TabOrder = 7 @@ -478,7 +530,7 @@ object frmConInPutNX: TfrmConInPutNX object SellFax: TEdit Tag = 2 Left = 636 - Top = 87 + Top = 85 Width = 150 Height = 18 TabOrder = 10 @@ -486,7 +538,7 @@ object frmConInPutNX: TfrmConInPutNX object BuyTel: TEdit Tag = 2 Left = 636 - Top = 112 + Top = 110 Width = 150 Height = 18 TabOrder = 12 @@ -494,7 +546,7 @@ object frmConInPutNX: TfrmConInPutNX object BuyFax: TEdit Tag = 2 Left = 636 - Top = 137 + Top = 134 Width = 150 Height = 18 TabOrder = 15 @@ -510,7 +562,7 @@ object frmConInPutNX: TfrmConInPutNX object BuyBankName: TEdit Tag = 2 Left = 371 - Top = 137 + Top = 134 Width = 150 Height = 18 TabOrder = 14 @@ -562,7 +614,7 @@ object frmConInPutNX: TfrmConInPutNX object BuyBankNo: TEdit Tag = 2 Left = 105 - Top = 137 + Top = 134 Width = 150 Height = 18 TabOrder = 13 @@ -580,8 +632,8 @@ object frmConInPutNX: TfrmConInPutNX end object TsNote: TEdit Tag = 1 - Left = 1004 - Top = 124 + Left = 1108 + Top = 4 Width = 150 Height = 18 TabStop = False @@ -591,7 +643,7 @@ object frmConInPutNX: TfrmConInPutNX object BuyName: TBtnEditC Tag = 2 Left = 105 - Top = 110 + Top = 109 Width = 150 Height = 20 ReadOnly = True @@ -627,6 +679,44 @@ object frmConInPutNX: TfrmConInPutNX #20869#38144 #22806#38144) 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 object ToolBar2: TToolBar Left = 0 @@ -950,39 +1040,41 @@ object frmConInPutNX: TfrmConInPutNX Connection = DataLink_ContractManagement.ADOLink LockType = ltReadOnly Parameters = <> - Left = 1000 - Top = 181 + Left = 546 + Top = 337 end object ADOCmd: TADOQuery Connection = DataLink_ContractManagement.ADOLink Parameters = <> - Left = 948 - Top = 181 + Left = 464 + Top = 337 end object DataSource1: TDataSource DataSet = Order_Sub - Left = 568 - Top = 440 + Left = 546 + Top = 399 end object Order_Sub: TClientDataSet Aggregates = <> Params = <> - Left = 500 - Top = 448 + Left = 710 + Top = 337 end object CDS_Type: TClientDataSet Aggregates = <> Params = <> - Left = 320 - Top = 436 + Left = 628 + Top = 337 end object cxGridPopupMenu2: TcxGridPopupMenu Grid = cxGrid1 PopupMenus = <> - Left = 840 - Top = 144 + Left = 792 + Top = 337 end object cxStyleRepository1: TcxStyleRepository + Left = 464 + Top = 399 PixelsPerInch = 96 object cxStyle1: TcxStyle AssignedValues = [svFont] diff --git a/合同管理(ContractManagement.dll)/U_ConInPutNX.pas b/合同管理(ContractManagement.dll)/U_ConInPutNX.pas index 44be798..b8fb48c 100644 --- a/合同管理(ContractManagement.dll)/U_ConInPutNX.pas +++ b/合同管理(ContractManagement.dll)/U_ConInPutNX.pas @@ -11,7 +11,19 @@ uses StdCtrls, ToolWin, DBClient, ADODB, ExtCtrls, BtnEdit, cxCalendar, StrUtils, cxDropDownEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxImage, cxBlobEdit, 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 TfrmConInPutNX = class(TForm) @@ -104,6 +116,14 @@ type Tv1Column3: TcxGridDBColumn; Tv1Column4: TcxGridDBColumn; Tv1Column5: TcxGridDBColumn; + Label11: TLabel; + BtnEditC1: TBtnEditC; + Label12: TLabel; + BtnEditC2: TBtnEditC; + Label13: TLabel; + begfkts: TEdit; + Label15: TLabel; + endfkts: TEdit; procedure TBCloseClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure TBSaveClick(Sender: TObject); @@ -127,6 +147,7 @@ type procedure v1PRTPricePropertiesEditValueChanged(Sender: TObject); procedure TSBtnUpClick(Sender: TObject); procedure v1Column10PropertiesEditValueChanged(Sender: TObject); + procedure BtnEditC1BtnUpClick(Sender: TObject); private fuserName: string; procedure InitData(); @@ -1028,5 +1049,30 @@ begin 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. diff --git a/合同管理(ContractManagement.dll)/U_ContractListNX.dfm b/合同管理(ContractManagement.dll)/U_ContractListNX.dfm index 3bd6783..5a75235 100644 --- a/合同管理(ContractManagement.dll)/U_ContractListNX.dfm +++ b/合同管理(ContractManagement.dll)/U_ContractListNX.dfm @@ -20,7 +20,7 @@ object frmContractListNX: TfrmContractListNX object ToolBar1: TToolBar Left = 0 Top = 0 - Width = 1365 + Width = 1373 Height = 62 AutoSize = True ButtonHeight = 30 @@ -205,7 +205,7 @@ object frmContractListNX: TfrmContractListNX object cxGrid1: TcxGrid Left = 0 Top = 139 - Width = 1365 + Width = 1373 Height = 362 Align = alTop TabOrder = 3 @@ -454,7 +454,7 @@ object frmContractListNX: TfrmContractListNX object Panel1: TPanel Left = 0 Top = 62 - Width = 1365 + Width = 1373 Height = 43 Align = alTop BevelInner = bvRaised @@ -681,7 +681,7 @@ object frmContractListNX: TfrmContractListNX object cxTabControl1: TcxTabControl Left = 0 Top = 105 - Width = 1365 + Width = 1373 Height = 34 Align = alTop Font.Charset = GB2312_CHARSET @@ -702,14 +702,14 @@ object frmContractListNX: TfrmContractListNX #20840#37096) OnChange = cxTabControl1Change ClientRectBottom = 34 - ClientRectRight = 1365 + ClientRectRight = 1373 ClientRectTop = 26 end object cxGrid2: TcxGrid Left = 0 Top = 509 - Width = 1365 - Height = 192 + Width = 1373 + Height = 200 Align = alClient TabOrder = 4 object Tv2: TcxGridDBTableView @@ -1011,6 +1011,27 @@ object frmContractListNX: TfrmContractListNX HeaderAlignmentHorz = taCenter Width = 69 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 object cxGridLevel1: TcxGridLevel GridView = Tv2 @@ -1019,7 +1040,7 @@ object frmContractListNX: TfrmContractListNX object cxSplitter2: TcxSplitter Left = 0 Top = 501 - Width = 1365 + Width = 1373 Height = 8 HotZoneClassName = 'TcxMediaPlayer9Style' AlignSplitter = salTop diff --git a/合同管理(ContractManagement.dll)/U_ContractListNX.pas b/合同管理(ContractManagement.dll)/U_ContractListNX.pas index 44e8f10..79700a1 100644 --- a/合同管理(ContractManagement.dll)/U_ContractListNX.pas +++ b/合同管理(ContractManagement.dll)/U_ContractListNX.pas @@ -15,18 +15,16 @@ uses dxBarBuiltInMenu, 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; + 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 TfrmContractListNX = class(TForm) @@ -146,6 +144,9 @@ type Tv2Column8: TcxGridDBColumn; Tv1Column4: TcxGridDBColumn; cxSplitter2: TcxSplitter; + Tv2Column9: TcxGridDBColumn; + Tv2Column10: TcxGridDBColumn; + Tv2Column11: TcxGridDBColumn; procedure FormDestroy(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure TBCloseClick(Sender: TObject); diff --git a/样品(YPGL.dll)/U_CPManage.dfm b/样品(YPGL.dll)/U_CPManage.dfm index c88fcf3..50fff9a 100644 --- a/样品(YPGL.dll)/U_CPManage.dfm +++ b/样品(YPGL.dll)/U_CPManage.dfm @@ -1,6 +1,6 @@ object frmCPManage: TfrmCPManage - Left = 151 - Top = 139 + Left = 410 + Top = 194 Width = 1358 Height = 664 Caption = #20135#21697#26723#26696 @@ -19,7 +19,7 @@ object frmCPManage: TfrmCPManage object ToolBar1: TToolBar Left = 0 Top = 0 - Width = 1342 + Width = 1350 Height = 31 ButtonHeight = 30 ButtonWidth = 83 @@ -134,7 +134,7 @@ object frmCPManage: TfrmCPManage end object ComboBox1: TComboBox Left = 794 - Top = 1 + Top = 0 Width = 112 Height = 27 Style = csDropDownList @@ -181,14 +181,14 @@ object frmCPManage: TfrmCPManage Left = 220 Top = 105 Width = 8 - Height = 521 + Height = 528 HotZoneClassName = 'TcxMediaPlayer9Style' Control = Panel5 end object Panel1: TPanel Left = 0 Top = 31 - Width = 1342 + Width = 1350 Height = 74 Align = alTop BevelInner = bvRaised @@ -394,7 +394,7 @@ object frmCPManage: TfrmCPManage Left = 0 Top = 105 Width = 220 - Height = 521 + Height = 528 Align = alLeft BevelInner = bvRaised BevelOuter = bvLowered @@ -403,15 +403,15 @@ object frmCPManage: TfrmCPManage Left = 2 Top = 2 Width = 216 - Height = 517 + Height = 524 Align = alClient Bands = < item end> - BufferedPaint = False DataController.DataSource = DataSource1 DataController.ParentField = 'CPParent' DataController.KeyField = 'CPID' + Navigator.Buttons.CustomButtons = <> OptionsBehavior.ExpandOnDblClick = False OptionsSelection.CellSelect = False OptionsView.CellAutoHeight = True @@ -425,17 +425,19 @@ object frmCPManage: TfrmCPManage object cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn DataBinding.FieldName = 'CPName' Width = 210 - Position.ColIndex = 1 + Position.ColIndex = 0 Position.RowIndex = 0 Position.BandIndex = 0 + Summary.FooterSummaryItems = <> + Summary.GroupFooterSummaryItems = <> end end end object Panel3: TPanel Left = 228 Top = 105 - Width = 1114 - Height = 521 + Width = 1122 + Height = 528 Align = alClient BevelInner = bvRaised BevelOuter = bvLowered @@ -444,15 +446,15 @@ object frmCPManage: TfrmCPManage object cxGrid1: TcxGrid Left = 2 Top = 32 - Width = 1110 - Height = 292 + Width = 1118 + Height = 299 Align = alClient PopupMenu = PopupMenu1 TabOrder = 0 object Tv1: TcxGridDBTableView - NavigatorButtons.ConfirmDelete = False - NavigatorButtons.Delete.Enabled = False - NavigatorButtons.Delete.Visible = False + Navigator.Buttons.CustomButtons = <> + Navigator.Buttons.Delete.Enabled = False + Navigator.Buttons.Delete.Visible = False OnCellClick = Tv1CellClick OnCellDblClick = Tv1CellDblClick DataController.DataSource = DataSource2 @@ -568,8 +570,8 @@ object frmCPManage: TfrmCPManage end object GroupBox1: TGroupBox Left = 2 - Top = 324 - Width = 1110 + Top = 331 + Width = 1118 Height = 195 Align = alBottom 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 Left = 2 Top = 14 - Width = 1106 + Width = 1114 Height = 179 Align = alClient BevelInner = bvLowered @@ -588,7 +590,7 @@ object frmCPManage: TfrmCPManage object Panel7: TPanel Left = 2 Top = 2 - Width = 1110 + Width = 1118 Height = 30 Align = alTop BevelOuter = bvNone @@ -613,10 +615,11 @@ object frmCPManage: TfrmCPManage Font.Name = #23435#20307 Font.Style = [fsBold] ParentFont = False - Style = 3 - TabIndex = 0 TabOrder = 0 - Tabs.Strings = ( + Properties.CustomButtons.Buttons = <> + Properties.Style = 3 + Properties.TabIndex = 0 + Properties.Tabs.Strings = ( #26410#23457#26680 #24050#23457#26680 #20840#37096) @@ -629,14 +632,14 @@ object frmCPManage: TfrmCPManage object Panel4: TPanel Left = 253 Top = 0 - Width = 857 + Width = 865 Height = 30 Align = alClient AutoSize = True BorderStyle = bsSingle TabOrder = 1 DesignSize = ( - 853 + 861 26) object Label14: TLabel Left = 25 diff --git a/样品(YPGL.dll)/U_CPManage.pas b/样品(YPGL.dll)/U_CPManage.pas index 8b4a562..2cdc1cb 100644 --- a/样品(YPGL.dll)/U_CPManage.pas +++ b/样品(YPGL.dll)/U_CPManage.pas @@ -12,7 +12,22 @@ uses cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common, RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection, 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 FdDy = record diff --git a/样品(YPGL.dll)/U_DataLink.dfm b/样品(YPGL.dll)/U_DataLink.dfm index 8567505..d198742 100644 --- a/样品(YPGL.dll)/U_DataLink.dfm +++ b/样品(YPGL.dll)/U_DataLink.dfm @@ -24,6 +24,7 @@ object DataLink_YPGL: TDataLink_YPGL object ThreeColorBase: TcxStyleRepository Left = 139 Top = 80 + PixelsPerInch = 96 object SHuangSe: TcxStyle AssignedValues = [svColor, svFont, svTextColor] Color = 4707838 diff --git a/样品(YPGL.dll)/U_DataLink.pas b/样品(YPGL.dll)/U_DataLink.pas index 6396dca..5320453 100644 --- a/样品(YPGL.dll)/U_DataLink.pas +++ b/样品(YPGL.dll)/U_DataLink.pas @@ -4,7 +4,20 @@ interface uses 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 DConString:String; {ȫַ} server, dtbase, user, pswd: String; {ݿӲ} diff --git a/样品(YPGL.dll)/U_FileUp.dfm b/样品(YPGL.dll)/U_FileUp.dfm index 03ee16b..6e9cea0 100644 --- a/样品(YPGL.dll)/U_FileUp.dfm +++ b/样品(YPGL.dll)/U_FileUp.dfm @@ -18,12 +18,12 @@ object frmFileUp: TfrmFileUp object cxGrid7: TcxGrid Left = 0 Top = 41 - Width = 581 - Height = 362 + Width = 589 + Height = 369 Align = alClient TabOrder = 0 object TV7: TcxGridDBTableView - NavigatorButtons.ConfirmDelete = False + Navigator.Buttons.CustomButtons = <> DataController.DataSource = DataSource1 DataController.Summary.DefaultGroupSummaryItems = <> DataController.Summary.FooterSummaryItems = <> @@ -67,10 +67,10 @@ object frmFileUp: TfrmFileUp Visible = False end object ToolBar6: TToolBar - Left = 581 + Left = 589 Top = 41 Width = 63 - Height = 362 + Height = 369 Align = alRight AutoSize = True ButtonHeight = 30 @@ -103,7 +103,7 @@ object frmFileUp: TfrmFileUp object Panel1: TPanel Left = 0 Top = 0 - Width = 644 + Width = 652 Height = 41 Align = alTop BevelInner = bvRaised diff --git a/样品(YPGL.dll)/U_FileUp.pas b/样品(YPGL.dll)/U_FileUp.pas index 31653d1..d2d44f8 100644 --- a/样品(YPGL.dll)/U_FileUp.pas +++ b/样品(YPGL.dll)/U_FileUp.pas @@ -9,7 +9,22 @@ uses cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxClasses, cxControls, cxGridCustomView, cxGrid, IdBaseComponent, IdComponent, 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 TfrmFileUp = class(TForm) diff --git a/样品(YPGL.dll)/U_GetDllForm.pas b/样品(YPGL.dll)/U_GetDllForm.pas index 7c45e3a..782dde5 100644 --- a/样品(YPGL.dll)/U_GetDllForm.pas +++ b/样品(YPGL.dll)/U_GetDllForm.pas @@ -70,7 +70,7 @@ begin user := 'longfengsa'; DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server; - DConString := DataBaseStr; +// DConString := DataBaseStr; // DParameters1:='Ȩ'; if not ConnData() then begin @@ -253,6 +253,7 @@ end; initialization OldDllApp := Application; + finalization DataLink_YPGL.Free; Application := OldDllApp; diff --git a/梭织计划单(ShuttleSchedule.dll)/ProjectGroup1.bpg b/梭织计划单(ShuttleSchedule.dll)/ProjectGroup1.bpg index 7c050f6..f624f9c 100644 --- a/梭织计划单(ShuttleSchedule.dll)/ProjectGroup1.bpg +++ b/梭织计划单(ShuttleSchedule.dll)/ProjectGroup1.bpg @@ -9,15 +9,15 @@ MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** DCC = $(ROOT)\bin\dcc32.exe $** BRCC = $(ROOT)\bin\brcc32.exe $** #------------------------------------------------------------------------------ -PROJECTS = testDll.exe ProductPrice.dll +PROJECTS = ShuttleSchedule.dll testDll.exe #------------------------------------------------------------------------------ default: $(PROJECTS) #------------------------------------------------------------------------------ +ShuttleSchedule.dll: ShuttleSchedule.dpr + $(DCC) + testDll.exe: testDll.dpr $(DCC) -ProductPrice.dll: ProductPrice.dpr - $(DCC) - diff --git a/梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dof b/梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dof index e10dff0..192d1ad 100644 --- a/梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dof +++ b/梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dof @@ -101,7 +101,7 @@ DebugSourceDirs= UsePackages=0 [Parameters] RunParams= -HostApplication=D:\Dp7Repo\Ŀ\·\֯ƻ(ShuttleSchedule.dll)\testDll.exe +HostApplication=E:\Ŀ\02_֯\·\D7szChenfeng\֯ƻ(ShuttleSchedule.dll)\testDll.exe Launcher= UseLauncher=0 DebugCWD= diff --git a/梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dpr b/梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dpr index 9b607d0..541e664 100644 --- a/梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dpr +++ b/梭织计划单(ShuttleSchedule.dll)/ShuttleSchedule.dpr @@ -20,7 +20,7 @@ uses U_ColumnBandSet in '..\Z99Dependency\ThreeFun\Form\U_ColumnBandSet.pas' {frmColumnBandSet}, U_SelPrintFieldNew in '..\Z99Dependency\ThreeFun\Form\U_SelPrintFieldNew.pas' {frmSelPrintFieldNew}, 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} diff --git a/梭织计划单(ShuttleSchedule.dll)/U_GetDllForm.pas b/梭织计划单(ShuttleSchedule.dll)/U_GetDllForm.pas index c564259..c3e5abe 100644 --- a/梭织计划单(ShuttleSchedule.dll)/U_GetDllForm.pas +++ b/梭织计划单(ShuttleSchedule.dll)/U_GetDllForm.pas @@ -68,17 +68,22 @@ begin SetLength(dtbase, 255); SetLength(user, 255); SetLength(pswd, 255); - - server := '101.132.143.144,7781'; - dtbase := 'chenfengdata'; - user := 'rtsa'; - pswd := 'rightsoft@5740'; + if Trim(DataBaseStr) = '' then + begin + server := '101.132.143.144,7781'; + dtbase := 'chenfengdata'; + user := 'rtsa'; + pswd := 'rightsoft@5740'; // server := '.'; // dtbase := 'yiduidata'; // user := 'sa'; // pswd := 'rightsoft'; - DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server; - DConString := DataBaseStr; + DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server; + end + else + begin + DConString := DataBaseStr; + end; if not ConnData() then begin diff --git a/梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYInPut.dfm b/梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYInPut.dfm index 1d3c16b..3995d5f 100644 --- a/梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYInPut.dfm +++ b/梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYInPut.dfm @@ -1,6 +1,6 @@ object frmClothGYInPut: TfrmClothGYInPut - Left = 244 - Top = 110 + Left = 693 + Top = 403 Width = 1425 Height = 809 Align = alClient @@ -19,7 +19,7 @@ object frmClothGYInPut: TfrmClothGYInPut object ToolBar1: TToolBar Left = 0 Top = 0 - Width = 1409 + Width = 1417 Height = 29 ButtonHeight = 30 ButtonWidth = 59 @@ -57,7 +57,7 @@ object frmClothGYInPut: TfrmClothGYInPut object ScrollBox1: TScrollBox Left = 0 Top = 29 - Width = 1409 + Width = 1417 Height = 416 Align = alTop BevelInner = bvNone @@ -782,8 +782,8 @@ object frmClothGYInPut: TfrmClothGYInPut object cxPageControl1: TcxPageControl Left = 0 Top = 474 - Width = 1409 - Height = 296 + Width = 1417 + Height = 304 Align = alClient Font.Charset = GB2312_CHARSET Font.Color = clWindowText @@ -796,8 +796,8 @@ object frmClothGYInPut: TfrmClothGYInPut Properties.CustomButtons.Buttons = <> Properties.Style = 9 OnChange = cxPageControl1Change - ClientRectBottom = 296 - ClientRectRight = 1409 + ClientRectBottom = 304 + ClientRectRight = 1417 ClientRectTop = 23 object cxTabSheet1: TcxTabSheet Caption = #32463#19997#32452#21512 @@ -805,8 +805,8 @@ object frmClothGYInPut: TfrmClothGYInPut object GroupBox1: TGroupBox Left = 980 Top = 0 - Width = 429 - Height = 273 + Width = 437 + Height = 281 Align = alClient Caption = #32463#25490#21015 Font.Charset = GB2312_CHARSET @@ -820,8 +820,8 @@ object frmClothGYInPut: TfrmClothGYInPut Tag = 2 Left = 2 Top = 31 - Width = 425 - Height = 240 + Width = 433 + Height = 248 Align = alClient Font.Charset = GB2312_CHARSET Font.Color = clWindowText @@ -836,7 +836,7 @@ object frmClothGYInPut: TfrmClothGYInPut Left = 0 Top = 0 Width = 980 - Height = 273 + Height = 281 Align = alLeft TabOrder = 1 object TV1: TcxGridDBTableView @@ -2183,7 +2183,7 @@ object frmClothGYInPut: TfrmClothGYInPut Style.BorderStyle = ebsSingle TabOrder = 0 OnDblClick = Picture4DblClick - Height = 269 + Height = 277 Width = 561 end object Button1: TButton @@ -2203,10 +2203,10 @@ object frmClothGYInPut: TfrmClothGYInPut end object YWBian: TMemo Tag = 2 - Left = 865 + Left = 873 Top = 0 Width = 540 - Height = 269 + Height = 277 Align = alRight TabOrder = 2 end @@ -2216,7 +2216,7 @@ object frmClothGYInPut: TfrmClothGYInPut object ToolBar2: TToolBar Left = 0 Top = 445 - Width = 1409 + Width = 1417 Height = 29 ButtonHeight = 30 ButtonWidth = 59 diff --git a/梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYList.dfm b/梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYList.dfm index 3df0a0c..bb526b2 100644 --- a/梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYList.dfm +++ b/梭织计划单(ShuttleSchedule.dll)/U_ShuttleClothGYList.dfm @@ -1,6 +1,6 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList - Left = 147 - Top = 106 + Left = 528 + Top = 203 Width = 1377 Height = 581 Caption = #26797#32455#32455#36896#21333 @@ -33,7 +33,7 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList object ToolBar1: TToolBar Left = 0 Top = 0 - Width = 1361 + Width = 1369 AutoSize = True ButtonHeight = 30 ButtonWidth = 83 @@ -165,7 +165,7 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList object Panel1: TPanel Left = 0 Top = 32 - Width = 1361 + Width = 1369 Height = 73 Align = alTop BevelInner = bvRaised @@ -318,7 +318,7 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList object cxTabControl1: TcxTabControl Left = 0 Top = 105 - Width = 1361 + Width = 1369 Height = 22 Align = alTop TabOrder = 2 @@ -330,14 +330,14 @@ object frmShuttleClothGYList: TfrmShuttleClothGYList #24050#21024#38500#25968#25454) OnChange = cxTabControl1Change ClientRectBottom = 22 - ClientRectRight = 1361 + ClientRectRight = 1369 ClientRectTop = 19 end object cxGrid4: TcxGrid Left = 0 Top = 127 - Width = 1361 - Height = 415 + Width = 1369 + Height = 423 Align = alClient TabOrder = 3 object Tv3: TcxGridDBTableView diff --git a/梭织计划单(ShuttleSchedule.dll)/getpic.pas b/梭织计划单(ShuttleSchedule.dll)/getpic.pas index d72a009..19bfce9 100644 --- a/梭织计划单(ShuttleSchedule.dll)/getpic.pas +++ b/梭织计划单(ShuttleSchedule.dll)/getpic.pas @@ -3,8 +3,8 @@ unit getpic; interface uses - Windows, Messages, SysUtils, strUtils,Variants, Classes, Graphics, Controls, Forms, - Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, + Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls, + Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, DelphiTwain, Buttons, StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdFTP; @@ -23,17 +23,12 @@ type adoqueryImage: TADOQuery; IdFTP1: TIdFTP; 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 FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); - procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; - Shift: TShiftState; X, Y: Integer); - procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, - Y: Integer); + procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure SpeedButton1Click(Sender: TObject); procedure SpeedButton2Click(Sender: TObject); procedure SpeedButton3Click(Sender: TObject); @@ -43,21 +38,21 @@ type procedure Initimage(); procedure SpeedButton5Click(Sender: TObject); private - hWndC : THandle; - CapturingAVI : bool; + hWndC: THandle; + CapturingAVI: bool; { Private declarations } ClickPos: TPoint; SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer; procedure CreThumb(Width, Height: Integer); - function SaveImage():Boolean; + function SaveImage(): Boolean; public - FilePath:string; - FileName:string; - FTFType:string; - pat1:string; - pic1:string; - fkeyNo:string; - fFlileFlag:string; + FilePath: string; + FileName: string; + FTFType: string; + pat1: string; + pic1: string; + fkeyNo: string; + fFlileFlag: string; { Public declarations } MyJpeg: TJPEGImage; // JPStream: TMemoryStream; @@ -67,44 +62,73 @@ var FormGetPic: TFormGetPic; implementation -uses U_DataLink,U_Fun10; -const WM_CAP_START = WM_USER; -const WM_CAP_STOP = WM_CAP_START + 68; -const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10; -const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; -const WM_CAP_SAVEDIB = WM_CAP_START + 25; -const WM_CAP_GRAB_FRAME = WM_CAP_START + 60; -const WM_CAP_SEQUENCE = WM_CAP_START + 62; -const 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'; + +uses + U_DataLink, U_Fun10; + +const + WM_CAP_START = WM_USER; + +const + WM_CAP_STOP = WM_CAP_START + 68; + +const + WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10; + +const + WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; + +const + WM_CAP_SAVEDIB = WM_CAP_START + 25; + +const + WM_CAP_GRAB_FRAME = WM_CAP_START + 60; + +const + WM_CAP_SEQUENCE = WM_CAP_START + 62; + +const + 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} procedure TFormGetPic.Initimage(); var - jpg:TJpegImage; + jpg: TJpegImage; myStream: TADOBlobStream; - sFieldName:string; + sFieldName: string; JPStream: TMemoryStream; begin - jpg:=TJpegImage.Create(); + jpg := TJpegImage.Create(); JPStream := TMemoryStream.Create; try @@ -112,48 +136,49 @@ begin begin close; 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; - IF not IsEmpty then + if not IsEmpty then begin - IF not fieldbyname(pic1).IsNull then + if not fieldbyname(pic1).IsNull then begin - myStream:=tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname(pic1)),bmread); + myStream := tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname(pic1)), bmread); jpg.LoadFromStream(myStream); Image2.Picture.Assign(jpg); myStream.Free; - try - IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','ַ','127.0.0.1'); - IdFTP1.Username := 'three'; - IdFTP1.Password := '641010'; - IdFTP1.Connect(); - except - ; - end; + try + IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', 'ַ', '127.0.0.1'); + IdFTP1.Username := 'three'; + IdFTP1.Password := '641010'; + IdFTP1.Connect(); + except + ; + end; - JPStream.Clear; - if IdFTP1.Connected then - begin - try - IdFTP1.Get(fFlileFlag+'\'+ Trim(fieldbyname(pat1).AsString), JPStream); - except - Application.MessageBox('ͻͼļ', 'ʾ', MB_ICONWARNING); - IdFTP1.Quit; - Exit; - end; - end - else - begin - Application.MessageBox('޷ļ', 'ʾ', MB_ICONWARNING); + JPStream.Clear; + if IdFTP1.Connected then + begin + try + IdFTP1.Get(fFlileFlag + '\' + Trim(fieldbyname(pat1).AsString), JPStream); + except + Application.MessageBox('ͻͼļ', 'ʾ', MB_ICONWARNING); IdFTP1.Quit; Exit; end; + end + else + begin + Application.MessageBox('޷ļ', 'ʾ', MB_ICONWARNING); + IdFTP1.Quit; + Exit; + end; - if IdFTP1.Connected then IdFTP1.Quit; - JPStream.Position := 0; - jpg.LoadFromStream(JPStream); - Image1.Picture.Assign(jpg); + if IdFTP1.Connected then + IdFTP1.Quit; + JPStream.Position := 0; + jpg.LoadFromStream(JPStream); + Image1.Picture.Assign(jpg); end; end; end; @@ -163,30 +188,31 @@ begin end; end; -function TFormGetPic.SaveImage():Boolean; +function TFormGetPic.SaveImage(): Boolean; var - myStream: TADOBlobStream; - maxNo:string; - fNewFileName:string; + myStream: TADOBlobStream; + maxNo: string; + fNewFileName: string; begin - fNewFileName:=formatdatetime('yyyyMMddhhnnsszzz',now())+ExtractFileExt(FilePath); - IF fkeyNO='' then fkeyNO:=fNewFileName; - result:=false; + fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath); + if fkeyNO = '' then + fkeyNO := fNewFileName; + result := false; try with adoqueryImage do begin close; sql.Clear; - sql.Add('select * from TP_File where WBID='+quotedstr(trim(fkeyNo))); - sql.Add('and TFType='+quotedstr(trim(FTFType))); + sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo))); + sql.Add('and TFType=' + quotedstr(trim(FTFType))); open; - if RecordCount<=0 then + if RecordCount <= 0 then begin Append; - if GetLSNo(ADOQuery1,maxNo,'FJ','TP_File',4,1)=False then + if GetLSNo(ADOQuery1, maxNo, 'FJ', 'TP_File', 4, 1) = False then begin - Application.MessageBox('ȡʧܣ','ʾ',0); - Exit; + Application.MessageBox('ȡʧܣ', 'ʾ', 0); + Exit; end; fieldByName('TFID').AsString := maxNo; fieldByName('WBID').AsString := fkeyNO; @@ -195,9 +221,9 @@ begin begin edit; end; - fieldByName(pat1).AsString :=trim(fNewFileName); - fieldByName('Filler').AsString :=trim(dName); - fieldByName('TFType').AsString :=trim(FTFType); + fieldByName(pat1).AsString := trim(fNewFileName); + fieldByName('Filler').AsString := trim(dName); + fieldByName('TFType').AsString := trim(FTFType); myStream := TADOBlobStream.Create(TBlobField(FieldByName(pic1)), bmWrite); MyJpeg.Assign(Image2.Picture.Graphic); MyJpeg.SaveToStream(myStream); @@ -208,30 +234,26 @@ begin if FilePath <> '' then begin try - IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI','SERVER','ַ','127.0.0.1'); - IdFTP1.Username := 'three'; - IdFTP1.Password := '641010'; - IdFTP1.Connect(); - IdFTP1.Put(FilePath, fFlileFlag+'\' + Trim(fNewFileName)); - IdFTP1.Quit; + IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', 'ַ', '127.0.0.1'); + IdFTP1.Username := 'three'; + IdFTP1.Password := '641010'; + IdFTP1.Connect(); + IdFTP1.Put(FilePath, fFlileFlag + '\' + Trim(fNewFileName)); + IdFTP1.Quit; except - IdFTP1.Quit; - Application.MessageBox('ϴͻͼļʧܣļ', 'ʾ', MB_ICONWARNING); + IdFTP1.Quit; + Application.MessageBox('ϴͻͼļʧܣļ', 'ʾ', MB_ICONWARNING); end; end; IdFTP1.Quit; - result:=true; + result := true; except myStream.Free; 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 Image1.Picture.Assign(Image); Cancel := TRUE; @@ -297,18 +319,18 @@ var begin Bitmap := TBitmap.Create; try - Ratio := Image1.Picture.Graphic.Width/Image1.Picture.Graphic.Height; + Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.Height; if Ratio > 1.333 then begin - AHeight := Round(Width/Ratio); - AHeightOffset := (Height-AHeight) div 2; + AHeight := Round(Width / Ratio); + AHeightOffset := (Height - AHeight) div 2; AWidth := Width; AWidthOffset := 0; end else begin - AWidth := Round(Height*Ratio); - AWidthOffset := (Width-AWidth) div 2; + AWidth := Round(Height * Ratio); + AWidthOffset := (Width - AWidth) div 2; AHeight := Height; AHeightOffset := 0; end; @@ -317,10 +339,10 @@ begin Bitmap.Canvas.Brush.Color := clBtnFace; Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height)); // 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); // Assign back to the Jpeg, and save to the file - Image2.Picture.Assign(BitMap); + Image2.Picture.Assign(Bitmap); // MyJpeg1.Assign(Image2.Picture.Graphic); finally Bitmap.Free; @@ -339,15 +361,13 @@ begin MyJpeg.Free; end; -procedure TFormGetPic.Image1MouseDown(Sender: TObject; - Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TFormGetPic.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ClickPos.x := X; ClickPos.y := Y; end; -procedure TFormGetPic.Image1MouseMove(Sender: TObject; Shift: TShiftState; - X, Y: Integer); +procedure TFormGetPic.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var NewPos: TPoint; begin @@ -355,14 +375,16 @@ begin if ssLeft in Shift then begin {Calculate new position} - NewPos.X := Image1.Left + x - ClickPos.x; - NewPos.Y := Image1.Top + y - ClickPos.y; + NewPos.X := Image1.Left + X - ClickPos.x; + NewPos.Y := Image1.Top + Y - ClickPos.y; if NewPos.x + Image1.Width < ScrollBox1.Width then NewPos.x := ScrollBox1.Width - Image1.Width; if NewPos.y + Image1.Height < ScrollBox1.Height then NewPos.y := ScrollBox1.Height - Image1.Height; - if NewPos.X > 0 then NewPos.X := 0; - if NewPos.Y > 0 then NewPos.Y := 0; + if NewPos.X > 0 then + NewPos.X := 0; + if NewPos.Y > 0 then + NewPos.Y := 0; Image1.Top := NewPos.Y; Image1.Left := NewPos.X; @@ -376,8 +398,8 @@ begin Image1.Top := 0; Image1.Left := 0; Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName); - FilePath:=OpenPictureDialog1.FileName; - FileName:=ExtractFileName(FilePath); + FilePath := OpenPictureDialog1.FileName; + FileName := ExtractFileName(FilePath); // CreThumb(240, 180); CreThumb(400, 300); SpeedButton2.Enabled := TRUE; @@ -387,13 +409,13 @@ end; procedure TFormGetPic.SpeedButton2Click(Sender: TObject); begin - IF SaveImage() then + if SaveImage() then begin ModalResult := 1; end else begin - application.MessageBox('ݱʧܣ','ʾϢ',0) + application.MessageBox('ݱʧܣ', 'ʾϢ', 0) end; // JPStream := TMemoryStream.Create; // MyJPeg.Assign(Image1.Picture.Graphic); @@ -410,14 +432,7 @@ procedure TFormGetPic.Button1Click(Sender: TObject); begin hWndC := 0; try - hWndC := capCreateCaptureWindowA('My Own Capture Window', - WS_CHILD or WS_VISIBLE , - ScrollBox1.Left, - ScrollBox1.Top, - ScrollBox1.Width, - ScrollBox1.Height, - FormGetPic.Handle, - 0); + hWndC := capCreateCaptureWindowA('My Own Capture Window', WS_CHILD or WS_VISIBLE, ScrollBox1.Left, ScrollBox1.Top, ScrollBox1.Width, ScrollBox1.Height, FormGetPic.Handle, 0); if hWndC <> 0 then begin 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_PREVIEW, 1, 0); - end else begin - application.MessageBox('ͷʧܣ','Ϣ',MB_ICONERROR); + application.MessageBox('ͷʧܣ', 'Ϣ', MB_ICONERROR); end; except end; @@ -443,73 +457,75 @@ end; procedure TFormGetPic.Button2Click(Sender: TObject); var - sFieldName:string; - MBMP:TBitmap; - MJPG:TJpegImage; + sFieldName: string; + MBMP: TBitmap; + MJPG: TJpegImage; begin - sFieldName:='D:\ץͼ'; + sFieldName := 'D:\ץͼ'; 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 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); hWndC := 0; application.ProcessMessages; try - MBMP:= TBitmap.Create; - MJPG:= TJpegImage.Create; - MBMP.LoadFromFile(pchar(sFieldName+'.BMP')); + MBMP := TBitmap.Create; + MJPG := TJpegImage.Create; + MBMP.LoadFromFile(pchar(sFieldName + '.BMP')); MJPG.assign(MBMP); Image1.Picture.Bitmap.Assign(MJPG); application.ProcessMessages; - MJPG.SaveToFile(pchar(sFieldName+'.JPG')); + MJPG.SaveToFile(pchar(sFieldName + '.JPG')); CreThumb(240, 180); finally MBMP.Free; MJPG.Free; - if Fileexists(pchar(sFieldName+'.BMP')) then DeleteFile(pchar(sFieldName+'.BMP')); - FilePath:=sFieldName+'.JPG'; - FileName:=ExtractFileName(FilePath); + if Fileexists(pchar(sFieldName + '.BMP')) then + DeleteFile(pchar(sFieldName + '.BMP')); + FilePath := sFieldName + '.JPG'; + FileName := ExtractFileName(FilePath); end; - SpeedButton2.Enabled:=true; + SpeedButton2.Enabled := true; end; end; procedure TFormGetPic.SpeedButton4Click(Sender: TObject); var - MJPG:TJpegImage; - pathFile:string; + MJPG: TJpegImage; + pathFile: string; begin - if Image1.Picture.Graphic=nil then exit; + if Image1.Picture.Graphic = nil then + exit; - MJPG:= TJpegImage.Create; + MJPG := TJpegImage.Create; try - SaveDialog1.FileName:=FileName; + SaveDialog1.FileName := FileName; if SaveDialog1.Execute then begin - if SaveDialog1.FileName<>'' then + if SaveDialog1.FileName <> '' then 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 - pathFile:=pathFile+'.JPG'; + pathFile := pathFile + '.JPG'; end; MJPG.Assign(Image1.Picture.Graphic); if fileexists(pathFile) then begin - if application.MessageBox(pchar('ļ['+trim(pathFile)+']ѴڣǷҪ滻'),'ʾϢ',MB_YESNO+mb_iconinformation+MB_DEFBUTTON2)=idyes then - MJPG.SaveToFile(pathFile); + if application.MessageBox(pchar('ļ[' + trim(pathFile) + ']ѴڣǷҪ滻'), 'ʾϢ', MB_YESNO + mb_iconinformation + MB_DEFBUTTON2) = idyes then + MJPG.SaveToFile(pathFile); end else - MJPG.SaveToFile(pathFile); + MJPG.SaveToFile(pathFile); end; end; @@ -526,13 +542,13 @@ begin begin close; 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; - if RecordCount>0 then + if RecordCount > 0 then begin edit; - fieldByName(pat1).Value:=null; - FieldByName(pic1).Value:=null; + fieldByName(pat1).Value := null; + FieldByName(pic1).Value := null; post; Image1.Picture.Assign(nil); Image2.Picture.Assign(nil); @@ -543,3 +559,4 @@ begin end; end. +