⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit2.pas

📁 本系统在一些大中型企业(跨多达24个区域)一直都在很好的服务过
💻 PAS
📖 第 1 页 / 共 2 页
字号:
           if i=25 then C:='Z';
           if i=26 then C:='AA';
           if i=27 then C:='AB';
           if i=28 then C:='AC';
           if i=29 then C:='AD';
           if i=30 then C:='AE';
           if i=31 then C:='AF';
           if i=32 then C:='AG';
           if i=33 then C:='AH';
           if i=34 then C:='AI';
           if i=35 then C:='AJ';
           if i=36 then C:='AK';
           if i=37 then C:='AL';
           if i=38 then C:='AM';
           if i=39 then C:='AN';
           if i=40 then C:='AO';
           if i=41 then C:='AP';
           if i=42 then C:='AK';
           if i=43 then C:='AR';
           if i=44 then C:='AS';
           if i=45 then C:='AT';
           if i=46 then C:='AU';
           if i=47 then C:='AV';
           if i=48 then C:='AW';
           if i=49 then C:='AX';
           if i=50 then C:='AY';
           if i=51 then C:='AZ';

           MsExcelWorkSheet.Range[C+IntToStr(1)].Value:=form4.ClientDataSet1.Fields[i].fieldname ;
           end;


       form4.ClientDataSet1.First;

      J:=0;
        WHILE NOT form4.ClientDataSet1.EOF DO
           begin
           J:=j+1;

           for i:=0 to form4.ClientDataSet1.FieldCount-1 do
           begin

           if i=0 then C:='A';
           if i=1 then C:='B';
           if i=2 then C:='C';
           if i=3 then C:='D';
           if i=4 then C:='E';
           if i=5 then C:='F';
           if i=6 then C:='G';
           if i=7 then C:='H';
           if i=8 then C:='I';
           if i=9 then C:='J';
           if i=10 then C:='K';
           if i=11 then C:='L';
           if i=12 then C:='M';
           if i=13 then C:='N';
           if i=14 then C:='O';
           if i=15 then C:='P';
           if i=16 then C:='K';
           if i=17 then C:='R';
           if i=18 then C:='S';
           if i=19 then C:='T';
           if i=20 then C:='U';
           if i=21 then C:='V';
           if i=22 then C:='W';
           if i=23 then C:='X';
           if i=24 then C:='Y';
           if i=25 then C:='Z';
           if i=26 then C:='AA';
           if i=27 then C:='AB';
           if i=28 then C:='AC';
           if i=29 then C:='AD';
           if i=30 then C:='AE';
           if i=31 then C:='AF';
           if i=32 then C:='AG';
           if i=33 then C:='AH';
           if i=34 then C:='AI';
           if i=35 then C:='AJ';
           if i=36 then C:='AK';
           if i=37 then C:='AL';
           if i=38 then C:='AM';
           if i=39 then C:='AN';
           if i=40 then C:='AO';
           if i=41 then C:='AP';
           if i=42 then C:='AK';
           if i=43 then C:='AR';
           if i=44 then C:='AS';
           if i=45 then C:='AT';
           if i=46 then C:='AU';
           if i=47 then C:='AV';
           if i=48 then C:='AW';
           if i=49 then C:='AX';
           if i=50 then C:='AY';
           if i=51 then C:='AZ';

           MsExcelWorkSheet.Range[C+IntToStr(J+1)].Value:=form4.ClientDataSet1.Fields[i].AsString ;
           end;


       form4.ClientDataSet1.Next;
    end;


   {+================================================+}

   try
   deletefile(dir+'\excel\显示结果.XLS');
       MsExcelWorkSheet.SaveAs(dir+'\excel\显示结果.XLS');
   except
       MessageDlg('无法保存 '+dir+'\excel\显示结果.XLS',mtInformation,[mbOK],0);
   end;


end
else
begin
   showmessage('系统已经检测到你想用EXCEL观看的数据库还没有数据,请先录入数据在用它观看...');
end;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin

dir:='C:\NewStar';
GFXComboBox1.ItemIndex:=3;


If Mixer.MixerCount>0 then
  begin
{======================}
try
  MPlayer.PathToDLL:=LMDSysInfo1.WinPath  +'\';
  MPlayer.init;
  MPlayer.AutoPlay:=false;
except
end;
end;



end;

procedure TForm2.SpeedButton14Click(Sender: TObject);
var
ret:integer;
begin

end;


procedure TForm2.N5Click(Sender: TObject);

begin

close;
end;






procedure TForm2.N3Click(Sender: TObject);
begin
N3.Checked:=not N3.Checked;
if N3.Checked then Toolbar971.Show else   Toolbar971.Hide;
end;

procedure TForm2.N11Click(Sender: TObject);
begin
N11.Checked:=not N11.Checked;
if N11.Checked then Toolbar972.Show else   Toolbar972.Hide;

end;

procedure TForm2.N26Click(Sender: TObject);
begin
N26.Checked:=not N26.Checked;
if N26.Checked then Toolbar973.Show else   Toolbar973.Hide;
end;

procedure TForm2.N28Click(Sender: TObject);
begin
N28.Checked:=not N28.Checked;
if N28.Checked then Toolbar974.Show else   Toolbar974.Hide;
end;

procedure TForm2.N30Click(Sender: TObject);
var
ret:integer;
i:integer;
begin
ret:=application.MessageBox(pchar('确实要保存《'+form4.name.Lines.Text+form2.label4.Caption+'》模板文件?'),'备份选项',MB_OKCANCEL+MB_DEFBUTTON2+MB_ICONQUESTION);
if  form4.ClientDataSet1.IsEmpty then
begin
   showmessage('系统检测到当前你所编辑的数据为空,不能设置为模板文件,请先录入数据!!');
end else
begin
if ret=1 then
begin
 width1.Clear;
 form4.ClientDataSet1.SaveToFile(trim('c:\NewStar\Save\'+form4.name.Lines.Text+form2.label4.Caption)+'.mod');
 for i:=0 to   form4.ClientDataSet1.FieldCount-1 do
 begin
  width1.Lines.Add(inttostr(form4.ClientDataSet1.Fields[i].DisplayWidth));
 end;
  width1.Lines.SaveToFile(trim('c:\NewStar\Save\'+form4.name.Lines.Text+form2.label4.Caption)+'.mwh');

 showmessage('《'+form4.name.Lines.Text+form2.label4.Caption+'》模板文件已经保存...');
end;
end;

end;

procedure TForm2.FormResize(Sender: TObject);
begin


if form4.label2.Caption='false' then
begin
if form2.WindowState= wsMinimized then
begin
mainform.WindowState:= wsMinimized ;
end;
end;


end;







procedure TForm2.Archiver1DeleteFile(Sender: TObject;
  const FileEntry: TFileEntry; var Accept: Boolean);
begin
accept:=true;
end;

procedure TForm2.N32Click(Sender: TObject);
begin
 with TAboutBox.Create(Self) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

procedure TForm2.N33Click(Sender: TObject);
begin
  N33.Checked:=true;
  CD021.Checked:=false;
   CD011.Checked:=false;
   CD031.Checked:=false;
CD041.Checked:=false;
If form2.Mixer.MixerCount>0 then
  begin
{======================}
try
  if form2.MPlayer.Mode>2 then
  begin
 form2.MPlayer.Close;
  end;
except
end;
end;


end;

procedure TForm2.CD011Click(Sender: TObject);
begin
   CD031.Checked:=false;
CD041.Checked:=false;

   N33.Checked:=false;
  CD021.Checked:=false;
   CD011.Checked:=true;
If Mixer.MixerCount>0 then
  begin
{======================}
try

  if MPlayer.Mode>2 then
  begin
  MPlayer.Close;
  end;

  MPlayer.StreamName:=LMDSysInfo1.WinPath+'\CD01.mp3' ;
  MPlayer.Open;
  MPlayer.Play;

 except

 end;
 end;
{=====================}
end;

procedure TForm2.CD021Click(Sender: TObject);
begin
   CD031.Checked:=false;
CD041.Checked:=false;
  N33.Checked:=false;
  CD021.Checked:=true;
   CD011.Checked:=false;
If Mixer.MixerCount>0 then
  begin
{======================}
try
  if MPlayer.Mode>2 then
  begin
  MPlayer.Close;
  end;


  MPlayer.StreamName:=LMDSysInfo1.WinPath+'\CD02.mp3' ;
  MPlayer.Open;
  MPlayer.Play;

 except

 end;
 end;
{=====================}


end;

procedure TForm2.CD031Click(Sender: TObject);
begin
CD031.Checked:=true;
CD041.Checked:=false;
  N33.Checked:=false;
  CD021.Checked:=false;
   CD011.Checked:=false;
If Mixer.MixerCount>0 then
  begin
{======================}
try
  if MPlayer.Mode>2 then
  begin
  MPlayer.Close;
  end;


  MPlayer.StreamName:=LMDSysInfo1.WinPath+'\CD03.mp3' ;
  MPlayer.Open;
  MPlayer.Play;

 except

 end;
 end;
{=====================}

end;

procedure TForm2.CD041Click(Sender: TObject);
begin
  N33.Checked:=false;
  CD021.Checked:=false;
   CD011.Checked:=false;
   CD031.Checked:=false;
CD041.Checked:=true;

If Mixer.MixerCount>0 then
  begin
{======================}
try
  if MPlayer.Mode>2 then
  begin
  MPlayer.Close;
  end;


  MPlayer.StreamName:=LMDSysInfo1.WinPath+'\CD04.mp3' ;
  MPlayer.Open;
  MPlayer.Play;

 except

 end;
 end;
{=====================}

end;

procedure TForm2.N34Click(Sender: TObject);
begin
if ColorDialog1.Execute then
begin
DBGrid1.Color:=ColorDialog1.Color;
end;
end;

procedure TForm2.N35Click(Sender: TObject);
begin
if ColorDialog1.Execute then
begin
DBGrid1.Font.Color:=ColorDialog1.Color;
end;
end;


procedure TForm2.SendbtClick(Sender: TObject);
var
t:variant;
i:integer;
begin
if Uppercase(form4.skyfsjyLabel.Caption)='TRUE' then
begin
   showmessage('系统检测到你没有此权限使用此功能!');
   exit;
end;




if not form4.ClientDataSet1.IsEmpty then
begin
showmessage('系统将自动检测你所录入的数据库字母部分是否有小写,并自动更该为大写!');
form4.ClientDataSet1.First;
WHILE NOT form4.ClientDataSet1.EOF do
  begin
for i:=0 to form4.ClientDataSet1.FieldCount-1 do
begin
if form4.ClientDataSet1.FieldDefs[i].datatype=ftstring then
   begin
    T:=form4.ClientDataSet1.Fields[i].AsString;
    form4.ClientDataSet1.Edit;
    form4.ClientDataSet1.Fields[i].Value:=uppercase(T);

   end;
end;
 form4.ClientDataSet1.Next;
  end;
  form4.dformctlabel.Caption:='form2';

{=======================================}
 dform := Tdform.Create( Application );
      try
       dform.Show;
       dform.Update;
       form2.label4.Caption:=trim(form2.label4.Caption);
       form4.name.Lines.Text:=trim(form4.name.Lines.Text);

       Fdate:=dform.DateTimePicker1.date;
       DecodeDate(fdate,y,m,d);
       dform.Edit1.Text:=form4.name.Lines.Text+trim(form2.label4.Caption)+inttostr(y)+inttostr(m)+inttostr(d)+'.cdx';
       dform.combobox1.Enabled:=false;
      except
       end;

{=======================================}


//dform.show;

end else
begin
 showmessage('系统已经检测到你想要提交的数据库是空数据库,提交将不能进行!!!');
end;




end;

procedure TForm2.FormActivate(Sender: TObject);
begin
form1.Enabled:=false;
end;

procedure TForm2.GFXComboBox1Change(Sender: TObject);
begin
if   GFXComboBox1.Text='100%' then
begin
  dbgrid1.Font.Size:=9;
  dbgrid1.TitleFont.Size:=9;
end;

if   GFXComboBox1.Text='25%' then
begin
  dbgrid1.Font.Size:=6;
  dbgrid1.TitleFont.Size:=9;
end;

if   GFXComboBox1.Text='50%' then
begin
  dbgrid1.Font.Size:=7;
  dbgrid1.TitleFont.Size:=9;
end;


if   GFXComboBox1.Text='150%' then
begin
  dbgrid1.Font.Size:=16;
  dbgrid1.TitleFont.Size:=16;
end;

 if   GFXComboBox1.Text='200%' then
begin
  dbgrid1.Font.Size:=18;
  dbgrid1.TitleFont.Size:=18;
end;


end;

procedure TForm2.N36Click(Sender: TObject);
begin
N36.Checked:=not N36.Checked;
if N36.Checked then StatusBar1.Visible:=true else  StatusBar1.Visible:=false;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -