u_form1.~pas

很好地delphi书籍源码

unit U_Form1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DBActns, ActnList, ComCtrls, StdCtrls, ToolWin, Grids, DBGrids,
  ExtCtrls, ImgList, Menus;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    DSAppendTB: TToolButton;
    DSEditTB: TToolButton;
    DSPostTB: TToolButton;
    DSDeleteTB: TToolButton;
    PrintTB: TToolButton;
    ActionList1: TActionList;
    DSAppend: TDataSetInsert;
    DSEdit: TDataSetEdit;
    DSDelete: TDataSetDelete;
    DSPost: TDataSetPost;
    Print: TAction;
    Exit: TAction;
    CloseTB: TToolButton;
    TeamCB: TComboBox;
    ImageList1: TImageList;
    DBGrid1: TDBGrid;
    StringGrid1: TStringGrid;
    PredictTB: TToolButton;
    Predict: TAction;
    WriteTo: TAction;
    WriteToTB: TToolButton;
    TeamTB: TToolButton;
    Team: TAction;
    Match: TAction;
    MatchTB: TToolButton;
    Splitter1: TSplitter;
    StatusBar1: TStatusBar;
    DBGrid2: TDBGrid;
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    OpenMenu: TMenuItem;
    SaveMenu: TMenuItem;
    SepMenu: TMenuItem;
    ExitMenu: TMenuItem;
    OpenAction: TAction;
    SaveAction: TAction;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    SaveAsAction: TAction;
    SaveAsMenu: TMenuItem;
    DSCancel: TDataSetCancel;
    CancelTB: TToolButton;
    procedure TeamCBChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TeamExecute(Sender: TObject);
    procedure MatchExecute(Sender: TObject);
    procedure ExitExecute(Sender: TObject);
    procedure PredictExecute(Sender: TObject);
    procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure WriteToExecute(Sender: TObject);
    procedure PrintExecute(Sender: TObject);
    procedure OpenActionExecute(Sender: TObject);
    procedure SaveActionExecute(Sender: TObject);
    procedure SaveAsActionExecute(Sender: TObject);
  private
    Modified: Boolean;
    CurrentFile: string;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses U_Form2, U_Form3, U_DataModule, U_QReport;

{$R *.dfm}
const Factor:array[1..6] of string=('实力因素','场所因素','历史因素','伤病因素','状态因素','预测结果');
const FactorNum=7;
const ChangCiNum=14;

procedure TForm1.TeamCBChange(Sender: TObject);
begin
  if TeamCB.ItemIndex>0 then
  begin
    Caption:=Format('足彩竞猜第%d轮投注表',[TeamCB.ItemIndex]);
    with DM.Query1 do
    begin
      Close;
      SQL.Clear;
      SQL.Add('SELECT 主队,客队 FROM  对阵表.db where  轮次='+TeamCB.Text );
      Open;
      DBGrid2.Visible:=true;
    end;
  end else
    DBGrid2.Visible:=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i,j:byte;
begin
  DBGrid1.Columns[0].Visible:=false;
  StringGrid1.ColCount:=FactorNum;
  StringGrid1.RowCount:=ChangCiNum;
  StringGrid1.Cells[0,0]:='场次';
  for i:=1 to FactorNum-1 do
    StringGrid1.Cells[i,0]:=Factor[i];
  for i:=1 to ChangCiNum-1 do
  begin
    StringGrid1.Cells[0,i]:=format('第%d场',[i]);
    DBGrid1.Columns[i].PickList.Add('胜');
    DBGrid1.Columns[i].PickList.Add('平');
    DBGrid1.Columns[i].PickList.Add('负');
  end;
  for i:=1 to StringGrid1.RowCount do
    for j:=1 to StringGrid1.ColCount-2 do
     StringGrid1.Cells[j,i]:='0';
  StatusBar1.SimpleText:='每个影响因素输入-10到10之间的一个整数。'+
    '投注时，如果计算结果大于3取胜,小于-3取负,-3与3之间取平 ！ ' ;

end;

procedure TForm1.TeamExecute(Sender: TObject);
begin
  Hide;
  Form2.Show;
end;

procedure TForm1.MatchExecute(Sender: TObject);
begin
  Hide;
  Form3.Show;
end;

procedure TForm1.ExitExecute(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.PredictExecute(Sender: TObject);
var
  i,j,Num: integer;
  function Answer(N:integer):string;
  begin
    if N>3 then
      Answer:=' 胜 '
    else if  N<-3 then
      Answer:=' 负 '
    else
      Answer:=' 平 ';
  end;
begin
  with  StringGrid1 do
  for i:=1 to RowCount-1 do
  begin
    Num:=0;
    for j:=1 to ColCount-2 do
      Num:=Num+StrToInt(Cells[j,i]);
     Cells[ColCount-1,i]:=Answer(Num);
  end;
  WriteTo.Enabled:=true;
end;

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in ['-','0','1','2','3','4','5','6','7','8','9']) then
    ShowMessage('请输入数字！');
end;

procedure TForm1.WriteToExecute(Sender: TObject);
var
  i:integer;
begin
  with DM.WriteTable do
  begin
    Append;
    for i:=1 to StringGrid1.RowCount-1 do
      Fields[i].AsString:=StringGrid1.Cells[FactorNum-1,i];
  end;
  Predict.Enabled:=True;
  WriteTo.Enabled:=false;

end;

procedure TForm1.PrintExecute(Sender: TObject);
begin
  Form4:=TForm4.Create(Application);
  Form4.QuickRep1.ReportTitle:='足彩竞猜第'+TeamCB.Text+'轮投注单';
  Form4.QuickRep1.Preview;
  Form4.Free;
end;

procedure TForm1.OpenActionExecute(Sender: TObject);
var
  LoadStream: TFileStream;
  I, J, Value: Integer;
begin
  if OpenDialog1.Execute then
  begin
    CurrentFile := OpenDialog1.Filename;
    Caption := '图表 [' + CurrentFile + ']';
    {load from the current file}
    LoadStream := TFileStream.Create (CurrentFile, fmOpenRead);
    try
      for I := 1 to FactorNum-1 do
        for J := 1 to ChangCiNum-1 do
        begin
          LoadStream.Read (Value, sizeof (Integer));
          StringGrid1.Cells [I, J] := IntToStr(Value);
        end;
      LoadStream.Read (Value, sizeof (Integer));
    finally
      LoadStream.Free;
    end;
    Modified := False;
  end;
end;

procedure TForm1.SaveActionExecute(Sender: TObject);
var
  SaveStream: TFileStream;
  I, J, Value: Integer;
begin
  if Modified then
    if CurrentFile = '' then
      SaveAsActionExecute(self)
    else
    begin
      {save to the current file}
      SaveStream := TFileStream.Create (
        CurrentFile, fmOpenWrite or fmCreate);
      try
        for I := 1 to FactorNum-1 do
          for J := 1 to ChangCiNum-1 do
          begin
            Value := StrToIntDef (Trim(StringGrid1.Cells [I, J]), 0);
            SaveStream.Write (Value, sizeof (Integer));
          end;
        SaveStream.Write (Value, sizeof (Integer));
        Modified := False;
      finally
        SaveStream.Free;
      end;
    end;
end;

procedure TForm1.SaveAsActionExecute(Sender: TObject);
begin
  if SaveDialog1.Execute then
  begin
    CurrentFile := SaveDialog1.Filename;
    Modified := True;
    SaveActionExecute(self);
  end;
end;

end.