main.pas

《参透Delphi Kylix》通过131个事例

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, Grids, ExtCtrls, ImgList, Math, JuUtils, LotBase,
  StdCtrls;

type
  TFnStreamIOProgress = procedure (const Info: string; Curr, Total: Integer) of object;
  TUpdatingFlag = (ufAppending, ufInserting, ufModifying, ufDeleting);

  TFormMain = class(TForm)
    PageControl: TPageControl;
    TabSheetStakes: TTabSheet;
    TabSheetFrequency: TTabSheet;
    TabSheetDistribution: TTabSheet;
    PaintBox: TPaintBox;
    DrawGrid: TDrawGrid;
    StatusBar: TStatusBar;
    ImageList: TImageList;
    Label1: TLabel;
    Bevel1: TBevel;
    Bevel2: TBevel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    EditID: TEdit;
    EditStake: TEdit;
    EditDate: TEdit;
    ButtonAppend: TButton;
    ButtonModify: TButton;
    ButtonDelete: TButton;
    ButtonFirst: TButton;
    ButtonLast: TButton;
    ButtonPrev: TButton;
    ButtonNext: TButton;
    ButtonClear: TButton;
    ButtonInsert: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure DrawGridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ButtonFirstClick(Sender: TObject);
    procedure ButtonLastClick(Sender: TObject);
    procedure ButtonPrevClick(Sender: TObject);
    procedure ButtonNextClick(Sender: TObject);
    procedure ButtonClearClick(Sender: TObject);
    procedure ButtonAppendClick(Sender: TObject);
    procedure ButtonModifyClick(Sender: TObject);
    procedure ButtonDeleteClick(Sender: TObject);
    procedure ButtonInsertClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    FStake: TLotStake;
    FStakeNo: Integer;  // Current rec no
    FStakeHits: array of TLotStake;
    FStakeSets: array of TLotElementSet;
    FModified: Boolean; // Is stake hits history changed?
    // Append 10 new rows for analyzing.
    FAnalyzedMinRow: Integer;
    FAnalyzedStakes: array [0..LOT_BLANK_LINES - 1] of TAnalyzedStakeElements;
//    FAnalyzedRects: array [0..LOT_BLANK_LINES - 1, 1..LOT_MAX_ELEMENT] of TRect;
  protected
    procedure StreamIn(FnProgress: TFnStreamIOProgress = nil; const FileName: string = LOT_FILE_NAME);
    procedure StreamOut(FnProgress: TFnStreamIOProgress = nil; const FileName: string = LOT_FILE_NAME);
    procedure StreamIOProgress(const Info: string; Curr, Total: Integer);
    procedure CountFrequencies(var Freqs: TLotElementFreqArr; WithSpecialNo: Boolean = True);
    procedure GetMinMaxFrequencies(const Freqs: TLotElementFreqArr; var Min, Max: Integer);

    procedure InitDrawGrid();
    procedure SetTopRowOfDrawGrid();
    procedure RaiseFileNotFoundError(const FileName: string);
    procedure UpdateStatusBar(const Info: string; Curr, Total: Integer);

    procedure SetModifiedFlag(Flag: Boolean = True);
    function  StakeToStr(const Stake: TLotElementArr): string;
    function  StakeToStrFmt(const Fmt: string; const Stake: TLotElementArr): string;
    function  StrToStake(const StakeStr: string): TLotElementArr;
    procedure GetStake(const StakeNo: Integer);
    procedure CopyStakeToWorkspace();
    procedure CopyWorkspaceToStake();
    procedure ClearWorkspace();
    procedure UpdateStakes(Flag: TUpdatingFlag);
  public
    { Public declarations }
    procedure LoadFromFile(const FileName: string);
    procedure SaveToFile(const FileName: string);
  end;

var
  FormMain: TFormMain;

resourcestring
  SBFSFileNotFoundErr = 'Can not find file ''%s''.';
  SBFSReading = 'Reading...';
  SBFSWriting = 'Writing...';
  SBFSReady = 'Ready';
  SBFSRecInfo = 'Rec: %d of %d';
  SDataModificationInfo = 'Stakes have been changed. Save to file ''%s''?';

implementation

{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Self.StreamIn(Self.StreamIOProgress);
  Self.InitDrawGrid();
  Self.ButtonLastClick(Sender);
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  Self.FStakeHits := nil;
  Self.FStakeSets := nil;
end;

procedure TFormMain.StreamIn(FnProgress: TFnStreamIOProgress; const FileName: string);
var
  BFS: TJuBlockFileStream;
  I, J, Num: Integer;
begin
  if not SysUtils.FileExists(FileName) then Self.RaiseFileNotFoundError(FileName);
  BFS := TJuBlockFileStream.Create(FileName, fmOpenRead and fmShareDenyWrite, Integer(SizeOf(TLotStake)));
  Num := BFS.NumOfBlocks;
  try
    if Num >= 1 then
    begin
      System.SetLength(Self.FStakeHits, Num);
      System.SetLength(Self.FStakeSets, Num);
      for I := 0 to Num - 1 do
      begin
        if System.Assigned(FnProgress) then
        begin
          if I < Num - 1 then FnProgress(SBFSReading, I + 1, Num) else FnProgress(SBFSReady, Num, Num);
        end;
        BFS.SeekBlock(I + 1);
        BFS.ReadBlock(FStakeHits[I]);
        Self.FStakeSets[I] := [];
        for J := 1 to LOT_NUM_OF_SERIES do
          Self.FStakeSets[I] := Self.FStakeSets[I] + [Self.FStakeHits[I].Elements[J]];
      end;
      Self.SetModifiedFlag(False);
    end;
  finally
    SysUtils.FreeAndNil(BFS);
  end;
end;

procedure TFormMain.StreamOut(FnProgress: TFnStreamIOProgress; const FileName: string);
var
  BFS: TJuBlockFileStream;
  I, Num: Integer;
begin
  BFS := TJuBlockFileStream.Create(FileName, fmCreate or fmOpenWrite and fmShareExclusive, Integer(SizeOf(TLotStake)));
  Num := System.Length(Self.FStakeHits);
  try
    if Num >= 1 then
    begin
      for I := 0 to Num - 1 do
      begin
        if System.Assigned(FnProgress) then
        begin
          if I < Num - 1 then FnProgress(SBFSWriting, I + 1, Num) else FnProgress(SBFSReady, Num, Num);
        end;
        BFS.WriteBlock(FStakeHits[I]);
      end;
      Self.SetModifiedFlag(False);
    end;
  finally
    SysUtils.FreeAndNil(BFS);
  end;
end;

procedure TFormMain.StreamIOProgress(const Info: string; Curr, Total: Integer);
begin
  Self.UpdateStatusBar(Info, Curr, Total);
  Application.ProcessMessages();
end;

procedure TFormMain.LoadFromFile(const FileName: string);
begin
  Self.StreamIn(nil, FileName);
end;

procedure TFormMain.SaveToFile(const FileName: string);
begin
  Self.StreamOut(nil, FileName);
end;

procedure TFormMain.CountFrequencies(var Freqs: TLotElementFreqArr; WithSpecialNo: Boolean);
var
  I, J, Upper: Integer;
begin
  for I := System.Low(Freqs) to System.High(Freqs) do Freqs[I] := 0;
  for I := 0 to System.High(Self.FStakeHits) do
  begin
    if WithSpecialNo then
      Upper := System.High(Self.FStakeHits[I].Elements)
    else
      Upper := System.High(Self.FStakeHits[I].Elements) - 1;
    for J := System.Low(Self.FStakeHits[I].Elements) to Upper do
      System.Inc(Freqs[Self.FStakeHits[I].Elements[J]]);
  end;
end;

procedure TFormMain.GetMinMaxFrequencies(const Freqs: TLotElementFreqArr; var Min, Max: Integer);
var
  I: Integer;
begin
  Min := Freqs[System.Low(Freqs)];
  Max := Freqs[System.Low(Freqs)];
  for I := System.Low(Freqs) + 1 to System.High(Freqs) do
  begin
    if Min > Freqs[I] then Min := Freqs[I];
    if Max < Freqs[I] then Max := Freqs[I];
  end;
end;

procedure TFormMain.PaintBoxPaint(Sender: TObject);

  procedure InitPainting(var Rect: TRect; var AxisX, AxisY, CellWidth, CellHeight: Integer; const Min, Max: Integer);
  begin
    Self.PaintBox.Canvas.Brush.Color := clPercent909090;
    Rect := Self.PaintBox.ClientRect;
    AxisX := 50;
    AxisY := Self.PaintBox.ClientHeight - 30;
    CellWidth := (Self.PaintBox.ClientWidth - 60) div LOT_MAX_ELEMENT - 8;
    CellHeight := (Self.PaintBox.ClientHeight - 40) div (Max - Min + 3);
  end;

  procedure PaintBackground(Rect: TRect);
  begin
    Self.PaintBox.Canvas.FillRect(Rect);
  end;

  procedure PaintAxisXY(AxisX, AxisY: Integer);
  begin
    // Draw axis X and axis Y
    Self.PaintBox.Canvas.Pen.Color := clPercent213657; // Lighter that the font-color
    Self.PaintBox.Canvas.Pen.Width := 3;
    Self.PaintBox.Canvas.MoveTo(AxisX - 10, AxisY + 1);
    Self.PaintBox.Canvas.LineTo(Self.PaintBox.ClientWidth - 15, AxisY + 1);
    Self.PaintBox.Canvas.MoveTo(AxisX - 9, AxisY + 1);
    Self.PaintBox.Canvas.LineTo(AxisX - 9, 15);
  end;

  procedure PaintFreqLabel();
  var
    Str: string;
    TextWidth, TextHeight: Integer;
  begin
    // Draw 'Freq.'
    Self.PaintBox.Canvas.Font.Style := [fsBold];
    Self.PaintBox.Canvas.Font.Color := clPercent183149;
    Str := 'Freq.';
    TextWidth := Self.PaintBox.Canvas.TextWidth(Str);
    TextHeight := Self.PaintBox.Canvas.TextHeight(Str);
    Self.PaintBox.Canvas.TextOut(35 - TextWidth, 15, Str);
  end;

  procedure PaintFreqCells(const Freqs: TLotElementFreqArr; var Rect: TRect; const AxisX, AxisY, CellWidth, CellHeight: Integer; Min: Integer);

    procedure PaintFreqCellRect(const N: Integer; const Freqs: TLotElementFreqArr; var Rect: TRect; const AxisX, AxisY, CellWidth, CellHeight: Integer; Min: Integer);
    var
      OldBrush: TBrush;
    begin
      // Draw the rect of Freqs[N].
      Rect.Left := AxisX + (CellWidth + 8) * (N - 1);
      Rect.Right := Rect.Left + CellWidth;
      Rect.Bottom := AxisY;
      Rect.Top := Rect.Bottom - CellHeight * (Freqs[N] - Min + 2);
      OldBrush := TBrush.Create();
      OldBrush.Assign(Self.PaintBox.Canvas.Brush);
      Self.PaintBox.Canvas.Brush.Color := clPercent296077;  // Headline color
      Self.PaintBox.Canvas.FillRect(Rect);
      Self.PaintBox.Canvas.Brush.Assign(OldBrush);
      SysUtils.FreeAndNil(OldBrush);
    end;

    procedure PaintFreqCellLabel(const N: Integer; Rect: TRect; const CellWidth{, CellHeight}: Integer);
    var
      Str: string;
      TextWidth, TextHeight: Integer;
    begin
      Str := SysUtils.Format('%2.2d', [N]);
      Self.PaintBox.Canvas.Font.Style := [fsBold];
      Self.PaintBox.Canvas.Font.Color := clPercent183149;
      TextWidth := Self.PaintBox.Canvas.TextWidth(Str);
      TextHeight := Self.PaintBox.Canvas.TextHeight(Str);
      Self.PaintBox.Canvas.TextOut(Rect.Left + (CellWidth - TextWidth) div 2, Rect.Bottom + TextHeight div 2, Str);
    end;

    procedure PaintFreqCellCount(const N: Integer; const Freqs: TLotElementFreqArr; Rect: TRect; const CellWidth{, CellHeight}: Integer);
    var
      Str: string;
      TextWidth, TextHeight: Integer;
    begin
      // Draw the number of Freqs[N]
      Str := SysUtils.IntToStr(Freqs[N]);
      TextWidth := Self.PaintBox.Canvas.TextWidth(Str);
      TextHeight := Self.PaintBox.Canvas.TextHeight(Str);
      Self.PaintBox.Canvas.TextOut(Rect.Left + (CellWidth - TextWidth) div 2, Rect.Top - TextHeight - 2, Str);
    end;

  var
    I: Integer;
  begin
    // Draw cells
    for I := 1 to LOT_MAX_ELEMENT do
    begin
      PaintFreqCellRect(I, Freqs, Rect, AxisX, AxisY, CellWidth, CellHeight, Min);
      PaintFreqCellLabel(I, Rect, CellWidth);
      PaintFreqCellCount(I, Freqs, Rect, CellWidth);
    end;
  end;

var
  Freqs: TLotElementFreqArr;
  Min, Max: Integer;
  AxisX, AxisY, CellHeight, CellWidth: Integer;
  Rect: TRect;
begin
  Self.CountFrequencies(Freqs, True);
  Self.GetMinMaxFrequencies(Freqs, Min, Max);
  InitPainting(Rect, AxisX, AxisY, CellWidth, CellHeight, Min, Max);
  PaintBackground(Rect);
  PaintAxisXY(AxisX, AxisY);
  PaintFreqLabel();
  PaintFreqCells(Freqs, Rect, AxisX, AxisY, CellWidth, CellHeight, Min);
end;

procedure TFormMain.DrawGridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
type
  TCellFlag = (cfHeadlineInfoCell, cfHeadlineColCell, cfHeadlineRowCell, cfEvenBlankCell, cfOddBlankCell, cfNormalHitCell, cfSpecialHitCell, cfReservedBmpCell, cfDiscardedBmpCell);

  procedure DrawAnalyzedCellBitmap(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState; CellFlag: TCellFlag);
  var
    Index: Integer;
  begin
    Index := Math.IfThen(CellFlag = cfReservedBmpCell, 1, 2);  // 1 is reserved; 2 is discarded
    JuUtils.DrawBitmapFromImageList(Self.DrawGrid.Canvas, Rect.Left + 3, Rect.Top, Self.ImageList, Index);
  end;

  procedure DrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState; CellFlag: TCellFlag);
  var
    OldFont: TFont;
    OldBrush: TBrush;
    Str: string;
    CX, CY: Integer;
  begin
    OldFont := TFont.Create();
    OldFont.Assign(Self.DrawGrid.Canvas.Font);
    OldBrush := TBrush.Create();
    OldBrush.Assign(Self.DrawGrid.Canvas.Brush);

    Str := '';
    case CellFlag of
      cfHeadlineInfoCell:
      begin
        Str := 'Hits';
        Self.DrawGrid.Canvas.Font.Color := clWhite;
      end;
      cfHeadlineRowCell:
      begin
        Str := SysUtils.Format('%2.2d', [ACol]);
        Self.DrawGrid.Canvas.Font.Color := clWhite;
      end;
      cfHeadlineColCell:
      begin
        Str := JuUtils.IfThen(ARow < System.Length(Self.FStakeHits) + 1, Self.FStakeHits[ARow - 1].ID, 'Next');
        Self.DrawGrid.Canvas.Font.Color := clWhite;
      end;
      cfEvenBlankCell:
      begin
        Self.DrawGrid.Canvas.Brush.Color := clPercent909090;
      end;
      cfOddBlankCell:
      begin
        Self.DrawGrid.Canvas.Brush.Color := clWhite;
      end;
      cfNormalHitCell:
      begin
        Self.DrawGrid.Canvas.Brush.Color := clPercent498282;
        Str := SysUtils.Format('%2.2d', [ACol]);
        Self.DrawGrid.Canvas.Font.Color := clBlack;
      end;
      cfSpecialHitCell:
      begin
        Self.DrawGrid.Canvas.Brush.Color := clPercent838974;