?? mainform.~pas

?? 電報收發,使用電流環收發電報的服務程序,使用國際電報2號碼,內含編碼解碼函數
?? ~PAS
字號:
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, CPort, CPortCtl, ComCtrls,StrUtils,ShellAPI;
const
  WM_BARICON=WM_USER+200;
type
  TFormMain = class(TForm)
    ComPort: TComPort;
    Memo: TMemo;
    Button_Open: TButton;
    Button_Settings: TButton;
    Edit_Data: TEdit;
    Button_Send: TButton;
    NewLine_CB: TCheckBox;
    Panel1: TPanel;
    Bt_Store: TButton;
    Bt_Load: TButton;
    ComLed1: TComLed;
    ComLed2: TComLed;
    ComLed3: TComLed;
    ComLed4: TComLed;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    ComLed5: TComLed;
    ComLed6: TComLed;
    Label1: TLabel;
    Label6: TLabel;
    Edit1: TEdit;
    Edit2: TEdit;
    Button2: TButton;
    Edit3: TEdit;
    Button1: TButton;
    procedure Button_OpenClick(Sender: TObject);
    procedure Button_SettingsClick(Sender: TObject);
    procedure Button_SendClick(Sender: TObject);
    procedure ComPortOpen(Sender: TObject);
    procedure ComPortClose(Sender: TObject);
    procedure ComPortRxChar(Sender: TObject; Count: Integer);
    procedure Bt_LoadClick(Sender: TObject);
    procedure Bt_StoreClick(Sender: TObject);
    Function ITA2ToStr(Source:String):String;
    Function ITA2ChToAsc(s:String):char;
    Function AscToIta2(c:Char):String;
    Function FindChar(c:Char;a:Array of char):Integer;
    Function AscStrToIta2Str(Source:String):String;
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure WMSysCommand(var  Message: TMessage); message WM_SYSCOMMAND;


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

  LTRSC: array [0..31] of char;
  FIGSC: array [0..31] of char;
  LTRS:array [0..31] of String;
  LTRB:Array [0..31] of char;
  isLtrs:Boolean;
  isA:Integer;//初始為0，1為字母，-1為數字
implementation

{$R *.dfm}


procedure TFormMain.Button_OpenClick(Sender: TObject);
begin
  if ComPort.Connected then
    ComPort.Close
  else
    ComPort.Open;
end;

procedure TFormMain.Button_SettingsClick(Sender: TObject);
begin
  ComPort.ShowSetupDialog;
end;

procedure TFormMain.Button_SendClick(Sender: TObject);
var
  Str: String;
begin
  Str := Edit_Data.Text;
  if NewLine_CB.Checked then
    Str := 'ZCZC '+Str + #13#10+'NNNN';
    Str:=AscStrToIta2Str(Str);
  ComPort.WriteStr(Str);
end;

procedure TFormMain.ComPortOpen(Sender: TObject);
begin
  Button_Open.Caption := '關閉';
end;

procedure TFormMain.ComPortClose(Sender: TObject);
begin
  if Button_Open <> nil then
    Button_Open.Caption := '打開';
end;

procedure TFormMain.ComPortRxChar(Sender: TObject; Count: Integer);
var
  Str: String;
begin
  ComPort.ReadStr( Str, Count);
  Memo.Text := Memo.Text + Ita2ToStr(Str);

end;

procedure TFormMain.Bt_LoadClick(Sender: TObject);
begin
  ComPort.LoadSettings(stRegistry, 'HKEY_LOCAL_MACHINE\Software\Dejan');
//  ComPort.LoadSettings(stIniFile, 'e:\Test.ini');
end;

procedure TFormMain.Bt_StoreClick(Sender: TObject);
begin
//  ComPort.StoreSettings(stIniFile, 'e:\Test.ini');

  ComPort.StoreSettings(stRegistry, 'HKEY_LOCAL_MACHINE\Software\Dejan');
end;

procedure TFormMain.Button2Click(Sender: TObject);
begin
Edit2.Text:=Ita2ToStr(Edit1.Text);
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
LTRB[0]:=#0;
LTRB[1]:=#1;
LTRB[2]:=#2;
LTRB[3]:=#3;
LTRB[4]:=#4;
LTRB[5]:=#5;
LTRB[6]:=#6;
LTRB[7]:=#7;
LTRB[8]:=#8;
LTRB[9]:=#9;
LTRB[10]:=#$A;
LTRB[11]:=#$B;
LTRB[12]:=#$C;
LTRB[13]:=#$D;
LTRB[14]:=#$E;
LTRB[15]:=#$F;
LTRB[16]:=#$10;
LTRB[17]:=#$11;
LTRB[18]:=#$12;
LTRB[19]:=#$13;
LTRB[20]:=#$14;
LTRB[21]:=#$15;
LTRB[22]:=#$16;
LTRB[23]:=#$17;
LTRB[24]:=#$18;
LTRB[25]:=#$19;
LTRB[26]:=#$1A;
LTRB[27]:=#$1B;
LTRB[28]:=#$1C;
LTRB[29]:=#$1D;
LTRB[30]:=#$1E;
LTRB[31]:=#$1F;

LTRS[0]:='#0';
LTRS[1]:='#1';
LTRS[2]:='#2';
LTRS[3]:='#3';
LTRS[4]:='#4';
LTRS[5]:='#5';
LTRS[6]:='#6';
LTRS[7]:='#7';
LTRS[8]:='#8';
LTRS[9]:='#9';
LTRS[10]:='#$A';
LTRS[11]:='#$B';
LTRS[12]:='#$C';
LTRS[13]:='#$D';
LTRS[14]:='#$E';
LTRS[15]:='#$F';
LTRS[16]:='#$10';
LTRS[17]:='#$11';
LTRS[18]:='#$12';
LTRS[19]:='#$13';
LTRS[20]:='#$14';
LTRS[21]:='#$15';
LTRS[22]:='#$16';
LTRS[23]:='#$17';
LTRS[24]:='#$18';
LTRS[25]:='#$19';
LTRS[26]:='#$1A';
LTRS[27]:='#$1B';
LTRS[28]:='#$1C';
LTRS[29]:='#$1D';
LTRS[30]:='#$1E';
LTRS[31]:='#$1F';


LTRSC[0]:=#0;
LTRSC[1]:='E';
LTRSC[2]:=#$A;
LTRSC[3]:='A';
LTRSC[4]:=#$20;
LTRSC[5]:='S';
LTRSC[6]:='I';
LTRSC[7]:='U';
LTRSC[8]:=#13;
LTRSC[9]:='D';
LTRSC[10]:='R';
LTRSC[11]:='J';
LTRSC[12]:='N';
LTRSC[13]:='F';
LTRSC[14]:='C';
LTRSC[15]:='K';
LTRSC[16]:='T';
LTRSC[17]:='Z';
LTRSC[18]:='L';
LTRSC[19]:='W';
LTRSC[20]:='H';
LTRSC[21]:='Y';
LTRSC[22]:='P';
LTRSC[23]:='Q';
LTRSC[24]:='O';
LTRSC[25]:='B';
LTRSC[26]:='G';
LTRSC[27]:=' ';
LTRSC[28]:='M';
LTRSC[29]:='X';
LTRSC[30]:='V';
LTRSC[31]:=' ';

FIGSC[0]:=#0;
FIGSC[1]:='3';
FIGSC[2]:=#$A;
FIGSC[3]:='-';
FIGSC[4]:=#$20;
FIGSC[5]:=#$27;
FIGSC[6]:='8';
FIGSC[7]:='7';
FIGSC[8]:=#$13;
FIGSC[9]:=#5;
FIGSC[10]:='4';
FIGSC[11]:=#7;
FIGSC[12]:=',';
FIGSC[13]:=' ';
FIGSC[14]:=':';
FIGSC[15]:='(';
FIGSC[16]:='5';
FIGSC[17]:='+';
FIGSC[18]:=')';
FIGSC[19]:='2';
FIGSC[20]:=' ';
FIGSC[21]:='6';
FIGSC[22]:='0';
FIGSC[23]:='1';
FIGSC[24]:='9';
FIGSC[25]:='?';
FIGSC[26]:=' ';
FIGSC[27]:=' ';
FIGSC[28]:='.';
FIGSC[29]:='/';
FIGSC[30]:='=';
FIGSC[31]:=' ';
isA:=0;
end;

function TFormMain.ITA2ToStr(Source: String): String;
var
sr,st,s:String;
i_l,i_start,i_stop:Integer;
begin
sr:='';
i_l:=Length(Source);
i_start:=1;
s:=Source+'#';
while i_start<i_l do
begin
i_stop:=pos('#',s);
s[i_start]:='#';
st:=MidStr(s,i_start,i_stop-i_start);

s[i_stop]:='*';
s[i_start]:='*';
if st='#$1F' then
    isLtrs:=True
else if st='#$1B' then
isLtrs:=False
else if st<>'' then
sr:=sr+StringOfChar(ITA2ChToAsc(st),1);
i_start:=i_stop;
end;
Result:=sr;
end;

function TFormMain.ITA2ChToAsc(s: String): char;
var
c:Char;
k,i:Integer;
begin
if isLtrs then
begin
  K:=0;
  For k:=0 to 31 do
    begin
    if LTRS[k]=s then
      begin
      c:=LTRSC[k];
      break;
      end;
    end;

  end

else
 For i:=0 to 31 do
    begin
    if LTRS[i]=s then
      begin
      c:=FIGSC[i];
      break;
      end;
    end;



Result := c;
end;

function TFormMain.AscToIta2(c: Char): String;
var
i,j,i_f:Integer;
s_r:String;
begin
s_r:='';
if isA=0 then
  begin
  i_f:=FindChar(c,LTRSC);
  if i_f<0 then
    begin
    s_r:=StringOfChar(#$1B,1);
    i_f:=FindChar(c,FIGSC);
    isA:=-1;
    s_r:=s_r+StringOfChar(LTRB[i_f],1);
    end
    else
      begin
      s_r:=StringOfChar(#$1F,1)+StringOfChar(LTRB[i_f],1);
      isA:=1;
      end;
  end
  else

  if isA>0 then
  begin
    i_f:=FindChar(c,LTRSC);
    if i_f<0 then
      begin
      isA:=-1*isA;
      s_r:=s_r+StringOfChar(#$1B,1)+StringOfChar(LTRB[i_f],1);
      end
    else
    s_r:=StringOfChar(LTRB[i_f],1);
  end
  else
  Begin
    i_f:=FindChar(c,FIGSC);
    if i_f<0 then
      begin
      isA:=-1*isA;
      s_r:=s_r+StringOfChar(#$1F,1)+StringOfChar(LTRB[i_f],1);
      end
    else
    s_r:=s_r+StringOfChar(LTRB[i_f],1);
  end;
  
  Result:=s_r;
end;



function TFormMain.FindChar(c: Char; a: array of char): Integer;
var
i_r,i:integer;
begin
i_r:=-1;
  For i:=0 to 31 do
    Begin
    if c=a[i] then
      begin
      i_r:=i;
      break;
      end;
    end;

    Result:=i_r;
end;

function TFormMain.AscStrToIta2Str(Source: String): String;
var
i_l,i:Integer;
s_r:String;
begin
isA:=0;
s_r:='';
  i_l:=Length(Source);
    For i:=0 To i_l do
        s_r:=s_r+AscToIta2(Source[i]);
    Result:=s_r;
end;

procedure TFormMain.Button1Click(Sender: TObject);
var
s:String;
begin
s:=AscStrToIta2Str(Edit2.Text);
Edit3.Text:=s;
end;

procedure TFormMain.WMSysCommand(var Message: TMessage);
var
   lpData:PNotifyIconData;
begin
  if Message.WParam = SC_ICON then
  begin
     //如果用戶最小化窗口則將窗口隱藏并在任務欄上添加圖標
     lpData := new(PNotifyIconDataA);
     lpData.cbSize := 88;
//SizeOf(PNotifyIconDataA);
     lpData.Wnd := FormMain.Handle;
     lpData.hIcon := FormMain.Icon.Handle;
     lpData.uCallbackMessage := WM_BARICON;
     lpData.uID :=0;
     lpData.szTip := '電報收發';
     lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
     Shell_NotifyIcon(NIM_ADD,lpData);
     dispose(lpData);
     FormMain.Visible := False;
  end
  else
  begin
     //如果是其它的SystemCommand消息則調用系統缺省處理函數處理之。
     DefWindowProc(FormMain.Handle,Message.Msg,Message.WParam,Message.LParam);
  end;
//


end;

end.
?? 文件大小 218 K
?? 上傳用戶 foreverxiluzai
?? 所屬分類通訊/手機編程
??? 相關標簽

#電報 #收發 #國際 #號碼
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? mainform.~pas

?? 快捷鍵說明
