mainform_.pas

梅花易数排课软件

unit MainForm_;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ImgList, StrUtils, MeiHuaYiShu, Buttons,
  jpeg, CoolTrayIcon, TextTrayIcon, Menus, XPMan, ActnList, ToolWin,
  ComCtrls, StdActns;

type
  TMainForm = class(TForm)
    Image1: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Memo: TMemo;
    Image2: TImage;
    Image3: TImage;
    Image4: TImage;
    Image5: TImage;
    Image6: TImage;
    Image7: TImage;
    Image8: TImage;
    Image9: TImage;
    Image10: TImage;
    LE1: TLabeledEdit;
    LE2: TLabeledEdit;
    LE3: TLabeledEdit;
    Label7: TLabel;
    cbx: TComboBox;
    Label8: TLabel;
    YiJing: TMemo;
    TextTrayIcon1: TTextTrayIcon;
    PopupMenu1: TPopupMenu;
    pmShow: TMenuItem;
    N1: TMenuItem;
    pmExit: TMenuItem;
    ImageList: TImageList;
    ActionList1: TActionList;
    FileOpen1: TFileOpen;
    FileSaveAs1: TFileSaveAs;
    WindowClose1: TWindowClose;
    RefreshAct: TAction;
    ClearAct: TAction;
    OptionAct: TAction;
    Label9: TLabel;
    WindowMinimize: TAction;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    DatePicker: TDateTimePicker;
    TimePicker: TDateTimePicker;
    btnNow: TButton;
    HelpAct: TAction;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    imgBGN: TImage;
    Label6: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit1Enter(Sender: TObject);
    procedure LE1Change(Sender: TObject);
    procedure NilImage;
    procedure TextTrayIcon1Click(Sender: TObject);
    procedure pmShowClick(Sender: TObject);
    procedure pmExitClick(Sender: TObject);
    procedure ActHelpExecute(Sender: TObject);
    procedure ActRefreshExecute(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure FileExit1Hint(var HintStr: String; var CanShow: Boolean);
    procedure ClearActExecute(Sender: TObject);
    procedure RefreshActExecute(Sender: TObject);
    procedure WindowClose1Execute(Sender: TObject);
    procedure btnNowClick(Sender: TObject);
    procedure HelpActExecute(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure FileSaveAs1Accept(Sender: TObject);
    procedure DatePickerChange(Sender: TObject);
    procedure FileOpen1Accept(Sender: TObject);
    procedure FileSaveAs1BeforeExecute(Sender: TObject);
    procedure FileOpen1BeforeExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure OptionActExecute(Sender: TObject);
    procedure LE2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LE3KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure LE1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure cbxKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  GNum1,GNum2,GNum3:Integer;
  Checking,Refreshing,Saved:Boolean;
  I:Integer;
  G:array[1..5] of TYiGua;
  MArchive:TArchiveData;
  ArchiveName:string;
  NeedToSave:Boolean;
  function CalcExpre(ExprStr:string):Integer;//计算文本表达式,只允许 0 至 9 以及 + 号，返回值小于0时，表示超过 maxint
  procedure DrawValue(Img:TImage;Val:TBaGuaValue);//按值画卦
  procedure DateTimeNow;

const
  dTop:Integer=12;
  dLeft:Integer=16;
  dWidth:Integer=16;
  dLen:Integer=88;
  dSpace:Integer=28;
  dGap:Integer=16;
  dColor:TColor=clHighLight;//$00F0ff;
implementation

uses InfoForm_, OpenErrForm_, OptionForm_;

{$R *.dfm}
procedure DateTimeNow;
begin
  MainForm.DatePicker.Date:=Now;
  MainForm.TimePicker.Time:=Now;
end;

procedure TMainForm.FormCreate(Sender: TObject);
{
var
  ZAppName: array[0..127] of char;
  Hold: String;
  Found: HWND;
begin

  Hold := Application.Title;
  Application.Title := 'OnlyOne'
     + IntToStr(HInstance); // 暂时修改窗口标题
  StrPCopy(ZAppName, Hold); // 原窗口标题
  Found := FindWindow(nil, ZAppName); // 查找窗口
  Application.Title := Hold; // 恢复窗口标题
  if Found<>0 then begin
    // 若找到则激活已运行的程序并结束自身
    ShowWindow(Found, SW_RESTORE);
    Application.Terminate;
  end;
}
begin
  Saved:=False;
  Checking:=False;
  Refreshing:=False;
  NilImage;
  MArchive:=TArchiveData.Create;
  DateTimeNow;
  FileSaveAs1.Enabled:=False;
  ArchiveName:='';
  NeedToSave:=False;
  MainForm.Update;
  //"G:\Documents and Settings\Karma.DSVR\桌面\2005.01.03  test.MHYS"
  if ParamCount=1 then
  begin
    if MArchive.LoadFromFile(ParamStr(1)) then
    begin
      DatePicker.DateTime:=MArchive.DateTime;
      TimePicker.DateTime:=MArchive.DateTime;
      Memo1.Lines.CommaText:=MArchive.Zhan;
      Memo2.Lines.CommaText:=MArchive.Duan;
      Memo3.Lines.CommaText:=MArchive.Yan;
      Memo4.Lines.CommaText:=MArchive.Jie;
      LE1.Text:=IntToStr(MArchive.Num1);
      LE2.Text:=IntToStr(MArchive.Num2);
      LE3.Text:=IntToStr(MArchive.Num3);
      RefreshAct.Execute;
      ArchiveName:=ParamStr(1);
      NeedToSave:=False;
    end
    else
      MessageDlg('打开文件：'+ParamStr(1)+'  失败!',mtWarning,[mbOK],0);
  end;
end;

procedure TMainForm.Edit1Change(Sender: TObject);
var
  ns,s:string;
  I:Integer;
begin
  //只允许 + , 0 .. 9 等12种字符
  if Checking then Exit;
  Checking:=True;
  ns:='';
  for I:=1 to Length(TEdit(Sender).Text) do
  begin
    s:=MidStr(TEdit(Sender).Text,I,1);
    if (s='+') or (s=',') or ((s>='0') and (s<='9') ) then ns:=ns+s;
  end;
  TEdit(Sender).Text:=ns;
  Checking:=False;

end;

function CalcExpre(ExprStr:string):Integer;//计算文本表达式,只允许 0 至 9 以及 + ,号，返回值小于0时，表示超过 maxint
var
  ns,s:string;
  I:Integer;
  sl:TStringList;
begin

  ExprStr:=Trim(ExprStr);
  ns:='';
  for I:=1 to Length(ExprStr) do//过滤非法字符
  begin
    s:=MidStr(ExprStr,I,1);
    if s='+' then s:=',';
    if (s=',') or ((s>='0') and (s<='9') ) then ns:=ns+s;
  end;
  Result:=0;
  sl:=TStringList.Create;
  sl.CommaText:=ns;
  try
    for I:=0 to sl.Count-1 do
      if sl.Strings[I]<>'' then Result:=Result+StrToInt(sl.Strings[I]);
  except
    Result:=-1;//非法值
  end;
  sl.Free;

end;

procedure TMainForm.Edit1Enter(Sender: TObject);
begin
  TEdit(Sender).SelectAll;
end;

procedure TMainForm.LE1Change(Sender: TObject);
var
  ns,s:string;
  I:Integer;
begin
  //只允许 + , 0 .. 9 等12种字符
  if Checking then Exit;
  Checking:=True;
  ns:='';
  for I:=1 to Length(TLabeledEdit(Sender).Text) do
  begin
    s:=MidStr(TLabeledEdit(Sender).Text,I,1);
    if (s='+') or (s=',') or ((s>='0') and (s<='9') ) then ns:=ns+s;
  end;
  TLabeledEdit(Sender).Text:=ns;
  TLabeledEdit(Sender).SelStart:=Length(ns);
  Checking:=False;

end;

procedure TMainForm.NilImage;
begin
  Image1.Picture.Bitmap:=nil;
  Image2.Picture.Bitmap:=nil;
  Image3.Picture.Bitmap:=nil;
  Image4.Picture.Bitmap:=nil;
  Image5.Picture.Bitmap:=nil;
  Image6.Picture.Bitmap:=nil;
  Image7.Picture.Bitmap:=nil;
  Image8.Picture.Bitmap:=nil;
  Image9.Picture.Bitmap:=nil;
  Image10.Picture.Bitmap:=nil;
end;

procedure DrawValue(Img:TImage;Val:TBaGuaValue);//按值画卦
var
  I,II:Integer;
//  YangYao:Boolean;
  procedure DrawLine(x1,y1:integer;Full:Boolean);
  begin
    Img.Canvas.MoveTo(x1,y1);
    if Full then
      Img.Canvas.LineTo(x1+dLen,y1)
    else
    begin
      Img.Canvas.LineTo(x1+(dLen div 2)- (dGap div 2)-8,y1);
      Img.Canvas.MoveTo(x1+(dLen div 2)+ dGap-2,y1);
      Img.Canvas.LineTo(x1+dLen,y1);
    end;
  end;
begin
  With MainForm do
  begin
    Image1.Canvas.Pen.Style:=psSolid;
    Image1.Canvas.Pen.Color:=dColor;
    Image1.Canvas.Pen.Width:=dWidth;
    Image2.Canvas.Pen:=Image1.Canvas.Pen;
    Image3.Canvas.Pen:=Image1.Canvas.Pen;
    Image4.Canvas.Pen:=Image1.Canvas.Pen;
    Image5.Canvas.Pen:=Image1.Canvas.Pen;
    Image6.Canvas.Pen:=Image1.Canvas.Pen;
    Image7.Canvas.Pen:=Image1.Canvas.Pen;
    Image8.Canvas.Pen:=Image1.Canvas.Pen;
    Image9.Canvas.Pen:=Image1.Canvas.Pen;
    Image10.Canvas.Pen:=Image1.Canvas.Pen;
  end;

  DrawLine(dLeft,dTop,(Val and 1)=1);
  DrawLine(dLeft,dTop+dSpace,(Val and 2)=2);
  DrawLine(dLeft,dTop+dSpace+dSpace,(Val and 4)=4);

end;

procedure TMainForm.TextTrayIcon1Click(Sender: TObject);
begin
  TextTrayIcon1.ShowMainForm;
  TextTrayIcon1.IconVisible:=False;
end;

procedure TMainForm.pmShowClick(Sender: TObject);
begin
  TextTrayIcon1Click(nil);
end;

procedure TMainForm.pmExitClick(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.ActHelpExecute(Sender: TObject);
begin
  InfoForm.ShowModal;
end;

procedure TMainForm.ActRefreshExecute(Sender: TObject);
var
  S,X,Y:Integer;//上、下、爻
  I,Ln:Integer;
  vb:string;
  label Change,Done;
begin
//确定用户使用哪种方式起卦
//计算1至3个输入表达式
//得到本卦和爻动
//互卦，互互，变卦、变互
//按卦画像，刷新IMAGE
  if Refreshing then Exit;
  Refreshing:=True;
//  RefreshBtn.Enabled:=False;

  if LE1.Text='' then
  begin
    ShowMessage('缺上卦');
    LE1.SetFocus;
    goto Done;
  end;

  if (LE2.Text='') and ((LE3.Text='') and (cbx.ItemIndex=0)) then
  begin
    ShowMessage('缺下卦或爻动');
    LE2.SetFocus;
    Exit;
  end;

  if (LE2.Text='') and (cbx.ItemIndex=0) then
  begin
    ShowMessage('这是什么起卦方法？真新鲜');
    LE3.SetFocus;
    goto Done;
  end;

  if (LE3.Text<>'') and (cbx.ItemIndex>0) then
  begin
    ShowMessage('请确定用数还是用时辰作为爻动，不用的项请留空');
    LE3.SetFocus;
    goto Done;
  end;

  S:=CalcExpre(LE1.Text);//上卦原始数据
  if S<0 then
  begin
    ShowMessage('数值太大！有必要吗？');
    LE1.SetFocus;
    goto Done;
  end;

  if (LE2.Text<>'') and (LE3.Text='') and (cbx.ItemIndex=0) then//只有上、下卦
  begin
    X:=CalcExpre(LE2.Text);
    if X<0 then
    begin
      ShowMessage('数值太大！有必要吗？');
      LE2.SetFocus;
      goto Done;
    end;
    Y:=(S+X);
    goto Change;
  end;

  if (LE2.Text<>'') and ((LE3.Text<>'') or (cbx.ItemIndex>0)) then//三部分都有
  begin