📄 unit5.pas
字号:
unit Unit5;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DB, ADODB, Grids, DBGridEh, ExtCtrls, StdCtrls, Buttons,
DBCtrls, Mask, ComCtrls, Menus;
type
Tfbanci = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
ScrollBox1: TScrollBox;
Image1: TImage;
DBGridEh1: TDBGridEh;
Image2: TImage;
Image3: TImage;
banci: TADOQuery;
DataSource1: TDataSource;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
DBEdit1: TDBEdit;
DBEdit2: TDBEdit;
DBRadioGroup1: TDBRadioGroup;
StatusBar1: TStatusBar;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
procedure DBGridEh1CellClick(Column: TColumnEh);
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 Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
private
{ Private declarations }
cycl,endx,endy,startx,starty:integer;
p_unit:integer;
timedata,h_time:AnsiString;
tmpbmp:TBitmap;
coordinate,nowtime,nowx:integer;
startdraw,cr,cl,okdown,add:boolean;
llim,rlim,nowdata,selrow:integer;
procedure displaybc;
public
{ Public declarations }
end;
var
fbanci: Tfbanci;
implementation
uses umdmmain;
{$R *.dfm}
procedure Tfbanci.DBGridEh1CellClick(Column: TColumnEh);
begin
cycl:=banci.FieldByName('banci_cycle').AsInteger;
p_unit:=banci.FieldByName('banci_unit').AsInteger;
timedata:=banci.FieldByName('banci_time').AsString;
displaybc;
Image1.Visible:=true;
end;
procedure Tfbanci.FormCreate(Sender: TObject);
begin
tmpbmp:=TBitmap.Create;
Image3.Canvas.Pen.Mode:=pmNotXor;
Image3.Canvas.Pen.Color:=clBlue;
Image3.Canvas.Pen.Width:=1;
coordinate:=0;
cl:=false;
cr:=false;
banci.Open;
end;
procedure Tfbanci.FormDestroy(Sender: TObject);
begin
tmpbmp.Free;
end;
procedure Tfbanci.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
k,k11,i,j,i2,i1,j1,j2:integer;
bufs,bufe,bufts,bufte:String;
pt:TPoint;
begin
//----------左键处理---------
if Button=mbLeft then
begin
//--------------定上下限--------
k:=98;
for i:=0 to cycl*p_unit-1 do begin
if (Y>(8+i*27))and(Y<(16+i*27)) then
k:=i;
end;
if k=98 then
exit;
i2:=(X-98)*24 div (492-98); //hour
j2:=(X-98-(i2*(492-98) div 24));
j2:=j2*60*24 div (492-98); //min
j2:=k*10000+i2*100+j2;
i:=Length(timedata);
i:=i div 12;
llim:=0;
rlim:=(cycl*p_unit-1)*10000+2400;
for k11:=0 to i-1 do
begin
bufs:=Copy(timedata,k11*12+1,12);
bufe:=bufs;
Delete(bufs,7,6);
Delete(bufe,1,6);
i1:=StrToInt(bufs);
j1:=StrToInt(bufe);
if (j1>llim) and (j1<j2-10) then llim:=j1;
if (i1<rlim) and (i1>j2+10) then rlim:=i1; //decide mouse move range
end;
// --可以限制两个班次的间隔时间
if llim>0 then llim:=llim+50;
if rlim<(cycl*p_unit-1)*10000+2400 then rlim:=rlim-50;
//-----------------------
if (X>98) and (X<493) and okdown then
for i:=0 to cycl*p_unit-1 do begin
if (Y>(8+i*27))and(Y<(16+i*27)) then
begin
if not(cl or cr) then
begin
nowtime:=Length(timedata) div 12;
startx:=X;
starty:=i;
endx:=X;
endy:=i;
end
else
begin
if starty<>endy then
begin
if cl then nowx:=493
else nowx:=99;
end;
end;
startdraw:=true;
end;
end;
end;
//----------右键处理---------
if Button=mbRight then
begin
for i:=0 to cycl*p_unit-1 do
begin
if (Y>(8+i*27))and(Y<(16+i*27)) then
k:=i;
end;
i2:=(X-98)*24 div (492-98);
j2:=(X-98-(i2*(492-98)div 24));
j2:=j2*60*24 div (492-98);
j2:=k*10000+i2*100+j2;
i:=Length(timedata) div 12;
if k<99 then
begin
for i2:=0 to i-1 do
begin
bufts:=Copy(timedata,12*i2+1,12);
bufte:=bufts;
Delete(bufte,1,6);
Delete(bufts,7,6);
if (StrToInt(bufts)<=j2)and(StrToInt(bufte)>=j2) then
begin
nowtime:=i2;
pt.X:=X;
pt.Y:=Y;
pt:=Image1.ClientToScreen(pt);
PopupMenu1.Popup(pt.x,pt.y);
end;
end;
end;
end;
end;
procedure Tfbanci.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
buf,kong:integer;
i,i1,i2,j1,j2,ig,jg,kg,mup,p,k:Integer;
temps,bufs,bufe:String;
begin
buf:=X;
cl:=false;
cr:=false;
if buf<99 then buf:=99;
if buf>492 then buf:=492;
if (X>=99)and(X<=492) then
begin
Image1.Cursor :=crCross;
Image3.Canvas.MoveTo(coordinate,0);
Image3.Canvas.LineTo(coordinate,27);
Image3.Canvas.MoveTo(buf-99+22,0);
Image3.Canvas.LineTo(buf-99+22,27);
coordinate:=buf-99+22;
end
else
Image1.Cursor :=crArrow;
//拉伸处理---------------------
kong:=0;
okdown:=true;
if(startdraw)and(X>=98)and(X<=493) then
begin
k:=99;
for i:=0 to cycl*p_unit-1 do begin
if (Y>(8+i*27)) and (Y<(16+i*27)) then
k:=i;
if ((k>starty)and(starty>endy)) or ((k<starty)and(starty<endy)) then
begin
k:=starty;
kong:=1;
end;
end;
i2:=(X-98)*24 div (492-98);
j2:=(X-98-(i2*(492-98)div 24));
j2:=j2*60*24 div (492-98);
j2:=k*10000+i2*100+j2;
if j2>990000 then
j2:=j2-990000+endy*10000;
if j2<=llim then
begin
temps:=IntToStr(llim+1000000);
Delete(temps,1,3);
jg:=StrToInt(temps) div 100;
temps:=IntToStr(llim+1000000);
Delete(temps,1,5);
kg:=StrToInt(temps);
jg:=jg*(492-98) div 24+kg*(492-98)div 24 div 60+98;
buf:=jg+3;
end;
if j2>=rlim then
begin
temps:=IntToStr(rlim+1000000);
Delete(temps,1,3);
jg:=StrToInt(temps)div 100;
temps:=IntToStr(rlim+1000000);
Delete(temps,1,5);
kg:=StrToInt(temps);
jg:=jg*(492-98)div 24+kg*(492-98)div 24 div 60+98;
buf:=jg-1;
end;
mup:=0;
if (j2 div 10000)=starty then
begin
nowx:=startx;
if ((endx<startx)and(endy<starty))or((endx>startx)and(endy<starty)) then mup:=1;
end;
if ((j2 div 10000)<>endy)and (j2<rlim) and (j2>llim) then
begin
if (((j2 div 10000)-starty)>=0)and (mup=0) then
begin
if (j2 div 10000)-endy>0 then
begin
for p:=0 to (j2 div 10000)-endy-1 do
begin
Image1.Canvas.CopyRect(Rect(84,3+27*(endy+1+p),99,19+27*(endy+1+p)),Image2.Canvas,Rect(84,8,99,24));
Image1.Canvas.CopyRect(Rect(493,3+27*(endy+p),506,19+27*(endy+p)),Image2.Canvas,Rect(493,8,506,24));
end;
Image1.Canvas.Pen.Mode:=pmCopy;
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Brush.Style :=bsSolid;
Image1.Canvas.Rectangle(nowx,8+endy*27,endx,16+endy*27);
Image1.Canvas.Pen.Color:=clBlue;
Image1.Canvas.Pen.Mode :=pmNotXor;
Image1.Canvas.CopyRect(Rect(nowx,8+endy*27,493,16+endy*27),Image2.Canvas,Rect(200,64,361,72));
Image1.Canvas.CopyRect(Rect(99,8+(j2 div 10000)*27,buf,16+(j2 div 10000)*27),Image2.Canvas,Rect(198,64,361,72));
for p:=1 to (j2 div 10000)-endy-1 do
Image1.Canvas.CopyRect(Rect(99,8+(endy+p)*27,493,16+(endy+p)*27),Image2.Canvas,Rect(198,64,361,72));
end
else
begin
Image1.Canvas.Pen.Mode :=pmCopy;
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Brush.Style :=bsSolid;
Image1.Canvas.Rectangle(nowx,8+endy*27,endx,16+endy*27);
Image1.Canvas.CopyRect(Rect(84,3+27*endy,99,19+27*endy),Image2.Canvas,Rect(84,201,99,217));
Image1.Canvas.CopyRect(Rect(493,3+27*(endy-1),506,19+27*(endy-1)),Image2.Canvas,Rect(493,138,506,154));
Image1.Canvas.Rectangle(99,8+endy*27,endx,16+endy*27);
Image1.Canvas.Rectangle(buf,8+(endy-1)*27,493,16+(endy-1)*27);
for p:=1 to endy-(j2 div 10000)-1 do
begin
Image1.Canvas.CopyRect(Rect(84,3+27*(endy-p),99,19+27*(endy-p)),Image2.Canvas,Rect(84,138,99,154));
Image1.Canvas.CopyRect(Rect(493,3+27*(endy-p-1),506,19+27*(endy-p-1)),Image2.Canvas,Rect(493,138,506,154));
Image1.Canvas.Rectangle(99,8+(endy-p)*27,buf,16+(endy-p)*27);
Image1.Canvas.Rectangle(buf,8+(endy-p-1)*27,493,16+(endy-p-1)*27);
end;
Image1.Canvas.CopyRect(Rect(84,3+27*((j2 div 10000)+1),99,19+27*((j2 div 10000)+1)),Image2.Canvas,Rect(84,138,99,154));
Image1.Canvas.CopyRect(Rect(493,3+27*((j2 div 10000)),506,19+27*((j2 div 10000))),Image2.Canvas,Rect(493,138,506,154));
Image1.Canvas.Pen.Color:=clBlue;
Image1.Canvas.Pen.Mode :=pmNotXor;
end;
nowx:=99;
end
else
begin
if (j2/10000)-endy<0 then
begin
for p:=0 to endy-(j2 div 10000)-1 do
begin
Image1.Canvas.CopyRect(Rect(84,3+27*(endy-p),99,19+27*(endy-p)),Image2.Canvas,Rect(84,8,99,24));
Image1.Canvas.CopyRect(Rect(493,3+27*(endy-p-1),506,19+27*(endy-p-1)),Image2.Canvas,Rect(493,8,506,24));
end;
Image1.Canvas.Pen.Mode :=pmCopy;
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Brush.Style :=bsSolid;
Image1.Canvas.Rectangle(nowx,8+endy*27,endx,16+endy*27);
Image1.Canvas.Pen.Color:=clBlue;
Image1.Canvas.Pen.Mode :=pmNotXor;
Image1.Canvas.CopyRect(Rect(99,8+endy*27,nowx,16+endy*27),Image2.Canvas,Rect(200,64,361,72));
Image1.Canvas.CopyRect(Rect(buf,8+(j2 div 10000)*27,493,16+(j2 div 10000)*27),Image2.Canvas,Rect(198,64,361,72));
for p:=1 to endy-(j2 div 10000)-1 do
Image1.Canvas.CopyRect(Rect(99,8+(endy-p)*27,493,16+(endy-p)*27),Image2.Canvas,Rect(198,64,361,72));
end
else
begin
Image1.Canvas.Pen.Mode :=pmCopy;
Image1.Canvas.Pen.Color:=clWhite;
Image1.Canvas.Brush.Color:=clWhite;
Image1.Canvas.Brush.Style :=bsSolid;
Image1.Canvas.Rectangle(nowx,8+endy*27,endx,16+endy*27);
Image1.Canvas.CopyRect(Rect(84,3+27*(endy+1),99,19+27*(endy+1)),Image2.Canvas,Rect(84,138,99,154));
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -