📄 pmt.~pas
字号:
unit pmt;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, ToolWin, ImgList,Printers,TypInfo,
Grids, OleCtrls, SHDocVw, MSHTML;
type
TForm4 = class(TForm)
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ImageList1: TImageList;
StatusBar1: TStatusBar;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
Image1: TImage;
TabSheet3: TTabSheet;
WebBrowser1: TWebBrowser;
WebBrowser2: TWebBrowser;
RichEdit1: TRichEdit;
procedure ToolButton1Click(Sender: TObject);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
procedure ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
private
function getBzfByCsf(strYinBZ: string; intSjcsf:integer;strLb:string): integer;
procedure OUtFz(yinsubz: string;sjcesf, bzfz: integer;var myStringList:TStringList);
function CreateCellsAdd():TStringList;
procedure OutText(s:string; j: integer;isP:bool);
{ Private declarations }
public
strRybh :string; //人员编号
strcmbh :string; //常模编号
end;
var
Form4: TForm4;
implementation
uses dataModel, main;
{$R *.dfm}
procedure TForm4.ToolButton1Click(Sender: TObject);
var
xscale, yscale: Integer;
aRect: TRect;
begin
Printer.BeginDoc;
xscale := GetDeviceCaps(Printer.Handle, LOGPIXELSX) div PixelsPerInch;
yscale := GetDeviceCaps(Printer.Handle, LOGPIXELSY) div PixelsPerInch;
aRect := Rect(0, 0, Image1.Picture.Width * xscale, Image1.Picture.Height * yscale);
Canvas.StretchDraw(aRect, Image1.Picture.Graphic);
Printer.EndDoc;
end;
var x1,y1 :integer;
procedure TForm4.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
x1 := x;
y1 :=y;
self.StatusBar1.Panels[0].Text := 'X' + inttostr(x) + ',' + 'y' + inttostr(y);
end;
procedure TForm4.Image1Click(Sender: TObject);
begin
// Image1.Canvas.TextOut(x1,y1,'你好');
end;
//枚举定义
type yinsu = (A,B,C,E,F,G,H,I,L,M,N,O,Q1,Q2,Q3,Q4);
function creatReport(rbh :string;bzf:integer;yinsuID:string) :string;
var
ss,xm,xbName,zyName :string; //姓名，性别，职业
nl : integer; //年龄
begin
DataModule1.ADOQuery9.SQL.Clear;
DataModule1.ADOQuery9.SQL.Add('select * from csz where bh =' + rbh ) ;
DataModule1.ADOQuery9.Open;
if DataModule1.ADOQuery9.RecordCount >0 then
begin
xm := DataModule1.ADOQuery9.FieldValues['xm']; //姓名
xbName := DataModule1.ADOQuery9.FieldValues['xb']; //性别
zyName := DataModule1.ADOQuery9.FieldValues['zy']; //职业
nl := DataModule1.ADOQuery9.FieldValues['nl']; //年龄
DataModule1.ADOQuery8.Close;
DataModule1.ADOQuery8.SQL.Clear;
ss := 'SELECT fzdsz.xgms FROM fzdsz WHERE fzdsz.xbCode_CodeName= '''
+ xbName + ''' AND fzdsz.zyfCode_CodeName= ''' + zyName + ''' AND '
+ inttostr(nl)
+ '>=fzdsz.Bage AND '
+ inttostr(nl)
+ '<fzdsz.Eage AND '
+ inttostr(bzf)
+ ' >=fzdsz.Bfz AND '
+ inttostr(bzf) +
' <fzdsz.Efz and fzdsz.YinSuBH = ''' + YinsuID + '''';
DataModule1.ADOQuery8.SQL.Add(ss);
{DataModule1.ADOQuery8.Parameters[0].Value := xbName;
DataModule1.ADOQuery8.Parameters[1].Value := zyName;
DataModule1.ADOQuery8.Parameters[2].Value := nl;
DataModule1.ADOQuery8.Parameters[3].Value :=bzf ;
DataModule1.ADOQuery8.Parameters[4].Value :=yinsuID ; }
DataModule1.ADOQuery8.Open;
if DataModule1.ADOQuery8.RecordCount =0 then
begin
creatReport := '';
end
else
begin
creatReport := DataModule1.ADOQuery8.FieldValues['xgms']
end;
end ;
DataModule1.ADOQuery9.Close;
end;
procedure TForm4.FormShow(Sender: TObject);
var strYinsu ,enumName,xgms: string; //因素表示
intCsF : integer; //某个因素实际测试得分
intBZfz : integer; //标准分
myStringList:TStringList;
tt:integer;
begin
xgms := '';
myStringList := CreateCellsAdd; //创建因素位置坐标记录
//得到某个测试人的分值统计
DataModule1.ADOQuery2.Close;
DataModule1.ADOQuery2.Parameters[0].value := strRybh; // strRybh是人员编号
DataModule1.ADOQuery2.Open;
if DataModule1.ADOQuery2.RecordCount =0 then
begin
exit;
end;
DataModule1.ADOQuery2.First;
while not DataModule1.ADOQuery2.Eof do
begin
if DataModule1.ADOQuery2.Recordset.Fields['yinsuID'].Value = null then
begin
DataModule1.ADOQuery2.Next; //cmbh
continue;
end ;
strYinsu :=DataModule1.ADOQuery2.Recordset.Fields['yinsuID'].Value; //因素标识名称
intCsF := DataModule1.ADOQuery2.Recordset.Fields['fzOfSum'].Value; //实际测试分
intBZfz := getBzfByCsf(strYinsu,intCsF,strcmbh); // '05' //标准分
//将人员测试的标准分保存
DataModule1.ADOTable6.Filter := 'rybh=' + QuotedStr(strRybh) + ' and ' + 'ysbh=' + QuotedStr(strYinsu);
DataModule1.ADOTable6.Filtered := true;
DataModule1.ADOTable6.Open;
if DataModule1.ADOTable6.RecordCount = 0 then
begin
DataModule1.ADOTable6.Append;
DataModule1.ADOTable6.FieldValues['rybh'] := strRybh;
DataModule1.ADOTable6.FieldValues['ysbh'] := strYinsu;
DataModule1.ADOTable6.FieldValues['bzf'] := intBZfz;
DataModule1.ADOTable6.Post;
DataModule1.ADOTable6.Close;
end;
//在折线图上输出分值 画出折线
if intCsF >=0 then
OUtFz(strYinsu,intCsF,intBZfz,myStringList);
for tt :=0 to 15 do
begin
enumName := GetEnumName(TypeInfo(yinsu),tt); //得到枚举的名称
xgms := xgms + creatReport(strRybh,intbzfz,strYinsu);
end;
DataModule1.ADOQuery2.Next; //cmbh
end;
self.Image1.Picture.SaveToFile('temp.bmp');
DataModule1.ADOQuery2.Close;
self.RichEdit1.Text := xgms;
if myStringList <> nil then
begin
myStringList.Free;
myStringList := nil;
end; // ExtractFilePath(application.ExeName) +'
WebBrowser1.Navigate(ExtractFilePath(application.ExeName) + 'database/sj.htm');
WebBrowser2.Navigate(ExtractFilePath(application.ExeName) + 'pmt.htm');
end;
function Tform4.CreateCellsAdd() :TStringList;
var
MyList: TStringList;
const intBaseX :integer = 78;
const intBaseY :integer = 163;
const intXstep :integer = 48;
const intYstep :integer = 42;
CONST intBLO :integer = 103; //标准分离第一列的距离
const intBaseXl :integer = 248;
const intXstep1 :integer = 43;
var i,j,m:integer;
var enumName :string;//枚举的名称
var cx,cy :integer;
begin
cx := intBaseX;
cy := intBaseY;
i := Ord(High(yinsu)) - Ord(Low(yinsu))+1; //得到枚举的个数
MyList := TStringList.Create;
for j:=0 to i do
begin
for m:= -1 to 0 do
begin
enumName := GetEnumName(TypeInfo(yinsu),j); //得到枚举的名称
MyList.Values[enumName + inttostr(m)] := inttostr(cx) + ',' + inttostr(cy);
cx := cx + intXstep;
end;
cx := intBaseXl;
for m:= 1 to 10 do
begin
enumName := GetEnumName(TypeInfo(yinsu),j); //得到枚举的名称
MyList.Values[enumName + inttostr(m)] := inttostr(cx) + ',' + inttostr(cy);
cx := cx + intXstep1;
end;
cx := intBaseX;
cy := cy + intYstep;
end;
MyList.Sort;
result := MyList;
end;
{
**********************************************
功能描述：输出分值
参数：yinsubz 因素标志
sjcesf 每因素实际测试得分
bzfz 按因素查得的标准分
}
procedure Tform4.OUtFz(yinsubz:string;sjcesf,bzfz:integer;var myStringList:TStringList);
var
s:string;
begin
s := myStringList.values[yinsubz + inttostr(-1)];
OutText(s, sjcesf,true);
s := myStringList.values[yinsubz + inttostr(0)];
OutText(s, bzfz,true);
s := myStringList.values[yinsubz + inttostr(bzfz)];
OutText(s, bzfz,false);
end;
var
oldx:integer=0;
oldy :integer =0;
procedure Tform4.OutText(s:string;j:integer;isP:bool);
var
strs :TStrings;
x,y :integer;
begin
try
strs := TStringList.Create;
strs.CommaText := s;
begin
x := strtoint(strs[0]);
y := strtoint(strs[1]);
if isP then
Image1.Canvas.TextOut(x,y,inttostr(j))
else
begin
Image1.Canvas.TextOut(x,y,'●');
Image1.Canvas.MoveTo(x,y);
if oldx <>0 then
Image1.Canvas.LineTo(oldx,oldy);
oldx := x;
oldy := y;
end;
end;
finally
strs := nil;
strs.Free;
end;
end;
//根据因素ID和实际测试分和长摸类别得到标准分
function Tform4.getBzfByCsf(strYinBZ:string;intSjcsf:integer;strLb:string):integer;
//var
//strCmd :string;
begin
DataModule1.ADOQuery3.Close;
// DataModule1.ADOQuery3.SQL.Clear;
// strCmd := 'select bzf from cmb where yinsu=''' + strYinBZ + ''' and lb =''' + strLb + ''' and beginFz>=' + inttostr(intSjcsf) + ' and endfz <=' + inttostr(intSjcsf);
//DataModule1.ADOQuery3.SQL.Add(strCmd);
DataModule1.ADOQuery3.Parameters[0].Value := strLb;
DataModule1.ADOQuery3.Parameters[1].Value := intSjcsf;
DataModule1.ADOQuery3.Parameters[2].Value := intSjcsf;
DataModule1.ADOQuery3.Parameters[3].Value := strYinBZ;
DataModule1.ADOQuery3.Open;
if DataModule1.ADOQuery3.RecordCount =0 then
begin
result := -1;
exit;
end;
DataModule1.ADOQuery3.First;
result := DataModule1.ADOQuery3.Recordset.Fields['bzf'].Value;
end;
procedure TForm4.WebBrowser1DocumentComplete(Sender: TObject;
const pDisp: IDispatch; var URL: OleVariant);
var
Doc:IHTMLDocument2;
//input:OleVariant;
userinputelement:ihtmlinputelement;
//ysSpan:IHTMLSpanElement;
begin
doc:=webbrowser1.document as ihtmldocument2;
userinputelement:=(doc.all.item('su1',0) as ihtmlinputelement);
userinputelement.value:='分值';
userinputelement:=(doc.all.item('su8',0) as ihtmlinputelement);
userinputelement.value:='分值';
userinputelement:=(doc.all.item('su9',0) as ihtmlinputelement);
userinputelement.value:='分值';
userinputelement:=(doc.all.item('su10',0) as ihtmlinputelement);
userinputelement.value:='分值';
userinputelement:=(doc.all.item('su11',0) as ihtmlinputelement);
userinputelement.value:='分值';
userinputelement:=(doc.all.item('su12',0) as ihtmlinputelement);
userinputelement.value:='分值';
userinputelement:=(doc.all.item('su13',0) as ihtmlinputelement);
userinputelement.value:='分值';
userinputelement:=(doc.all.item('su14',0) as ihtmlinputelement);
userinputelement.value:='分值';
//pwdinputelement:=(doc.all.item('password',0) as ihtmlinputelement);
//pwdinputelement.value:=edit2.text;
//input:=doc.all.item('submit',0);
//input.click;
end;
procedure TForm4.ScrollBar1Scroll(Sender: TObject; ScrollCode: TScrollCode;
var ScrollPos: Integer);
begin
if ScrollCode =scLineUp then
Image1.Top := 0 + ScrollPos * 10
else if ScrollCode =scLineDown then
Image1.Top := 0 - ScrollPos * 10 ;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -