unit1.pas

delphi 控制设备程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ToolWin, ComCtrls, Menus, ImgList, StdCtrls, OleCtrls, SHDocVw,
  ExtCtrls, MSCommLib_TLB;

//  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
//  ExtCtrls, LMDCustomScrollBox, LMDScrollBox, lmdsplt, LMDCustomControl,
//  LMDCustomPanel, LMDCustomBevelPanel, StdCtrls, Grids, DBGrids, Db,
//  DAODataset, DAOQuery, DAODatabase, LMDControl, LMDBaseControl,
//  LMDBaseGraphicControl, LMDGraphicControl, LMDLEDCustomLabel, LMDLEDLabel,
//  ColorBtns, ClrPanel, IniFiles, MyComm0, PubUnit, MPlayer,
//  LMDCustomParentPanel, LMDCustomPanelFill, LMDPanelFill;


type
  TForm1 = class(TForm)
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    miFile: TMenuItem;
    miFileOpen: TMenuItem;
    miSaveAs: TMenuItem;
    N1: TMenuItem;
    miPrint: TMenuItem;
    N2: TMenuItem;
    miClose: TMenuItem;
    miEdit: TMenuItem;
    miCut: TMenuItem;
    miCopy: TMenuItem;
    miPaste: TMenuItem;
    N3: TMenuItem;
    miSelectAll: TMenuItem;
    N4: TMenuItem;
    miFind: TMenuItem;
    miView: TMenuItem;
    miViewToolBar: TMenuItem;
    miViewStateBar: TMenuItem;
    N5: TMenuItem;
    miTurnTo: TMenuItem;
    miStop: TMenuItem;
    miRefresh: TMenuItem;
    miHelp: TMenuItem;
    miAbout: TMenuItem;
    miViewStandardButton: TMenuItem;
    miViewAddressBar: TMenuItem;
    miBack: TMenuItem;
    miForward: TMenuItem;
    miBlank: TMenuItem;
    tbMainMenu: TToolBar;
    ImageListNormal: TImageList;
    ImageListHot: TImageList;
    tbCmdButton: TToolBar;
    tButtonBack: TToolButton;
    tButtonForward: TToolButton;
    tButtonHome: TToolButton;
    tButtonRefresh: TToolButton;
    tButtonStop: TToolButton;
    CmbBoxAddress: TComboBox;
    CoolBar1: TCoolBar;
    Panel1: TPanel;
    WebBrowser1: TWebBrowser;
    PopupMenu1: TPopupMenu;
    miLabelBotton: TMenuItem;
    miLabelRight: TMenuItem;
    miNoLabel: TMenuItem;
    OpenDialog1: TOpenDialog;
    ReBoot: TMenuItem;
    OffPc: TMenuItem;
    MSComm1: TMSComm;
    Memo1: TMemo;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    Button3: TButton;
    Memo2: TMemo;
    Label3: TLabel;
    Edit3: TEdit;
    Button4: TButton;
    Edit4: TEdit;
    Button5: TButton;
    Button6: TButton;
    Label4: TLabel;
    Label5: TLabel;
    procedure miCloseClick(Sender: TObject);
    procedure CmbBoxAddressClick(Sender: TObject);
    procedure CmbBoxAddressKeyPress(Sender: TObject; var Key: Char);
    procedure FormCreate(Sender: TObject);
    procedure miLabelBottonClick(Sender: TObject);
    procedure miLabelRightClick(Sender: TObject);
    procedure miNoLabelClick(Sender: TObject);
    procedure tButtonBackClick(Sender: TObject);
    procedure tButtonForwardClick(Sender: TObject);
    procedure tButtonHomeClick(Sender: TObject);
    procedure tButtonRefreshClick(Sender: TObject);
    procedure tButtonStopClick(Sender: TObject);
    procedure miAboutClick(Sender: TObject);
    procedure miFileOpenClick(Sender: TObject);
    procedure miSaveAsClick(Sender: TObject);
    procedure miBlankClick(Sender: TObject);
    procedure miViewStandardButtonClick(Sender: TObject);
    procedure miViewAddressBarClick(Sender: TObject);
    procedure OffPcClick(Sender: TObject);
    procedure ReBootClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure MSComm1Comm(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button4Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure Button6Click(Sender: TObject);
  private      //只能在类的内部使用，不能被外部访问
    { Private declarations }
  protected
    { protected declarations }
  public
    procedure MyShowHint(Sender: TObject);
    { Public declarations }
  end;

var
  Form1: TForm1;
  senddata:array[1..20] of char;
  reData:array of Variant;
  sendstr:string;
  restr:string;
  Rgt: integer;
  Btm: integer; 

implementation

uses Unit2;

var
 add_times: integer;
 temp1:integer;
{$R *.dfm}

function Small2Big(SourceMoney:Currency):string;
var
    //strSourceMoney保存未转换的小写字符串，strSourceMoney保存已转换的大写字符串
    strSourceMoney,strObjectMoney:string;
    //ThisWei为当前位的大写，ThisPos为当前位的人民币单位
    ThisWei,ThisPos:string[2];
    //iWei为当前位置,posPoint为小数点的位置
    iWei,posPoint:integer;
begin
    strSourceMoney :=formatfloat('0.00',SourceMoney);//将浮点数转换成指定格式字符串
    posPoint:= pos('.', strSourceMoney);    // 小数点的位置
    //循环小写货币的每一位，从小写的右边位置到左边
    for iWei :=length(strSourceMoney) downto 1 do
    begin
        case strSourceMoney[iWei] of      //转换当前数字
            '.':Continue;					//如果是小数点，则不进行转换操作
            '1':ThisWei:='壹'; '2': ThisWei:='贰';
            '3': ThisWei:='叁'; '4': ThisWei:='肆';
            '5': ThisWei:='伍'; '6': ThisWei:='陆';
            '7': ThisWei:='柒'; '8': ThisWei:='捌';
            '9': ThisWei:='玖'; '0': ThisWei:='零';
        end;
        case PosPoint-iWei of              //获得当前人民币单位
            -3:ThisPos:='厘';-2:ThisPos:='分';
            -1:ThisPos:='角';1 :ThisPos:='元';
            2 :ThisPos:='拾';3 :ThisPos:='佰';
            4 :ThisPos:='千';5 :ThisPos:='万';
            6 :ThisPos:='拾';7:ThisPos:='佰';
            8 :ThisPos:='千';9 :ThisPos:='亿';
            10 :ThisPos:='十';11:ThisPos:='佰';
            12:ThisPos:='千';
        end;
    strObjectMoney :=ThisWei+ThisPos+strObjectMoney;//组合成大写金额
    end;
Small2Big:=strObjectMoney;      //
end;

procedure TForm1.miCloseClick(Sender: TObject);
begin
Close;
end;

procedure TForm1.CmbBoxAddressClick(Sender: TObject);
begin
WebBrowser1.Navigate(cmbBoxAddress.Text);
end;

procedure TForm1.CmbBoxAddressKeyPress(Sender: TObject; var Key: Char);
begin
  if Key =#13 then
    WebBrowser1.Navigate(cmbBoxAddress.Text);
end;

procedure TForm1.MyShowHint(Sender: TObject);
begin
  StatusBar1.SimplePanel :=True;
  StatusBar1.SimpleText :=Application.Hint ;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnHint :=MyShowHint;
  WebBrowser1.Navigate('about:blank');

  MSComm1.PortOpen :=true;
//  mscomm1.CommPort := 1;//指定端口
//  mscomm1.Settings := '4800,o,8,1';//其它参数
//  mscomm1.InBufferSize := 1024; //接收缓冲区
//  mscomm1.OutBufferSize := 1024;  //发送缓冲区
//  mscomm1.InputMode := comInputModeBinary;  //接收模式
//  mscomm1.InputLen := 0;       //一次读取所有数据
//  mscomm1.SThreshold := 0;    //一次发送所有数据
//  mscomm1.InBufferCount := 0;   //清空读取缓冲区
//  mscomm1.OutBufferCount := 0;  //清空发送缓冲区
//  mscomm1.PortOpen:=true;      //打开端口
//  MSComm1.RThreshold := 6;
//  MSComm1.RThreshold := 1;

end;

procedure TForm1.miLabelBottonClick(Sender: TObject);
begin
  tbCmdButton.Align:=alNone;
  tbCmdButton.ShowCaptions :=True;
  tbCmdButton.List :=False;
  tbCmdButton.Align :=alClient;
  miLabelBotton.Checked :=True;
end;

procedure TForm1.miLabelRightClick(Sender: TObject);
begin
  tbCmdButton.Align:=alNone;
  tbCmdButton.ShowCaptions :=True;
  tbCmdButton.List :=True;
  tbCmdButton.Align :=alClient;
  miLabelBotton.Checked :=True;

end;

procedure TForm1.miNoLabelClick(Sender: TObject);
begin
  tbCmdButton.Align:=alNone;
  tbCmdButton.List :=False;
  tbCmdButton.ShowCaptions :=False;
  tbCmdButton.Align :=alClient;
  miLabelBotton.Checked :=True;
end;

procedure TForm1.tButtonBackClick(Sender: TObject);
begin
WebBrowser1.GoBack;
end;

procedure TForm1.tButtonForwardClick(Sender: TObject);
begin
WebBrowser1.GoForward;
end;

procedure TForm1.tButtonHomeClick(Sender: TObject);
begin
WebBrowser1.GoHome;
end;

procedure TForm1.tButtonRefreshClick(Sender: TObject);
begin
WebBrowser1.Refresh;
end;

procedure TForm1.tButtonStopClick(Sender: TObject);
begin
WebBrowser1.Stop ;
end;

procedure TForm1.miAboutClick(Sender: TObject);
begin
FmAbout.ShowModal ;
end;

procedure TForm1.miFileOpenClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    WebBrowser1.Navigate(OpenDialog1.FileName );
end;

procedure TForm1.miSaveAsClick(Sender: TObject);
begin
  WebBrowser1.ExecWB(OLECMDID_SAVEAS,2);
end;

procedure TForm1.miBlankClick(Sender: TObject);
begin
  WebBrowser1.Navigate('about:blank');
end;

procedure TForm1.miViewStandardButtonClick(Sender: TObject);
begin
  miViewStandardButton.Checked := not miViewStandardButton.Checked;
  CoolBar1.Bands[1].Visible := miViewStandardButton.Checked;
end;

procedure TForm1.miViewAddressBarClick(Sender: TObject);
begin
  miViewAddressBar.Checked := not miViewAddressBar.Checked;
  CoolBar1.Bands[2].Visible := miViewAddressBar.Checked;
end;

procedure TForm1.OffPcClick(Sender: TObject);
var
//  st:SYSTEMTIME;
  hToken:THANDLE;
  tkp:TOKEN_PRIVILEGES;
  rr:Dword;
begin
  OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken);
  LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid );
  tkp.PrivilegeCount:=1;
  tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
  AdjustTokenPrivileges(hToken,FALSE,tkp,0,nil,rr);
//  ExitWindowsEx(EWX_SHUTDOWN OR EWX_POWEROFF,0);
  ExitWindowsEx(EWX_SHUTDOWN OR EWX_POWEROFF,0);
end;

procedure TForm1.ReBootClick(Sender: TObject);
var
//  st:SYSTEMTIME;
  hToken:THANDLE;
  tkp:TOKEN_PRIVILEGES;
  rr:Dword;
begin
  OpenProcessToken(GetCurrentProcess(),TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken);
  LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid );
  tkp.PrivilegeCount:=1;
  tkp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
  AdjustTokenPrivileges(hToken,FALSE,tkp,0,nil,rr);
//  ExitWindowsEx(EWX_REBOOT OR EWX_POWEROFF,0);
  ExitWindowsEx(EWX_REBOOT,0);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
MSComm1.PortOpen:=false;
MSComm1.Destroy;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   file1: TextFile;
   s1 : string;
 begin

   Memo1.Clear ;
   s1:=ExtractFilePath(Application.ExeName);
   s1:=s1+'zhou.dat';
   AssignFile(file1,s1);
   Rewrite(file1);
   Write(file1,'Enter a line of text: ');
   Writeln(file1,'You typed: 01 ');
   Writeln(file1,'You typed: 02 ');
   Writeln(file1,'You typed: 03 ');
   CloseFile(file1);

end;

procedure TForm1.MSComm1Comm(Sender: TObject);
//type
//  IArr = ^integer;
//  var
//    buffer:string;
//    CommRevStr :  String;
//    RevP : array [1..10] of byte;
//    i,bufferLength: byte;
//begin
//  bufferLength:=2;
//  buffer:=MsComm1.Input;
//  Move(IArr(buffer)^,Revp,bufferLength);
//  For i:=1 to BufferLength do
//    begin
//     CommrevStr :=CommrevStr+ inttohex(Revp[i],2)+' ';
//    end;

var
  i:longint;
begin
  redata:=mscomm1.Input;  //接收数据
  restr:='';
  for i:=0 to vararrayhighbound(redata,1) do
  restr:=restr + inttohex(redata[i],2)+' ';
//  mscomm1.PortOpen:=false;
//  memo1.Text:=restr;
  case MSComm1.CommEvent of
    comEvReceive:
      Memo1.Lines.Add(restr);
  end;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i,j,k:integer;
  s:string;
  MyArray:array[1..5,1..5]of integer;
begin
  i:=StrToInt(Edit1.Text);
  Edit2.Text :=IntToHex(i,2);
  s:=IntToHex(i,2);
  Memo1.Lines.Add(s);
//  Label2.Caption :=IntToStr(i);
//  Label2.Caption := IntToStr(StrToInt(Edit1.Text) * StrToInt(Edit2.Text));

  k:=0;
  for i:=1 to 5 do
    for j:=1 to 5 do
      inc(k,MyArray[i,j]);
 Edit1.Text:=IntToStr(k);
end;

procedure TForm1.Button3Click(Sender: TObject);
var
S,T :string;
label someplace;

begin
  add_times:=add_times+1;
  ShowMessage(Format('%d',[add_times]));

  ShowMessage(Application.ExeName);
  ShowMessage(ExtractFileName(Application.ExeName));
  ShowMessage(ExtractFilePath(Application.ExeName));
//  ShowMessage(ExtractFile(Application.ExeName));
  Application.MessageBox('abcdefg','测试',MB_OK);

  temp1:=Application.MessageBox('abcdefg','测试',3);

  Application.MessageBox('abcdefg','测试',3);
  if temp1=1 then
     goto someplace;
     
  Str(11.48:2:1,T);
  edit1.Text :=T;

  someplace:
    s:=T+'Truncs to'+IntToStr(Trunc(1.4))+#13#10;
  s:=s+'abcdefg';
  memo2.Text :=s;
  MessageDlg(s,mtInformation,[mbOk],0);

end;

procedure TForm1.Button5Click(Sender: TObject);
var
  AppPath : String;
begin
  AppPath:=ExtractFilePath(ParamStr(0));
  edit4.Text :=AppPath;
  ShowCursor(false);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if(Key=VK_F4) and ([ssAlt]=shift) then    //屏蔽Alt+F4键让程序不能被关闭
    begin
      Key:=0;
      ShowCursor(True);
    end;  
end;

procedure TForm1.Button4Click(Sender: TObject);
var
    ThisMoney:Currency;
begin
    try
        ThisMoney:=StrToFloat(Edit3.Text);
    except
        ShowMessage('Please input correct number');
        exit;
    end;
   Label3.Caption:= Small2Big(ThisMoney);
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  ShowCursor(True);
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  Rect: TRect;
  s:string;
begin
  s:=edit4.Text;
  Label5.Caption :=S[1]+S[6];
  MessageBeep(0);  //让计算机蜂鸣
  MessageBeep(0);  //让计算机蜂鸣
  SendMessage(Memo1.Handle, EM_GETRECT, 0, LongInt(@Rect));  //获取Memo1的矩形边界
  Rgt:= Rect.Right;    //保存原始矩形边界宽度
  Btm:= Rect.Bottom;   //保存原始矩形边界高度
  if Edit1.Text<> '' then
    Rect.Left:= StrToInt(Edit1.Text)   //更改Rect边界值
  else ShowMessage('请填入左边距');
  if Edit2.Text<>'' then
    Rect.Top:= StrToInt(Edit2.Text)
  else ShowMessage('请填入上边距');
  Rect.Right:= Rect.Right- StrToInt(Edit1.Text)+ 1;
  Rect.Bottom:= Rect.Bottom- StrToInt(Edit2.Text)+ 1;
  SendMessage(Memo1.Handle, EM_SETRECT, 0, LongInt(@Rect));   //重绘Memo1的矩形边界
  Memo1.Refresh;
end;


end.