明鑫成品仓库

This commit is contained in:
DESKTOP-E401PHE\Administrator 2026-02-06 14:33:24 +08:00
commit d89ee71fa2
396 changed files with 311813 additions and 0 deletions

17
.gitignore vendored Normal file
View File

@ -0,0 +1,17 @@
**/layout
**/report
**/实施文件
**/image
**/doc
**/wav
**/__history
**/__recovery
*.dll
*.exe
*.ddp
*.dcu
*.~pas
*.~dfm
*.~ddp
*.~dpr
public10/ThreeFun/Fun/U_RTFun250225.pas

View File

@ -0,0 +1,133 @@
unit U_CustomFun;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, BtnEdit, cxStyles, cxCustomData,
cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, DBGrids, DB, cxDBData,
cxGridLevel, cxClasses, cxControls, cxGridCustomView, ADODB, StrUtils, Midas,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxTimeEdit,
cxTreeView, cxGrid, cxDBLookupComboBox, cxCalendar, cxCurrencyEdit,
cxGridExportLink, ExtCtrls, Buttons, DBClient, RTComboBox, cxDropDownEdit,
cxGridBandedTableView, cxGridDBBandedTableView, cxRichEdit, cxButtonEdit,
IniFiles, WinSock, IdHTTP, dxcore, cxTextEdit, FireDAC.Comp.Client,
Vcl.Clipbrd, cxMemo, dxLayoutControl;
procedure CreatCDSData(ADO1: TADOQuery; Tv1: TcxGridDBTableView; FType: string);
procedure CreatLabelEdit(ADO1: TADOQuery; Tv1: TcxGridDBTableView; TMPanel: TPanel; FType: string);
implementation
uses
U_DataLink;
procedure CreatCDSData(ADO1: TADOQuery; Tv1: TcxGridDBTableView; FType: string);
var
FieldName, Caption, FootNote, SqlStr: string;
Column: TcxGridDBColumn;
begin
SqlStr := 'SELECT ZDYName AS FieldName, Note AS Caption, Note1 AS FLabel, Note2 AS FootNote FROM KH_ZDY where Type=''' + FType + ''' ';
with ADO1 do
begin
Filtered := False;
Close;
sql.Clear;
sql.Add(SqlStr);
Open;
end;
Tv1.BeginUpdate;
try
while Tv1.ColumnCount > 0 do //清空所有列
Tv1.Columns[0].Free;
// 遍历查询结果
while not ADO1.Eof do
begin
FieldName := ADO1.FieldByName('FieldName').AsString;
Caption := ADO1.FieldByName('Caption').AsString;
FootNote := ADO1.FieldByName('FootNote').AsString;
// 创建新列
Column := Tv1.CreateColumn;
Column.Caption := Caption;
Column.DataBinding.FieldName := FieldName;
Column.Width := 100;
Column.HeaderAlignmentHorz := taCenter;
ADO1.Next;
end;
finally
Tv1.EndUpdate;
end;
end;
procedure CreatLabelEdit(ADO1: TADOQuery; Tv1: TcxGridDBTableView; TMPanel: TPanel; FType: string);
var
LabelControl: TLabel;
EditControl: TEdit;
Caption, FLabel, FieldName, SqlStr: string;
I, CurrentTop, CurrentLeft, ControlWidth, LabelWidth: Integer;
begin
SqlStr := 'SELECT ZDYName AS FieldName, Note AS Caption, Note1 AS FLabel, Note2 AS FootNote FROM KH_ZDY where Type=''' + FType + ''' ';
with ADO1 do
begin
Filtered := False;
Close;
sql.Clear;
sql.Add('SELECT ZDYName AS FieldName, Note AS Caption, Note1 AS FLabel FROM KH_ZDY where Type=''WBGlide'' ');
Open;
end;
// 清空现有控件
for I := TMPanel.ControlCount - 1 downto 0 do
begin
TMPanel.Controls[I].Free;
end;
// 初始化位置(所有控件的顶部位置,第一个控件的左侧位置,Edit框的宽度)
CurrentTop := 10;
CurrentLeft := 10;
ControlWidth := 100;
// 遍历查询结果并创建标签和编辑框
I := 0;
while not ADO1.Eof do
begin
Caption := ADO1.FieldByName('Caption').AsString;
FLabel := ADO1.FieldByName('FLabel').AsString;
FieldName := ADO1.FieldByName('FieldName').AsString;
if FLabel = '是' then
begin
// 创建新Label
LabelControl := TLabel.Create(TMPanel);
LabelControl.Parent := TMPanel;
LabelControl.Caption := Caption;
LabelControl.Left := CurrentLeft;
LabelControl.Top := CurrentTop + 3; //下移一点为了和Edit框对齐
LabelControl.AutoSize := True;
// 计算标签的宽度
LabelWidth := LabelControl.Width;
// 创建新Edit
EditControl := TEdit.Create(TMPanel);
EditControl.Parent := TMPanel;
EditControl.Left := CurrentLeft + LabelWidth + 3; // 在Label右边并留有间隔
EditControl.Top := CurrentTop; // 设置距顶距离
EditControl.Width := ControlWidth; // 设置宽度
EditControl.Name := FieldName; // 设置Name属性
EditControl.Tag := 2; // 刷新触发过滤
// 更新位置
CurrentLeft := EditControl.Left + EditControl.Width + 20; // 为下一个控件的位置留空间
EditControl.Text := '';
Inc(I);
end;
ADO1.Next;
end;
end;
end.

View File

@ -0,0 +1,359 @@
unit U_HttpFun;
interface
uses
System.SysUtils, System.Net.HttpClientComponent, System.Classes, System.JSON,
Datasnap.DBClient, Data.DB;
function UrlDecode(const AStr: AnsiString): AnsiString;
function GetRequest(Url: string): string;
function RTGetRequest(Url: string): string;
procedure JsonToDataset(JsonStr, ArrName: string; CDS_1: TclientDataSet);
function JsonErr(JsonStr, Success: string): string;
function JsonGetChildValue(JsonStr, KeyName: string): string;
function JsonGetChildObject(JsonStr, KeyName: string): string;
function YongYouGettoken(): string;
function YongYouSpliceUrl(BsUrl, ChildUrl, from_account, to_account, app_key, token, arg: string): string;
procedure JsonToCHDA(JSONStr, ArrName: string; CDS_1: TclientDataSet);
implementation
uses
U_DataLink;
function RTGetRequest(Url: string): string;
var
vHttp: TNetHTTPClient;
vUTF8: TStringStream;
begin
vHttp := TNetHTTPClient.Create(nil);
vUTF8 := TStringStream.Create('', TEncoding.GetEncoding(65001));
try
with vHttp do
begin
vUTF8.Clear;
ConnectionTimeout := 2000; // 2
ResponseTimeout := 10000; // 10
AcceptCharSet := 'utf-8';
AcceptEncoding := '65001';
AcceptLanguage := 'zh-CN';
ContentType := 'text/html';
UserAgent := 'Embarcadero URI Client/1.0';
try
Get(Url, vUTF8);
Result := vUTF8.DataString; // UrlDecode(vUTF8.DataString); //TNetEncoding.URL.
except
on E: Exception do
// Error sending data: (12002) 操作超时.
// Error receiving data: (12002) 操作超时
if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
Result := '{"RtErr":"接口连接失败!"}'
else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
Result := '{"RtErr":"接口传输数据失败,请延长接收超时时间"}'
else
Result := '{"RtErr":"' + E.Message + '"}';
end;
end;
finally
vUTF8.Free;
vHttp.Free;
end;
end;
procedure JsonToCHDA(JSONStr, ArrName: string; CDS_1: TclientDataSet);
var
JSONObject, JSONObject2: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, j, k: Integer; // 循环变量
Cloint: Integer; // 循环变量
temp: string; // 临时使用变量
jsonArray: TJSONArray; // JSON数组变量
mfieldName: string;
mSize: Integer;
begin
JSONObject := nil;
try
CDS_1.DisableControls;
CDS_1.FieldDefs.Clear;
CDS_1.FieldDefs.Add('code', ftString, 255);
CDS_1.FieldDefs.Add('name', ftString, 255);
CDS_1.FieldDefs.Add('specs', ftString, 255);
CDS_1.FieldDefs.Add('SSel', ftBoolean, 0);
CDS_1.close;
CDS_1.CreateDataSet;
{ 从字符串生成JSON }
JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if JSONObject.Count > 0 then
begin
// json数组
jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
if jsonArray.Count > 0 then
begin
// 循环取得JSON数组中每个元素
for i := 0 to jsonArray.Size - 1 do
begin
with CDS_1 do
begin
Append;
Cloint := jsonArray.Items[i].GetValue<TJSONObject>.Count;
for k := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[k];
if Findfield(JSONPair.JsonString.Value) <> nil then
begin
FieldByName(JSONPair.JsonString.Value).Value := JSONPair.JSONValue.Value;
end;
end;
Post;
end;
end;
end;
end
else
begin
temp := '没有数据!';
end;
finally
CDS_1.First;
CDS_1.EnableControls;
JSONObject.Free;
end;
end;
function YongYouGettoken(): string;
var
JsonStr: string;
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
begin
Result := '';
BJ_Url := 'https://api.yonyouup.com/api/';
BJ_FromAccount := 'hbyl2024';
BJ_ToAccount := 'hbyl2024:mesapp';
BJ_appKey := 'opaeaf8afe01e3fe21f';
JsonStr := GetRequest('https://api.yonyouup.com/system/token?from_account=hbyl2024&app_key=opaeaf8afe01e3fe21f&app_secret=8d699f9b39ac41139941f224d5da154e');
if JsonErr(JsonStr, '0') = '0' then
begin
BJ_token := JsonGetChildValue(JsonGetChildObject(JsonStr, 'token'), 'id');
end
else
begin
Result := JsonStr;
end;
end;
function YongYouSpliceUrl(BsUrl, ChildUrl, from_account, to_account, app_key, token, arg: string): string;
begin
Result := BsUrl + ChildUrl + '?from_account=' + from_account + '&to_account=' + to_account + '&app_key=' + app_key + '&token=' + token + arg;
end;
function UrlDecode(const AStr: AnsiString): AnsiString;
var
Sp, Rp, Cp: PAnsiChar;
s: AnsiString;
begin
SetLength(Result, Length(AStr));
Sp := PAnsiChar(AStr);
Rp := PAnsiChar(Result);
Cp := Sp;
while Sp^ <> #0 do
begin
case Sp^ of
'+':
Rp^ := ' ';
'%':
begin
Inc(Sp);
if Sp^ = '%' then
Rp^ := '%'
else
begin
Cp := Sp;
Inc(Sp);
if (Cp^ <> #0) and (Sp^ <> #0) then
begin
s := AnsiChar('$') + Cp^ + Sp^;
Rp^ := AnsiChar(StrToInt(string(s)));
end;
end;
Cp := Cp;
end;
else
Rp^ := Sp^;
end;
Inc(Rp);
Inc(Sp);
end;
SetLength(Result, Rp - PAnsiChar(Result));
end;
function GetRequest(Url: string): string;
var
vHttp: TNetHTTPClient;
vUTF8: TStringStream;
begin
vHttp := TNetHTTPClient.Create(nil);
vUTF8 := TStringStream.Create('', TEncoding.GetEncoding(65001));
try
with vHttp do
begin
vUTF8.Clear;
ConnectionTimeout := 2000; // 2
ResponseTimeout := 10000; // 10
AcceptCharSet := 'utf-8';
AcceptEncoding := '65001';
AcceptLanguage := 'zh-CN';
ContentType := 'text/html';
UserAgent := 'Embarcadero URI Client/1.0';
try
Get(Url, vUTF8);
Result := vUTF8.DataString; // UrlDecode(vUTF8.DataString); //TNetEncoding.URL.
except
on E: Exception do
// Error sending data: (12002) 操作超时.
// Error receiving data: (12002) 操作超时
if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error sending data' then
Result := '{"RtErr":"接口连接失败!"}'
else if Copy(E.Message, 1, Pos(':', E.Message) - 1) = 'Error receiving data' then
Result := '{"RtErr":"接口传输数据失败,请延长接收超时时间"}'
else
Result := '{"RtErr":"' + E.Message + '"}';
end;
end;
finally
vUTF8.Free;
vHttp.Free;
end;
end;
procedure JsonToDataset(JSONStr, ArrName: string; CDS_1: TclientDataSet);
var
JSONObject, JSONObject2: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, j, k: Integer; // 循环变量
Cloint: Integer; // 循环变量
temp: string; // 临时使用变量
jsonArray: TJSONArray; // JSON数组变量
mfieldName: string;
mSize: Integer;
begin
JSONObject := nil;
try
CDS_1.DisableControls;
{ 从字符串生成JSON }
JSONObject := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if JSONObject.Count > 0 then
begin
// json数组
jsonArray := TJSONArray(JSONObject.GetValue(ArrName));
if jsonArray.Count > 0 then
begin
// 循环取得JSON数组中每个元素
for i := 0 to jsonArray.Size - 1 do
begin
if i = 0 then
begin
Cloint := jsonArray.Items[i].GetValue<TJSONObject>.Count;
CDS_1.FieldDefs.Clear;
for j := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[j];
CDS_1.FieldDefs.Add(JSONPair.JsonString.Value, ftString, 255);
end;
CDS_1.FieldDefs.Add('SSel', ftBoolean, 0);
CDS_1.close;
CDS_1.CreateDataSet;
end;
with CDS_1 do
begin
Append;
for k := 0 to Cloint - 1 do
begin
JSONPair := jsonArray.Items[i].GetValue<TJSONObject>.Pairs[k];
if Findfield(JSONPair.JsonString.Value) <> nil then
FieldByName(JSONPair.JsonString.Value).Value := JSONPair.JSONValue.Value;
end;
Post;
end;
end;
end;
end
else
begin
temp := '没有数据!';
end;
finally
CDS_1.First;
CDS_1.EnableControls;
JSONObject.Free;
end;
end;
function JsonErr(JsonStr, Success: string): string;
var
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
begin
Result := Success;
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Cloint := JSONObject.Count;
for i := 0 to Cloint - 1 do
begin
JSONPair := JSONObject.Pairs[i];
if JSONPair.JsonString.Value = 'errcode' then
Result := JSONPair.JSONValue.Value;
end;
end;
function JsonGetChildObject(JsonStr, KeyName: string): string;
var
JSONObject: TJSONObject; // JSON类
begin
Result := '';
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Result := JSONObject.GetValue(KeyName).ToString;
end;
function JsonGetChildValue(JsonStr, KeyName: string): string;
var
JSONObject: TJSONObject; // JSON类
JSONPair: TJSONPair;
i, Cloint: integer;
Z, X: string;
begin
Result := '';
JSONObject := TJSONObject.ParseJSONValue(JsonStr) as TJSONObject;
Cloint := JSONObject.Count;
for i := 0 to Cloint - 1 do
begin
JSONPair := JSONObject.Pairs[i];
Z := JSONPair.JsonString.Value;
X := JSONPair.JSONValue.Value;
if JSONPair.JsonString.Value = KeyName then
Result := JSONPair.JSONValue.Value;
end;
end;
end.

View File

@ -0,0 +1,122 @@
unit U_PrintLabFun;
interface
uses
ADODB, System.SysUtils, Vcl.Forms;
procedure PrintServerLabel(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
procedure PrintServerLabelStkId(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
implementation
uses
U_printPdf, U_RTFun, U_DataLink;
procedure PrintServerLabel(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
var
MaxBLCLID, LBName: string;
WBoolean: Boolean;
i: Integer;
Mmessage, MpdfFileId, Mcode: string;
begin
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add(' EXEC P_Trade_Card_Prt1 ');
SQL.Add(' @Filtration=''' + Trim(FFiltration1) + '''');
Open;
end;
if ADO_Prt.IsEmpty then
begin
raise Exception.Create('标签内容未找到!');
end;
LBName := Trim(ADO_Prt.fieldbyname('LabVolume').AsString);
try
if GetLSNo(ADO_Prt, MaxBLCLID, 'L', 'Bs_Report_Cloud_Log', 4, 1) = False then
begin
end;
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add('select * from Bs_Report_Cloud_Log where 1=2');
Open;
end;
with ADO_Prt do
begin
Append;
FieldByName('BLCLID').Value := MaxBLCLID;
FieldByName('Filler').Value := dname;
FieldByName('LMName').Value := LBName;
FieldByName('LMSql1').Value := 'P_Trade_Card_Prt1';
FieldByName('Filtration1').Value := Trim(FFiltration1);
FieldByName('IsSql1').Value := 0;
FieldByName('Sheets').Value := mSheets;
Post;
end;
printPdf(Application, 1, PChar('title'), PChar(dcode), PChar(dname), PChar(MaxBLCLID), mSheets, mprintFlag, mprinter, PChar(DConString));
except
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure PrintServerLabelStkId(ADO_Prt: TADOQuery; mSheets, mprintFlag, mprinter: Integer; FFiltration1: string);
var
MaxBLCLID, LBName: string;
WBoolean: Boolean;
i: Integer;
Mmessage, MpdfFileId, Mcode: string;
begin
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add(' EXEC P_Trade_Cloth_Prt_Lab ');
SQL.Add(' @Filtration=''' + Trim(FFiltration1) + '''');
Open;
end;
if ADO_Prt.IsEmpty then
begin
raise Exception.Create('标签内容未找到!');
end;
LBName := Trim(ADO_Prt.fieldbyname('LabVolume').AsString);
try
if GetLSNo(ADO_Prt, MaxBLCLID, 'L', 'Bs_Report_Cloud_Log', 4, 1) = False then
begin
end;
with ADO_Prt do
begin
Close;
SQL.Clear;
sql.Add('select * from Bs_Report_Cloud_Log where 1=2');
Open;
end;
with ADO_Prt do
begin
Append;
FieldByName('BLCLID').Value := MaxBLCLID;
FieldByName('Filler').Value := dname;
FieldByName('LMName').Value := LBName;
FieldByName('LMSql1').Value := 'P_Trade_Cloth_Prt_Lab';
FieldByName('Filtration1').Value := Trim(FFiltration1);
FieldByName('IsSql1').Value := 0;
FieldByName('Sheets').Value := mSheets;
Post;
end;
printPdf(Application, 1, PChar('title'), PChar(dcode), PChar(dname), PChar(MaxBLCLID), mSheets, mprintFlag, mprinter, PChar(DConString));
except
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
end.

View File

@ -0,0 +1,157 @@
{格式化 JSON 单元
}
unit uFomat_JSON;
interface
uses
system.JSON,
System.SysUtils, System.Variants, System.Classes;
const
Level_indent = 2;
//格式化 JSON 字符串
// JSONStr : 表示需要格式化的 JSON字符串
// lv : 表示缩进层级
function JSON_Format(JSONStr : string; lv : Word = 0) : string;
//格式化数组, 缩进
function JSON_Fromat_Array(ja : TJSONArray; lv : word = 0) : string;
//跨过的indent
function LI(lv : Word) : string;
implementation
//格式化 JSON 字符串
// JSONStr : 表示需要格式化的 JSON字符串
// Left_Space : 表示左边统一留多少个空格
// Level_index :表示每级缩进多个个空格
function JSON_Format(JSONStr : string; lv : Word = 0) : string;
var
S : string;
jo : TJSONObject;
jo1: TJSONObject;
jp : TJSONPair;
js : TJSONString;
jn : TJSONNumber;
jb : TJSONBool;
ja : TJSONArray;
jpe : TJSONObject.TEnumerator;
begin
//1. 解析 JSONStr
jo := TJSONObject.ParseJSONValue(JSONStr) as TJSONObject;
if jo = nil then Exit(JSONStr);
Result := '{' + #13#10;
try
jpe := jo.GetEnumerator;
if jpe = nil then Exit(JSONSTr);
while jpe.MoveNext do
begin
jp := jpe.Current;
if jp.JsonValue.TryGetValue(jo1) then
begin
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '":'#13#10;
Result := Result + LI(lv + 1) + JSON_Format(jo1.ToJSON,lv + 2);
Continue;
end
else
if jp.JsonValue.TryGetValue(jn) then //数字
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '": ' + jn.Value + ','#13#10
else
if jp.JsonValue.TryGetValue(jb) then //Boolean
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '": ' + jb.Value + ','#13#10
else
if jp.JsonValue.TryGetValue(ja) then //字符串
begin
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '": '#13#10;
Result := Result + LI(lv + 1) + JSON_Fromat_Array(ja,lv + 1);
end
else
if jp.JsonValue.TryGetValue(js) then //字符串
Result := Result + LI(lv + 1) + '"' + jp.JsonString.Value + '": "' + js.Value + '",'#13#10
end;
//去掉最后一行的 ,
S := Result.Substring(Length(Result) - 3,3);
if S = ','#13#10 then
Result := Result.Substring(0,Length(Result) - 3) + #13#10;
//最后结果的 }
if lv > 0 then
begin
lv := lv - 1;
Result := Result + LI(lv) + '},'#13#10;
end
else
Result := Result + LI(0) + '}'#13#10;
finally
if jo <> nil then
jo.Free;
if jpe <> nil then
jpe.Free;
end;
end;
//格式化数组, 缩进
function JSON_Fromat_Array(ja : TJSONArray; lv : word = 0) : string;
var
jae : TJSONArray.TEnumerator;
jv : TJSONValue;
js : TJSONString;
jn : TJSONNumber;
jb : TJSONBool;
jo : TJSONObject;
ja1 : TJSONArray;
S : string;
begin
//
Result := '['#13#10;
jae := ja.GetEnumerator;
if jae = nil then Exit('');
while jae.MoveNext do
begin
jv := jae.Current;
//进行数据处理
if jv.TryGetValue(jn) then //Number
Result := Result + LI(lv + 1) + jn.Value + ','#13#10
else
if jv.TryGetValue(jb) then //Boolean
Result := Result + LI(lv + 1) + jb.Value + ','#13#10
else
if jv.TryGetValue(jo) then //JSONObject
begin
Result := Result + LI(lv + 1) + JSON_Format(jo.ToString,lv + 2) ;
end
else
if jv.TryGetValue(ja1) then //JSONArray
Result := Result + LI(lv + 1) + JSON_Fromat_Array(ja1,lv + 1)
else
if jv.TryGetValue(js) then //string
Result := Result + LI(lv + 1) + '"' + js.Value + '",'#13#10;
end;
//去掉最后一行的 ,
S := Result.Substring(Length(Result) - 3,3);
if S = ','#13#10 then
Result := Result.Substring(0,Length(Result) - 3) + #13#10;
Result := Result + LI(lv) + '],'#13#10;
if jae <> nil then
jae.Free;
end;
//跨过的indent
function LI(lv : Word) : string;
begin
Result := StringOfChar(' ', lv * Level_indent);
end;
end.

View File

@ -0,0 +1,248 @@
{**************************************
时间:2021-06-18
功能:1 实现delphi原生的JSON操作为 S[] 操作方式
作者sensor QQ:910731685
}
unit uSZHN_JSON;
interface
uses
//System.Classes,
//System.Types,
//System.DateUtil,
//System.Generics.Collections,
System.SysUtils,
System.JSON;
type
TJSONObjectHelper = class helper for TJSONObject
private
function Get_ValueS(PairName : string) : string;
procedure Set_ValueS(PairName,PairValue : string);
function Get_ValueI(PairName : string) : Integer;
procedure Set_ValueI(PairName : string; PairValue : Integer);
function Get_ValueI64(PairName : string) : Int64;
procedure Set_ValueI64(PairName : string; PairValue : Int64);
function Get_ValueD(PairName : string) : TDateTime;
procedure Set_ValueD(PairName : string; PairValue : TDateTime);
function Get_ValueB(PairName : string) : Boolean;
procedure Set_ValueB(PairName : string; PairValue : Boolean);
function Get_ValueA(PairName : string) : TJSONArray;
procedure Set_ValueA(PairName : string; PairValue : TJSONArray);
function Get_ValueO(PairName : string) : TJSONObject;
procedure Set_ValueO(PairName : string; PairValue : TJSONObject);
public
//判断某个字段是否存在
function PairExists(PairName : string) : Boolean;
procedure Remove(PairName : string);
//定义字段读取函数
property S[PairName : string] : string read Get_ValueS write Set_ValueS;
property I[PairName : string] : integer read Get_ValueI write Set_ValueI;
property I64[PairName : string] : Int64 read Get_ValueI64 write Set_ValueI64;
property D[PairName : string] : TDateTime read Get_ValueD write Set_ValueD;
property B[PairName : string] : Boolean read Get_ValueB write Set_ValueB;
property A[PairName : string] : TJSONArray read Get_ValueA write Set_ValueA;
property O[PairName : string] : TJSONObject read Get_ValueO write Set_ValueO;
end;
implementation
{ TJSONObjectHelper }
function TJSONObjectHelper.Get_ValueS(PairName: string): string;
var
js : TJSONString;
begin
if PairName = '' then Exit;
if Self.TryGetValue(PairName,js) then
Result := js.Value
else
Result := '';
end;
function TJSONObjectHelper.PairExists(PairName: string): Boolean;
begin
Result := Self.Values[PairName] <> nil;
end;
procedure TJSONObjectHelper.Remove(PairName: string);
begin
Self.RemovePair(PairName).Free;
end;
procedure TJSONObjectHelper.Set_ValueS(PairName, PairValue: string);
var
js : TJSONString;
begin
//1. 首先查找有没有该字段, 如果有,则直接删除
if Self.TryGetValue(PairName,js) then
begin
Self.RemovePair(PairName).Free; //如果没有free就会产生内存泄露
end;
//2. 然后在增加
Self.AddPair(PairName, PairValue);
end;
function TJSONObjectHelper.Get_ValueI(PairName: string): Integer;
var
ji : TJSONNumber;
begin
if PairName = '' then Exit(0);
if Self.TryGetValue(PairName,ji) then
Result := ji.AsInt
else
Result := 0;
end;
procedure TJSONObjectHelper.Set_ValueI(PairName: string; PairValue: Integer);
var
jn : TJSONNumber;
begin
//1. 首先查找有没有该字段, 如果有,则直接删除
if Self.TryGetValue(PairName,jn) then
Self.RemovePair(PairName).Free;
//2. 然后在增加
Self.AddPair(PairName, TJSONNumber.Create(PairValue));
end;
function TJSONObjectHelper.Get_ValueD(PairName: string): TDateTime;
var
ji : TJSONNumber;
begin
if PairName = '' then Exit(0);
if Self.TryGetValue(PairName,ji) then
Result := ji.AsDouble
else
Result := 0;
end;
procedure TJSONObjectHelper.Set_ValueD(PairName: string; PairValue: TDateTime);
var
jn : TJSONNumber;
begin
//1. 首先查找有没有该字段, 如果有,则直接删除
if Self.TryGetValue(PairName,jn) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, TJSONNumber.Create(PairValue));
end;
function TJSONObjectHelper.Get_ValueB(PairName: string): Boolean;
var
jb : TJSONBool;
begin
if PairName = '' then Exit(False);
if Self.TryGetValue(PairName,jb) then
Result := jb.AsBoolean
else
Result := False;
end;
procedure TJSONObjectHelper.Set_ValueB(PairName: string; PairValue: Boolean);
var
jb : TJSONBool;
begin
//1. 首先查找有没有该字段, 如果有,则直接删除
if Self.TryGetValue(PairName,jb) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, TJSONBool.Create(PairValue));
end;
function TJSONObjectHelper.Get_ValueI64(PairName: string): Int64;
var
ji : TJSONNumber;
begin
if PairName = '' then Exit(0);
if Self.TryGetValue(PairName,ji) then
Result := ji.AsInt64
else
Result := 0;
end;
procedure TJSONObjectHelper.Set_ValueI64(PairName: string; PairValue: Int64);
var
jn : TJSONNumber;
begin
//1. 首先查找有没有该字段, 如果有,则直接删除
if Self.TryGetValue(PairName,jn) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, TJSONNumber.Create(PairValue));
end;
function TJSONObjectHelper.Get_ValueA(PairName: string): TJSONArray;
var
ja : TJSONArray;
begin
if PairName = '' then Exit(nil);
Self.TryGetValue(PairName,Result);
end;
procedure TJSONObjectHelper.Set_ValueA(PairName: string; PairValue: TJSONArray);
var
ja : TJSONArray;
begin
//1. 首先查找有没有该字段, 如果有,则直接删除
if Self.TryGetValue(PairName,ja) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, PairValue);
end;
function TJSONObjectHelper.Get_ValueO(PairName: string): TJSONObject;
var
jo : TJSONObject;
begin
if PairName = '' then Exit(nil);
if Self.TryGetValue(PairName,jo) then
Result := jo
else
Result := nil;
end;
procedure TJSONObjectHelper.Set_ValueO(PairName: string; PairValue: TJSONObject);
var
jo : TJSONObject;
begin
//1. 首先查找有没有该字段, 如果有,则直接删除
if Self.TryGetValue(PairName,jo) then
Self.RemovePair(PairName).Free;
Self.AddPair(PairName, PairValue as TJSONObject);
end;
end.

4
A00通用模板/File.INI Normal file
View File

@ -0,0 +1,4 @@
[生产车间配置]
卷条码机台标志=99
成品DLL文件=CYZZ.dll
成品DLL调用号=11

View File

@ -0,0 +1,7 @@
[FILEPATH]
FileClass=YP,AA,BB,HT
YP=D:\YP
AA=D:\AA
BB=D:\BB
HT=D:\HT
OTHER=D:\OTHER

View File

@ -0,0 +1,42 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-U"D:\말繫ERP"
-O"D:\말繫ERP"
-I"D:\말繫ERP"
-R"D:\말繫ERP"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,138 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=D:\말繫ERP
Packages=vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOffice2k;Rave50CLX;Rave50VCL
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=D:\땀둑룟역랙덜쯤\淃커덜쯤\낀菫介놉\虔廉셕뺍데(ShuttleSchedule.dll)\testDll.exe
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2052
CodePage=936
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
c:\program files\borland\delphi7\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package

View File

@ -0,0 +1,60 @@
library InformationBase;
uses
SysUtils,
classes,
forms,
WinTypes,
WinProcs,
midaslib,
U_GetDllForm in 'U_GetDllForm.pas',
U_DataLink in 'U_DataLink.pas' {DataLink_InformationBase: TDataModule},
U_iniParam in 'U_iniParam.pas',
U_BaseHelp in '..\..\..\public10\design\U_BaseHelp.pas' {frmBaseHelp},
U_BaseInput in '..\..\..\public10\design\U_BaseInput.pas' {frmBaseInput},
U_BaseList in '..\..\..\public10\design\U_BaseList.pas' {frmBaseList},
U_CompressionFun in '..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas',
U_RTFun in '..\..\..\public10\ThreeFun\Fun\U_RTFun.pas',
U_ZDYHelp in '..\..\..\public10\ThreeFun\Form\U_ZDYHelp.pas' {frmZDYHelp},
Unit1 in 'Unit1.pas' {Form1},
U_AttachmentUpload in '..\A00通用窗体\U_AttachmentUpload.pas' {frmFjList_RZ},
U_ClothInfoSel in '..\A00通用窗体\U_ClothInfoSel.pas' {frmClothInfoSel},
U_CompanySel in '..\A00通用窗体\U_CompanySel.pas' {frmCompanySel},
U_EmployeeSel in '..\A00通用窗体\U_EmployeeSel.pas' {frmEmployeeSel},
U_LabelMapSet in '..\A00通用窗体\U_LabelMapSet.pas' {frmLabelMapSet},
U_LabelPrint in '..\A00通用窗体\U_LabelPrint.pas' {frmLabelPrint},
U_BaseDataLink in '..\..\..\public10\design\U_BaseDataLink.pas' {BaseDataLink: TDataModule},
FrameDateSel in '..\A00通用组件\FrameDateSel.pas' {frmFrameDateSel: TFrame},
FramePagingSel in '..\A00通用组件\FramePagingSel.pas' {frmFramePagingSel: TFrame},
U_cxGridCustomCss in '..\..\..\public10\design\U_cxGridCustomCss.pas',
U_cxGridCustomSet in '..\..\..\public10\design\U_cxGridCustomSet.pas',
U_FormLayOutDesign in '..\..\..\public10\design\U_FormLayOutDesign.pas',
U_globalVar in '..\..\..\public10\design\U_globalVar.pas',
U_WindowFormdesign in '..\..\..\public10\design\U_WindowFormdesign.pas';
{$R *.res}
procedure DllEnterPoint(dwReason: DWORD); far; stdcall;
begin
DLLProc := @DLLEnterPoint;
DllEnterPoint(DLL_PROCESS_ATTACH);
end;
procedure DLLUnloadProc(Reason: Integer); register;
begin
// if (Reason = DLL_PROCESS_DETACH) or (Reason = DLL_THREAD_DETACH) then
// Application := NewDllApp;
end;
exports
GetDllForm;
begin
try
NewDllApp := Application;
DLLProc := @DLLUnloadProc;
except
end;
end.

View File

@ -0,0 +1,940 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{7B70AA99-C84C-40AE-B4AE-13C5223B874C}</ProjectGuid>
<MainSource>InformationBase.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>38017</TargetedPlatforms>
<AppType>Library</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>19.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Base)'=='true') or '$(Base_Android64)'!=''">
<Base_Android64>true</Base_Android64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Base)'=='true') or '$(Base_iOSDevice64)'!=''">
<Base_iOSDevice64>true</Base_iOSDevice64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Android64)'!=''">
<Cfg_2_Android64>true</Cfg_2_Android64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Cfg_2)'=='true') or '$(Cfg_2_iOSDevice64)'!=''">
<Cfg_2_iOSDevice64>true</Cfg_2_iOSDevice64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX64)'!=''">
<Cfg_2_OSX64>true</Cfg_2_OSX64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<DCC_UnitSearchPath>D:\富通ERP;$(DCC_UnitSearchPath)</DCC_UnitSearchPath>
<DCC_UsePackage>vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;bdertl;vcldbx;webdsnap;websnap;adortl;ibxpress;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOffice2k;Rave50CLX;Rave50VCL;$(DCC_UsePackage)</DCC_UsePackage>
<GenDll>true</GenDll>
<SanitizedProjectName>InformationBase</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;Data.Win;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>2052</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android64)'!=''">
<Android_LauncherIcon192>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png</Android_LauncherIcon192>
<EnabledSysJars>android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar</EnabledSysJars>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_iOSDevice64)'!=''">
<iOS_AppStore1024>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png</iOS_AppStore1024>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>System.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Icon_MainIcon>InformationBase_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<Icon_MainIcon>InformationBase_Icon.ico</Icon_MainIcon>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Android64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_iOSDevice64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_OSX64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<Debugger_HostApplication>D:\RTFormwork\项目代码\RTBasicsV1\A00通用模板\testDll.exe</Debugger_HostApplication>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="U_GetDllForm.pas"/>
<DCCReference Include="U_DataLink.pas">
<Form>DataLink_InformationBase</Form>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="U_iniParam.pas"/>
<DCCReference Include="..\..\..\public10\design\U_BaseHelp.pas">
<Form>frmBaseHelp</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseInput.pas">
<Form>frmBaseInput</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseList.pas">
<Form>frmBaseList</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas"/>
<DCCReference Include="..\..\..\public10\ThreeFun\Fun\U_RTFun.pas"/>
<DCCReference Include="..\..\..\public10\ThreeFun\Form\U_ZDYHelp.pas">
<Form>frmZDYHelp</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="Unit1.pas">
<Form>Form1</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_AttachmentUpload.pas">
<Form>frmFjList_RZ</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_ClothInfoSel.pas">
<Form>frmClothInfoSel</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_CompanySel.pas">
<Form>frmCompanySel</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_EmployeeSel.pas">
<Form>frmEmployeeSel</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_LabelMapSet.pas">
<Form>frmLabelMapSet</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\A00通用窗体\U_LabelPrint.pas">
<Form>frmLabelPrint</Form>
<FormType>dfm</FormType>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_BaseDataLink.pas">
<Form>BaseDataLink</Form>
<FormType>dfm</FormType>
<DesignClass>TDataModule</DesignClass>
</DCCReference>
<DCCReference Include="..\A00通用组件\FrameDateSel.pas">
<Form>frmFrameDateSel</Form>
<FormType>dfm</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="..\A00通用组件\FramePagingSel.pas">
<Form>frmFramePagingSel</Form>
<FormType>dfm</FormType>
<DesignClass>TFrame</DesignClass>
</DCCReference>
<DCCReference Include="..\..\..\public10\design\U_cxGridCustomCss.pas"/>
<DCCReference Include="..\..\..\public10\design\U_cxGridCustomSet.pas"/>
<DCCReference Include="..\..\..\public10\design\U_FormLayOutDesign.pas"/>
<DCCReference Include="..\..\..\public10\design\U_globalVar.pas"/>
<DCCReference Include="..\..\..\public10\design\U_WindowFormdesign.pas"/>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">InformationBase.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Android64">True</Platform>
<Platform value="iOSDevice64">True</Platform>
<Platform value="Linux64">True</Platform>
<Platform value="OSX64">True</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
<Deployment Version="3">
<DeployFile LocalName="InformationBase.dll" Configuration="Debug" Class="ProjectOutput">
<Platform Name="Win32">
<RemoteName>InformationBase.dll</RemoteName>
<Overwrite>true</Overwrite>
</Platform>
</DeployFile>
<DeployClass Name="AdditionalDebugSymbols">
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidClassesDexFile">
<Platform Name="Android">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>classes</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidFileProvider">
<Platform Name="Android">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\xml</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidGDBServer">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiFile">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeArmeabiv7aFile">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidLibnativeMipsFile">
<Platform Name="Android">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\mips</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidServiceOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashImageDef">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStyles">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="AndroidSplashStylesV21">
<Platform Name="Android">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values-v21</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Colors">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_DefaultAppIcon">
<Platform Name="Android">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon144">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon192">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-ldpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_LauncherIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon24">
<Platform Name="Android">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-mdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon36">
<Platform Name="Android">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-hdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon48">
<Platform Name="Android">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon72">
<Platform Name="Android">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_NotificationIcon96">
<Platform Name="Android">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xxxhdpi</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage426">
<Platform Name="Android">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-small</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage470">
<Platform Name="Android">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-normal</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage640">
<Platform Name="Android">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-large</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_SplashImage960">
<Platform Name="Android">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\drawable-xlarge</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="Android_Strings">
<Platform Name="Android">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>res\values</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DebugSymbols">
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyFramework">
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.framework</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="DependencyModule">
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.dll;.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="DependencyPackage">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
<Extensions>.dylib</Extensions>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
<Extensions>.bpl</Extensions>
</Platform>
</DeployClass>
<DeployClass Name="File">
<Platform Name="Android">
<Operation>0</Operation>
</Platform>
<Platform Name="Android64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>0</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>0</Operation>
</Platform>
<Platform Name="OSX64">
<Operation>0</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iOS_AppStore1024">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon152">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_AppIcon167">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPad_SpotLight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_AppIcon180">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Launch3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark2x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_LaunchDark3x">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification40">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Notification60">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting58">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Setting87">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight120">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="iPhone_Spotlight80">
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<RemoteDir>..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectAndroidManifest">
<Platform Name="Android">
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSDeviceDebug">
<Platform Name="iOSDevice32">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectiOSEntitlements"/>
<DeployClass Name="ProjectiOSInfoPList"/>
<DeployClass Name="ProjectiOSLaunchScreen"/>
<DeployClass Name="ProjectiOSResource">
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOSXDebug"/>
<DeployClass Name="ProjectOSXEntitlements"/>
<DeployClass Name="ProjectOSXInfoPList"/>
<DeployClass Name="ProjectOSXResource">
<Platform Name="OSX32">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<RemoteDir>Contents\Resources</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Required="true" Name="ProjectOutput">
<Platform Name="Android">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Android64">
<RemoteDir>library\lib\arm64-v8a</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice32">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSDevice64">
<Operation>1</Operation>
</Platform>
<Platform Name="iOSSimulator">
<Operation>1</Operation>
</Platform>
<Platform Name="Linux64">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX32">
<Operation>1</Operation>
</Platform>
<Platform Name="OSX64">
<Operation>1</Operation>
</Platform>
<Platform Name="Win32">
<Operation>0</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectOutput_Android32">
<Platform Name="Android64">
<RemoteDir>library\lib\armeabi-v7a</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="ProjectUWPManifest">
<Platform Name="Win32">
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo150">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<DeployClass Name="UWP_DelphiLogo44">
<Platform Name="Win32">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
<Platform Name="Win64">
<RemoteDir>Assets</RemoteDir>
<Operation>1</Operation>
</Platform>
</DeployClass>
<ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="OSX64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android64" Name="$(PROJECTNAME)"/>
</Deployment>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
<Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
</Project>

View File

@ -0,0 +1,115 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<Transactions>
<Transaction>1899-12-30 00:00:00.000.832,=D:\Dp10Repo\public10\design\U_BaseHelp.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.048,=D:\Dp10Repo\public10\design\U_BaseList.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.135,D:\Dp10Repo\项目代码\睿特\新DLL初始化(CSH.dll)\U_ZDYHelp.pas=</Transaction>
<Transaction>1899-12-30 00:00:00.000.616,D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_CompanySel.dfm=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_LablePrint.dfm</Transaction>
<Transaction>1899-12-30 00:00:00.000.975,=D:\Dp10Repo\public10\ThreeFun\Fun\U_CompressionFun.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.873,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_LbaelMapSet.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.844,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_AttachmentUpload.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.905,=D:\Dp10RepoV1\public10\design\U_BaseDataLink.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.339,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_ClothInfoSel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.692,D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_ClothInfoSel.pas=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_CompanySel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.149,=D:\Dp10Repo\public10\ThreeFun\Form\U_ZDYHelp.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.939,=D:\Dp10Repo\public10\design\U_BaseInput.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.692,D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_ClothInfoSel.dfm=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_CompanySel.dfm</Transaction>
<Transaction>1899-12-30 00:00:00.000.493,=D:\Dp10Repo\项目代码\RTBasics\A00通用模板\Unit1.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.716,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_ProcessSel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.178,=D:\Dp10Repo\public10\design\U_WindowFormdesign.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.931,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_LabelMapSet.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.015,=D:\Dp10Repo\public10\ThreeFun\Fun\U_RTFun.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.086,=D:\Dp10Repo\public10\design\U_cxGridCustomCss.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.123,=D:\Dp10Repo\public10\design\U_globalVar.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.736,D:\Dp10Repo\项目代码\睿特\新DLL初始化(CSH.dll)\U_ModuleNote.pas=</Transaction>
<Transaction>1899-12-30 00:00:00.000.616,D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_CompanySel.pas=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_LablePrint.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.135,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_LabelPrint.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.487,D:\Dp10Repo\项目代码\睿特\新DLL初始化(CSH.dll)\U_ZDYHelpSel.pas=</Transaction>
<Transaction>1899-12-30 00:00:00.000.092,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_EmployeeSel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.630,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_CompanySel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.734,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_CompanySel.pas</Transaction>
<Transaction>1899-12-30 00:00:00.000.422,=D:\Dp10Repo\项目代码\RTBasics\A00通用窗体\U_CompanySel.pas</Transaction>
<Transaction>2024-09-02 16:59:02.280,=D:\RTFormwork\项目代码\RTBasicsV1\A00通用组件\FrameDateSel.pas</Transaction>
<Transaction>2024-09-02 16:59:02.415,=D:\RTFormwork\项目代码\RTBasicsV1\A00通用组件\FramePagingSel.pas</Transaction>
<Transaction>2024-09-02 16:59:27.890,=D:\RTFormwork\public10\design\U_cxGridCustomSet.pas</Transaction>
<Transaction>2024-09-02 16:59:27.935,=D:\RTFormwork\public10\design\U_FormLayOutDesign.pas</Transaction>
</Transactions>
<ProjectSortOrder AutoSort="0" SortType="0">
<File Path="android-support-v4.dex.jar"/>
<File Path="cloud-messaging.dex.jar"/>
<File Path="com-google-android-gms.play-services-ads-base.17.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-ads.17.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar"/>
<File Path="com-google-android-gms.play-services-analytics.16.0.8.dex.jar"/>
<File Path="com-google-android-gms.play-services-base.16.0.1.dex.jar"/>
<File Path="com-google-android-gms.play-services-basement.16.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-gass.17.2.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-identity.16.0.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-maps.16.1.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar"/>
<File Path="com-google-android-gms.play-services-stats.16.0.1.dex.jar"/>
<File Path="com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar"/>
<File Path="com-google-android-gms.play-services-tasks.16.0.1.dex.jar"/>
<File Path="com-google-android-gms.play-services-wallet.16.0.1.dex.jar"/>
<File Path="com-google-firebase.firebase-analytics.16.4.0.dex.jar"/>
<File Path="com-google-firebase.firebase-common.16.1.0.dex.jar"/>
<File Path="com-google-firebase.firebase-iid-interop.16.0.1.dex.jar"/>
<File Path="com-google-firebase.firebase-iid.17.1.1.dex.jar"/>
<File Path="com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar"/>
<File Path="com-google-firebase.firebase-messaging.17.5.0.dex.jar"/>
<File Path="fmx.dex.jar"/>
<File Path="google-play-billing.dex.jar"/>
<File Path="google-play-licensing.dex.jar"/>
<File Path="..\..\RTBasicsV1"/>
<File Path="..\A00通用窗体"/>
<File Path="..\A00通用窗体\U_AttachmentUpload.pas"/>
<File Path="..\A00通用窗体\U_AttachmentUpload.dfm"/>
<File Path="..\A00通用窗体\U_ClothInfoSel.pas"/>
<File Path="..\A00通用窗体\U_ClothInfoSel.dfm"/>
<File Path="..\A00通用窗体\U_EmployeeSel.pas"/>
<File Path="..\A00通用窗体\U_EmployeeSel.dfm"/>
<File Path="..\A00通用窗体\U_CompanySel.pas"/>
<File Path="..\A00通用窗体\U_CompanySel.dfm"/>
<File Path="..\A00通用窗体\U_LabelMapSet.pas"/>
<File Path="..\A00通用窗体\U_LabelMapSet.dfm"/>
<File Path="..\A00通用窗体\U_LabelPrint.pas"/>
<File Path="..\A00通用窗体\U_LabelPrint.dfm"/>
<File Path="..\A00通用组件"/>
<File Path="..\A00通用组件\FrameDateSel.pas"/>
<File Path="..\A00通用组件\FrameDateSel.dfm"/>
<File Path="..\A00通用组件\FramePagingSel.pas"/>
<File Path="..\A00通用组件\FramePagingSel.dfm"/>
<File Path="D:\RTFormwork"/>
<File Path="..\..\..\public10"/>
<File Path="..\..\..\public10\design"/>
<File Path="..\..\..\public10\design\U_BaseDataLink.pas"/>
<File Path="..\..\..\public10\design\U_BaseDataLink.dfm"/>
<File Path="..\..\..\public10\design\U_BaseHelp.pas"/>
<File Path="..\..\..\public10\design\U_BaseHelp.dfm"/>
<File Path="..\..\..\public10\design\U_BaseInput.pas"/>
<File Path="..\..\..\public10\design\U_BaseInput.dfm"/>
<File Path="..\..\..\public10\design\U_BaseList.pas"/>
<File Path="..\..\..\public10\design\U_BaseList.dfm"/>
<File Path="..\..\..\public10\design\U_cxGridCustomCss.pas"/>
<File Path="..\..\..\public10\design\U_globalVar.pas"/>
<File Path="..\..\..\public10\design\U_WindowFormdesign.pas"/>
<File Path="..\..\..\public10\design\U_cxGridCustomSet.pas"/>
<File Path="..\..\..\public10\design\U_FormLayOutDesign.pas"/>
<File Path="..\..\..\public10\ThreeFun"/>
<File Path="..\..\..\public10\ThreeFun\Form"/>
<File Path="..\..\..\public10\ThreeFun\Form\U_ZDYHelp.pas"/>
<File Path="..\..\..\public10\ThreeFun\Form\U_ZDYHelp.dfm"/>
<File Path="..\..\..\public10\ThreeFun\Fun"/>
<File Path="..\..\..\public10\ThreeFun\Fun\U_CompressionFun.pas"/>
<File Path="..\..\..\public10\ThreeFun\Fun\U_RTFun.pas"/>
<File Path="U_DataLink.pas"/>
<File Path="U_DataLink.dfm"/>
<File Path="U_GetDllForm.pas"/>
<File Path="U_iniParam.pas"/>
<File Path="Unit1.pas"/>
<File Path="Unit1.dfm"/>
</ProjectSortOrder>
</BorlandProject>

Binary file not shown.

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 766 B

View File

@ -0,0 +1,23 @@
#------------------------------------------------------------------------------
VERSION = BWS.01
#------------------------------------------------------------------------------
!ifndef ROOT
ROOT = $(MAKEDIR)\..
!endif
#------------------------------------------------------------------------------
MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**
DCC = $(ROOT)\bin\dcc32.exe $**
BRCC = $(ROOT)\bin\brcc32.exe $**
#------------------------------------------------------------------------------
PROJECTS = testDll.exe ProductPrice.dll
#------------------------------------------------------------------------------
default: $(PROJECTS)
#------------------------------------------------------------------------------
testDll.exe: testDll.dpr
$(DCC)
ProductPrice.dll: ProductPrice.dpr
$(DCC)

View File

@ -0,0 +1,48 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{D75EC075-444C-40C2-8ACB-0AAD801B39FF}</ProjectGuid>
</PropertyGroup>
<ItemGroup>
<Projects Include="InformationBase.dproj">
<Dependencies/>
</Projects>
<Projects Include="testDll.dproj">
<Dependencies/>
</Projects>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Default.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Default.Personality/>
</BorlandProject>
</ProjectExtensions>
<Target Name="InformationBase">
<MSBuild Projects="InformationBase.dproj"/>
</Target>
<Target Name="InformationBase:Clean">
<MSBuild Projects="InformationBase.dproj" Targets="Clean"/>
</Target>
<Target Name="InformationBase:Make">
<MSBuild Projects="InformationBase.dproj" Targets="Make"/>
</Target>
<Target Name="testDll">
<MSBuild Projects="testDll.dproj"/>
</Target>
<Target Name="testDll:Clean">
<MSBuild Projects="testDll.dproj" Targets="Clean"/>
</Target>
<Target Name="testDll:Make">
<MSBuild Projects="testDll.dproj" Targets="Make"/>
</Target>
<Target Name="Build">
<CallTarget Targets="InformationBase;testDll"/>
</Target>
<Target Name="Clean">
<CallTarget Targets="InformationBase:Clean;testDll:Clean"/>
</Target>
<Target Name="Make">
<CallTarget Targets="InformationBase:Make;testDll:Make"/>
</Target>
<Import Project="$(BDS)\Bin\CodeGear.Group.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Group.Targets')"/>
</Project>

View File

@ -0,0 +1,7 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<Transactions/>
<Default.Personality>
<Projects ActiveProject="D:\RTFormwork\项目代码\RTBasicsV1\A00通用模板\InformationBase.dproj"/>
</Default.Personality>
</BorlandProject>

View File

@ -0,0 +1,6 @@
[SERVER]
服务器地址=101.132.143.144
服务器地址类型=2002
是否自动更新=1
软件名称=睿特版本库
登陆标题=sss

14165
A00通用模板/U_DataLink.dfm Normal file

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,131 @@
unit U_DataLink;
interface
uses
SysUtils, Classes, DB, ADODB, ImgList, Controls, cxStyles, cxLookAndFeels,
Windows, Messages, forms, OleCtnrs, DateUtils, ExtCtrls, SyncObjs, cxClasses,
dxSkinsCore, dxSkinsDefaultPainters, System.ImageList, U_BaseDataLink,
cxImageList, cxGraphics, cxEdit, cxContainer, dxSkinsForm, dxSkinBasic,
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, dxSkinOffice2016Colorful,
dxSkinOffice2016Dark, dxSkinOffice2019Black, dxSkinOffice2019Colorful,
dxSkinOffice2019DarkGray, dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven,
dxSkinSevenClassic, dxSkinSharp, dxSkinSharpPlus, dxSkinSilver,
dxSkinSpringtime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld,
dxSkinTheBezier, dxSkinValentine, dxSkinVisualStudio2013Blue,
dxSkinVisualStudio2013Dark, dxSkinVisualStudio2013Light, dxSkinVS2010,
dxSkinWhiteprint, dxSkinWXI, dxSkinXmas2008Blue, dxCore, cxLocalization,
dxLayoutLookAndFeels;
type
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
var
DConString: string; {全局连接字符串}
server, dtbase, user, pswd: string; {数据库连接参数}
DCurHandle: hwnd; //当前窗体句柄
DName: string; //#用户名#//
DCode: string; //#用户编号#//
Ddatabase: string; //#数据库名称#//
DTitCaption: string; //#主窗体名称#//
PicSvr: string;
fDllFileName: string;
DParameters1, DParameters2, DParameters3, DParameters4, DParameters5: string; // 外部参数;
DParameters6, DParameters7, DParameters8, DParameters9, DParameters10: string; //外部参数;
OldDllApp: Tapplication; //保存原有句柄
NewDllApp: Tapplication; //当前句柄
MainApplication: Tapplication;
DFormCode: integer; //当前窗口号
IsDelphiLanguage: integer;
DServerDate: TdateTime; //服务器时间
DCompany: string; //公司
IpCall: Integer;
IpWLDZStr: string;
UserDataFlag: string;
type
TDataLink_InformationBase = class(TBaseDataLink)
AdoDataLink: TADOQuery;
ADOLink: TADOConnection;
ThreeImgList: TImageList;
Timer_link: TTimer;
ImageList_new32: TImageList;
procedure DataModuleDestroy(Sender: TObject);
procedure Timer_linkTimer(Sender: TObject);
procedure DataModuleCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TMakebar = procedure(ucData: pchar; nDataLen: integer; nErrLevel: integer; nMask: integer; nBarEdition: integer; szBmpFileName: pchar; nScale: integer); stdcall;
TMixtext = procedure(szSrcBmpFileName: PChar; szDstBmpFileName: PChar; sztext: PChar; fontsize, txtheight, hmargin, vmargin, txtcntoneline: integer); stdcall;
var
DataLink_InformationBase: TDataLink_InformationBase;
CriticalSection: TCriticalSection; {声明临界}
implementation
{$R *.dfm}
procedure TMyThread.Execute;
begin
FreeOnTerminate := True;
CriticalSection.Enter;
try
with DataLink_InformationBase.AdoDataLink do
begin
close;
sql.Clear;
sql.Add('select getdate()');
open;
end;
except
try
with DataLink_InformationBase.ADOLink do
begin
Connected := false;
ConnectionString := DConString;
LoginPrompt := false;
Connected := true;
end;
except
end;
end;
CriticalSection.Leave;
end;
procedure TDataLink_InformationBase.DataModuleDestroy(Sender: TObject);
begin
inherited;
CriticalSection.Free;
DataLink_InformationBase := nil;
end;
procedure TDataLink_InformationBase.Timer_linkTimer(Sender: TObject);
begin
TMyThread.Create(False);
end;
procedure TDataLink_InformationBase.DataModuleCreate(Sender: TObject);
begin
inherited;
CriticalSection := TCriticalSection.Create;
end;
end.

View File

@ -0,0 +1,218 @@
unit U_GetDllForm;
interface
uses
Windows, Messages, forms, OleCtnrs, DateUtils, SysUtils, ADODB, dxCore,
ActiveX, IniFiles;
function GetDllForm(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd; export; stdcall;
function ConnData(): Boolean;
function GetsysParam(muserId: pchar; fparam1: pchar): Boolean;
implementation
uses
U_DataLink, U_iniParam, Unit1;
/////////////////////////////////////////////////////////////////
// 功能说明:取Dll中得窗体 //
// 参数说明App>>调用应用程序; //
// FormH>>调用窗口句柄 //
// FormID>>窗口号; //
// Language>>语言种类; //
// WinStyle>>窗口类型; //
/////////////////////////////////////////////////////////////////
function GetDllForm(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd;
var
i: Integer;
bFound: Boolean;
mnewHandle: hwnd;
mstyle: TFormStyle; // 0:子窗口; 1:普通窗口
mstate: TWindowState;
mborderstyle: TFormBorderStyle;
begin
mnewHandle := 0;
DName := PChar(GName);
DCode := PChar(GCode);
DdataBase := DataBase;
DTitCaption := Title;
DParameters1 := Parameters1;
DParameters2 := Parameters2;
DParameters3 := Parameters3;
DParameters4 := Parameters4;
DParameters5 := Parameters5;
DParameters6 := Parameters6;
DParameters7 := Parameters7;
DParameters8 := Parameters8;
DParameters9 := Parameters9;
DParameters10 := Parameters10;
SetLength(fDllFileName, 255);
GetModuleFileName(HInstance, PChar(fDllFileName), Length(fDllFileName));
fDllFileName := ExtractFileName(PChar(fDllFileName));
MainApplication := App;
DCurHandle := FormH;
IsDelphiLanguage := Language;
Application := TApplication(App);
DCurHandle := 0;
//赋值链接字符串
SetLength(server, 255);
SetLength(dtbase, 255);
SetLength(user, 255);
SetLength(pswd, 255);
if trim(DataBaseStr) = '' then
begin
server := '101.132.143.144,7781';
dtbase := 'RTBasicsData';
user := 'rtsa';
pswd := 'rightsoft@5740';
DConString := 'Provider=SQLOLEDB.1;Password=' + pswd + ';Persist Security Info=True;User ID=' + user + ';Initial Catalog=' + dtbase + ';Data Source=' + server;
// DParameters1:='高权限';
end
else
begin
DConString := DataBaseStr;
end;
if not ConnData() then
begin
result := 0;
exit;
end;
if IsINIFile() then
ReadINIFile()
else
WriteINIFile;
GetsysParam('', '');
// 定义窗口类型 、状态
if WinStyle = 0 then
begin
mstyle := fsMDIChild;
mstate := wsMaximized;
mborderstyle := bsSizeable;
end
else
begin
mstyle := fsNormal;
mstate := wsNormal;
mborderstyle := bsSizeable;
end;
bFound := False;
if FormID <> 10000 then
begin
for i := 0 to Application.MainForm.MDIChildCount - 1 do
begin
if Application.MainForm.MDIChildren[i].Caption = Title then
begin
mnewHandle := Application.MainForm.MDIChildren[i].Handle;
Application.MainForm.MDIChildren[i].BringToFront;
bFound := True;
Result := mnewHandle;
exit;
end;
end;
end;
/////////////////////
//调用子模块窗口
case FormID of
1: //测试用
begin
with TForm1.Create(Application.MainForm, Title, trim(Parameters1), trim(Parameters2), trim(Parameters3), trim(Parameters4), trim(Parameters5), trim(Parameters10)) do //
begin
fFormID := FormID;
FormStyle := mstyle;
WindowState := mstate;
BorderStyle := mborderstyle;
mnewHandle := Handle;
end;
end;
10000:
begin
for i := 0 to application.MainForm.MDIChildCount - 1 do
begin
if application.MainForm.MDIChildren[i].Caption = Title then
begin
application.MainForm.MDIChildren[i].Close;
end;
end;
end;
end;
Result := mnewHandle;
end;
function GetsysParam(muserId: pchar; fparam1: pchar): Boolean;
begin
result := true;
//////////////////////////////
// shortDateFormat := 'yyyy-MM-dd';
//服务器日期
with DataLink_InformationBase.AdoDataLink do
begin
close;
sql.Clear;
sql.Add('select getDate()as dt');
open;
DServerDate := fieldByName('dt').AsDatetime;
end;
result := true;
end;
//===========================================================
//建立数据库连接池
//===========================================================
function ConnData(): Boolean;
var
IniFile: TIniFile;
begin
try
IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'SYSTEMSET.INI');
PicSvr := IniFile.ReadString('SERVER', '服务器地址', '127.0.0.1');
UserDataFlag := IniFile.ReadString('SERVER', '服务器地址类型', '-1');
finally
IniFile.Free;
end;
if not Assigned(DataLink_InformationBase) then
DataLink_InformationBase := TDataLink_InformationBase.Create(Application);
try
with DataLink_InformationBase.ADOLink do
begin
if not Connected then
begin
Connected := false;
ConnectionString := DConString;
LoginPrompt := false;
Connected := true;
end;
end;
Result := true;
except
Result := false;
application.MessageBox('数据库连接失败!', '错误', mb_Ok + MB_ICONERROR);
end;
end;
initialization
CoInitialize(nil);
dxUnitsLoader.Initialize;
finalization
DataLink_InformationBase.Free;
application := NewDllApp;
dxUnitsLoader.Finalize;
end.

View File

@ -0,0 +1,77 @@
unit U_iniParam;
interface
uses
IniFiles, SysUtils;
var
Filename: string; //文件名
iParam2: integer;
bParam1: Boolean;
bParam2: Boolean;
SCXFlag: string; //生产线 根据此标志获取卷条码前缀 不能包含字母 1,2
SCXCount: string; //机台个数
PortNoStr: string; //端口号
DllName: string; //端口Dll文件
DZCDYDllName: string; //电子秤调用Dll文件
MBDYDllName: string; // 码表调用Dll文件
function IsINIFile(): Boolean; //判断InI配置文件是否存在
procedure ReadINIFile();
procedure WriteINIFile();
implementation
///////////////////////////////////////////////////////////////////
//读取ini文件设置参数
//参数:
////////////////////////////////////////////////////////////////////
procedure ReadINIFile();
var
programIni: Tinifile; //配置文件名
begin
FileName := ExtractFilePath(Paramstr(0)) + 'File.INI';
programIni := Tinifile.create(FileName);
SCXFlag := programIni.ReadString('生产车间配置', '卷条码机台标志', '1');
SCXCount := programIni.ReadString('生产车间配置', '机台个数', '1');
PortNoStr := programIni.ReadString('生产车间配置', '端口号', 'com1');
DllName := programIni.ReadString('生产车间配置', '端口Dll文件', 'JZCRS323C.DLL');
DZCDYDllName := programIni.ReadString('生产车间配置', '电子秤调用Dll文件', '');
MBDYDllName := programIni.ReadString('生产车间配置', '码表调用Dll文件', '');
programIni.Free;
end;
//////////////////////////////////////////////////////////////////
//写设置信息到INI文件
//参数
//////////////////////////////////////////////////////////////////
procedure WriteINIFile();
var
programIni: Tinifile; //配置文件名
begin
FileName := ExtractFilePath(Paramstr(0)) + 'File.INI';
programIni := Tinifile.create(FileName);
programIni.WriteString('生产车间配置', '卷条码机台标志', SCXFlag);
programIni.WriteString('生产车间配置', '机台个数', SCXCount);
programIni.WriteString('生产车间配置', '端口号', PortNoStr);
programIni.WriteString('生产车间配置', '端口Dll文件', DllName);
programIni.Free;
end;
//////////////////////////////////////////////////////////////////
//判断InI文件是否存在
//////////////////////////////////////////////////////////////////
function IsINIFile(): Boolean;
begin
FileName := ExtractFilePath(Paramstr(0)) + 'File.INI';
if FileExists(FileName) then
Result := true
else
Result := false;
end;
end.

View File

@ -0,0 +1,221 @@
object Form1: TForm1
Left = 203
Top = 121
Caption = 'Form1'
ClientHeight = 426
ClientWidth = 716
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
FormStyle = fsMDIForm
Menu = MainMenu1
OldCreateOrder = False
WindowState = wsMaximized
OnClose = FormClose
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
object ToolBar1: TToolBar
Left = 0
Top = 0
Width = 716
Height = 25
ButtonWidth = 57
Caption = 'ToolBar1'
Images = ImageList1
TabOrder = 0
ExplicitWidth = 120
object Edit1: TEdit
Left = 0
Top = 0
Width = 81
Height = 22
TabOrder = 0
Text = '1'
end
object ToolButton1: TToolButton
Left = 81
Top = 0
Caption = #20851#38381
ImageIndex = 0
OnClick = ToolButton1Click
end
object Label1: TLabel
Left = 138
Top = 0
Width = 79
Height = 22
Caption = ' DllName'#65306
end
object DllName: TEdit
Left = 217
Top = 0
Width = 135
Height = 22
TabOrder = 1
end
end
object MainMenu1: TMainMenu
Left = 232
Top = 40
object test1: TMenuItem
Caption = 'test'
OnClick = test1Click
end
end
object ImageList1: TImageList
Left = 320
Top = 56
Bitmap = {
494C010101000400040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000001000000001002000000000000010
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000EFEFEF000000
0000EFEFEF00EFEFEF000000000000000000EFEFEF0000000000000000000000
0000EFEFEF00EFEFEF0000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000EFEFEF0000000000EFEFEF00EFEFEF0000000000EFEFEF00000000008080
00008080000000000000C0C0C000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
00000000000000000000000000000000000000000000EFEFEF00EFEFEF000000
0000EFEFEF00EFEFEF000000000000000000C0C0C00000000000000000008080
00008080000080800000EFEFEF00EFEFEF000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000EFEFEF0000000000000000000000000000000000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000EFEFEF0000000000808080008080800080808000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000008080000000000000808080008080800080808000000000008080
0000000000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000EFEFEF00EFEF
EF0000000000FFFF000080800000000000008080800080808000000000000000
0000000000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FFFF0000FFFF0000808000000000000080808000000000008080
0000000000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000808000008080
000080800000FFFF0000FFFF0000FFFF00000000000080808000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000FFFF0000FFFF
0000FFFF0000FFFF000000000000FFFF00000000000080808000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000FFFF0000FFFF0000FFFF00000000000080808000000000008080
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000808000000000000080808000808080008080800080808000FFFF
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000808080008080800080808000808080000000
0000808000008080000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
0000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000424D3E000000000000003E000000
2800000040000000100000000100010000000000800000000000000000000000
000000000000000000000000FFFFFF00FFFF000000000000D343000000000000
F4810000000000009340000000000000F801000000000000F001000000000000
F001000000000000C001000000000000C001000000000000C001000000000000
C201000000000000C001000000000000F001000000000000F001000000000000
FC03000000000000FFFF00000000000000000000000000000000000000000000
000000000000}
end
object ADOConnection1: TADOConnection
ConnectionString =
'Provider=SQLOLEDB.1;Password=sa;Persist Security Info=True;User ' +
'ID=sa;Initial Catalog=rzdata;Data Source=6GMFFMYKYMJDZW7'
LoginPrompt = False
Provider = 'SQLOLEDB.1'
Left = 408
Top = 64
end
end

View File

@ -0,0 +1,94 @@
unit U_testdll;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Menus, ToolWin, ComCtrls, ImgList, DB, ADODB,
System.ImageList;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
test1: TMenuItem;
ToolBar1: TToolBar;
Edit1: TEdit;
ToolButton1: TToolButton;
ImageList1: TImageList;
ADOConnection1: TADOConnection;
DllName: TEdit;
Label1: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure test1Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
newh: hwnd;
implementation
{$R *.dfm}
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
sendmessage(newh, 1034, 4, 0);
Action := cafree;
end;
procedure TForm1.test1Click(Sender: TObject);
type
TMyFunc = function(App: Tapplication; FormH: hwnd; FormID: integer; Language: integer; WinStyle: integer; GCode: Pchar; GName: Pchar; DataBase: Pchar; Title: PChar; Parameters1: PChar; Parameters2: PChar; Parameters3: PChar; Parameters4: PChar; Parameters5: PChar; Parameters6: PChar; Parameters7: PChar; Parameters8: PChar; Parameters9: PChar; Parameters10: PChar; DataBaseStr: PChar): hwnd; stdcall;
var
Tf: TMyFunc;
Tp: TFarProc;
Th: Thandle;
begin
//静态加载
//newh:=getForm(Application,1,ADOConnection1,PChar('sa'),PChar('dsa'));
//动态加载
// showMessage(intTostr(application.Handle));
Th := LoadLibrary('InformationBase.dll');
if Th > 0 then
begin
try
Tp := GetProcAddress(Th, 'GetDllForm');
if Tp <> nil then
begin
Tf := TMyFunc(Tp);
newh := Tf(Application, 0, strToint(edit1.text), 0, 0, PChar('ygcode'), PChar('ygname'), PChar('datebase'), PChar('title'), PChar(''), PChar(''), '', '', '', '', '', '', '', '', '');
end
else
begin
ShowMessage('打印执行错误');
end;
finally
// FreeLibrary();
end;
end
else
begin
ShowMessage('找不到' + Trim(DllName.Text));
end;
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.FormResize(Sender: TObject);
begin
sendmessage(newh, 1034, 1, 0);
end;
end.

64
A00通用模板/Unit1.dfm Normal file
View File

@ -0,0 +1,64 @@
inherited Form1: TForm1
Caption = 'Form1'
ClientHeight = 299
ClientWidth = 635
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Height = -11
Font.Name = 'Tahoma'
ExplicitWidth = 651
ExplicitHeight = 338
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton [0]
Left = 32
Top = 16
Width = 75
Height = 25
Caption = #23458#25143
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton [1]
Left = 32
Top = 47
Width = 75
Height = 25
Caption = #26679#21697
TabOrder = 1
OnClick = Button2Click
end
object Button3: TButton [2]
Left = 32
Top = 78
Width = 75
Height = 25
Caption = #24037#24207#36873#25321
TabOrder = 2
end
object Button4: TButton [3]
Left = 32
Top = 118
Width = 75
Height = 25
Caption = #21592#24037#36873#25321
TabOrder = 3
OnClick = Button4Click
end
object Button5: TButton [4]
Left = 32
Top = 174
Width = 75
Height = 25
Caption = #26631#31614#25171#21360
TabOrder = 4
OnClick = Button5Click
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = DataLink_InformationBase.ADOLink
Left = 345
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = DataLink_InformationBase.ADOLink
end
end

106
A00通用模板/Unit1.pas Normal file
View File

@ -0,0 +1,106 @@
unit Unit1;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, U_BaseList,
Data.DB, Data.Win.ADODB, Vcl.StdCtrls;
type
TForm1 = class(TfrmBaseList)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
U_DataLink, U_CompanySel, U_ClothInfoSel, U_EmployeeSel, U_LabelPrint;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
try
frmCompanySel := TfrmCompanySel.Create(Application);
with frmCompanySel do
begin
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmCompanySel.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
try
frmClothInfoSel := TfrmClothInfoSel.Create(Application);
with frmClothInfoSel do
begin
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmClothInfoSel.Free;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
try
frmEmployeeSel := TfrmEmployeeSel.Create(Application);
with frmEmployeeSel do
begin
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmEmployeeSel.Free;
end;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
try
frmLabelPrint := TfrmLabelPrint.Create(Application);
with frmLabelPrint do
begin
if ShowModal = 1 then
begin
// Self.InitGrid();
end;
end;
finally
frmLabelPrint.Free;
end;
end;
end.

View File

@ -0,0 +1,2 @@
[SERVER]
SERVER=192.168.88.254

View File

@ -0,0 +1,38 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

136
A00通用模板/testDll.dof Normal file
View File

@ -0,0 +1,136 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=D:\selfware_83398\selfware\马国钢开发代码\项目代码\self\坯布码单待检DDMD.dll)\testDll.exe
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2052
CodePage=936
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=

View File

@ -0,0 +1,14 @@
program testDll;
uses
Forms,
U_testdll in 'U_testdll.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -0,0 +1,184 @@
<Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<PropertyGroup>
<ProjectGuid>{6ED24B72-E038-4A45-BA13-AC1AB432C410}</ProjectGuid>
<MainSource>testDll.dpr</MainSource>
<Base>True</Base>
<Config Condition="'$(Config)'==''">Debug</Config>
<TargetedPlatforms>38017</TargetedPlatforms>
<AppType>Application</AppType>
<FrameworkType>VCL</FrameworkType>
<ProjectVersion>19.2</ProjectVersion>
<Platform Condition="'$(Platform)'==''">Win32</Platform>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Base)'=='true') or '$(Base_Android64)'!=''">
<Base_Android64>true</Base_Android64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Base)'=='true') or '$(Base_iOSDevice64)'!=''">
<Base_iOSDevice64>true</Base_iOSDevice64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
<Base_Win32>true</Base_Win32>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
<Base_Win64>true</Base_Win64>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
<Cfg_1>true</Cfg_1>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
<Cfg_1_Win32>true</Cfg_1_Win32>
<CfgParent>Cfg_1</CfgParent>
<Cfg_1>true</Cfg_1>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
<Cfg_2>true</Cfg_2>
<CfgParent>Base</CfgParent>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Android64' and '$(Cfg_2)'=='true') or '$(Cfg_2_Android64)'!=''">
<Cfg_2_Android64>true</Cfg_2_Android64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Cfg_2)'=='true') or '$(Cfg_2_iOSDevice64)'!=''">
<Cfg_2_iOSDevice64>true</Cfg_2_iOSDevice64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='OSX64' and '$(Cfg_2)'=='true') or '$(Cfg_2_OSX64)'!=''">
<Cfg_2_OSX64>true</Cfg_2_OSX64>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_2)'=='true') or '$(Cfg_2_Win32)'!=''">
<Cfg_2_Win32>true</Cfg_2_Win32>
<CfgParent>Cfg_2</CfgParent>
<Cfg_2>true</Cfg_2>
<Base>true</Base>
</PropertyGroup>
<PropertyGroup Condition="'$(Base)'!=''">
<DCC_E>false</DCC_E>
<DCC_F>false</DCC_F>
<DCC_K>false</DCC_K>
<DCC_N>true</DCC_N>
<DCC_S>false</DCC_S>
<DCC_ImageBase>00400000</DCC_ImageBase>
<DCC_DebugInformation>1</DCC_DebugInformation>
<DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
<SanitizedProjectName>testDll</SanitizedProjectName>
<DCC_Namespace>Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;Data.Win;$(DCC_Namespace)</DCC_Namespace>
<VerInfo_Locale>2052</VerInfo_Locale>
<VerInfo_Keys>CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Android64)'!=''">
<Android_LauncherIcon192>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png</Android_LauncherIcon192>
<EnabledSysJars>android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar</EnabledSysJars>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_iOSDevice64)'!=''">
<iOS_AppStore1024>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_1024x1024.png</iOS_AppStore1024>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win32)'!=''">
<DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
<BT_BuildType>Debug</BT_BuildType>
<VerInfo_IncludeVerInfo>true</VerInfo_IncludeVerInfo>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
<Manifest_File>$(BDS)\bin\default_app.manifest</Manifest_File>
<Icon_MainIcon>testDll_Icon.ico</Icon_MainIcon>
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Base_Win64)'!=''">
<Icon_MainIcon>testDll_Icon.ico</Icon_MainIcon>
<UWP_DelphiLogo44>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png</UWP_DelphiLogo44>
<UWP_DelphiLogo150>$(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png</UWP_DelphiLogo150>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1)'!=''">
<DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
<DCC_DebugInformation>0</DCC_DebugInformation>
<DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
<DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2)'!=''">
<DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
<DCC_Optimize>false</DCC_Optimize>
<DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Android64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_iOSDevice64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_OSX64)'!=''">
<BT_BuildType>Debug</BT_BuildType>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_2_Win32)'!=''">
<AppEnableRuntimeThemes>true</AppEnableRuntimeThemes>
<AppDPIAwarenessMode>PerMonitorV2</AppDPIAwarenessMode>
<VerInfo_Keys>CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)</VerInfo_Keys>
</PropertyGroup>
<ItemGroup>
<DelphiCompile Include="$(MainSource)">
<MainSource>MainSource</MainSource>
</DelphiCompile>
<DCCReference Include="U_testdll.pas">
<Form>Form1</Form>
</DCCReference>
<BuildConfiguration Include="Debug">
<Key>Cfg_2</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
<BuildConfiguration Include="Release">
<Key>Cfg_1</Key>
<CfgParent>Base</CfgParent>
</BuildConfiguration>
</ItemGroup>
<ProjectExtensions>
<Borland.Personality>Delphi.Personality.12</Borland.Personality>
<Borland.ProjectType/>
<BorlandProject>
<Delphi.Personality>
<Source>
<Source Name="MainSource">testDll.dpr</Source>
</Source>
</Delphi.Personality>
<Platforms>
<Platform value="Android64">True</Platform>
<Platform value="iOSDevice64">True</Platform>
<Platform value="Linux64">True</Platform>
<Platform value="OSX64">True</Platform>
<Platform value="Win32">True</Platform>
<Platform value="Win64">False</Platform>
</Platforms>
</BorlandProject>
<ProjectFileVersion>12</ProjectFileVersion>
</ProjectExtensions>
<Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
<Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
</Project>

View File

@ -0,0 +1,2 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject/>

Binary file not shown.

BIN
A00通用模板/testDll.res Normal file

Binary file not shown.

View File

@ -0,0 +1,38 @@
-$A8
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J-
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-LN"c:\program files (x86)\borland\delphi7\Projects\Bpl"
-w-UNSAFE_TYPE
-w-UNSAFE_CODE
-w-UNSAFE_CAST

View File

@ -0,0 +1,136 @@
[FileVersion]
Version=7.0
[Compiler]
A=8
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=0
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
NamespacePrefix=
SymbolDeprecated=1
SymbolLibrary=1
SymbolPlatform=1
UnitLibrary=1
UnitPlatform=1
UnitDeprecated=1
HResultCompat=1
HidingMember=1
HiddenVirtual=1
Garbage=1
BoundsError=1
ZeroNilCompat=1
StringConstTruncated=1
ForLoopVarVarPar=1
TypedConstVarPar=1
AsgToTypedConst=1
CaseLabelRange=1
ForVariable=1
ConstructingAbstract=1
ComparisonFalse=1
ComparisonTrue=1
ComparingSignedUnsigned=1
CombiningSignedUnsigned=1
UnsupportedConstruct=1
FileOpen=1
FileOpenUnitSrc=1
BadGlobalSymbol=1
DuplicateConstructorDestructor=1
InvalidDirective=1
PackageNoLink=1
PackageThreadVar=1
ImplicitImport=1
HPPEMITIgnored=1
NoRetVal=1
UseBeforeDef=1
ForLoopVarUndef=1
UnitNameMismatch=1
NoCFGFileFound=1
MessageDirective=1
ImplicitVariants=1
UnicodeToLocale=1
LocaleToUnicode=1
ImagebaseMultiple=1
SuspiciousTypecast=1
PrivatePropAccessor=1
UnsafeType=0
UnsafeCode=0
UnsafeCast=0
[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=
[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=
Conditionals=
DebugSourceDirs=
UsePackages=0
[Parameters]
RunParams=
HostApplication=D:\selfware_83398\selfware\马国钢开发代码\项目代码\self\长阳针织(CYZZ.dll)\testDll.exe
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=2052
CodePage=936
[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=

Binary file not shown.

Binary file not shown.

After

Width:  |  Height:  |  Size: 766 B

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,401 @@
unit U_AttachmentUpload;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, Menus, cxLookAndFeelPainters, StdCtrls, cxButtons,
DB, ADODB, ImgList, shellapi, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData,
cxDataStorage, cxEdit, cxDBData, cxGridCustomTableView, cxGridTableView,
cxGridDBTableView, cxGridLevel, cxClasses, cxControls, cxGridCustomView,
cxGrid, cxLookAndFeels, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, IdExplicitTLSClientServerBase, System.ImageList, U_BaseHelp,
Vcl.ToolWin;
type
TfrmAttachmentUpload = class(TfrmBaseHelp)
ListView1: TListView;
ADOQueryTmp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel2: TPanel;
IdFTP1: TIdFTP;
ADOConnection1: TADOConnection;
Tv1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
v1Column1: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
DataSource1: TDataSource;
v1Column4: TcxGridDBColumn;
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBAdd: TToolButton;
TBClose: TToolButton;
TBDel: TToolButton;
btnDown: TToolButton;
ImageList1: TImageList;
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Panel2DblClick(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
procedure TBAddClick(Sender: TObject);
procedure TBDelClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure btnDownClick(Sender: TObject);
private
procedure InitData();
{ Private declarations }
public
fkeyNO: string;
fType: string;
fId: integer;
FEditAuthority: Boolean;
{ Public declarations }
end;
var
frmAttachmentUpload: TfrmAttachmentUpload;
implementation
uses
U_DataLink, U_RTFun, U_CompressionFun;
{$R *.dfm}
procedure TfrmAttachmentUpload.InitData();
var
ListItem: TListItem;
Flag: Cardinal;
info: SHFILEINFOA;
Icon: TIcon;
begin
ListView1.Items.Clear;
try
with adoqueryTmp do
begin
close;
sql.Clear;
sql.Add('select * from FJ_File ');
sql.Add('where WBID=' + quotedstr(trim(fkeyNO)));
sql.Add('and TFType=' + quotedstr(trim(fType)));
open;
end;
except
end;
end;
procedure TfrmAttachmentUpload.FormDestroy(Sender: TObject);
begin
frmAttachmentUpload := nil;
end;
procedure TfrmAttachmentUpload.FormCreate(Sender: TObject);
begin
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmAttachmentUpload.FormShow(Sender: TObject);
begin
if FEditAuthority then
begin
btnDown.Visible := True;
TBDel.Visible := True;
TBAdd.Visible := True;
end
else
begin
btnDown.Visible := false;
TBDel.Visible := false;
TBAdd.Visible := false;
end;
initdata();
end;
procedure TfrmAttachmentUpload.ListView1DblClick(Sender: TObject);
var
sFieldName: string;
fileName: string;
begin
if ListView1.Items.Count < 1 then
EXIT;
if listView1.SelCount < 1 then
exit;
sFieldName := 'D:\附件查看';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName), nil);
fileName := ListView1.Selected.Caption;
sFieldName := sFieldName + '\' + trim(fileName);
try
IdFTP1.Host := PicSvr;
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
except
;
end;
if IdFTP1.Connected then
begin
Panel2.Caption := '正在下载数据,请稍等...';
Panel2.Visible := true;
application.ProcessMessages;
try
IdFTP1.Get('FJ\' + Trim(fileName), sFieldName, false, true);
except
Panel2.Visible := false;
Application.MessageBox('附件文件不存在', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
end
else
begin
Panel2.Visible := false;
Application.MessageBox('无法连接文件服务器', '提示', MB_ICONWARNING);
IdFTP1.Quit;
Exit;
end;
Panel2.Visible := false;
if IdFTP1.Connected then
IdFTP1.Quit;
ShellExecute(Handle, 'open', PChar(sFieldName), '', '', SW_SHOWNORMAL);
end;
procedure TfrmAttachmentUpload.btnDownClick(Sender: TObject);
var
SaveDialog: TSaveDialog;
fFileName: string;
fFilePath: string;
ff: TADOBlobStream;
FJStream: TMemoryStream;
begin
if adoqueryTmp.IsEmpty then
exit;
try
fFileName := adoqueryTmp.fieldbyname('FileName').AsString;
SaveDialog := TSaveDialog.Create(Self);
SaveDialog.FileName := fFileName;
if SaveDialog.Execute then
begin
Panel2.Caption := '正在保存数据,请稍等...';
Panel2.Visible := true;
application.ProcessMessages;
fFilePath := SaveDialog.FileName;
try
ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead);
FJStream := TMemoryStream.Create;
ff.SaveToStream(FJStream);
UnCompressionStream(FJStream);
FJStream.SaveToFile(fFilePath);
// ShellExecute(Handle, 'open',PChar(sFieldName),'', '', SW_SHOWNORMAL);
finally
FJStream.free;
ff.Free;
end;
Panel2.Visible := false;
// if IdFTP1.Connected then IdFTP1.Quit;
end;
except
Panel2.Visible := false;
end;
end;
procedure TfrmAttachmentUpload.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if fId = 10 then
Action := cafree
else
Action := cahide;
end;
procedure TfrmAttachmentUpload.Panel2DblClick(Sender: TObject);
begin
Panel2.Visible := false;
end;
procedure TfrmAttachmentUpload.TBAddClick(Sender: TObject);
var
OpenDiaLog: TOpenDialog;
fFileName: string;
fFilePath: string;
maxNo: string;
FJStream: TMemoryStream;
mfileSize: integer;
mCreationTime: TdateTime;
mWriteTime: TdateTime;
begin
try
adoqueryCmd.Connection.BeginTrans;
OpenDiaLog := TOpenDialog.Create(Self);
if OpenDiaLog.Execute then
begin
fFilePath := OpenDiaLog.FileName;
fFileName := ExtractFileName(OpenDiaLog.FileName);
Panel2.Caption := '正在上传数据,请稍等...';
Panel2.Visible := true;
application.ProcessMessages;
if GetLSNo(ADOQueryCmd, maxNo, 'FJ', 'FJ_File', 4, 1) = False then
begin
adoqueryCmd.Connection.RollbackTrans;
Application.MessageBox('取最大号失败!', '提示', 0);
Exit;
end;
//获取文件信息
GetFileInfo(fFilePath, mfileSize, mCreationTime, mWriteTime);
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from FJ_File ');
sql.Add('where TFID=' + quotedstr(trim(maxNo)));
execsql;
end;
try
FJStream := TMemoryStream.Create;
with adoqueryCmd do
begin
close;
sql.Clear;
sql.Add('select * from FJ_File ');
sql.Add('where TFID=' + quotedstr(trim(maxNo)));
open;
append;
fieldbyname('TFID').Value := trim(maxNo);
fieldbyname('WBID').Value := trim(fkeyNO);
fieldbyname('TFType').Value := trim(fType);
fieldbyname('Filler').Value := trim(DName);
fieldbyname('FileName').Value := trim(fFileName);
fieldbyname('TFDate').Value := mWriteTime;
FJStream.LoadFromFile(fFilePath);
CompressionStream(FJStream);
tblobfield(FieldByName('Filesother')).LoadFromStream(FJStream);
post;
end;
Panel2.Visible := false;
initdata();
finally
FJStream.Free;
end;
end;
adoqueryCmd.Connection.CommitTrans;
except
adoqueryCmd.Connection.RollbackTrans;
application.MessageBox('附件保存失败!', '提示信息', 0);
end;
end;
procedure TfrmAttachmentUpload.TBCloseClick(Sender: TObject);
begin
ADOQueryTmp.Close;
ADOQuerycmd.Close;
ListView1.Free;
ModalResult := 1;
end;
procedure TfrmAttachmentUpload.TBDelClick(Sender: TObject);
var
fFileName: string;
fFilePath: string;
begin
if ADOQueryTmp.IsEmpty then
exit;
if trim(ADOQueryTmp.fieldbyname('Filler').AsString) <> trim(DName) then
begin
Application.MessageBox('权限不足,上传账户可删除!', '提示', 0);
Exit;
end;
if Application.MessageBox('确定要删除数据吗?', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
close;
sql.Clear;
sql.Add('delete from FJ_File ');
sql.Add('where TFID=' + quotedstr(trim(ADOQueryTmp.fieldbyname('TFID').AsString)));
execsql;
end;
initData();
end;
procedure TfrmAttachmentUpload.TBRafreshClick(Sender: TObject);
begin
initData();
end;
procedure TfrmAttachmentUpload.Tv1DblClick(Sender: TObject);
var
sFieldName: string;
fileName: string;
ff: TADOBlobStream;
FJStream: TMemoryStream;
begin
if adoqueryTmp.IsEmpty then
exit;
sFieldName := 'D:\附件查看';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName), nil);
fileName := adoqueryTmp.fieldbyname('FileName').AsString;
sFieldName := sFieldName + '\' + trim(fileName);
try
ff := TADOBlobstream.Create(adoqueryTmp.fieldByName('FilesOther') as TblobField, bmRead);
FJStream := TMemoryStream.Create;
ff.SaveToStream(FJStream);
UnCompressionStream(FJStream);
FJStream.SaveToFile(sFieldName);
ShellExecute(Handle, 'open', PChar(sFieldName), '', '', SW_SHOWNORMAL);
finally
FJStream.free;
ff.Free;
end;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,181 @@
unit U_BankSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxDropDownEdit;
type
TfrmBankSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
BankName: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v2Column1: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure BankNameChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoType, FAuthority: string;
{ Public declarations }
end;
var
frmBankSel: TfrmBankSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmBankSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmBankSel.BankNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmBankSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
BankName.SetFocus;
Action := cahide;
end;
procedure TfrmBankSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select * from BS_Bank order by SerialNo ');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmBankSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmBankSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmBankSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmBankSel.ToolButton1Click(Sender: TObject);
begin
BankName.SetFocus;
ModalResult := 1;
end;
procedure TfrmBankSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmBankSel.FormDestroy(Sender: TObject);
begin
inherited;
frmBankSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,432 @@
unit U_ClothInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxTL,
cxMaskEdit, cxTLdxBarBuiltInMenu, cxCheckBox, cxInplaceContainer, cxDBTL,
cxTLData, math, dxSkinBasic, 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, dxSkinOffice2016Colorful, dxSkinOffice2016Dark,
dxSkinOffice2019Black, dxSkinOffice2019Colorful, dxSkinOffice2019DarkGray,
dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringtime, dxSkinStardust,
dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinTheBezier, dxSkinValentine,
dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint, dxSkinWXI,
dxSkinXmas2008Blue, dxScrollbarAnnotations, cxImageList, cxContainer;
type
TfrmClothInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DS_Tree: TDataSource;
CDS_Tree: TClientDataSet;
ADOQueryTree: TADOQuery;
Panel3: TPanel;
Panel7: TPanel;
Panel4: TPanel;
Label14: TLabel;
LBCPAP1: TLabel;
Button1: TButton;
Button2: TButton;
TCBNOR1: TComboBox;
Panel1: TPanel;
Label3: TLabel;
Label4: TLabel;
Label9: TLabel;
Label8: TLabel;
C_Code: TcxTextEdit;
C_Name: TcxTextEdit;
C_GramWeight: TcxTextEdit;
C_Composition: TcxTextEdit;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
cxImageList_bar: TcxImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SSel: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1CYNo: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
Tv1Column10: TcxGridDBColumn;
v1Column11: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column9: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
Tv1Column11: TcxGridDBColumn;
Tv1Column13: TcxGridDBColumn;
Tv1Column23: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column12: TcxGridDBColumn;
Tv1Column14: TcxGridDBColumn;
Tv1Column15: TcxGridDBColumn;
Tv1Column16: TcxGridDBColumn;
Tv1Column17: TcxGridDBColumn;
Tv1Column18: TcxGridDBColumn;
Tv1Column22: TcxGridDBColumn;
Tv1Column19: TcxGridDBColumn;
Tv1Column20: TcxGridDBColumn;
Tv1Column21: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Label1: TLabel;
Label2: TLabel;
Label5: TLabel;
Label6: TLabel;
GC_Name: TcxTextEdit;
CraftCode: TcxTextEdit;
C_Spec: TcxTextEdit;
C_EComposition: TcxTextEdit;
Label7: TLabel;
Label10: TLabel;
CraftEName: TcxTextEdit;
CraftName: TcxTextEdit;
GroupBox1: TGroupBox;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
cxGridDBColumn4: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
cxGridDBColumn6: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
GPM_2: TcxGridPopupMenu;
CDS_Selok: TClientDataSet;
DS_2: TDataSource;
cxtxtdtscan: TcxTextEdit;
Label11: TLabel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TCBNOR1Change(Sender: TObject);
procedure C_NameChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
procedure cxtxtdtscanKeyPress(Sender: TObject; var Key: Char);
procedure GC_NameKeyPress(Sender: TObject; var Key: Char);
private
IsOnShow: Boolean;
CurrentPage, RecordsNumber: Integer;
procedure InitGrid(PType: string);
procedure InitTree();
{ Private declarations }
public
IsMultipleSelection: Boolean;
FCTType: string;
xzflag: Integer;
{ Public declarations }
end;
var
frmClothInfoSel: TfrmClothInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmClothInfoSel.InitTree();
var
i: Integer;
begin
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_Type ');
if Trim(FCTType) = '全部' then
begin
end
else if FCTType = '坯布' then
begin
SQL.Add(' where CTType in (''梭织'',''针织'') ');
end
else
begin
SQL.Add(' where CTType=' + quotedstr(FCTType));
end;
Open;
end;
SCreateCDS(ADOQueryTree, CDS_Tree);
SInitCDSData(ADOQueryTree, CDS_Tree);
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmClothInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
//frmZDYHelp.Free;
end;
end;
procedure TfrmClothInfoSel.Button1Click(Sender: TObject);
begin
if CurrentPage > 1 then
CurrentPage := CurrentPage - 1;
InitGrid('');
end;
procedure TfrmClothInfoSel.Button2Click(Sender: TObject);
begin
if CurrentPage < CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
InitGrid('');
end;
procedure TfrmClothInfoSel.cxDBTreeList1DblClick(Sender: TObject);
begin
InitGrid('');
end;
procedure TfrmClothInfoSel.cxtxtdtscanKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
SClearData(Panel1, 2);
C_Code.Text := cxtxtdtscan.Text;
InitGrid('回车');
if CDS_1.RecordCount = 1 then
begin
MoveCDS(CDS_1, CDS_Selok);
end;
cxtxtdtscan.Text := '';
C_Code.Text := '';
end;
end;
procedure TfrmClothInfoSel.C_NameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmClothInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
C_Code.SetFocus;
Action := cahide;
end;
procedure TfrmClothInfoSel.InitGrid(PType: string);
var
fwhere, MBCIID, Pwhere: string;
begin
if not CDS_1.IsEmpty then
MBCIID := Trim(CDS_1.FieldByName('BCIID').AsString)
else
MBCIID := '';
Pwhere := SGetFilters(Panel1, 1, 2);
if trim(Pwhere) <> '' then
begin
if fwhere <> '' then
fwhere := fwhere + ' and ' + trim(Pwhere)
else
fwhere := ' where ' + trim(Pwhere);
end;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
Filtered := False;
sql.Clear;
sql.Add(' exec P_BS_CloInfo_Get ');
if PType = '回车' then
sql.Add(' @CTID= ''''')
else
sql.Add(' @CTID=' + quotedstr(Trim(CDS_Tree.fieldbyname('CTID').AsString)));
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
sql.Add(',@criteria= ' + quotedstr(fwhere));
// ShowMessage(sql.Text);
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
if IsOnShow then
SCreateCDS(ADOQueryMain, CDS_Selok);
IsOnShow := False;
TV1.DataController.Filter.Clear;
LBCPAP1.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber));
finally
ADOQueryMain.EnableControls;
TV1.DataController.Filter.Clear;
end;
if MBCIID <> '' then
CDS_1.Locate('BCIID', MBCIID, []);
end;
procedure TfrmClothInfoSel.FormShow(Sender: TObject);
begin
inherited;
IsOnShow := true;
if IsMultipleSelection then
GroupBox1.Visible := True;
RecordsNumber := 500;
CurrentPage := 1;
if Trim(FCTType) = '' then
FCTType := '通用';
ReadCxGrid(trim(self.Caption) + 'TV1', TV1, '自定义数据');
ReadCxGrid(trim(self.Caption) + 'TV2', TV2, '自定义数据');
InitTree();
InitGrid('');
end;
procedure TfrmClothInfoSel.GC_NameKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
InitGrid('回车');
end;
end;
procedure TfrmClothInfoSel.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmClothInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(trim(self.Caption) + 'TV1', TV1, '自定义数据');
WriteCxGrid(trim(self.Caption) + 'TV2', TV2, '自定义数据');
end;
procedure TfrmClothInfoSel.TCBNOR1Change(Sender: TObject);
begin
RecordsNumber := StrToInt(TCBNOR1.Text);
CurrentPage := 1;
C_Code.SetFocus;
InitGrid('');
end;
procedure TfrmClothInfoSel.ToolButton1Click(Sender: TObject);
begin
if xzflag = 1 then
begin
if cds_1.Locate('ssel', true, []) = False then
begin
Application.MessageBox('请选择数据!', '提示', 0);
exit;
end;
end;
ModalResult := 1;
end;
procedure TfrmClothInfoSel.TV1DblClick(Sender: TObject);
begin
if IsMultipleSelection then
begin
if not CDS_Selok.Locate('C_Code', CDS_1.FieldByName('C_Code').AsString, []) then
MoveCDS(CDS_1, CDS_Selok)
end
else
ModalResult := 1;
end;
procedure TfrmClothInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmClothInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,246 @@
unit U_ClothPurchasePlanSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxCheckBox, Vcl.Menus, cxCalendar, cxPC;
type
TfrmClothPurchasePlanSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
Y_Spec: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SPName: TcxGridDBColumn;
v1SPSpec: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1QtyUnit: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Tv1Column4: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
Label2: TLabel;
Y_Name: TEdit;
Label3: TLabel;
SellName: TEdit;
Label4: TLabel;
PurNo: TEdit;
Label5: TLabel;
BegDate: TDateTimePicker;
EndDate: TDateTimePicker;
IsJYTime: TCheckBox;
Tv1Column10: TcxGridDBColumn;
cxTabControl1: TcxTabControl;
ToolButton2: TToolButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure Y_SpecChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName, FAuthority: string;
{ Public declarations }
end;
var
frmClothPurchasePlanSel: TfrmClothPurchasePlanSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmClothPurchasePlanSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
EndDate.DateTime := SGetServerDate(ADOQueryTemp);
BegDate.DateTime := EndDate.DateTime - 90;
end;
procedure TfrmClothPurchasePlanSel.Y_SpecChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmClothPurchasePlanSel.cxTabControl1Change(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmClothPurchasePlanSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Y_Name.SetFocus;
Action := cahide;
end;
procedure TfrmClothPurchasePlanSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.*,B.* ');
sql.Add(' from Pur_YarnPlan_Main A');
sql.Add(' inner join BS_YarnPurPlan_Sub B on A.PurMId=B.PurMId');
sql.Add(' where isnull(A.status,''0'')=''9''');
sql.add(' and A.ConDate>=''' + Trim(FormatDateTime('yyyy-MM-dd', BegDate.DateTime)) + '''');
sql.Add(' and A.ConDate<''' + Trim(FormatDateTime('yyyy-MM-dd', enddate.DateTime + 1)) + '''');
case cxTabControl1.TabIndex of
0:
begin
sql.Add(' and not EXISTS (select X.FromSubID from BS_Yarn_IO X where X.FromSubID=B.PurSId) ');
end;
1:
begin
sql.Add(' and EXISTS (select X.FromSubID from BS_Yarn_IO X where X.FromSubID=B.PurSId) ');
end;
end;
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmClothPurchasePlanSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, true);
end;
procedure TfrmClothPurchasePlanSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmClothPurchasePlanSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid(self.Caption, TV1, '自定义数据');
end;
procedure TfrmClothPurchasePlanSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmClothPurchasePlanSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(self.Caption, TV1, '自定义数据');
end;
procedure TfrmClothPurchasePlanSel.ToolButton1Click(Sender: TObject);
begin
Y_Name.SetFocus;
ModalResult := 1;
end;
procedure TfrmClothPurchasePlanSel.ToolButton2Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmClothPurchasePlanSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmClothPurchasePlanSel.FormDestroy(Sender: TObject);
begin
inherited;
frmClothPurchasePlanSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,208 @@
unit U_CompanySel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxContainer,
cxImageList, dxSkinWXI, dxScrollbarAnnotations, dxSkinBasic, 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, dxSkinOffice2016Colorful, dxSkinOffice2016Dark,
dxSkinOffice2019Black, dxSkinOffice2019Colorful, dxSkinOffice2019DarkGray,
dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringtime, dxSkinStardust,
dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinTheBezier, dxSkinValentine,
dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint,
dxSkinXmas2008Blue;
type
TfrmCompanySel = class(TfrmBaseHelp)
TV1: TcxGridDBTableView;
cxGrid1Level1: TcxGridLevel;
cxGrid1: TcxGrid;
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
TV1Column1: TcxGridDBColumn;
TV1Column2: TcxGridDBColumn;
TV1Column3: TcxGridDBColumn;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
CoName: TcxTextEdit;
cxImageList_bar: TcxImageList;
TV1Column4: TcxGridDBColumn;
TV1Column5: TcxGridDBColumn;
TV1Column6: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure CoNamePropertiesChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoType, FAuthority: string;
{ Public declarations }
end;
var
frmCompanySel: TfrmCompanySel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmCompanySel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmCompanySel.CoNamePropertiesChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmCompanySel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CoName.SetFocus;
Action := cahide;
end;
procedure TfrmCompanySel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.*,B.* from BS_Company A ');
sql.Add('left join BS_Company_contact B ON A.COID=B.COID AND B.IsDefault=1 ');
sql.Add('where 1=1 ');
if Trim(FCoType) <> '' then
begin
sql.Add(' and A.CoType=''' + Trim(FCoType) + '''');
end;
if Trim(FAuthority) = '理单业务' then
begin
sql.Add(' and ( SalesId=' + quotedstr(trim(DCode)) + ' or exists (select * from [dbo].[F_Tool_SplitString](TallyId,'','') X where X.RTValue =' + quotedstr(trim(DCode)) + '))');
end;
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmCompanySel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmCompanySel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmCompanySel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmCompanySel.ToolButton1Click(Sender: TObject);
begin
CoName.SetFocus;
ModalResult := 1;
end;
procedure TfrmCompanySel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmCompanySel.FormDestroy(Sender: TObject);
begin
inherited;
frmCompanySel := nil;
end;
end.

View File

@ -0,0 +1,937 @@
inherited frmEmployeeSel: TfrmEmployeeSel
Left = 342
Top = 13
Caption = #25968#25454#36873#25321
ClientHeight = 637
ClientWidth = 731
Font.Charset = GB2312_CHARSET
Font.Height = -12
Font.Name = #23435#20307
Position = poScreenCenter
OnClose = FormClose
ExplicitWidth = 747
ExplicitHeight = 676
PixelsPerInch = 96
TextHeight = 12
object ScrollBox1: TScrollBox [0]
Left = 0
Top = 0
Width = 731
Height = 637
Align = alClient
TabOrder = 0
object btn1: TSpeedButton
Left = 23
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
OnClick = btn1Click
end
object btn2: TSpeedButton
Left = 111
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn3: TSpeedButton
Left = 199
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn4: TSpeedButton
Left = 287
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn5: TSpeedButton
Left = 375
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn6: TSpeedButton
Left = 463
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn7: TSpeedButton
Left = 551
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn8: TSpeedButton
Left = 639
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn58: TSpeedButton
Left = 23
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn9: TSpeedButton
Left = 111
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn10: TSpeedButton
Left = 199
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn11: TSpeedButton
Left = 287
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn12: TSpeedButton
Left = 375
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn13: TSpeedButton
Left = 463
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn14: TSpeedButton
Left = 551
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn15: TSpeedButton
Left = 639
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn59: TSpeedButton
Left = 23
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn16: TSpeedButton
Left = 111
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn17: TSpeedButton
Left = 199
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn18: TSpeedButton
Left = 287
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn19: TSpeedButton
Left = 375
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn20: TSpeedButton
Left = 463
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn21: TSpeedButton
Left = 551
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn22: TSpeedButton
Left = 639
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn60: TSpeedButton
Left = 23
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn23: TSpeedButton
Left = 111
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn24: TSpeedButton
Left = 199
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn25: TSpeedButton
Left = 287
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn26: TSpeedButton
Left = 375
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn27: TSpeedButton
Left = 463
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn28: TSpeedButton
Left = 551
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn29: TSpeedButton
Left = 639
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn61: TSpeedButton
Left = 23
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn30: TSpeedButton
Left = 111
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn31: TSpeedButton
Left = 199
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn32: TSpeedButton
Left = 287
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn33: TSpeedButton
Left = 375
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn34: TSpeedButton
Left = 463
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn35: TSpeedButton
Left = 551
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn36: TSpeedButton
Left = 639
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn62: TSpeedButton
Left = 23
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn37: TSpeedButton
Left = 111
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn38: TSpeedButton
Left = 199
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn39: TSpeedButton
Left = 287
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn40: TSpeedButton
Left = 375
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn41: TSpeedButton
Left = 463
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn42: TSpeedButton
Left = 551
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn43: TSpeedButton
Left = 639
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn63: TSpeedButton
Left = 23
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn44: TSpeedButton
Left = 111
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn45: TSpeedButton
Left = 199
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn46: TSpeedButton
Left = 287
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn47: TSpeedButton
Left = 375
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn48: TSpeedButton
Left = 463
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn49: TSpeedButton
Left = 551
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn50: TSpeedButton
Left = 639
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn64: TSpeedButton
Left = 23
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn51: TSpeedButton
Left = 111
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn52: TSpeedButton
Left = 199
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn53: TSpeedButton
Left = 287
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn54: TSpeedButton
Left = 375
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn55: TSpeedButton
Left = 463
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn56: TSpeedButton
Left = 551
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn57: TSpeedButton
Left = 639
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = ADOConnection1
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = ADOConnection1
end
object ADOTmp: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 120
Top = 176
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 296
Top = 192
end
end

View File

@ -0,0 +1,218 @@
unit U_EmployeeSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, DB, ADODB, U_BaseHelp, System.ImageList, Vcl.ImgList;
type
TfrmEmployeeSel = class(TfrmBaseHelp)
ScrollBox1: TScrollBox;
btn1: TSpeedButton;
btn2: TSpeedButton;
btn3: TSpeedButton;
btn4: TSpeedButton;
btn5: TSpeedButton;
btn6: TSpeedButton;
btn7: TSpeedButton;
btn8: TSpeedButton;
btn58: TSpeedButton;
btn9: TSpeedButton;
btn10: TSpeedButton;
btn11: TSpeedButton;
btn12: TSpeedButton;
btn13: TSpeedButton;
btn14: TSpeedButton;
btn15: TSpeedButton;
btn59: TSpeedButton;
btn16: TSpeedButton;
btn17: TSpeedButton;
btn18: TSpeedButton;
btn19: TSpeedButton;
btn20: TSpeedButton;
btn21: TSpeedButton;
btn22: TSpeedButton;
btn60: TSpeedButton;
btn23: TSpeedButton;
btn24: TSpeedButton;
btn25: TSpeedButton;
btn26: TSpeedButton;
btn27: TSpeedButton;
btn28: TSpeedButton;
btn29: TSpeedButton;
btn61: TSpeedButton;
btn30: TSpeedButton;
btn31: TSpeedButton;
btn32: TSpeedButton;
btn33: TSpeedButton;
btn34: TSpeedButton;
btn35: TSpeedButton;
btn36: TSpeedButton;
btn62: TSpeedButton;
btn37: TSpeedButton;
btn38: TSpeedButton;
btn39: TSpeedButton;
btn40: TSpeedButton;
btn41: TSpeedButton;
btn42: TSpeedButton;
btn43: TSpeedButton;
btn63: TSpeedButton;
btn44: TSpeedButton;
btn45: TSpeedButton;
btn46: TSpeedButton;
btn47: TSpeedButton;
btn48: TSpeedButton;
btn49: TSpeedButton;
btn50: TSpeedButton;
btn64: TSpeedButton;
btn51: TSpeedButton;
btn52: TSpeedButton;
btn53: TSpeedButton;
btn54: TSpeedButton;
btn55: TSpeedButton;
btn56: TSpeedButton;
btn57: TSpeedButton;
ADOTmp: TADOQuery;
ADOConnection1: TADOConnection;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
procedure InitEmployee();
{ Private declarations }
public
FRCode, FRName, FPost: string;
{ Public declarations }
end;
var
frmEmployeeSel: TfrmEmployeeSel;
implementation
uses
U_DataLink;
{$R *.dfm}
procedure TfrmEmployeeSel.FormDestroy(Sender: TObject);
begin
inherited;
frmEmployeeSel := nil;
end;
procedure TfrmEmployeeSel.InitEmployee();
type
FdDy = record
inc: integer;
FCode: string[32];
FName: string[32];
end;
var
BB: array[0..100] of FdDy;
i, j: Integer;
begin
with ADOTmp do
begin
Close;
sql.Clear;
sql.Add('select EECode,EEName from SY_Employee where Post=''' + Trim(FPost) + ''' ');
SQL.Add('order by EECode,EEName ');
Open;
end;
if ADOTmp.IsEmpty then
begin
Application.MessageBox('没有定义数据!', '提示', 0);
Exit;
end;
with ADOTmp do
begin
First;
i := 0;
while not Eof do
begin
BB[i].inc := i;
BB[i].FCode := Trim(fieldbyname('EECode').AsString);
BB[i].FName := Trim(fieldbyname('EEName').AsString);
i := i + 1;
Next;
end;
end;
i := i - 1;
if i > 63 then
begin
i := 63;
end;
for j := 0 to i do
begin
with ScrollBox1 do
begin
TSpeedButton(Controls[j]).Visible := True;
TSpeedButton(Controls[j]).Hint := BB[j].FCode;
TSpeedButton(Controls[j]).Caption := BB[j].FName;
{TSpeedButton(Controls[j]).Hint:=BB[j];
if Length(BB[j])>4 then
begin
TSpeedButton(Controls[j]).Caption:=Copy(Trim(BB[j]),1,4)+#13+Copy(Trim(BB[j]),5,Length(BB[j])-4);
end else
TSpeedButton(Controls[j]).Caption:=BB[j]; }
end;
end;
end;
procedure TfrmEmployeeSel.FormShow(Sender: TObject);
begin
inherited;
InitEmployee();
end;
procedure TfrmEmployeeSel.btn1Click(Sender: TObject);
begin
FRCode := Trim(TSpeedButton(Sender).Hint);
FRName := Trim(TSpeedButton(Sender).Caption);
ModalResult := 1;
end;
procedure TfrmEmployeeSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
// Action:=caHide;
end;
procedure TfrmEmployeeSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
end;
end;
end.

View File

@ -0,0 +1,67 @@
object frmInputBoxSingleNumber: TfrmInputBoxSingleNumber
Left = 682
Top = 315
Caption = #35831#36755#20837#25968#23383
ClientHeight = 100
ClientWidth = 362
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 362
Height = 100
Align = alClient
TabOrder = 0
ExplicitTop = 1
object Label1: TLabel
Left = 31
Top = 37
Width = 66
Height = 21
Caption = #25968#23383#65306
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 217
Top = 33
Width = 83
Height = 29
Caption = #30830#35748
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object Price: TEdit
Left = 90
Top = 33
Width = 121
Height = 29
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
end
end
end

View File

@ -0,0 +1,39 @@
unit U_InputBoxSingleNumber;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DB, ADODB;
type
TfrmInputBoxSingleNumber = class(TForm)
Panel1: TPanel;
Button1: TButton;
Label1: TLabel;
Price: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
FFFIDS: string;
{ Public declarations }
end;
var
frmInputBoxSingleNumber: TfrmInputBoxSingleNumber;
implementation
{$R *.dfm}
procedure TfrmInputBoxSingleNumber.Button1Click(Sender: TObject);
begin
if StrToFloatDef(Price.Text, 0) = 0 then
Price.Text := '0';
ModalResult := 1;
end;
end.

View File

@ -0,0 +1,54 @@
object frmInputBoxSingleString: TfrmInputBoxSingleString
Left = 682
Top = 315
Caption = #35831#36755#20837#25991#26412
ClientHeight = 123
ClientWidth = 467
Color = clWhite
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poMainFormCenter
PixelsPerInch = 96
TextHeight = 13
object Panel1: TPanel
Left = 0
Top = 0
Width = 467
Height = 123
Align = alClient
TabOrder = 0
ExplicitHeight = 122
object Button1: TButton
Left = 340
Top = 12
Width = 111
Height = 93
Caption = #30830#35748
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -35
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object Memo1: TMemo
Left = 13
Top = 12
Width = 306
Height = 93
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #23435#20307
Font.Style = []
ParentFont = False
TabOrder = 1
end
end
end

View File

@ -0,0 +1,37 @@
unit U_InputBoxSingleString;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DB, ADODB;
type
TfrmInputBoxSingleString = class(TForm)
Panel1: TPanel;
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
FFFIDS: string;
{ Public declarations }
end;
var
frmInputBoxSingleString: TfrmInputBoxSingleString;
implementation
{$R *.dfm}
procedure TfrmInputBoxSingleString.Button1Click(Sender: TObject);
begin
ModalResult := 1;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,293 @@
unit U_KnitClothInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxTL,
cxMaskEdit, cxTLdxBarBuiltInMenu, cxCheckBox, cxInplaceContainer, cxDBTL,
cxTLData, math;
type
TfrmKnitClothInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DS_Tree: TDataSource;
CDS_Tree: TClientDataSet;
ADOQueryTree: TADOQuery;
Panel3: TPanel;
Panel7: TPanel;
Panel4: TPanel;
Label14: TLabel;
LBCPAP1: TLabel;
Button1: TButton;
Button2: TButton;
TCBNOR1: TComboBox;
Panel1: TPanel;
Label3: TLabel;
Label4: TLabel;
Label9: TLabel;
Label8: TLabel;
C_Code: TEdit;
C_Name: TEdit;
C_GramWeight: TEdit;
C_Width: TEdit;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SSel: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1CYNo: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
Tv1Column11: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TCBNOR1Change(Sender: TObject);
procedure C_NameChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
private
CurrentPage, RecordsNumber: Integer;
procedure InitGrid();
procedure InitTree();
{ Private declarations }
public
FCoType: string;
{ Public declarations }
end;
var
frmKnitClothInfoSel: TfrmKnitClothInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmKnitClothInfoSel.InitTree();
var
i: Integer;
begin
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_Type where CTType=''针织'' ');
Open;
end;
SCreateCDS(ADOQueryTree, CDS_Tree);
SInitCDSData(ADOQueryTree, CDS_Tree);
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmKnitClothInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
//frmZDYHelp.Free;
end;
end;
procedure TfrmKnitClothInfoSel.Button1Click(Sender: TObject);
begin
if CurrentPage > 1 then
CurrentPage := CurrentPage - 1;
InitGrid();
end;
procedure TfrmKnitClothInfoSel.Button2Click(Sender: TObject);
begin
if CurrentPage < CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
InitGrid();
end;
procedure TfrmKnitClothInfoSel.C_NameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmKnitClothInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
C_Code.SetFocus;
Action := cahide;
end;
procedure TfrmKnitClothInfoSel.InitGrid();
var
fwhere, MBCIID, Pwhere: string;
begin
if not CDS_1.IsEmpty then
MBCIID := Trim(CDS_1.FieldByName('BCIID').AsString)
else
MBCIID := '';
Pwhere := SGetFilters(Panel1, 1, 2);
if trim(Pwhere) <> '' then
begin
if fwhere <> '' then
fwhere := fwhere + ' and ' + trim(Pwhere)
else
fwhere := ' where ' + trim(Pwhere);
end;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
Filtered := False;
sql.Clear;
sql.Add(' exec P_BS_CloInfo_Get ');
sql.Add(' @CTID=' + quotedstr(Trim(CDS_Tree.fieldbyname('CTID').AsString)));
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
sql.Add(',@criteria= ' + quotedstr(fwhere));
// ShowMessage(sql.Text);
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
TV1.DataController.Filter.Clear;
LBCPAP1.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber));
finally
ADOQueryMain.EnableControls;
TV1.DataController.Filter.Clear;
end;
if MBCIID <> '' then
CDS_1.Locate('BCIID', MBCIID, []);
end;
procedure TfrmKnitClothInfoSel.FormShow(Sender: TObject);
begin
inherited;
RecordsNumber := 500;
CurrentPage := 1;
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
InitTree();
InitGrid();
end;
procedure TfrmKnitClothInfoSel.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmKnitClothInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmKnitClothInfoSel.TCBNOR1Change(Sender: TObject);
begin
RecordsNumber := StrToInt(TCBNOR1.Text);
CurrentPage := 1;
C_Code.SetFocus;
InitGrid();
end;
procedure TfrmKnitClothInfoSel.ToolButton1Click(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmKnitClothInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmKnitClothInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmKnitClothInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,398 @@
unit U_LabelMapSet;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxPC, cxCheckComboBox, cxDropDownEdit, Menus, RM_e_Xls,
cxLookAndFeels, cxLookAndFeelPainters, cxNavigator, dxSkinsCore,
dxSkinsDefaultPainters, dxDateRanges, dxBarBuiltInMenu, System.ImageList,
Vcl.ImgList, U_BaseHelp, Vcl.Clipbrd;
type
TfrmLabelMapSet = class(Tform)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
Panel1: TPanel;
LMName: TEdit;
v2Column8: TcxGridDBColumn;
Label1: TLabel;
v2Column12: TcxGridDBColumn;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
Label2: TLabel;
LMType: TEdit;
v2Column1: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
ToolButton1: TToolButton;
Tv1Column2: TcxGridDBColumn;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
cxGrid2: TcxGrid;
TV2: TcxGridDBTableView;
cxGridLevel2: TcxGridLevel;
DS_2: TDataSource;
ToolBar2: TToolBar;
ToolButton12: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton3: TToolButton;
ADO_2: TADOQuery;
PM_2: TPopupMenu;
N3: TMenuItem;
Tv1Column3: TcxGridDBColumn;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
procedure CustomerChange(Sender: TObject);
procedure v2Column8PropertiesEditValueChanged(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ToolButton12Click(Sender: TObject);
procedure ToolButton6Click(Sender: TObject);
procedure ToolButton7Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure TextEdit(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
procedure Getfields(MSql: Integer);
public
IsSql1: Boolean;
FLMType: string;
FFiltration1, FFiltration2, FFiltration3: string;
{ Public declarations }
end;
var
frmLabelMapSet: TfrmLabelMapSet;
implementation
uses
U_DataLink, U_RTFun, U_ZDYHelp;
{$R *.dfm}
procedure TfrmLabelMapSet.Getfields(MSql: Integer);
begin
case MSql of
1:
begin
if IsSql1 then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql1').AsString));
sql.add(FFiltration1);
Open;
end;
end
else
begin
if trim(CDS_1.fieldbyname('LMSql1').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql1').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration1)));
Open;
end;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(false); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
2:
begin
if trim(CDS_1.fieldbyname('LMSql2').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql2').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration2)));
Open;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(False); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
3:
begin
if trim(CDS_1.fieldbyname('LMSql3').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_1.fieldbyname('LMSql3').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration3)));
Open;
end;
end;
TV2.ClearItems; //清空数据
(TV2.DataController as IcxCustomGridDataController).DeleteAllItems; //删除所有列
(TV2.DataController as IcxCustomGridDataController).CreateAllItems(false); //创建数据源中的所有列
TV2.ApplyBestFit; //让列宽自适应 .BestFitMaxWidth;
end;
end;
end;
procedure TfrmLabelMapSet.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
SQL.Clear;
sql.Add(' select A.* from BS_Label_Map A ');
sql.Add(' where LMType=' + quotedstr(FLMType));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
ToolButton2.Click;
end;
end;
procedure TfrmLabelMapSet.N3Click(Sender: TObject);
begin
Clipboard.SetTextBuf(PChar(TV2.Controller.FocusedColumn.DataBinding.FilterFieldName));
end;
procedure TfrmLabelMapSet.FormDestroy(Sender: TObject);
begin
frmLabelMapSet := nil;
end;
procedure TfrmLabelMapSet.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmLabelMapSet.FormCreate(Sender: TObject);
begin
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
// ADOQueryBaseCmd.Connection := ADOConnection1;
// ADOQueryBaseTemp.Connection := ADOConnection1;
except
end;
end;
procedure TfrmLabelMapSet.TBCloseClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmLabelMapSet.FormShow(Sender: TObject);
begin
ReadCxGrid(Trim(Self.Caption), Tv1, '标签管理');
InitGrid();
end;
procedure TfrmLabelMapSet.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmLabelMapSet.ToolButton12Click(Sender: TObject);
begin
Getfields(1);
end;
procedure TfrmLabelMapSet.ToolButton1Click(Sender: TObject);
begin
WriteCxGrid(Trim(Self.Caption), Tv1, '标签管理');
end;
procedure TfrmLabelMapSet.ToolButton2Click(Sender: TObject);
var
sql: string;
begin
if ADOQueryMain.Active then
begin
sql := SGetFilters(Panel1, 1, 2);
SDofilter(ADOQueryMain, sql);
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmLabelMapSet.ToolButton3Click(Sender: TObject);
begin
TcxGridToExcel('sql字段', cxgrid2);
end;
procedure TfrmLabelMapSet.cxTabControl1Change(Sender: TObject);
begin
InitGrid;
end;
procedure TfrmLabelMapSet.CustomerChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmLabelMapSet.v2Column8PropertiesEditValueChanged(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName);
try
ADOQueryCmd.Connection.BeginTrans;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('UPdate BS_Label_Map ');
sql.Add(' Set ' + FFieldName + '=''' + Trim(mvalue) + '''');
sql.Add(' , Editer=''' + Trim(DName) + '''');
sql.Add(' , Edittime=getdate()');
sql.Add(' where LMID=' + quotedstr(CDS_1.fieldbyname('LMID').AsString));
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
tv1.Controller.EditingController.ShowEdit();
except
tv1.Controller.EditingController.ShowEdit();
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!', '提示', 0);
end
end;
procedure TfrmLabelMapSet.ToolButton4Click(Sender: TObject);
begin
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('insert into BS_Label_Map(LMType,Filler) values(' + quotedstr(Trim(FLMType)) + ',' + quotedstr(Trim(dname)) + ')');
ExecSQL;
end;
InitGrid();
end;
procedure TfrmLabelMapSet.ToolButton5Click(Sender: TObject);
begin
if CDS_1.IsEmpty then
Exit;
if Application.MessageBox('确定要删除数据吗?', '提示', 32 + 4) <> IDYES then
Exit;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('delete BS_Label_Map where LMID=' + QuotedStr(CDS_1.FieldByName('LMID').AsString));
ExecSQL;
end;
CDS_1.Delete;
end;
procedure TfrmLabelMapSet.ToolButton6Click(Sender: TObject);
begin
Getfields(2);
end;
procedure TfrmLabelMapSet.ToolButton7Click(Sender: TObject);
begin
Getfields(3);
end;
procedure TfrmLabelMapSet.TextEdit(Sender: TObject);
var
mvalue, FFieldName: string;
begin
mvalue := TcxTextEdit(Sender).EditingText;
FFieldName := Trim(Tv1.Controller.FocusedColumn.DataBinding.FilterFieldName);
try
ADOQueryCmd.Connection.BeginTrans;
with CDS_1 do
begin
Edit;
FieldByName(FFieldName).Value := Trim(mvalue);
Post;
end;
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('UPdate BS_Label_Map ');
sql.Add(' Set ' + FFieldName + '=' + Trim(mvalue));
sql.Add(' , Editer=''' + Trim(DName) + '''');
sql.Add(' , Edittime=getdate()');
sql.Add(' where LMID=' + quotedstr(CDS_1.fieldbyname('LMID').AsString));
ExecSQL;
end;
ADOQueryCmd.Connection.CommitTrans;
tv1.Controller.EditingController.ShowEdit();
except
tv1.Controller.EditingController.ShowEdit();
ADOQueryCmd.Connection.RollbackTrans;
Application.MessageBox('保存失败!', '提示', 0);
end
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,294 @@
unit U_LabelPrint;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
RM_Class, RM_GridReport, RM_Dataset, Vcl.Buttons, RM_E_llPDF, RM_BarCode,
RM_e_Graphic, RM_e_Jpeg, RM_e_Xls, cxContainer, cxMaskEdit, cxDropDownEdit,
cxMRUEdit;
type
TfrmLabelPrint = class(TfrmBaseHelp)
ADOQueryTemp: TADOQuery;
ADOConnection1: TADOConnection;
Panel1: TPanel;
ImageList1: TImageList;
RMDB_1: TRMDBDataSet;
RM1: TRMGridReport;
RMDB_2: TRMDBDataSet;
CDS_Label: TClientDataSet;
ADO_1: TADOQuery;
btnPrint: TSpeedButton;
btnShow: TSpeedButton;
ADO_2: TADOQuery;
RMDB_3: TRMDBDataSet;
ADO_3: TADOQuery;
RMXLSExport1: TRMXLSExport;
RMJPEGExport1: TRMJPEGExport;
RMBarCodeObject1: TRMBarCodeObject;
RMllPDFExport1: TRMllPDFExport;
CheckBox1: TCheckBox;
ComboBox1: TComboBox;
Label1: TLabel;
cbbLab: TcxMRUEdit;
CheckBox2: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure btnShowClick(Sender: TObject);
procedure cbbLabPropertiesButtonClick(Sender: TObject);
private
procedure InitGrid();
procedure PrintLabel(MIsShow: Boolean);
{ Private declarations }
public
FPreviewPrint, IsSql1: Boolean;
FLMType: string; //标签类型
FFiltration1, FFiltration2, FFiltration3: string;
{ Public declarations }
end;
var
frmLabelPrint: TfrmLabelPrint;
implementation
uses
U_DataLink, U_RTFun, U_LabelMapSet;
{$R *.dfm}
procedure TfrmLabelPrint.PrintLabel(MIsShow: Boolean);
var
fPrintFile, fPrintFile10, FMainID, LBName: string;
begin
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置标签!'), '提示', 0);
Exit;
end;
RMllPDFExport1.ShowDialog := CheckBox2.Checked;
RMJPEGExport1.ShowDialog := CheckBox2.Checked;
RMXLSExport1.ShowDialog := CheckBox2.Checked;
RM1.ShowPrintDialog := CheckBox1.Checked;
LBName := cbbLab.text;
ExportFtErpFile(LBName + '.rmf', ADOQueryTemp);
if CDS_Label.Locate('LMName', LBName, []) then
begin
if IsSql1 then
begin
with ADO_1 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql1').AsString));
sql.add(FFiltration1);
Open;
end;
end
else
begin
if trim(CDS_Label.fieldbyname('LMSql1').AsString) <> '' then
begin
with ADO_1 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql1').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration1)));
Open;
end;
end;
if trim(CDS_Label.fieldbyname('LMSql2').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql2').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration2)));
Open;
end;
end;
if trim(CDS_Label.fieldbyname('LMSql3').AsString) <> '' then
begin
with ADO_3 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('LMSql3').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration3)));
Open;
end;
end;
end;
end;
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf';
if FileExists(fPrintFile) then
begin
RM1.LoadFromFile(fPrintFile);
RM1.DefaultCopies := StrToIntDef(ComboBox1.Text, 1);
RMVariables['LBPrtCode'] := dcode;
RMVariables['LBPrtName'] := dname;
if MIsShow then
RM1.ShowReport
else
RM1.PrintReport;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile), '提示', 0);
end;
end;
procedure TfrmLabelPrint.FormCreate(Sender: TObject);
begin
inherited;
FPreviewPrint := True;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
end;
end;
procedure TfrmLabelPrint.btnPrintClick(Sender: TObject);
begin
PrintLabel(False);
ModalResult := 1;
end;
procedure TfrmLabelPrint.btnShowClick(Sender: TObject);
begin
PrintLabel(true);
end;
procedure TfrmLabelPrint.cbbLabPropertiesButtonClick(Sender: TObject);
begin
try
frmLabelMapSet := TfrmLabelMapSet.Create(Application);
with frmLabelMapSet do
begin
IsSql1 := self.IsSql1;
FFiltration1 := self.FFiltration1;
FFiltration2 := self.FFiltration2;
FFiltration3 := self.FFiltration3;
FLMType := self.FLMType;
if ShowModal = 1 then
begin
Self.InitGrid();
end;
end;
finally
frmLabelMapSet.Free;
end;
end;
procedure TfrmLabelPrint.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cahide;
end;
procedure TfrmLabelPrint.InitGrid();
begin
with ADOQueryTemp do
begin
close;
sql.Clear;
sql.Add('select LMName name from BS_Label_Map where LMType=' + QuotedStr(TRIM(FLMType)));
sql.Add(' order by SerialNo ');
Open;
if isEmpty then
begin
exit;
end;
cbbLab.Properties.LookupItems.Clear;
while not Eof do
begin
cbbLab.Properties.LookupItems.Add(Trim(fieldByName('Name').AsString));
Next;
end;
cbbLab.ItemIndex := 0;
end;
with ADOQueryTemp do
begin
Filtered := False;
Close;
sql.Clear;
Sql.Add('select * from BS_Label_Map where LMType=' + QuotedStr(TRIM(FLMType)));
Open;
end;
SCreateCDS(ADOQueryTemp, CDS_Label);
SInitCDSData(ADOQueryTemp, CDS_Label);
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置标签!'), '提示', 0);
Exit;
end;
end;
procedure TfrmLabelPrint.FormShow(Sender: TObject);
begin
inherited;
if FPreviewPrint then
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbPrint, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]
else
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator];
if Trim(FFiltration2) = '' then
FFiltration2 := FFiltration1;
if Trim(FFiltration3) = '' then
FFiltration3 := FFiltration1;
InitGrid();
end;
procedure TfrmLabelPrint.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmLabelPrint.FormDestroy(Sender: TObject);
begin
inherited;
frmLabelPrint := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,189 @@
unit U_LabelPrintSql;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
RM_Class, RM_GridReport, RM_Dataset, Vcl.Buttons, RM_E_llPDF, RM_BarCode,
RM_e_Graphic, RM_e_Jpeg, RM_e_Xls, cxContainer, cxMaskEdit, cxDropDownEdit,
cxMRUEdit;
type
TfrmLabelPrintSql = class(TfrmBaseHelp)
ADOQueryTemp: TADOQuery;
ADOConnection1: TADOConnection;
Panel1: TPanel;
ImageList1: TImageList;
RMDB_1: TRMDBDataSet;
RM1: TRMGridReport;
RMDB_2: TRMDBDataSet;
ADO_1: TADOQuery;
btnPrint: TSpeedButton;
btnShow: TSpeedButton;
ADO_2: TADOQuery;
RMDB_3: TRMDBDataSet;
ADO_3: TADOQuery;
RMXLSExport1: TRMXLSExport;
RMJPEGExport1: TRMJPEGExport;
RMBarCodeObject1: TRMBarCodeObject;
RMllPDFExport1: TRMllPDFExport;
CheckBox1: TCheckBox;
ComboBox1: TComboBox;
Label1: TLabel;
CheckBox2: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure btnShowClick(Sender: TObject);
private
procedure PrintLabel(MIsShow: Boolean);
{ Private declarations }
public
FPreviewPrint, IsWhile: Boolean;
MSQLS: TStringList;
{ Public declarations }
end;
var
frmLabelPrintSql: TfrmLabelPrintSql;
implementation
uses
U_DataLink, U_RTFun, U_LabelPrint;
{$R *.dfm}
procedure TfrmLabelPrintSql.PrintLabel(MIsShow: Boolean);
var
fPrintFile, fPrintFile10, FMainID, LBName: string;
i: Integer;
begin
RMllPDFExport1.ShowDialog := CheckBox2.Checked;
RMJPEGExport1.ShowDialog := CheckBox2.Checked;
RMXLSExport1.ShowDialog := CheckBox2.Checked;
RM1.ShowPrintDialog := CheckBox1.Checked;
for i := 1 to MSQLS.Count do
begin
with ADO_1 do
begin
Close;
sql.Clear;
sql.add(MSQLS[i - 1]);
Open;
end;
LBName := Trim(ADO_1.FieldByName('LBName').AsString);
if LBName <> '' then
begin
ExportFtErpFile(LBName + '.rmf', ADOQueryTemp);
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf';
if FileExists(fPrintFile) then
begin
RM1.LoadFromFile(fPrintFile);
RM1.DefaultCopies := StrToIntDef(ComboBox1.Text, 1);
RMVariables['LBPrtCode'] := dcode;
RMVariables['LBPrtName'] := dname;
if MIsShow then
RM1.ShowReport
else
RM1.PrintReport;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile), '提示', 0);
Exit;
end;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile), '提示', 0);
Exit;
end;
end;
end;
procedure TfrmLabelPrintSql.FormCreate(Sender: TObject);
begin
inherited;
FPreviewPrint := True;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
end;
end;
procedure TfrmLabelPrintSql.btnPrintClick(Sender: TObject);
var
i: Integer;
begin
PrintLabel(False);
ModalResult := 1;
end;
procedure TfrmLabelPrintSql.btnShowClick(Sender: TObject);
begin
PrintLabel(true);
end;
procedure TfrmLabelPrintSql.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cahide;
end;
procedure TfrmLabelPrintSql.FormShow(Sender: TObject);
begin
inherited;
if FPreviewPrint then
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbPrint, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]
else
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator];
end;
procedure TfrmLabelPrintSql.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmLabelPrintSql.FormDestroy(Sender: TObject);
begin
inherited;
frmLabelPrint := nil;
end;
end.

View File

@ -0,0 +1,992 @@
inherited frmLoomSel: TfrmLoomSel
Left = 342
Top = 13
Caption = #25968#25454#36873#25321
ClientHeight = 668
ClientWidth = 731
Font.Charset = GB2312_CHARSET
Font.Height = -12
Font.Name = #23435#20307
Position = poScreenCenter
OnClose = FormClose
ExplicitWidth = 747
ExplicitHeight = 707
PixelsPerInch = 96
TextHeight = 12
object ScrollBox1: TScrollBox [0]
Left = 0
Top = 0
Width = 731
Height = 668
Align = alClient
TabOrder = 0
object btn1: TSpeedButton
Left = 23
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
OnClick = btn1Click
end
object btn2: TSpeedButton
Left = 111
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn3: TSpeedButton
Left = 199
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn4: TSpeedButton
Left = 287
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn5: TSpeedButton
Left = 375
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn6: TSpeedButton
Left = 463
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn7: TSpeedButton
Left = 551
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn8: TSpeedButton
Left = 639
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn58: TSpeedButton
Left = 23
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn9: TSpeedButton
Left = 111
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn10: TSpeedButton
Left = 199
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn11: TSpeedButton
Left = 287
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn12: TSpeedButton
Left = 375
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn13: TSpeedButton
Left = 463
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn14: TSpeedButton
Left = 551
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn15: TSpeedButton
Left = 639
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn59: TSpeedButton
Left = 23
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn16: TSpeedButton
Left = 111
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn17: TSpeedButton
Left = 199
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn18: TSpeedButton
Left = 287
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn19: TSpeedButton
Left = 375
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn20: TSpeedButton
Left = 463
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn21: TSpeedButton
Left = 551
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn22: TSpeedButton
Left = 639
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn60: TSpeedButton
Left = 23
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn23: TSpeedButton
Left = 111
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn24: TSpeedButton
Left = 199
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn25: TSpeedButton
Left = 287
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn26: TSpeedButton
Left = 375
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn27: TSpeedButton
Left = 463
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn28: TSpeedButton
Left = 551
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn29: TSpeedButton
Left = 639
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn61: TSpeedButton
Left = 23
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn30: TSpeedButton
Left = 111
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn31: TSpeedButton
Left = 199
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn32: TSpeedButton
Left = 287
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn33: TSpeedButton
Left = 375
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn34: TSpeedButton
Left = 463
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn35: TSpeedButton
Left = 551
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn36: TSpeedButton
Left = 639
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn62: TSpeedButton
Left = 23
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn37: TSpeedButton
Left = 111
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn38: TSpeedButton
Left = 199
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn39: TSpeedButton
Left = 287
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn40: TSpeedButton
Left = 375
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn41: TSpeedButton
Left = 463
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn42: TSpeedButton
Left = 551
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn43: TSpeedButton
Left = 639
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn63: TSpeedButton
Left = 23
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn44: TSpeedButton
Left = 111
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn45: TSpeedButton
Left = 199
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn46: TSpeedButton
Left = 287
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn47: TSpeedButton
Left = 375
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn48: TSpeedButton
Left = 463
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn49: TSpeedButton
Left = 551
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn50: TSpeedButton
Left = 639
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn64: TSpeedButton
Left = 23
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn51: TSpeedButton
Left = 111
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn52: TSpeedButton
Left = 199
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn53: TSpeedButton
Left = 287
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn54: TSpeedButton
Left = 375
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn55: TSpeedButton
Left = 463
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn56: TSpeedButton
Left = 551
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn57: TSpeedButton
Left = 639
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object Label1: TLabel
Left = 352
Top = 626
Width = 33
Height = 19
Caption = '1/1'
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -19
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 199
Top = 623
Width = 75
Height = 25
Caption = #19978#19968#39029
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 445
Top = 623
Width = 75
Height = 25
Caption = #19979#19968#39029
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = Button2Click
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = ADOConnection1
Left = 222
Top = 182
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = ADOConnection1
end
inherited ImageList_new32: TImageList
Left = 228
Top = 263
end
object ADOTmp: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 118
Top = 261
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 315
Top = 173
end
object CDS_All: TClientDataSet
Aggregates = <>
Params = <>
Left = 318
Top = 256
end
end

View File

@ -0,0 +1,239 @@
unit U_LoomSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, DB, ADODB, U_BaseHelp, System.ImageList, Vcl.ImgList,
Datasnap.DBClient, Vcl.StdCtrls, math;
type
TfrmLoomSel = class(TfrmBaseHelp)
ScrollBox1: TScrollBox;
btn1: TSpeedButton;
btn2: TSpeedButton;
btn3: TSpeedButton;
btn4: TSpeedButton;
btn5: TSpeedButton;
btn6: TSpeedButton;
btn7: TSpeedButton;
btn8: TSpeedButton;
btn58: TSpeedButton;
btn9: TSpeedButton;
btn10: TSpeedButton;
btn11: TSpeedButton;
btn12: TSpeedButton;
btn13: TSpeedButton;
btn14: TSpeedButton;
btn15: TSpeedButton;
btn59: TSpeedButton;
btn16: TSpeedButton;
btn17: TSpeedButton;
btn18: TSpeedButton;
btn19: TSpeedButton;
btn20: TSpeedButton;
btn21: TSpeedButton;
btn22: TSpeedButton;
btn60: TSpeedButton;
btn23: TSpeedButton;
btn24: TSpeedButton;
btn25: TSpeedButton;
btn26: TSpeedButton;
btn27: TSpeedButton;
btn28: TSpeedButton;
btn29: TSpeedButton;
btn61: TSpeedButton;
btn30: TSpeedButton;
btn31: TSpeedButton;
btn32: TSpeedButton;
btn33: TSpeedButton;
btn34: TSpeedButton;
btn35: TSpeedButton;
btn36: TSpeedButton;
btn62: TSpeedButton;
btn37: TSpeedButton;
btn38: TSpeedButton;
btn39: TSpeedButton;
btn40: TSpeedButton;
btn41: TSpeedButton;
btn42: TSpeedButton;
btn43: TSpeedButton;
btn63: TSpeedButton;
btn44: TSpeedButton;
btn45: TSpeedButton;
btn46: TSpeedButton;
btn47: TSpeedButton;
btn48: TSpeedButton;
btn49: TSpeedButton;
btn50: TSpeedButton;
btn64: TSpeedButton;
btn51: TSpeedButton;
btn52: TSpeedButton;
btn53: TSpeedButton;
btn54: TSpeedButton;
btn55: TSpeedButton;
btn56: TSpeedButton;
btn57: TSpeedButton;
ADOTmp: TADOQuery;
ADOConnection1: TADOConnection;
CDS_All: TClientDataSet;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FMCNO, FMCType: string;
FPage: Integer;
{ Public declarations }
end;
var
frmLoomSel: TfrmLoomSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmLoomSel.FormDestroy(Sender: TObject);
begin
inherited;
frmLoomSel := nil;
end;
procedure TfrmLoomSel.InitGrid();
var
i: Integer;
str: string;
begin
with ADOTmp do
begin
Close;
sql.Clear;
sql.Add('select MCNO,MCName ');
sql.Add(',ROW_NUMBER() over(order by A.MCNO) as keyNo ');
sql.Add('from Bs_Machine A ');
sql.Add('where MCType= ' + QuotedStr(FMCType));
SQL.Add('order by MCNO,MCName ');
Open;
end;
if ADOTmp.IsEmpty then
begin
Application.MessageBox('没有定义数据!', '提示', 0);
Exit;
end;
SCreateCDS(ADOTmp, CDS_All);
SInitCDSData(ADOTmp, CDS_All);
if CDS_All.RecordCount < FPage * 64 then
begin
FPage := FPage - 1;
end;
if FPage <= 0 then
begin
FPage := 1;
end;
if CDS_All.RecordCount mod 64 > 0 then
Label1.Caption := IntToStr(FPage) + '/' + IntToStr(Floor(CDS_All.RecordCount / 64 + 1))
else
Label1.Caption := IntToStr(FPage) + '/' + IntToStr(Floor(CDS_All.RecordCount / 64));
for i := 0 to 63 do
begin
if CDS_All.Locate('keyNo', (FPage - 1) * 64 + i + 1, []) then
begin
with ScrollBox1 do
begin
TSpeedButton(Controls[i]).Visible := True;
TSpeedButton(Controls[i]).Hint := CDS_All.fieldbyname('MCNO').AsString;
TSpeedButton(Controls[i]).Caption := CDS_All.fieldbyname('MCNO').AsString;
end;
end
else
begin
with ScrollBox1 do
begin
TSpeedButton(Controls[i]).Visible := False;
TSpeedButton(Controls[i]).Hint := '';
TSpeedButton(Controls[i]).Caption := '';
end;
end;
end;
end;
procedure TfrmLoomSel.FormShow(Sender: TObject);
begin
inherited;
FPage := 1;
InitGrid();
end;
procedure TfrmLoomSel.btn1Click(Sender: TObject);
begin
FMCNO := Trim(TSpeedButton(Sender).Hint);
ModalResult := 1;
end;
procedure TfrmLoomSel.Button1Click(Sender: TObject);
begin
FPage := FPage - 1;
InitGrid();
end;
procedure TfrmLoomSel.Button2Click(Sender: TObject);
begin
FPage := FPage + 1;
InitGrid();
end;
procedure TfrmLoomSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
// Action:=caHide;
end;
procedure TfrmLoomSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
end;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,332 @@
unit U_MdPrint;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxNavigator, dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput,
RM_Common, RM_Class, RM_GridReport, RM_Dataset, Vcl.Buttons, RM_E_llPDF,
RM_BarCode, RM_e_Graphic, RM_e_Jpeg, RM_e_Xls, cxContainer, cxMaskEdit,
cxDropDownEdit, cxMRUEdit, cxLookAndFeelPainters, dxSkinsCore,
dxSkinsDefaultPainters;
type
TfrmMdPrint = class(TfrmBaseHelp)
ADOQueryTemp: TADOQuery;
ADOConnection1: TADOConnection;
Panel1: TPanel;
ImageList1: TImageList;
RMDB_1: TRMDBDataSet;
RM1: TRMGridReport;
RMDB_2: TRMDBDataSet;
CDS_Label: TClientDataSet;
ADO_1: TADOQuery;
btnPrint: TSpeedButton;
btnShow: TSpeedButton;
ADO_2: TADOQuery;
RMDB_3: TRMDBDataSet;
ADO_3: TADOQuery;
RMXLSExport1: TRMXLSExport;
RMJPEGExport1: TRMJPEGExport;
RMBarCodeObject1: TRMBarCodeObject;
RMllPDFExport1: TRMllPDFExport;
CheckBox1: TCheckBox;
Label1: TLabel;
CheckBox2: TCheckBox;
ComboBox1: TcxComboBox;
cbbLab: TcxMRUEdit;
ADOQueryCmd: TADOQuery;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure btnPrintClick(Sender: TObject);
procedure btnShowClick(Sender: TObject);
procedure cbbLabPropertiesButtonClick(Sender: TObject);
procedure RM1PrintReportEvent(Sender: TObject);
private
procedure InitGrid();
procedure PrintLabel(MIsShow: Boolean);
{ Private declarations }
public
FPreviewPrint, IsSql1: Boolean;
FLMType: string; //标签类型
FFiltration1, FFiltration2, FFiltration3: string;
{ Public declarations }
end;
var
frmMdPrint: TfrmMdPrint;
implementation
uses
U_DataLink, U_RTFun, U_globalVar, U_BillPrintList;
{$R *.dfm}
procedure TfrmMdPrint.PrintLabel(MIsShow: Boolean);
var
fPrintFile, fPrintFile10, FMainID, LBName: string;
begin
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置标签!'), '提示', 0);
Exit;
end;
RMllPDFExport1.ShowDialog := CheckBox2.Checked;
RMJPEGExport1.ShowDialog := CheckBox2.Checked;
RMXLSExport1.ShowDialog := CheckBox2.Checked;
RM1.ShowPrintDialog := CheckBox1.Checked;
LBName := cbbLab.text;
ExportFtErpFile(LBName + '.rmf', ADOQueryTemp);
if CDS_Label.Locate('billName', LBName, []) then
begin
if IsSql1 then
begin
with ADO_1 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('procedureName').AsString));
sql.add(FFiltration1);
Open;
end;
end
else
begin
if trim(CDS_Label.fieldbyname('procedureName').AsString) <> '' then
begin
with ADO_1 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('procedureName').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration1)));
sql.Add(',@billName=' + QuotedStr(cbbLab.Text));
Open;
end;
end;
if trim(CDS_Label.fieldbyname('procedureName2').AsString) <> '' then
begin
with ADO_2 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('procedureName2').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration2)));
sql.Add(',@billName=' + QuotedStr(cbbLab.Text));
Open;
end;
end;
if trim(CDS_Label.fieldbyname('procedureName3').AsString) <> '' then
begin
with ADO_3 do
begin
Close;
sql.Clear;
sql.add('exec ' + trim(CDS_Label.fieldbyname('procedureName3').AsString) + ' @Filtration=' + quotedstr(Trim(FFiltration3)));
Open;
end;
end;
end;
end;
fPrintFile := ExtractFilePath(Application.ExeName) + 'Report\' + LBName + '.rmf';
if FileExists(fPrintFile) then
begin
RM1.LoadFromFile(fPrintFile);
RM1.DefaultCopies := StrToIntDef(ComboBox1.Text, 1);
RMVariables['LBPrtCode'] := dcode;
RMVariables['LBPrtName'] := dname;
if MIsShow then
RM1.ShowReport
else
RM1.PrintReport;
end
else
begin
Application.MessageBox(PChar('没有找' + fPrintFile), '提示', 0);
end;
end;
procedure TfrmMdPrint.RM1PrintReportEvent(Sender: TObject);
var
MDmaxno: string;
begin
if GetLSNo(ADOQueryCmd, MDmaxno, '', 'Trade_MDbh', 3, 1) = false then
raise Exception.Create('取最大号失败!');
with ADOQueryCmd do
begin
Close;
sql.Clear;
sql.Add('update Trade_MDbh set MDbh=''' + trim(MDmaxno) + ''' ');
// ShowMessage(SQL.text);
ExecSQL;
end;
end;
procedure TfrmMdPrint.FormCreate(Sender: TObject);
begin
inherited;
FPreviewPrint := True;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
end;
end;
procedure TfrmMdPrint.btnPrintClick(Sender: TObject);
begin
if Trim(cbbLab.Text) = '' then
begin
application.MessageBox('未设置码单打印格式!', '提示信息', 0);
exit;
end;
PrintLabel(False);
ModalResult := 1;
end;
procedure TfrmMdPrint.btnShowClick(Sender: TObject);
begin
if Trim(cbbLab.Text) = '' then
begin
application.MessageBox('未设置码单打印格式!', '提示信息', 0);
exit;
end;
PrintLabel(true);
end;
procedure TfrmMdPrint.cbbLabPropertiesButtonClick(Sender: TObject);
begin
if not gIsCanDesign then
exit;
try
frmBillPrintList := TfrmBillPrintList.Create(Application);
with frmBillPrintList do
begin
IsSql1 := self.IsSql1;
FFiltration1 := self.FFiltration1;
FFiltration2 := self.FFiltration2;
FFiltration3 := self.FFiltration3;
FLMType := self.FLMType;
if ShowModal = 1 then
begin
Self.InitGrid();
end;
end;
finally
frmBillPrintList.Free;
end;
end;
procedure TfrmMdPrint.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := cahide;
end;
procedure TfrmMdPrint.InitGrid();
begin
with ADOQueryTemp do
begin
close;
sql.Clear;
sql.Add('select recid, billname from SD_BillPrint');
sql.Add('where billtype=' + QuotedStr(TRIM(FLMType)));
sql.Add('and billGroup=''码单'' and valid=1');
sql.Add('and isnull(billname,'''')<>''''');
sql.Add(' order by orderno ');
Open;
if isEmpty then
begin
exit;
end;
cbbLab.Properties.LookupItems.Clear;
while not Eof do
begin
// cbbLab.Properties.items.AddObject()
// cbbLab.Properties.items.AddPair(Trim(fieldByName('billname').AsString),Trim(fieldByName('recid').AsString)) ;
cbbLab.Properties.items.Add(Trim(fieldByName('billname').AsString));
// cbbLab.Properties.LookupItems.Add(Trim(fieldByName('recid').AsString));
Next;
end;
cbbLab.ItemIndex := 0;
end;
with ADOQueryTemp do
begin
Filtered := False;
Close;
sql.Clear;
Sql.Add('select * from SD_BillPrint where billtype=' + QuotedStr(TRIM(FLMType)));
sql.Add('and billGroup=''码单'' and valid=1');
Open;
end;
SCreateCDS(ADOQueryTemp, CDS_Label);
SInitCDSData(ADOQueryTemp, CDS_Label);
if CDS_Label.IsEmpty then
begin
Application.MessageBox(PChar('类型' + FLMType + '没有设置码单报表文件!'), '提示', 0);
Exit;
end;
end;
procedure TfrmMdPrint.FormShow(Sender: TObject);
begin
inherited;
if FPreviewPrint then
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbPrint, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator]
else
RM1.PreviewButtons := [rmpbZoom, rmpbLoad, rmpbSave, rmpbFind, rmpbPageSetup, rmpbExit, rmpbSaveToXLS, rmpbExport, rmpbNavigator];
if Trim(FFiltration2) = '' then
FFiltration2 := FFiltration1;
if Trim(FFiltration3) = '' then
FFiltration3 := FFiltration1;
InitGrid();
end;
procedure TfrmMdPrint.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmMdPrint.FormDestroy(Sender: TObject);
begin
inherited;
frmMdPrint := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

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

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,521 @@
unit U_PictureUpload;
interface
uses
Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls,
Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, Buttons,
StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, IdExplicitTLSClientServerBase, System.ImageList,
Vcl.ImgList;
type
TfrmPictureUpload = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
Image2: TImage;
SpeedButton3: TSpeedButton;
ADOQuery1: TADOQuery;
SaveDialog1: TSavePictureDialog;
adoqueryImage: TADOQuery;
IdFTP1: TIdFTP;
ToolBar1: TToolBar;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ImageList1: TImageList;
ADOConnection1: TADOConnection;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
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 Initimage();
procedure TBCloseClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
private
hWndC: THandle;
CapturingAVI: bool;
ClickPos: TPoint;
SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
FilePath, FileName: string;
MyJpeg: TJPEGImage;
procedure CreThumb(Width, Height: Integer);
function SaveImage(): Boolean;
procedure Rotate90(Source: TGraphic; Target: TJpegImage);
public
FTFType, fFlileFlag: string;
FWidth, FHeight: Integer;
FPictureName, FDataId: string;
{ Public declarations }
end;
var
frmPictureUpload: TfrmPictureUpload;
implementation
uses
U_DataLink, U_RTFun;
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 TfrmPictureUpload.Rotate90(Source: TGraphic; Target: TJpegImage);
var
SourceBmp, TargetBmp: TBitmap;
r, c: Integer;
x, y: Integer;
begin
SourceBmp := TBitmap.Create;
SourceBmp.Assign(Source);
TargetBmp := TBitmap.Create;
TargetBmp.Width := SourceBmp.Height;
TargetBmp.Height := SourceBmp.Width;
for r := 0 to SourceBmp.Height - 1 do
begin
for c := 0 to SourceBmp.Width - 1 do
begin
//x := (SourceBmp.Height-1) - r; // -90
//y := c; //-90
x := r; //90
y := (SourceBmp.Width - 1) - c; //90
// look into Bitmap.ScanLine for faster pixel access
TargetBmp.Canvas.Pixels[x, y] := SourceBmp.Canvas.Pixels[c, r];
end;
end;
Target.Assign(TargetBmp);
SourceBmp.Free;
TargetBmp.Free;
end;
procedure TfrmPictureUpload.Initimage();
var
jpg: TJpegImage;
myStream: TADOBlobStream;
sFieldName: string;
JPStream: TMemoryStream;
begin
jpg := TJpegImage.Create();
JPStream := TMemoryStream.Create;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FDataId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if not IsEmpty then
begin
if not fieldbyname('FilesOther').IsNull then
begin
myStream := tadoblobstream.Create(tblobfield(adoqueryImage.fieldbyname('FilesOther')), 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;
JPStream.Clear;
if IdFTP1.Connected then
begin
try
IdFTP1.Get(fFlileFlag + '\' + Trim(fieldbyname('FileName').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);
end;
end;
end;
finally
jpg.free;
JPStream.Free;
end;
end;
function TfrmPictureUpload.SaveImage(): Boolean;
var
myStream: TADOBlobStream;
maxNo: string;
fNewFileName: string;
begin
//取文件后缀 ExtractFileExt(FilePath)
if FPictureName = '' then
begin
fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath);
FPictureName := fNewFileName;
end;
if FDataId = '' then
FDataId := FPictureName;
result := false;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FDataId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if RecordCount <= 0 then
begin
Append;
if GetLSNo(ADOQuery1, maxNo, 'FJ', 'TP_File', 4, 1) = False then
begin
Application.MessageBox('取最大号失败!', '提示', 0);
Exit;
end;
fieldByName('TFID').AsString := maxNo;
fieldByName('WBID').AsString := FDataId;
end
else
begin
edit;
end;
fieldByName('FileName').AsString := trim(FPictureName);
fieldByName('Filler').AsString := trim(dName);
fieldByName('TFType').AsString := trim(FTFType);
myStream := TADOBlobStream.Create(TBlobField(FieldByName('FilesOther')), bmWrite);
MyJpeg.Assign(Image2.Picture.Graphic);
MyJpeg.SaveToStream(myStream);
myStream.Free;
Post;
end;
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(FPictureName));
IdFTP1.Quit;
except
IdFTP1.Quit;
Application.MessageBox('上传客户图样文件失败,请检查文件服务器!', '提示', MB_ICONWARNING);
end;
end;
IdFTP1.Quit;
result := true;
except
myStream.Free;
end;
end;
procedure TfrmPictureUpload.TBCloseClick(Sender: TObject);
begin
Close;
end;
procedure TfrmPictureUpload.TBSaveClick(Sender: TObject);
begin
if SaveImage() then
begin
ModalResult := 1;
end
else
begin
application.MessageBox('数据保存失败!', '提示信息', 0)
end;
end;
procedure TfrmPictureUpload.ToolButton1Click(Sender: TObject);
var
Jpeg: TJPEGImage;
begin
if OpenPictureDialog1.Execute then
begin
Image1.Top := 0;
Image1.Left := 0;
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
FilePath := OpenPictureDialog1.FileName;
FileName := ExtractFileName(FilePath);
// Jpeg := TJPEGImage.Create;
// Rotate90(Image1.Picture.Graphic, Jpeg);
// Image1.Picture.Assign(Jpeg);
// Jpeg.Free;
CreThumb(FWidth, FHeight);
TBSave.Enabled := TRUE;
end;
end;
procedure TfrmPictureUpload.ToolButton2Click(Sender: TObject);
begin
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FPictureName)));
open;
if RecordCount > 0 then
begin
edit;
fieldByName('FileName').Value := null;
FieldByName('FilesOther').Value := null;
post;
Image1.Picture.Assign(nil);
Image2.Picture.Assign(nil);
end;
end;
except
end;
end;
procedure TfrmPictureUpload.ToolButton3Click(Sender: TObject);
var
MJPG: TJpegImage;
pathFile: string;
begin
if Image1.Picture.Graphic = nil then
exit;
MJPG := TJpegImage.Create;
try
SaveDialog1.FileName := FileName;
if SaveDialog1.Execute then
begin
if SaveDialog1.FileName <> '' then
begin
pathFile := trim(SaveDialog1.FileName);
if (RightStr(UPPERCASE(pathFile), 4) <> '.JPG') and (RightStr(UPPERCASE(pathFile), 5) <> '.JPEG') then
begin
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);
end
else
MJPG.SaveToFile(pathFile);
end;
end;
finally
MJPG.Free;
end;
end;
procedure TfrmPictureUpload.ToolButton4Click(Sender: TObject);
begin
ModalResult := 2;
end;
procedure TfrmPictureUpload.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
Image1.Picture.Assign(Image);
Cancel := TRUE;
CreThumb(150, 150);
TBSave.Enabled := TRUE;
end;
procedure TfrmPictureUpload.FormShow(Sender: TObject);
var
Ini: TIniFile;
begin
{ Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
try
SelectedSource := Ini.ReadInteger( 'SCANNER', 'Scanner', 0);
PicLeft := Ini.ReadInteger( 'SCANNER', 'Left', 0);
PicTop := Ini.ReadInteger( 'SCANNER', 'Top', 0);
PicWidth := Ini.ReadInteger( 'SCANNER', 'Width', 100);
PicHeight := Ini.ReadInteger( 'SCANNER', 'Height', 100);
finally
Ini.Free;
end; }
Initimage();
end;
procedure TfrmPictureUpload.CreThumb(Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.Height;
if Ratio > 0.75 then
begin
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;
AHeight := Height;
AHeightOffset := 0;
end;
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.Canvas.Brush.Color := clBtnFace;
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
ARect := Rect(AWidthOffset, AHeightOffset, AWidth + AWidthOffset, AHeight + AHeightOffset);
Bitmap.Canvas.StretchDraw(ARect, Image1.Picture.Graphic);
Image2.Picture.Assign(Bitmap);
finally
Bitmap.Free;
end;
end;
procedure TfrmPictureUpload.FormCreate(Sender: TObject);
begin
MyJpeg := TJpegImage.Create;
TBSave.Enabled := false;
if FWidth = 0 then
FWidth := 197;
if FHeight = 0 then
FHeight := 110;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
// ADOQueryBaseCmd.Connection := ADOConnection1;
// ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmPictureUpload.FormDestroy(Sender: TObject);
begin
// MyJpeg1.Free;
MyJpeg.Free;
end;
procedure TfrmPictureUpload.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ClickPos.x := X;
ClickPos.y := Y;
end;
procedure TfrmPictureUpload.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
NewPos: TPoint;
begin
{The left button was pressed}
if ssLeft in Shift then
begin
{Calculate new position}
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;
Image1.Top := NewPos.Y;
Image1.Left := NewPos.X;
end {if ssLeft in Shift}
end;
end.

View File

@ -0,0 +1,986 @@
inherited frmPositionSel: TfrmPositionSel
Left = 342
Top = 13
Caption = #25968#25454#36873#25321
ClientHeight = 668
ClientWidth = 731
Font.Charset = GB2312_CHARSET
Font.Height = -12
Font.Name = #23435#20307
Position = poScreenCenter
OnClose = FormClose
ExplicitWidth = 747
ExplicitHeight = 707
PixelsPerInch = 96
TextHeight = 12
object ScrollBox1: TScrollBox [0]
Left = 0
Top = 0
Width = 731
Height = 668
Align = alClient
TabOrder = 0
object btn1: TSpeedButton
Left = 23
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clBlack
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
OnClick = btn1Click
end
object btn2: TSpeedButton
Left = 111
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn3: TSpeedButton
Left = 199
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn4: TSpeedButton
Left = 287
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn5: TSpeedButton
Left = 375
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn6: TSpeedButton
Left = 463
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn7: TSpeedButton
Left = 551
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn8: TSpeedButton
Left = 639
Top = 3
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn58: TSpeedButton
Left = 23
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn9: TSpeedButton
Left = 111
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn10: TSpeedButton
Left = 199
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn11: TSpeedButton
Left = 287
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn12: TSpeedButton
Left = 375
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn13: TSpeedButton
Left = 463
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn14: TSpeedButton
Left = 551
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn15: TSpeedButton
Left = 639
Top = 81
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn59: TSpeedButton
Left = 23
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn16: TSpeedButton
Left = 111
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn17: TSpeedButton
Left = 199
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn18: TSpeedButton
Left = 287
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn19: TSpeedButton
Left = 375
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn20: TSpeedButton
Left = 463
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn21: TSpeedButton
Left = 551
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn22: TSpeedButton
Left = 639
Top = 158
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn60: TSpeedButton
Left = 23
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn23: TSpeedButton
Left = 111
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn24: TSpeedButton
Left = 199
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn25: TSpeedButton
Left = 287
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn26: TSpeedButton
Left = 375
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn27: TSpeedButton
Left = 463
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn28: TSpeedButton
Left = 551
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn29: TSpeedButton
Left = 639
Top = 236
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn61: TSpeedButton
Left = 23
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn30: TSpeedButton
Left = 111
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn31: TSpeedButton
Left = 199
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn32: TSpeedButton
Left = 287
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn33: TSpeedButton
Left = 375
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn34: TSpeedButton
Left = 463
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn35: TSpeedButton
Left = 551
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn36: TSpeedButton
Left = 639
Top = 314
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn62: TSpeedButton
Left = 23
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn37: TSpeedButton
Left = 111
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn38: TSpeedButton
Left = 199
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn39: TSpeedButton
Left = 287
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn40: TSpeedButton
Left = 375
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn41: TSpeedButton
Left = 463
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn42: TSpeedButton
Left = 551
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn43: TSpeedButton
Left = 639
Top = 392
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn63: TSpeedButton
Left = 23
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn44: TSpeedButton
Left = 111
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn45: TSpeedButton
Left = 199
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn46: TSpeedButton
Left = 287
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn47: TSpeedButton
Left = 375
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn48: TSpeedButton
Left = 463
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn49: TSpeedButton
Left = 551
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn50: TSpeedButton
Left = 639
Top = 469
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn64: TSpeedButton
Left = 23
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn51: TSpeedButton
Left = 111
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn52: TSpeedButton
Left = 199
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn53: TSpeedButton
Left = 287
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn54: TSpeedButton
Left = 375
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn55: TSpeedButton
Left = 463
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn56: TSpeedButton
Left = 551
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object btn57: TSpeedButton
Left = 639
Top = 547
Width = 70
Height = 70
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -21
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
Visible = False
OnClick = btn1Click
end
object Label1: TLabel
Left = 352
Top = 626
Width = 33
Height = 19
Caption = '1/1'
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -19
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
end
object Button1: TButton
Left = 199
Top = 623
Width = 75
Height = 25
Caption = #19978#19968#39029
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 445
Top = 623
Width = 75
Height = 25
Caption = #19979#19968#39029
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = Button2Click
end
end
inherited ADOQueryBaseCmd: TADOQuery
Connection = ADOConnection1
end
inherited ADOQueryBaseTemp: TADOQuery
Connection = ADOConnection1
end
object ADOTmp: TADOQuery
Connection = ADOConnection1
LockType = ltReadOnly
Parameters = <>
Left = 120
Top = 176
end
object ADOConnection1: TADOConnection
LoginPrompt = False
Left = 296
Top = 192
end
object CDS_All: TClientDataSet
Aggregates = <>
Params = <>
Left = 296
Top = 272
end
end

View File

@ -0,0 +1,237 @@
unit U_PositionSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Buttons, DB, ADODB, U_BaseHelp, System.ImageList, Vcl.ImgList,
Datasnap.DBClient, Vcl.StdCtrls, math;
type
TfrmPositionSel = class(TfrmBaseHelp)
ScrollBox1: TScrollBox;
btn1: TSpeedButton;
btn2: TSpeedButton;
btn3: TSpeedButton;
btn4: TSpeedButton;
btn5: TSpeedButton;
btn6: TSpeedButton;
btn7: TSpeedButton;
btn8: TSpeedButton;
btn58: TSpeedButton;
btn9: TSpeedButton;
btn10: TSpeedButton;
btn11: TSpeedButton;
btn12: TSpeedButton;
btn13: TSpeedButton;
btn14: TSpeedButton;
btn15: TSpeedButton;
btn59: TSpeedButton;
btn16: TSpeedButton;
btn17: TSpeedButton;
btn18: TSpeedButton;
btn19: TSpeedButton;
btn20: TSpeedButton;
btn21: TSpeedButton;
btn22: TSpeedButton;
btn60: TSpeedButton;
btn23: TSpeedButton;
btn24: TSpeedButton;
btn25: TSpeedButton;
btn26: TSpeedButton;
btn27: TSpeedButton;
btn28: TSpeedButton;
btn29: TSpeedButton;
btn61: TSpeedButton;
btn30: TSpeedButton;
btn31: TSpeedButton;
btn32: TSpeedButton;
btn33: TSpeedButton;
btn34: TSpeedButton;
btn35: TSpeedButton;
btn36: TSpeedButton;
btn62: TSpeedButton;
btn37: TSpeedButton;
btn38: TSpeedButton;
btn39: TSpeedButton;
btn40: TSpeedButton;
btn41: TSpeedButton;
btn42: TSpeedButton;
btn43: TSpeedButton;
btn63: TSpeedButton;
btn44: TSpeedButton;
btn45: TSpeedButton;
btn46: TSpeedButton;
btn47: TSpeedButton;
btn48: TSpeedButton;
btn49: TSpeedButton;
btn50: TSpeedButton;
btn64: TSpeedButton;
btn51: TSpeedButton;
btn52: TSpeedButton;
btn53: TSpeedButton;
btn54: TSpeedButton;
btn55: TSpeedButton;
btn56: TSpeedButton;
btn57: TSpeedButton;
ADOTmp: TADOQuery;
ADOConnection1: TADOConnection;
CDS_All: TClientDataSet;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btn1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FPOSNO: string;
FPage: Integer;
{ Public declarations }
end;
var
frmPositionSel: TfrmPositionSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmPositionSel.FormDestroy(Sender: TObject);
begin
inherited;
frmPositionSel := nil;
end;
procedure TfrmPositionSel.InitGrid();
var
i: Integer;
str: string;
begin
with ADOTmp do
begin
Close;
sql.Clear;
sql.Add('select POSNO,POSName ');
sql.Add(',ROW_NUMBER() over(order by A.POSNO) as keyNo ');
sql.Add('from Bs_Position A ');
SQL.Add('order by POSNO,POSName ');
Open;
end;
if ADOTmp.IsEmpty then
begin
Application.MessageBox('没有定义数据!', '提示', 0);
Exit;
end;
SCreateCDS(ADOTmp, CDS_All);
SInitCDSData(ADOTmp, CDS_All);
if CDS_All.RecordCount < FPage * 64 then
begin
FPage := FPage - 1;
end;
if FPage <= 0 then
begin
FPage := 1;
end;
if CDS_All.RecordCount mod 64 > 0 then
Label1.Caption := IntToStr(FPage) + '/' + IntToStr(Floor(CDS_All.RecordCount / 64 + 1))
else
Label1.Caption := IntToStr(FPage) + '/' + IntToStr(Floor(CDS_All.RecordCount / 64));
for i := 0 to 63 do
begin
if CDS_All.Locate('keyNo', (FPage - 1) * 64 + i + 1, []) then
begin
with ScrollBox1 do
begin
TSpeedButton(Controls[i]).Visible := True;
TSpeedButton(Controls[i]).Hint := CDS_All.fieldbyname('POSNO').AsString;
TSpeedButton(Controls[i]).Caption := CDS_All.fieldbyname('POSNO').AsString;
end;
end
else
begin
with ScrollBox1 do
begin
TSpeedButton(Controls[i]).Visible := False;
TSpeedButton(Controls[i]).Hint := '';
TSpeedButton(Controls[i]).Caption := '';
end;
end;
end;
end;
procedure TfrmPositionSel.FormShow(Sender: TObject);
begin
inherited;
FPage := 1;
InitGrid();
end;
procedure TfrmPositionSel.btn1Click(Sender: TObject);
begin
FPOSNO := Trim(TSpeedButton(Sender).Hint);
ModalResult := 1;
end;
procedure TfrmPositionSel.Button1Click(Sender: TObject);
begin
FPage := FPage - 1;
InitGrid();
end;
procedure TfrmPositionSel.Button2Click(Sender: TObject);
begin
FPage := FPage + 1;
InitGrid();
end;
procedure TfrmPositionSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
// Action:=caHide;
end;
procedure TfrmPositionSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
end;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,178 @@
unit U_ProductInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxDropDownEdit;
type
TfrmProductInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
CoName: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
cxGrid2: TcxGrid;
Tv1: TcxGridDBTableView;
Tv1Column2: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
v2Column1: TcxGridDBColumn;
v1Column8: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid2Level1: TcxGridLevel;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure CoNameChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName: string;
{ Public declarations }
end;
var
frmProductInfoSel: TfrmProductInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmProductInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmProductInfoSel.CoNameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmProductInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CoName.SetFocus;
Action := cahide;
end;
procedure TfrmProductInfoSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(' from BS_Product_Info A');
sql.Add(' where isnull(STKNAME,'''')=''' + Trim(FSTKName) + '''');
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmProductInfoSel.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid('物料类型' + Trim(FSTKName), TV1, '通用窗体');
InitGrid();
end;
procedure TfrmProductInfoSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmProductInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('物料类型' + Trim(FSTKName), TV1, '通用窗体');
end;
procedure TfrmProductInfoSel.ToolButton1Click(Sender: TObject);
begin
CoName.SetFocus;
ModalResult := 1;
end;
procedure TfrmProductInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmProductInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmProductInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,301 @@
unit U_ReportImgSet;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
RM_Preview, RM_Dataset, RM_Class, RM_GridReport, RM_e_Graphic, RM_e_Jpeg,
RM_BarCode, RM_Designer, RM_DsgGridReport;
type
TfrmReportImgSet = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADO_1: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
RMPreview1: TRMPreview;
RMDB_Label: TRMDBDataSet;
ADOQueryLabel: TADOQuery;
RMJPEGExport1: TRMJPEGExport;
RMLabel: TRMGridReport;
RMBarCodeObject1: TRMBarCodeObject;
RMReport1: TRMReport;
RMGridReportDesigner1: TRMGridReportDesigner;
RMDesigner1: TRMDesigner;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
private
FFilePath, FFileName: string;
procedure DownloadLabel();
procedure InitLabel();
function SaveData(): Boolean;
{ Private declarations }
public
FDataID, FLabelName: string;
{ Public declarations }
end;
var
frmReportImgSet: TfrmReportImgSet;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
function TfrmReportImgSet.SaveData(): Boolean;
var
MaxId, FImagePath1, FImagePath2: string;
FJStream: TMemoryStream;
begin
with RMLabel do
begin
// LoadFromBlobField(tblobfield(ADOQueryLabel.fieldbyname('Files')));
FImagePath1 := ExtractFilePath(Application.ExeName) + 'image\label0001.jpg';
if FileExists(FImagePath1) then
DeleteFile(FImagePath1);
FImagePath2 := ExtractFilePath(Application.ExeName) + 'image\label.jpg';
PrepareReport;
ExportTo(RMjpegExport1, FImagePath2);
end;
try
FJStream := TMemoryStream.Create;
FJStream.LoadFromFile(FImagePath1);
ADOQueryCmd.Connection.BeginTrans;
if Trim(FDataID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxId, 'R', 'BS_Img_Label', 4, 1) = False then
begin
raise Exception.Create('取最大号失败!');
end;
end
else
begin
MaxId := Trim(FDataID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from BS_Img_Label where LabelId=''' + Trim(FDataID) + '''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FDataID) = '' then
begin
Append;
FieldByName('Filler').Value := Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value := Trim(DName);
FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('LabelId').Value := Trim(MaxId);
FieldByName('DataID').Value := Trim(FDataID);
tblobfield(FieldByName('LabelFile')).LoadFromFile(FFilePath);
tblobfield(FieldByName('ImgFile')).LoadFromStream(FJStream);
Post;
end;
ADOQueryCmd.Connection.CommitTrans;
FJStream.Free;
Result := True;
except
Result := false;
FJStream.Free;
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmReportImgSet.DownloadLabel();
var
ff: TADOBlobstream;
Stream: TMemoryStream;
begin
if FileExists(FFilePath) then
begin
DeleteFile(FFilePath);
end;
with ADOQueryLabel do
begin
close;
sql.Clear;
sql.Add(' select * from BS_Img_Label ');
sql.Add(' where DataId= ' + quotedstr(FDataId));
Open;
end;
if not ADOQueryLabel.IsEmpty then
begin
ff := TADOBlobstream.create(ADOQueryLabel.fieldByName('LabelFile') as TblobField, bmRead);
if ff <> nil then
begin
try
Stream := TMemoryStream.create;
ff.SaveToStream(Stream);
Stream.SaveToFile(FFilePath);
finally
Stream.Free;
end;
end;
end;
end;
procedure TfrmReportImgSet.InitLabel();
begin
with RMLabel do
begin
Clear;
LoadFromFile(FFilePath);
Preview := RMPreview1;
ShowReport;
end;
end;
procedure TfrmReportImgSet.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmReportImgSet.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := cafree;
end;
procedure TfrmReportImgSet.FormShow(Sender: TObject);
begin
inherited;
self.Caption := FLabelName;
with ADO_1 do
begin
close;
sql.Clear;
sql.Add(' select x=1');
Open;
end;
FFilePath := ExtractFilePath(Application.ExeName) + 'report\' + trim(FDataID) + '.rmf';
FFileName := trim(FDataID) + '.rmf';
if not FileExists(FFilePath) then
begin
ExportFtErpFile(FLabelName + '.rmf', ADOQueryTemp);
CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'Report\' + FLabelName + '.rmf'), PChar(FFilePath), False);
end;
DownloadLabel();
Initlabel();
end;
procedure TfrmReportImgSet.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmReportImgSet.TBSaveClick(Sender: TObject);
begin
if SaveData() then
begin
ModalResult := 1;
end
else
begin
Application.MessageBox('保存数据失败!', '提示', 0);
Exit;
end;
end;
procedure TfrmReportImgSet.ToolButton1Click(Sender: TObject);
begin
// with RMLabel do
// begin
// Clear;
// RMDB_Label.DataSet := nil;
// Dictionary.FieldAliases.Clear;
// Dictionary.FieldAliases['RMDB_Label'] := '标签数据';
// RMDB_Label.DataSet := ADO_1;
// LoadFromFile(FFilePath);
// application.ProcessMessages;
// RMLabel.DesignReport();
// end;
RMLabel.DesignReport();
InitLabel();
end;
procedure TfrmReportImgSet.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmReportImgSet.FormDestroy(Sender: TObject);
begin
inherited;
frmReportImgSet := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,305 @@
unit U_ReportImgSet1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, RM_Common,
RM_Preview, RM_Dataset, RM_Class, RM_GridReport, RM_e_Graphic, RM_e_Jpeg;
type
TfrmReportImgSet1 = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADO_1: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
RMPreview1: TRMPreview;
RMLabel: TRMGridReport;
RMDB_Label: TRMDBDataSet;
ADOQueryLabel: TADOQuery;
RMJPEGExport1: TRMJPEGExport;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
private
FFilePath, FFileName: string;
procedure DownloadLabel();
procedure InitLabel();
function SaveData(): Boolean;
{ Private declarations }
public
FDataID, FLabelName: string;
{ Public declarations }
end;
var
frmReportImgSet1: TfrmReportImgSet1;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
function TfrmReportImgSet1.SaveData(): Boolean;
var
MaxId, FImagePath1, FImagePath2: string;
FJStream: TMemoryStream;
begin
with RMLabel do
begin
// LoadFromBlobField(tblobfield(ADOQueryLabel.fieldbyname('Files')));
FImagePath1 := ExtractFilePath(Application.ExeName) + 'image\label0001.jpg';
if FileExists(FImagePath1) then
DeleteFile(FImagePath1);
FImagePath2 := ExtractFilePath(Application.ExeName) + 'image\label.jpg';
PrepareReport;
ExportTo(RMjpegExport1, FImagePath2);
end;
try
FJStream := TMemoryStream.Create;
FJStream.LoadFromFile(FImagePath1);
ADOQueryCmd.Connection.BeginTrans;
if Trim(FDataID) = '' then
begin
if GetLSNo(ADOQueryCmd, MaxId, 'R', 'BS_Img_Label', 4, 1) = False then
begin
raise Exception.Create('取最大号失败!');
end;
end
else
begin
MaxId := Trim(FDataID);
end;
with ADOQueryCmd do
begin
Close;
SQL.Clear;
sql.Add('select * from BS_Img_Label where LabelId=''' + Trim(FDataID) + '''');
Open;
end;
with ADOQueryCmd do
begin
if Trim(FDataID) = '' then
begin
Append;
FieldByName('Filler').Value := Trim(DName);
end
else
begin
Edit;
FieldByName('Editer').Value := Trim(DName);
FieldByName('Edittime').Value := SGetServerDateTime(ADOQueryTemp);
end;
FieldByName('LabelId').Value := Trim(MaxId);
FieldByName('DataID').Value := Trim(FDataID);
tblobfield(FieldByName('LabelFile')).LoadFromFile(FFilePath);
tblobfield(FieldByName('ImgFile')).LoadFromStream(FJStream);
Post;
end;
ADOQueryCmd.Connection.CommitTrans;
FJStream.Free;
Result := True;
except
Result := false;
FJStream.Free;
ADOQueryCmd.Connection.RollbackTrans;
application.MessageBox(PChar(Exception(ExceptObject).Message), '提示信息', 0);
end;
end;
procedure TfrmReportImgSet1.DownloadLabel();
var
ff: TADOBlobstream;
Stream: TMemoryStream;
begin
if FileExists(FFilePath) then
begin
DeleteFile(FFilePath);
end;
with ADOQueryLabel do
begin
close;
sql.Clear;
sql.Add(' select * from BS_Img_Label ');
sql.Add(' where DataId= ' + quotedstr(FDataId));
Open;
end;
if not ADOQueryLabel.IsEmpty then
begin
ff := TADOBlobstream.create(ADOQueryLabel.fieldByName('LabelFile') as TblobField, bmRead);
if ff <> nil then
begin
try
Stream := TMemoryStream.create;
ff.SaveToStream(Stream);
Stream.SaveToFile(FFilePath);
finally
Stream.Free;
end;
end;
end;
end;
procedure TfrmReportImgSet1.InitLabel();
begin
with RMLabel do
begin
Clear;
LoadFromFile(FFilePath);
Preview := RMPreview1;
ShowReport;
end;
end;
procedure TfrmReportImgSet1.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmReportImgSet1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := cafree;
end;
procedure TfrmReportImgSet1.FormShow(Sender: TObject);
begin
inherited;
self.Caption := FLabelName;
with ADO_1 do
begin
close;
sql.Clear;
sql.Add(' select x=1');
Open;
end;
FFilePath := ExtractFilePath(Application.ExeName) + 'report\' + trim(FDataID) + '.rmf';
FFileName := trim(FDataID) + '.rmf';
if not FileExists(FFilePath) then
begin
ExportFtErpFile(FLabelName + '.rmf', ADOQueryTemp);
CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'Report\' + FLabelName + '.rmf'), PChar(FFilePath), False);
end;
DownloadLabel();
Initlabel();
end;
procedure TfrmReportImgSet1.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmReportImgSet1.TBSaveClick(Sender: TObject);
begin
if SaveData() then
begin
ModalResult := 1;
end
else
begin
Application.MessageBox('保存数据失败!', '提示', 0);
Exit;
end;
end;
procedure TfrmReportImgSet1.ToolButton1Click(Sender: TObject);
begin
//
// MLabelID := TRIM(CDS_Label.fieldByName('LabelID').asString);
// MLabelCaption := TRIM(CDS_Label.fieldByName('LabelCaption').asString);
// ExportFtErpFile(MLabelCaption + '.rmf', ADOQueryTemp);
// fPrintFile := ExtractFilePath(Application.ExeName) + 'report\' + MLabelCaption + '.rmf';
//
// if not FileExists(fPrintFile) then
// CopyFile(PChar(ExtractFilePath(Application.ExeName) + 'Report\模板标签.rmf'), PChar(fPrintFile), False);
with RMLabel do
begin
RMLabel.Clear;
RMDB_Label.DataSet := nil;
Dictionary.FieldAliases.Clear;
Dictionary.FieldAliases['RMDB_Label'] := '标签数据';
// RMDB_Label.DataSet := ADO_1;
LoadFromFile(FFilePath);
application.ProcessMessages;
DesignReport();
end;
InitLabel();
end;
procedure TfrmReportImgSet1.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmReportImgSet1.FormDestroy(Sender: TObject);
begin
inherited;
frmReportImgSet1 := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,216 @@
unit U_SalesContractSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxDropDownEdit, cxCheckBox, Vcl.Menus;
type
TfrmSalesContractSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
ConNo: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxStyleRepository1: TcxStyleRepository;
cxStyle1: TcxStyle;
cxGrid1: TcxGrid;
TV1: TcxGridDBTableView;
VC_SCSCode: TcxGridDBColumn;
cxGridDBColumn2: TcxGridDBColumn;
cxGridDBColumn3: TcxGridDBColumn;
v1Column5: TcxGridDBColumn;
cxGridDBColumn4: TcxGridDBColumn;
cxGridDBColumn5: TcxGridDBColumn;
cxGridDBColumn6: TcxGridDBColumn;
cxGridDBColumn7: TcxGridDBColumn;
cxGridDBColumn8: TcxGridDBColumn;
v1Column6: TcxGridDBColumn;
v1Column7: TcxGridDBColumn;
v1PRTOrderQty: TcxGridDBColumn;
v1OrderUnit: TcxGridDBColumn;
v1Column2: TcxGridDBColumn;
cxGridLevel1: TcxGridLevel;
TV1Column1: TcxGridDBColumn;
TV1Column2: TcxGridDBColumn;
TV1Column3: TcxGridDBColumn;
TV1Column4: TcxGridDBColumn;
TV1Column5: TcxGridDBColumn;
TV1Column6: TcxGridDBColumn;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
TV1Column7: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Label2: TLabel;
C_Name: TEdit;
Label3: TLabel;
BuyName: TEdit;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure ConNoChange(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FCoType, FAuthority: string;
{ Public declarations }
end;
var
frmSalesContractSel: TfrmSalesContractSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmSalesContractSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmSalesContractSel.ConNoChange(Sender: TObject);
begin
if ADOQueryMain.Active = False then
Exit;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
procedure TfrmSalesContractSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ConNo.SetFocus;
Action := cahide;
end;
procedure TfrmSalesContractSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add('select A.*,B.* from BS_Contract_Main A inner join BS_Contract_Sub B on A.ConMId=B.ConMId ');
sql.Add(' and isnull(A.status,''0'')=''9''');
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmSalesContractSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, True);
end;
procedure TfrmSalesContractSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmSalesContractSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid(Trim(self.Caption), TV1, '自定义数据');
end;
procedure TfrmSalesContractSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmSalesContractSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(Trim(self.Caption), TV1, '自定义数据');
end;
procedure TfrmSalesContractSel.ToolButton1Click(Sender: TObject);
begin
ConNo.SetFocus;
ModalResult := 1;
end;
procedure TfrmSalesContractSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmSalesContractSel.FormDestroy(Sender: TObject);
begin
inherited;
frmSalesContractSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,304 @@
unit U_TatClothInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxTL,
cxMaskEdit, cxTLdxBarBuiltInMenu, cxCheckBox, cxInplaceContainer, cxDBTL,
cxTLData, math;
type
TfrmTatClothInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxDBTreeList1: TcxDBTreeList;
cxDBTreeList1cxDBTreeListColumn2: TcxDBTreeListColumn;
DS_Tree: TDataSource;
CDS_Tree: TClientDataSet;
ADOQueryTree: TADOQuery;
Panel3: TPanel;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SSel: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
v1CYNo: TcxGridDBColumn;
v1Column9: TcxGridDBColumn;
Tv1Column11: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
Tv1Column1: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
Panel7: TPanel;
Panel4: TPanel;
Label14: TLabel;
LBCPAP1: TLabel;
Button1: TButton;
Button2: TButton;
TCBNOR1: TComboBox;
Panel1: TPanel;
Label3: TLabel;
Label4: TLabel;
Label9: TLabel;
Label8: TLabel;
C_Code: TEdit;
C_Name: TEdit;
C_GramWeight: TEdit;
C_Width: TEdit;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
Tv1Column3: TcxGridDBColumn;
Tv1Column4: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TCBNOR1Change(Sender: TObject);
procedure C_NameChange(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure cxDBTreeList1DblClick(Sender: TObject);
private
CurrentPage, RecordsNumber: Integer;
procedure InitGrid();
procedure InitTree();
{ Private declarations }
public
FCoType: string;
{ Public declarations }
end;
var
frmTatClothInfoSel: TfrmTatClothInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmTatClothInfoSel.InitTree();
var
i: Integer;
begin
with ADOQueryTree do
begin
Close;
SQL.Clear;
SQL.Add('select * from BS_Cloth_Type where CTType=''梭织'' ');
Open;
end;
SCreateCDS(ADOQueryTree, CDS_Tree);
SInitCDSData(ADOQueryTree, CDS_Tree);
cxDBTreeList1.Items[0].Expand(false);
end;
procedure TfrmTatClothInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
{if Application.MessageBox('网络连接失败,是否要再次连接?','提示',32+4)=IDYES then
begin
try
with ADOConnection1 do
begin
Connected:=false;
ConnectionString:=DConString;
//ConnectionString:='23242';
Connected:=true;
end;
except
end;
end; }
//frmZDYHelp.Free;
end;
end;
procedure TfrmTatClothInfoSel.Button1Click(Sender: TObject);
begin
if CurrentPage > 1 then
CurrentPage := CurrentPage - 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.Button2Click(Sender: TObject);
begin
if CurrentPage < CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber then
CurrentPage := CurrentPage + 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.cxDBTreeList1DblClick(Sender: TObject);
begin
CurrentPage := 1;
InitGrid();
end;
procedure TfrmTatClothInfoSel.C_NameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmTatClothInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
C_Code.SetFocus;
Action := cahide;
end;
procedure TfrmTatClothInfoSel.InitGrid();
var
fwhere, MBCIID, Pwhere: string;
begin
if not CDS_1.IsEmpty then
MBCIID := Trim(CDS_1.FieldByName('BCIID').AsString)
else
MBCIID := '';
Pwhere := SGetFilters(Panel1, 1, 2);
if trim(Pwhere) <> '' then
begin
if fwhere <> '' then
fwhere := fwhere + ' and ' + trim(Pwhere)
else
fwhere := ' where ' + trim(Pwhere);
end;
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
Filtered := False;
sql.Clear;
sql.Add(' exec P_BS_CloInfo_Get ');
sql.Add(' @CTID=' + quotedstr(Trim(CDS_Tree.fieldbyname('CTID').AsString)));
sql.Add(',@pageIndex=' + inttostr(CurrentPage));
sql.Add(',@pageSize=' + inttostr(RecordsNumber));
sql.Add(',@criteria= ' + quotedstr(fwhere));
// ShowMessage(sql.Text);
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
TV1.DataController.Filter.Clear;
LBCPAP1.Caption := inttostr(CurrentPage) + '/' + inttostr(ceil(CDS_1.FieldByName('TotalCount').AsInteger / RecordsNumber));
finally
ADOQueryMain.EnableControls;
TV1.DataController.Filter.Clear;
end;
if MBCIID <> '' then
CDS_1.Locate('BCIID', MBCIID, []);
end;
procedure TfrmTatClothInfoSel.FormShow(Sender: TObject);
begin
inherited;
RecordsNumber := 500;
CurrentPage := 1;
ReadCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
InitTree();
InitGrid();
end;
procedure TfrmTatClothInfoSel.TBCloseClick(Sender: TObject);
begin
Close;
;
end;
procedure TfrmTatClothInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FCoType), TV1, '自定义数据');
end;
procedure TfrmTatClothInfoSel.TCBNOR1Change(Sender: TObject);
begin
RecordsNumber := StrToInt(TCBNOR1.Text);
CurrentPage := 1;
C_Code.SetFocus;
InitGrid();
end;
procedure TfrmTatClothInfoSel.ToolButton1Click(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmTatClothInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmTatClothInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmTatClothInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,199 @@
unit U_UserSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxGraphics, cxCustomData, cxStyles, cxTL, cxMaskEdit, DB, ADODB,
cxInplaceContainer, cxDBTL, cxControls, cxTLData, ComCtrls, ToolWin, StdCtrls,
cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, DBClient,
cxGridCustomTableView, cxGridTableView, cxGridDBTableView, ExtCtrls,
cxSplitter, cxGridLevel, cxClasses, cxGridCustomView, cxGrid,
cxGridCustomPopupMenu, cxGridPopupMenu, RM_Dataset, RM_System, RM_Common,
RM_Class, RM_GridReport, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, ShellAPI, IniFiles, cxCheckBox, cxCalendar, cxButtonEdit,
cxTextEdit, cxDBLookupComboBox, ComObj, cxLookAndFeels, cxLookAndFeelPainters,
dxSkinsCore, dxSkinsDefaultPainters, cxNavigator, dxDateRanges, U_BaseHelp,
dxBarBuiltInMenu, System.ImageList, Vcl.ImgList;
type
FdDy = record
inc: integer; //客户端套接字句柄
FDdys: string[32]; //客户端套接字
FdDysName: string[32]; //客户端套接字
end;
TfrmUserSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
TBRafresh: TToolButton;
TBClose: TToolButton;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
Panel1: TPanel;
ToolButton2: TToolButton;
ADOQueryMain: TADOQuery;
Label3: TLabel;
UserName: TEdit;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
cxGridLevel1: TcxGridLevel;
cxGridPopupMenu2: TcxGridPopupMenu;
DS_1: TDataSource;
CDS_1: TClientDataSet;
Label1: TLabel;
UserID: TEdit;
btnOK: TToolButton;
v2Column1: TcxGridDBColumn;
v2Column2: TcxGridDBColumn;
v2Column3: TcxGridDBColumn;
VC_SSel: TcxGridDBColumn;
ADOConnection1: TADOConnection;
ImageList1: TImageList;
procedure FormDestroy(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure TBCloseClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TBRafreshClick(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure UserNameChange(Sender: TObject);
procedure btnOKClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Tv1DblClick(Sender: TObject);
private
{ Private declarations }
procedure InitGrid();
public
Fdept: string;
FMultiple: Boolean;
end;
var
frmUserSel: TfrmUserSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmUserSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Filtered := False;
Close;
SQL.Clear;
sql.Add(' select * from SY_User where 1=1 ');
if Trim(Fdept) <> '' then
begin
sql.Add('and Udept=' + QuotedStr(Trim(Fdept)));
end;
Open;
end;
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmUserSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmUserSel.FormDestroy(Sender: TObject);
begin
inherited;
frmUserSel := nil;
end;
procedure TfrmUserSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
inherited;
Action := caFree;
end;
procedure TfrmUserSel.TBCloseClick(Sender: TObject);
begin
WriteCxGrid(trim(self.caption), Tv1, '账户选择');
Close;
end;
procedure TfrmUserSel.FormShow(Sender: TObject);
begin
inherited;
ReadCxGrid(trim(self.Caption), Tv1, '账户选择');
if FMultiple then
begin
VC_SSel.Visible := True;
VC_SSel.Hidden := False;
end
else
begin
VC_SSel.Visible := False;
VC_SSel.Hidden := True;
end;
InitGrid();
end;
procedure TfrmUserSel.TBRafreshClick(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmUserSel.ToolButton2Click(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmUserSel.Tv1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmUserSel.UserNameChange(Sender: TObject);
begin
ToolButton2.Click;
end;
procedure TfrmUserSel.btnOKClick(Sender: TObject);
begin
if FMultiple then
begin
if not CDS_1.Locate('SSel', true, []) then
begin
Application.MessageBox('请选择数据!', '提示', 0);
Exit;
end;
end;
ModalResult := 1;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,201 @@
unit U_WBSpecSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxCheckBox, Vcl.Menus;
type
TfrmWBSpecSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
WB_Spec: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column2: TcxGridDBColumn;
v1Column18: TcxGridDBColumn;
v1Column15: TcxGridDBColumn;
v1SPSpec: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
Tv1Column1: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure WB_SpecChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName, FAuthority, FYType: string;
{ Public declarations }
end;
var
frmWBSpecSel: TfrmWBSpecSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmWBSpecSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmWBSpecSel.WB_SpecChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmWBSpecSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
WB_Spec.SetFocus;
Action := cahide;
end;
procedure TfrmWBSpecSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(' from Tat_WB_Spec A');
// if Trim(FYType) <> '' then
// sql.Add(' where Y_Type=' + QuotedStr(FYType));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmWBSpecSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, true);
end;
procedure TfrmWBSpecSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmWBSpecSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FSTKName), TV1, '自定义数据');
end;
procedure TfrmWBSpecSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmWBSpecSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FSTKName), TV1, '自定义数据');
end;
procedure TfrmWBSpecSel.ToolButton1Click(Sender: TObject);
begin
WB_Spec.SetFocus;
ModalResult := 1;
end;
procedure TfrmWBSpecSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmWBSpecSel.FormDestroy(Sender: TObject);
begin
inherited;
frmWBSpecSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,202 @@
unit U_YarnInfoSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxCheckBox, Vcl.Menus;
type
TfrmYarnInfoSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
Y_Name: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1Column2: TcxGridDBColumn;
v1Column18: TcxGridDBColumn;
v1Column15: TcxGridDBColumn;
v1SPName: TcxGridDBColumn;
v1SPSpec: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1QtyUnit: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column3: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure Y_NameChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName, FAuthority, FYType: string;
{ Public declarations }
end;
var
frmYarnInfoSel: TfrmYarnInfoSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmYarnInfoSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
end;
procedure TfrmYarnInfoSel.Y_NameChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmYarnInfoSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Y_Name.SetFocus;
Action := cahide;
end;
procedure TfrmYarnInfoSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.* ');
sql.Add(' from BS_Yarn_Info A');
if Trim(FYType) <> '' then
sql.Add(' where Y_Type=' + QuotedStr(FYType));
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmYarnInfoSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, true);
end;
procedure TfrmYarnInfoSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmYarnInfoSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid('单位名称' + Trim(FSTKName), TV1, '自定义数据');
end;
procedure TfrmYarnInfoSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmYarnInfoSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid('单位名称' + Trim(FSTKName), TV1, '自定义数据');
end;
procedure TfrmYarnInfoSel.ToolButton1Click(Sender: TObject);
begin
Y_Name.SetFocus;
ModalResult := 1;
end;
procedure TfrmYarnInfoSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmYarnInfoSel.FormDestroy(Sender: TObject);
begin
inherited;
frmYarnInfoSel := nil;
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -0,0 +1,249 @@
unit U_YarnPurchasePlanSel;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage,
cxEdit, DB, cxDBData, ToolWin, ComCtrls, U_BaseHelp, cxGridCustomTableView,
cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls,
cxGridCustomView, cxGrid, DBClient, ADODB, ImgList, StdCtrls, ExtCtrls,
cxTextEdit, cxGridCustomPopupMenu, cxGridPopupMenu, cxLookAndFeels,
cxLookAndFeelPainters, dxSkinsCore, dxSkinsDefaultPainters, cxNavigator,
dxDateRanges, dxBarBuiltInMenu, System.ImageList, U_BaseInput, cxButtonEdit,
cxCheckBox, Vcl.Menus, cxCalendar, cxPC;
type
TfrmYarnPurchasePlanSel = class(TfrmBaseHelp)
ToolBar1: TToolBar;
ADOQueryMain: TADOQuery;
ADOQueryTemp: TADOQuery;
ADOQueryCmd: TADOQuery;
DS_1: TDataSource;
CDS_1: TClientDataSet;
TBSave: TToolButton;
TBClose: TToolButton;
ToolButton1: TToolButton;
ADOConnection1: TADOConnection;
Panel1: TPanel;
Label1: TLabel;
Y_Spec: TEdit;
GPM_1: TcxGridPopupMenu;
ImageList1: TImageList;
cxGrid1: TcxGrid;
Tv1: TcxGridDBTableView;
v1SPName: TcxGridDBColumn;
v1SPSpec: TcxGridDBColumn;
v1Column1: TcxGridDBColumn;
v1QtyUnit: TcxGridDBColumn;
v1Column10: TcxGridDBColumn;
v1Column12: TcxGridDBColumn;
cxGrid1Level1: TcxGridLevel;
ThreeColorBase: TcxStyleRepository;
SHuangSe: TcxStyle;
SkyBlue: TcxStyle;
Default: TcxStyle;
QHuangSe: TcxStyle;
Red: TcxStyle;
FontBlue: TcxStyle;
TextSHuangSe: TcxStyle;
FonePurple: TcxStyle;
FoneClMaroon: TcxStyle;
FoneRed: TcxStyle;
RowColor: TcxStyle;
handBlack: TcxStyle;
cxBlue: TcxStyle;
SHuangSeCu: TcxStyle;
Tv1Column1: TcxGridDBColumn;
Tv1Column2: TcxGridDBColumn;
PM_1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
Tv1Column4: TcxGridDBColumn;
Tv1Column6: TcxGridDBColumn;
Tv1Column8: TcxGridDBColumn;
Tv1Column3: TcxGridDBColumn;
Tv1Column5: TcxGridDBColumn;
Tv1Column7: TcxGridDBColumn;
Tv1Column9: TcxGridDBColumn;
Label2: TLabel;
Y_Name: TEdit;
Label3: TLabel;
SellName: TEdit;
Label4: TLabel;
PurNo: TEdit;
Label5: TLabel;
BegDate: TDateTimePicker;
EndDate: TDateTimePicker;
IsJYTime: TCheckBox;
Tv1Column10: TcxGridDBColumn;
cxTabControl1: TcxTabControl;
ToolButton2: TToolButton;
Tv1Column11: TcxGridDBColumn;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure TBSaveClick(Sender: TObject);
procedure TV1DblClick(Sender: TObject);
procedure TBCloseClick(Sender: TObject);
procedure Y_SpecChange(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure cxTabControl1Change(Sender: TObject);
private
procedure InitGrid();
{ Private declarations }
public
FSTKName, FAuthority: string;
{ Public declarations }
end;
var
frmYarnPurchasePlanSel: TfrmYarnPurchasePlanSel;
implementation
uses
U_DataLink, U_RTFun;
{$R *.dfm}
procedure TfrmYarnPurchasePlanSel.FormCreate(Sender: TObject);
begin
inherited;
try
with ADOConnection1 do
begin
Connected := false;
ConnectionString := DConString;
Connected := true;
end;
ADOQueryBaseCmd.Connection := ADOConnection1;
ADOQueryBaseTemp.Connection := ADOConnection1;
except
application.MessageBox('网络连接失败!', '提示信息');
end;
EndDate.DateTime := SGetServerDate(ADOQueryTemp);
BegDate.DateTime := EndDate.DateTime - 90;
end;
procedure TfrmYarnPurchasePlanSel.Y_SpecChange(Sender: TObject);
begin
if ADOQueryMain.Active then
begin
SDofilter(ADOQueryMain, SGetFilters(Panel1, 1, 2));
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
end;
end;
procedure TfrmYarnPurchasePlanSel.cxTabControl1Change(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmYarnPurchasePlanSel.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Y_Name.SetFocus;
Action := cahide;
end;
procedure TfrmYarnPurchasePlanSel.InitGrid();
begin
try
ADOQueryMain.DisableControls;
with ADOQueryMain do
begin
Close;
sql.Clear;
sql.Add(' select A.*,B.* ');
sql.Add(' from Pur_YarnPlan_Main A');
sql.Add(' inner join Pur_YarnPlan_sub B on A.PurMId=B.PurMId');
sql.Add(' where isnull(A.status,''0'')=''9''');
sql.add(' and A.PurDate>=''' + Trim(FormatDateTime('yyyy-MM-dd', BegDate.DateTime)) + '''');
sql.Add(' and A.PurDate<''' + Trim(FormatDateTime('yyyy-MM-dd', enddate.DateTime + 1)) + '''');
case cxTabControl1.TabIndex of
0:
begin
sql.Add(' and not EXISTS (select X.FromSubID from BS_Yarn_IO X where X.FromSubID=B.PurSId) ');
end;
1:
begin
sql.Add(' and EXISTS (select X.FromSubID from BS_Yarn_IO X where X.FromSubID=B.PurSId) ');
end;
end;
// ShowMessage(sql.Text);
Open;
end;
SCreateCDS(ADOQueryMain, CDS_1);
SInitCDSData(ADOQueryMain, CDS_1);
finally
ADOQueryMain.EnableControls;
end;
end;
procedure TfrmYarnPurchasePlanSel.N1Click(Sender: TObject);
begin
SelOKNo(CDS_1, true);
end;
procedure TfrmYarnPurchasePlanSel.N2Click(Sender: TObject);
begin
SelOKNo(CDS_1, False);
end;
procedure TfrmYarnPurchasePlanSel.FormShow(Sender: TObject);
begin
inherited;
InitGrid();
ReadCxGrid(self.Caption, TV1, '自定义数据');
end;
procedure TfrmYarnPurchasePlanSel.TBCloseClick(Sender: TObject);
begin
inherited;
Close;
end;
procedure TfrmYarnPurchasePlanSel.TBSaveClick(Sender: TObject);
begin
WriteCxGrid(self.Caption, TV1, '自定义数据');
end;
procedure TfrmYarnPurchasePlanSel.ToolButton1Click(Sender: TObject);
begin
Y_Name.SetFocus;
ModalResult := 1;
end;
procedure TfrmYarnPurchasePlanSel.ToolButton2Click(Sender: TObject);
begin
InitGrid();
end;
procedure TfrmYarnPurchasePlanSel.TV1DblClick(Sender: TObject);
begin
ModalResult := 1;
end;
procedure TfrmYarnPurchasePlanSel.FormDestroy(Sender: TObject);
begin
inherited;
frmYarnPurchasePlanSel := nil;
end;
end.

144
A00通用窗体/getpic.dfm Normal file
View File

@ -0,0 +1,144 @@
object FormGetPic: TFormGetPic
Left = 697
Top = 183
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = #33719#21462#22270#29255
ClientHeight = 449
ClientWidth = 670
Color = clBtnFace
Font.Charset = GB2312_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = #23435#20307
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 12
object Image2: TImage
Left = 464
Top = 8
Width = 160
Height = 120
end
object SpeedButton1: TSpeedButton
Left = 500
Top = 334
Width = 80
Height = 22
Caption = #25171#24320#22270#29255'...'
OnClick = SpeedButton1Click
end
object SpeedButton2: TSpeedButton
Left = 500
Top = 380
Width = 80
Height = 22
Caption = #30830#23450
Enabled = False
OnClick = SpeedButton2Click
end
object SpeedButton3: TSpeedButton
Left = 500
Top = 426
Width = 80
Height = 22
Caption = #25918#24323
OnClick = SpeedButton3Click
end
object SpeedButton4: TSpeedButton
Left = 500
Top = 358
Width = 80
Height = 22
Caption = #22270#29255#21478#23384'...'
OnClick = SpeedButton4Click
end
object SpeedButton5: TSpeedButton
Left = 500
Top = 404
Width = 80
Height = 22
Caption = #21024#38500
OnClick = SpeedButton5Click
end
object ScrollBox1: TScrollBox
Left = 5
Top = 5
Width = 300
Height = 400
HorzScrollBar.Visible = False
VertScrollBar.Visible = False
TabOrder = 0
object Image1: TImage
Left = 0
Top = 0
Width = 296
Height = 396
Cursor = crSizeAll
Align = alClient
Center = True
IncrementalDisplay = True
Stretch = True
OnMouseDown = Image1MouseDown
OnMouseMove = Image1MouseMove
ExplicitLeft = -2
ExplicitTop = 3
ExplicitWidth = 275
ExplicitHeight = 436
end
end
object Button1: TButton
Left = 464
Top = 252
Width = 81
Height = 21
Caption = #25171#24320#25668#20687#22836
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
Left = 560
Top = 252
Width = 81
Height = 21
Caption = #25235#22270
TabOrder = 2
OnClick = Button2Click
end
object OpenPictureDialog1: TOpenPictureDialog
Left = 336
Top = 176
end
object ADOQuery1: TADOQuery
Connection = DataLink_YPGL.ADOLink
Parameters = <>
Left = 504
Top = 280
end
object SaveDialog1: TSavePictureDialog
Left = 344
Top = 251
end
object adoqueryImage: TADOQuery
Connection = DataLink_YPGL.ADOLink
Parameters = <>
Left = 488
Top = 184
end
object IdFTP1: TIdFTP
ConnectTimeout = 0
NATKeepAlive.UseKeepAlive = False
NATKeepAlive.IdleTimeMS = 0
NATKeepAlive.IntervalMS = 0
ProxySettings.ProxyType = fpcmNone
ProxySettings.Port = 0
ReadTimeout = 0
Left = 492
Top = 134
end
end

669
A00通用窗体/getpic.pas Normal file
View File

@ -0,0 +1,669 @@
unit getpic;
interface
uses
Windows, Messages, SysUtils, strUtils, Variants, Classes, Graphics, Controls,
Forms, Dialogs, ComCtrls, ToolWin, ExtCtrls, jpeg, IniFiles, ExtDlgs, Buttons,
StdCtrls, DB, ADODB, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdFTP, IdExplicitTLSClientServerBase;
type
TFormGetPic = class(TForm)
ScrollBox1: TScrollBox;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
Image2: TImage;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
Button1: TButton;
Button2: TButton;
ADOQuery1: TADOQuery;
SpeedButton4: TSpeedButton;
SaveDialog1: TSavePictureDialog;
adoqueryImage: TADOQuery;
IdFTP1: TIdFTP;
SpeedButton5: TSpeedButton;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
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 SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure Initimage();
procedure SpeedButton5Click(Sender: TObject);
private
hWndC: THandle;
CapturingAVI: bool;
{ Private declarations }
ClickPos: TPoint;
SelectedSource, PicLeft, PicTop, PicWidth, PicHeight: Integer;
procedure CreThumb(Width, Height: Integer);
function SaveImage(): Boolean;
procedure Rotate90(Source: TGraphic; Target: TJpegImage);
public
FilePath: string;
FileName: string;
FTFType: string;
pat1: string;
pic1: string;
fkeyNo, FMainId: string;
fFlileFlag: string;
FWidth, FHeight: INTEGER;
{ Public declarations }
MyJpeg: TJPEGImage;
// JPStream: TMemoryStream;
end;
var
FormGetPic: TFormGetPic;
implementation
uses
U_DataLink, U_RTFun;
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.Rotate90(Source: TGraphic; Target: TJpegImage);
var
SourceBmp, TargetBmp: TBitmap;
r, c: Integer;
x, y: Integer;
begin
SourceBmp := TBitmap.Create;
SourceBmp.Assign(Source);
TargetBmp := TBitmap.Create;
TargetBmp.Width := SourceBmp.Height;
TargetBmp.Height := SourceBmp.Width;
for r := 0 to SourceBmp.Height - 1 do
begin
for c := 0 to SourceBmp.Width - 1 do
begin
//x := (SourceBmp.Height-1) - r; // -90
//y := c; //-90
x := r; //90
y := (SourceBmp.Width - 1) - c; //90
// look into Bitmap.ScanLine for faster pixel access
TargetBmp.Canvas.Pixels[x, y] := SourceBmp.Canvas.Pixels[c, r];
end;
end;
Target.Assign(TargetBmp);
SourceBmp.Free;
TargetBmp.Free;
end;
procedure TFormGetPic.Initimage();
var
jpg: TJpegImage;
myStream: TADOBlobStream;
sFieldName: string;
JPStream: TMemoryStream;
begin
jpg := TJpegImage.Create();
JPStream := TMemoryStream.Create;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FMainId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if not IsEmpty then
begin
if not fieldbyname(pic1).IsNull then
begin
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;
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);
end;
end;
end;
finally
jpg.free;
JPStream.Free;
end;
end;
function TFormGetPic.SaveImage(): Boolean;
var
myStream: TADOBlobStream;
maxNo: string;
fNewFileName: string;
begin
//取文件后缀 ExtractFileExt(FilePath)
if fkeyNO = '' then
begin
fNewFileName := formatdatetime('yyyyMMddhhnnsszzz', now()) + ExtractFileExt(FilePath);
fkeyNO := fNewFileName;
end;
result := false;
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(FMainId)));
sql.Add('and TFType=' + quotedstr(trim(FTFType)));
open;
if RecordCount <= 0 then
begin
Append;
if GetLSNo(ADOQuery1, maxNo, 'FJ', 'TP_File', 4, 1) = False then
begin
Application.MessageBox('取最大号失败!', '提示', 0);
Exit;
end;
fieldByName('TFID').AsString := maxNo;
fieldByName('WBID').AsString := FMainId;
end
else
begin
edit;
end;
fieldByName(pat1).AsString := trim(fkeyNO);
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);
myStream.Free;
Post;
end;
if FilePath <> '' then
begin
try
IdFTP1.Host := ReadINIFileStr('SYSTEMSET.INI', 'SERVER', '服务器地址', '127.0.0.1');
IdFTP1.Username := 'three';
IdFTP1.Password := '641010';
IdFTP1.Connect();
// IdFTP1.Delete(fFlileFlag + '\' + Trim(fNewFileName));
IdFTP1.Put(FilePath, fFlileFlag + '\' + Trim(fkeyNO));
IdFTP1.Quit;
except
IdFTP1.Quit;
Application.MessageBox('上传客户图样文件失败,请检查文件服务器!', '提示', MB_ICONWARNING);
end;
end;
IdFTP1.Quit;
result := true;
except
myStream.Free;
end;
end;
procedure TFormGetPic.ToolButton1Click(Sender: TObject);
var
Ini: TIniFile;
begin
// if Twain.LoadLibrary then
// begin
// {Load source manager}
// Twain.SourceManagerLoaded := TRUE;
// {Allow user to select source}
// SelectedSource := Twain.SelectSource;
// if SelectedSource <> -1 then
// begin
// Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
// try
// Ini.WriteInteger( 'SCANNER', 'Scanner', SelectedSource);
// finally
// Ini.Free;
// end;
// end {if SelectedSource <> -1}
// end
// else
// ShowMessage('未安装扫描仪');
end;
procedure TFormGetPic.ToolButton3Click(Sender: TObject);
begin
// if Twain.LoadLibrary then
// begin
// {Load source manager}
// Twain.SourceManagerLoaded := TRUE;
//
// if SelectedSource <> -1 then
// begin
// {Load source, select transference method and enable (display interface)}
// Twain.Source[SelectedSource].Loaded := TRUE;
// Twain.Source[SelectedSource].SetICapUnits(tuInches);
// Twain.Source[SelectedSource].SetImagelayoutFrame(PicLeft/25.4, PicTop/25.4, (PicLeft+PicWidth)/25.4, (PicTop+PicHeight)/25.4);
// Twain.Source[SelectedSource].SetIYResolution(200);
// Twain.Source[SelectedSource].SetIXResolution(200);
// Twain.Source[SelectedSource].TransferMode := ttmMemory;
// Twain.Source[SelectedSource].EnableSource(FALSE, TRUE);
// while Twain.Source[SelectedSource].Enabled do Application.ProcessMessages;
// end; {if SelectedSource <> -1}
//// Twain.UnloadLibrary;
// end
// else
// ShowMessage('未安装扫描仪');
end;
procedure TFormGetPic.TwainTwainAcquire(Sender: TObject; const Index: Integer; Image: TBitmap; var Cancel: Boolean);
begin
Image1.Picture.Assign(Image);
Cancel := TRUE;
CreThumb(150, 150);
SpeedButton2.Enabled := TRUE;
end;
procedure TFormGetPic.FormShow(Sender: TObject);
var
Ini: TIniFile;
begin
{ Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
try
SelectedSource := Ini.ReadInteger( 'SCANNER', 'Scanner', 0);
PicLeft := Ini.ReadInteger( 'SCANNER', 'Left', 0);
PicTop := Ini.ReadInteger( 'SCANNER', 'Top', 0);
PicWidth := Ini.ReadInteger( 'SCANNER', 'Width', 100);
PicHeight := Ini.ReadInteger( 'SCANNER', 'Height', 100);
finally
Ini.Free;
end; }
Initimage();
end;
{
procedure TFormGetPic.ToolButton6Click(Sender: TObject);
var
Ini: TIniFile;
begin
FormGetPos := TFormGetPos.Create(Self);
FormGetPos.SpinEdit1.Value := PicLeft;
FormGetPos.SpinEdit2.Value := PicTop;
FormGetPos.SpinEdit3.Value := PicWidth;
FormGetPos.SpinEdit4.Value := PicHeight;
if FormGetPos.ShowModal = 1 then
begin
PicLeft := FormGetPos.SpinEdit1.Value;
PicTop := FormGetPos.SpinEdit2.Value;
PicWidth := FormGetPos.SpinEdit3.Value;
PicHeight := FormGetPos.SpinEdit4.Value;
Ini := TIniFile.Create(ExtractFilePath(ParamStr(0)) + 'scanner.ini');
try
Ini.WriteInteger( 'SCANNER', 'Left', PicLeft);
Ini.WriteInteger( 'SCANNER', 'Top', PicTop);
Ini.WriteInteger( 'SCANNER', 'Width', PicWidth);
Ini.WriteInteger( 'SCANNER', 'Height', PicHeight);
finally
Ini.Free;
end;
end;
FormGetPos.Free;
end;
}
procedure TFormGetPic.CreThumb(Width, Height: Integer);
var
Bitmap: TBitmap;
Ratio: Double;
ARect: TRect;
AHeight, AHeightOffset: Integer;
AWidth, AWidthOffset: Integer;
begin
Bitmap := TBitmap.Create;
try
Ratio := Image1.Picture.Graphic.Width / Image1.Picture.Graphic.Height;
if Ratio > 0.75 then
begin
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;
AHeight := Height;
AHeightOffset := 0;
end;
Bitmap.Width := Width;
Bitmap.Height := Height;
Bitmap.Canvas.Brush.Color := clBtnFace;
Bitmap.Canvas.FillRect(Rect(0, 0, Width, Height));
// StretchDraw original image
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);
// MyJpeg1.Assign(Image2.Picture.Graphic);
finally
Bitmap.Free;
end;
end;
procedure TFormGetPic.FormCreate(Sender: TObject);
begin
MyJpeg := TJpegImage.Create;
// MyJpeg1 := TJpegImage.Create;
Button2.Enabled := false;
if FWidth = 0 then
FWidth := 197;
if FHeight = 0 then
FHeight := 110;
end;
procedure TFormGetPic.FormDestroy(Sender: TObject);
begin
// MyJpeg1.Free;
MyJpeg.Free;
end;
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);
var
NewPos: TPoint;
begin
{The left button was pressed}
if ssLeft in Shift then
begin
{Calculate new position}
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;
Image1.Top := NewPos.Y;
Image1.Left := NewPos.X;
end {if ssLeft in Shift}
end;
procedure TFormGetPic.SpeedButton1Click(Sender: TObject);
var
Jpeg: TJPEGImage;
begin
if OpenPictureDialog1.Execute then
begin
Image1.Top := 0;
Image1.Left := 0;
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
FilePath := OpenPictureDialog1.FileName;
FileName := ExtractFileName(FilePath);
// Jpeg := TJPEGImage.Create;
// Rotate90(Image1.Picture.Graphic, Jpeg);
// Image1.Picture.Assign(Jpeg);
// Jpeg.Free;
CreThumb(FWidth, FHeight);
SpeedButton2.Enabled := TRUE;
end;
end;
procedure TFormGetPic.SpeedButton2Click(Sender: TObject);
begin
if SaveImage() then
begin
ModalResult := 1;
end
else
begin
application.MessageBox('数据保存失败!', '提示信息', 0)
end;
// JPStream := TMemoryStream.Create;
// MyJPeg.Assign(Image1.Picture.Graphic);
// MyJPeg.SaveToStream(JPStream);
end;
procedure TFormGetPic.SpeedButton3Click(Sender: TObject);
begin
ModalResult := 2;
end;
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);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
//SendMessage(hWndC, WM_CAP_SEQUENCE_NOFILE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
Button1.Enabled := false;
Button2.Enabled := true;
end
else
begin
application.MessageBox('连接摄像头失败!', '错误信息', MB_ICONERROR);
end;
except
end;
application.ProcessMessages;
end;
procedure TFormGetPic.Button2Click(Sender: TObject);
var
sFieldName: string;
MBMP: TBitmap;
MJPG: TJpegImage;
begin
sFieldName := 'D:\抓图';
if not DirectoryExists(pchar(sFieldName)) then
CreateDirectory(pchar(sFieldName), nil);
sFieldName := sFieldName + '\' + formatdateTime('yyyyMMddhhnnss', SGetServerDateTime(ADOQuery1));
FileName := ExtractFileName(sFieldName);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(pchar(sFieldName + '.BMP')));
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
application.ProcessMessages;
Button1.Enabled := true;
Button2.Enabled := false;
try
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'));
CreThumb(240, 180);
finally
MBMP.Free;
MJPG.Free;
if Fileexists(pchar(sFieldName + '.BMP')) then
DeleteFile(pchar(sFieldName + '.BMP'));
FilePath := sFieldName + '.JPG';
FileName := ExtractFileName(FilePath);
end;
SpeedButton2.Enabled := true;
end;
end;
procedure TFormGetPic.SpeedButton4Click(Sender: TObject);
var
MJPG: TJpegImage;
pathFile: string;
begin
if Image1.Picture.Graphic = nil then
exit;
MJPG := TJpegImage.Create;
try
SaveDialog1.FileName := FileName;
if SaveDialog1.Execute then
begin
if SaveDialog1.FileName <> '' then
begin
pathFile := trim(SaveDialog1.FileName);
if (RightStr(UPPERCASE(pathFile), 4) <> '.JPG') and (RightStr(UPPERCASE(pathFile), 5) <> '.JPEG') then
begin
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);
end
else
MJPG.SaveToFile(pathFile);
end;
end;
finally
MJPG.Free;
end;
end;
procedure TFormGetPic.SpeedButton5Click(Sender: TObject);
begin
try
with adoqueryImage do
begin
close;
sql.Clear;
sql.Add('select * from TP_File where WBID=' + quotedstr(trim(fkeyNo)));
open;
if RecordCount > 0 then
begin
edit;
fieldByName(pat1).Value := null;
FieldByName(pic1).Value := null;
post;
Image1.Picture.Assign(nil);
Image2.Picture.Assign(nil);
end;
end;
except
end;
end;
end.

View File

@ -0,0 +1,108 @@
object frmFrameDateSel: TfrmFrameDateSel
Left = 0
Top = 0
Width = 1078
Height = 37
Color = clWhite
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentBackground = False
ParentColor = False
ParentFont = False
TabOrder = 0
object lbl1: TLabel
Left = 23
Top = 7
Width = 64
Height = 21
AutoSize = False
Caption = #26597#35810#26085#26399
end
object lbl2: TLabel
Left = 215
Top = 7
Width = 16
Height = 21
Caption = #33267
end
object BegDate: TcxDateEdit
Left = 91
Top = 1
AutoSize = False
Properties.ShowTime = False
TabOrder = 0
Height = 33
Width = 120
end
object EndDate: TcxDateEdit
Left = 235
Top = 1
AutoSize = False
Properties.ShowTime = False
TabOrder = 1
Height = 33
Width = 120
end
object cxButton1: TcxButton
Left = 443
Top = 1
Width = 80
Height = 33
Caption = #26412#26376
TabOrder = 2
OnClick = cxButton1Click
end
object cxButton2: TcxButton
Left = 611
Top = 1
Width = 80
Height = 33
Caption = #24448#21069
TabOrder = 3
OnClick = cxButton2Click
end
object cxButton3: TcxButton
Left = 750
Top = 1
Width = 80
Height = 33
Caption = #24448#21518
TabOrder = 4
OnClick = cxButton3Click
end
object cbbType: TcxComboBox
Left = 695
Top = 1
AutoSize = False
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
#26085
#26376
#24180)
TabOrder = 5
Text = #26085
Height = 33
Width = 51
end
object cxButton4: TcxButton
Left = 359
Top = 1
Width = 80
Height = 33
Caption = #26412#26085
TabOrder = 6
OnClick = cxButton4Click
end
object cxButton5: TcxButton
Left = 527
Top = 1
Width = 80
Height = 33
Caption = #26412#24180
TabOrder = 7
OnClick = cxButton5Click
end
end

View File

@ -0,0 +1,115 @@
unit FrameDateSel;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
Vcl.ComCtrls, dxCore, cxDateUtils, dxSkinsCore, dxSkinsDefaultPainters,
dxSkinWXI, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar, Vcl.StdCtrls,
Vcl.Menus, cxButtons, Vcl.ExtCtrls, DateUtils, dxSkinBasic, 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, dxSkinOffice2016Colorful, dxSkinOffice2016Dark,
dxSkinOffice2019Black, dxSkinOffice2019Colorful, dxSkinOffice2019DarkGray,
dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringtime, dxSkinStardust,
dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinTheBezier, dxSkinValentine,
dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint,
dxSkinXmas2008Blue;
type
TfrmFrameDateSel = class(TFrame)
lbl1: TLabel;
lbl2: TLabel;
BegDate: TcxDateEdit;
EndDate: TcxDateEdit;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxButton3: TcxButton;
cbbType: TcxComboBox;
cxButton4: TcxButton;
cxButton5: TcxButton;
procedure cxButton4Click(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxButton5Click(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure cxButton3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
//uses
// U_RTFun;
{$R *.dfm}
procedure TfrmFrameDateSel.cxButton1Click(Sender: TObject);
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-MM-dd', Now)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-MM-dd', Now)));
end;
procedure TfrmFrameDateSel.cxButton2Click(Sender: TObject);
begin
if cbbType.Text = 'ÈÕ' then
begin
BegDate.Date := BegDate.Date - 1;
EndDate.Date := EndDate.Date - 1;
end;
if cbbType.Text = 'ÔÂ' then
begin
BegDate.Date := StartOfTheMonth(StartOfTheMonth(EndDate.Date) - 1);
EndDate.Date := EndOfTheMonth(StartOfTheMonth(EndDate.Date) - 1);
end;
if cbbType.Text = 'Äê' then
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', strToDate(FormatDateTime('yyyy-01-01', EndDate.Date)) - 1)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', BegDate.Date)));
end;
end;
procedure TfrmFrameDateSel.cxButton3Click(Sender: TObject);
begin
if cbbType.Text = 'ÈÕ' then
begin
BegDate.Date := BegDate.Date + 1;
EndDate.Date := EndDate.Date + 1;
end;
if cbbType.Text = 'ÔÂ' then
begin
BegDate.Date := EndOfTheMonth(EndDate.Date) + 1;
EndDate.Date := EndOfTheMonth(EndOfTheMonth(EndDate.Date) + 1);
end;
if cbbType.Text = 'Äê' then
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', strToDate(FormatDateTime('yyyy-12-31', EndDate.Date)) + 1)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', BegDate.Date)));
end;
end;
procedure TfrmFrameDateSel.cxButton4Click(Sender: TObject);
begin
BegDate.Date := strToDate(FormatDateTime('yyyy-MM-dd', Now));
EndDate.Date := strToDate(FormatDateTime('yyyy-MM-dd', Now));
end;
procedure TfrmFrameDateSel.cxButton5Click(Sender: TObject);
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', Now)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', Now)));
end;
end.

View File

@ -0,0 +1,259 @@
object frmFrameDateSel10: TfrmFrameDateSel10
Left = 0
Top = 0
Width = 956
Height = 45
AutoSize = True
Color = clBtnFace
ParentBackground = False
ParentColor = False
TabOrder = 0
object dxLayoutControl1: TdxLayoutControl
Left = 0
Top = 0
Width = 956
Height = 45
Align = alTop
ParentBackground = True
TabOrder = 0
Transparent = True
object BegDate: TcxDateEdit
Left = 110
Top = 5
ParentCustomHint = False
AutoSize = False
Properties.ImmediatePost = True
Properties.ShowTime = False
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.TransparentBorder = False
Style.ButtonStyle = bts3D
Style.PopupBorderStyle = epbsFrame3D
TabOrder = 1
Height = 33
Width = 120
end
object EndDate: TcxDateEdit
Left = 250
Top = 5
AutoSize = False
Properties.ImmediatePost = True
Properties.ShowTime = False
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.TransparentBorder = False
Style.ButtonStyle = bts3D
Style.PopupBorderStyle = epbsFrame3D
TabOrder = 2
Height = 33
Width = 120
end
object cxButton1: TcxButton
Left = 450
Top = 5
Width = 80
Height = 33
Caption = #26412#26376
TabOrder = 4
OnClick = cxButton1Click
end
object cxButton2: TcxButton
Left = 610
Top = 5
Width = 80
Height = 33
Caption = #24448#21069
TabOrder = 6
OnClick = cxButton2Click
end
object cxButton3: TcxButton
Left = 741
Top = 5
Width = 80
Height = 33
Caption = #24448#21518
TabOrder = 8
OnClick = cxButton3Click
end
object cbbType: TcxComboBox
Left = 690
Top = 5
AutoSize = False
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
#26085
#26376
#24180)
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.LookAndFeel.NativeStyle = True
Style.TransparentBorder = False
Style.ButtonStyle = bts3D
Style.PopupBorderStyle = epbsFrame3D
StyleDisabled.LookAndFeel.NativeStyle = True
StyleFocused.LookAndFeel.NativeStyle = True
StyleHot.LookAndFeel.NativeStyle = True
TabOrder = 7
Text = #26085
Height = 32
Width = 51
end
object cxButton4: TcxButton
Left = 370
Top = 5
Width = 80
Height = 33
Caption = #26412#26085
TabOrder = 3
OnClick = cxButton4Click
end
object cxButton5: TcxButton
Left = 530
Top = 5
Width = 80
Height = 33
Caption = #26412#24180
TabOrder = 5
OnClick = cxButton5Click
end
object TimeType: TcxComboBox
Left = 10
Top = 5
AutoSize = False
Properties.DropDownListStyle = lsEditFixedList
Properties.ImmediatePost = True
Properties.Items.Strings = (
#26597#35810#26085#26399)
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.TransparentBorder = False
Style.ButtonStyle = bts3D
Style.PopupBorderStyle = epbsFrame3D
TabOrder = 0
Text = #26597#35810#26085#26399
Height = 32
Width = 100
end
object jqModel: TcxCheckBox
Left = 835
Top = 5
Caption = #31934#30830#26597#35810
Style.BorderColor = clWindowFrame
Style.BorderStyle = ebs3D
Style.HotTrack = False
Style.TransparentBorder = False
TabOrder = 9
Transparent = True
end
object dxLayoutControl1Group_Root: TdxLayoutGroup
AlignHorz = ahLeft
AlignVert = avTop
Hidden = True
LayoutDirection = ldHorizontal
Padding.Top = -5
Padding.AssignedValues = [lpavTop]
ShowBorder = False
UseIndent = False
Index = -1
end
object dxLayoutItem1: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Visible = False
Control = TimeType
ControlOptions.OriginalHeight = 32
ControlOptions.OriginalWidth = 100
ControlOptions.ShowBorder = False
Index = 0
end
object dxLayoutItem2: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Visible = False
Control = BegDate
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 120
ControlOptions.ShowBorder = False
Index = 1
end
object dxLayoutItem3: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Text = ' '#33267
Control = EndDate
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 120
ControlOptions.ShowBorder = False
Index = 2
end
object dxLayoutItem4: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
AlignVert = avClient
CaptionOptions.Text = 'New Item'
CaptionOptions.Visible = False
Control = cxButton4
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 80
ControlOptions.ShowBorder = False
Index = 3
end
object dxLayoutItem5: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Text = 'New Item'
CaptionOptions.Visible = False
Control = cxButton1
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 80
ControlOptions.ShowBorder = False
Index = 4
end
object dxLayoutItem6: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Text = 'New Item'
CaptionOptions.Visible = False
Control = cxButton5
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 80
ControlOptions.ShowBorder = False
Index = 5
end
object dxLayoutItem7: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Text = 'New Item'
CaptionOptions.Visible = False
Control = cxButton2
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 80
ControlOptions.ShowBorder = False
Index = 6
end
object dxLayoutItem8: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Visible = False
Control = cbbType
ControlOptions.OriginalHeight = 32
ControlOptions.OriginalWidth = 51
ControlOptions.ShowBorder = False
Index = 7
end
object dxLayoutItem9: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Visible = False
Control = cxButton3
ControlOptions.OriginalHeight = 33
ControlOptions.OriginalWidth = 80
ControlOptions.ShowBorder = False
Index = 8
end
object dxLayoutItem10: TdxLayoutItem
Parent = dxLayoutControl1Group_Root
CaptionOptions.Text = ' '
Control = jqModel
ControlOptions.OriginalHeight = 17
ControlOptions.OriginalWidth = 66
ControlOptions.ShowBorder = False
Index = 9
end
end
end

View File

@ -0,0 +1,125 @@
unit FrameDateSel10;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
Vcl.ComCtrls, dxCore, cxDateUtils, dxSkinsCore, dxSkinsDefaultPainters,
dxSkinWXI, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar, Vcl.StdCtrls,
Vcl.Menus, cxButtons, Vcl.ExtCtrls, DateUtils, cxCheckBox,
dxLayoutcxEditAdapters, dxLayoutContainer, cxClasses, dxLayoutControl,
dxLayoutControlAdapters;
type
TfrmFrameDateSel10 = class(TFrame)
BegDate: TcxDateEdit;
EndDate: TcxDateEdit;
cxButton1: TcxButton;
cxButton2: TcxButton;
cxButton3: TcxButton;
cbbType: TcxComboBox;
cxButton4: TcxButton;
cxButton5: TcxButton;
TimeType: TcxComboBox;
jqModel: TcxCheckBox;
dxLayoutControl1Group_Root: TdxLayoutGroup;
dxLayoutControl1: TdxLayoutControl;
dxLayoutItem1: TdxLayoutItem;
dxLayoutItem2: TdxLayoutItem;
dxLayoutItem3: TdxLayoutItem;
dxLayoutItem4: TdxLayoutItem;
dxLayoutItem5: TdxLayoutItem;
dxLayoutItem6: TdxLayoutItem;
dxLayoutItem7: TdxLayoutItem;
dxLayoutItem8: TdxLayoutItem;
dxLayoutItem9: TdxLayoutItem;
dxLayoutItem10: TdxLayoutItem;
procedure cxButton4Click(Sender: TObject);
procedure cxButton1Click(Sender: TObject);
procedure cxButton5Click(Sender: TObject);
procedure cxButton2Click(Sender: TObject);
procedure cxButton3Click(Sender: TObject);
private
{ Private declarations }
public
procedure initTimeType(mType:string);
end;
implementation
//uses
// U_RTFun;
{$R *.dfm}
procedure TfrmFrameDateSel10.cxButton1Click(Sender: TObject);
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-MM-dd', Now)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-MM-dd', Now)));
end;
procedure TfrmFrameDateSel10.cxButton2Click(Sender: TObject);
begin
if cbbType.Text = 'ÈÕ' then
begin
BegDate.Date := BegDate.Date - 1;
EndDate.Date := EndDate.Date - 1;
end;
if cbbType.Text = 'ÔÂ' then
begin
BegDate.Date := StartOfTheMonth(StartOfTheMonth(EndDate.Date) - 1);
EndDate.Date := EndOfTheMonth(StartOfTheMonth(EndDate.Date) - 1);
end;
if cbbType.Text = 'Äê' then
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', strToDate(FormatDateTime('yyyy-01-01', EndDate.Date)) - 1)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', BegDate.Date)));
end;
end;
procedure TfrmFrameDateSel10.cxButton3Click(Sender: TObject);
begin
if cbbType.Text = 'ÈÕ' then
begin
BegDate.Date := BegDate.Date + 1;
EndDate.Date := EndDate.Date + 1;
end;
if cbbType.Text = 'ÔÂ' then
begin
BegDate.Date := EndOfTheMonth(EndDate.Date) + 1;
EndDate.Date := EndOfTheMonth(EndOfTheMonth(EndDate.Date) + 1);
end;
if cbbType.Text = 'Äê' then
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', strToDate(FormatDateTime('yyyy-12-31', EndDate.Date)) + 1)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', BegDate.Date)));
end;
end;
procedure TfrmFrameDateSel10.cxButton4Click(Sender: TObject);
begin
BegDate.Date := strToDate(FormatDateTime('yyyy-MM-dd', Now));
EndDate.Date := strToDate(FormatDateTime('yyyy-MM-dd', Now));
end;
procedure TfrmFrameDateSel10.cxButton5Click(Sender: TObject);
begin
BegDate.Date := StartOfTheMonth(strToDate(FormatDateTime('yyyy-01-01', Now)));
EndDate.Date := EndOfTheMonth(strToDate(FormatDateTime('yyyy-12-01', Now)));
end;
/////////////////////////////////////////////////
///
procedure TfrmFrameDateSel10.initTimeType(mType:string);
var
array_str:TArray<string>;
begin
if trim(mType)='' then exit;
array_str:=mtype.Split([',']) ;
TimeType.Properties.Items.Clear;
TimeType.Properties.Items.AddStrings(array_str) ;
TimeType.ItemIndex:=0;
end;
end.

View File

@ -0,0 +1,139 @@
object frmFramePagingSel: TfrmFramePagingSel
Left = 0
Top = 0
Width = 1078
Height = 37
Color = clWhite
ParentBackground = False
ParentColor = False
TabOrder = 0
DesignSize = (
1078
37)
object lbl1: TLabel
Left = 23
Top = 7
Width = 64
Height = 21
Alignment = taCenter
Caption = #27599#39029#26465#25968
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
end
object LBDQY: TLabel
Left = 237
Top = 7
Width = 9
Height = 21
Alignment = taCenter
Anchors = [akLeft]
Caption = '1'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
Layout = tlCenter
end
object Label2: TLabel
Left = 181
Top = 7
Width = 52
Height = 21
Alignment = taCenter
Anchors = [akLeft]
Caption = #24403#21069#39029':'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
Layout = tlCenter
end
object LBZYS: TLabel
Left = 338
Top = 7
Width = 9
Height = 21
Alignment = taCenter
Anchors = [akLeft]
Caption = '1'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
Layout = tlCenter
end
object Label3: TLabel
Left = 282
Top = 7
Width = 52
Height = 21
Alignment = taCenter
Anchors = [akLeft]
Caption = #24635#39029#25968':'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
Layout = tlCenter
end
object BTLP: TcxButton
Left = 392
Top = 1
Width = 80
Height = 33
Caption = #19978#19968#39029
TabOrder = 0
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
end
object cxButton3: TcxButton
Left = 476
Top = 1
Width = 80
Height = 33
Caption = #19979#19968#39029
TabOrder = 1
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = #24494#36719#38597#40657
Font.Style = []
ParentFont = False
end
object TCBNOR: TcxComboBox
Left = 91
Top = 1
ParentFont = False
Properties.DropDownListStyle = lsFixedList
Properties.Items.Strings = (
'1000'
'2000'
'5000'
'10000')
Style.Font.Charset = ANSI_CHARSET
Style.Font.Color = clWindowText
Style.Font.Height = -16
Style.Font.Name = #24494#36719#38597#40657
Style.Font.Style = []
Style.IsFontAssigned = True
TabOrder = 2
Text = '2000'
Width = 86
end
end

View File

@ -0,0 +1,51 @@
unit FramePagingSel;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics,
cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
Vcl.ComCtrls, dxCore, cxDateUtils, dxSkinsCore, dxSkinsDefaultPainters,
dxSkinWXI, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar, Vcl.StdCtrls,
Vcl.Menus, cxButtons, Vcl.ExtCtrls, DateUtils, dxSkinBasic, 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, dxSkinOffice2016Colorful, dxSkinOffice2016Dark,
dxSkinOffice2019Black, dxSkinOffice2019Colorful, dxSkinOffice2019DarkGray,
dxSkinOffice2019White, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic,
dxSkinSharp, dxSkinSharpPlus, dxSkinSilver, dxSkinSpringtime, dxSkinStardust,
dxSkinSummer2008, dxSkinTheAsphaltWorld, dxSkinTheBezier, dxSkinValentine,
dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
dxSkinVisualStudio2013Light, dxSkinVS2010, dxSkinWhiteprint,
dxSkinXmas2008Blue;
type
TfrmFramePagingSel = class(TFrame)
lbl1: TLabel;
BTLP: TcxButton;
cxButton3: TcxButton;
TCBNOR: TcxComboBox;
LBDQY: TLabel;
Label2: TLabel;
LBZYS: TLabel;
Label3: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
implementation
{$R *.dfm}
end.

Some files were not shown because too many files have changed in this diff Show More