⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 flyingmain.pas

📁 DevExpress公司出品的Borland Delphi和C++ Builder的控件(包含完整源代码)。 ExpressSpreadSheet:交叉数据表格控件。 一款Delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:

procedure TFlyingMainForm.UpdateCofG;                               // Update the C of G
begin
  Pb.Repaint;                                              // Repaint the paint box
end;

procedure TFlyingMainForm.cxSpread1SetSelection(Sender: TObject;
  ASheet: TcxSSBookSheet);                                 // Selection has changed update the hint in the status bar
var
  fCell   : TPoint;                                        // The Current cell
  fHelpId : integer;                                       // The Help ID
begin
  fCell := aSheet.ActiveCell;                              // Get the Active Cell
  if (fCell.Y < 20) and (fCell.X < 4) then                 // If we are on the active area of the sheet
  begin
    fHelpId := HelpIds[fCell.Y, fCell.X];                  // Get the helpid
    if fMaxPersons = 2 then                                // If this is a 2 seater it has two baggage areas
    begin
      if (fCell.Y = 15) then                               // If we are on the Second seat in a 4 seater then display the baggage help
        Inc(fHelpId)                                       // bump the help id
      else if (fCell.Y = 16) then                          // If we are on the baggae area on a 4 seater the display special help for second baggae area
        fHelpId := 9;                                      // specila 2 setare second baggae area
    end;
  end
  else
    fHelpId := 0;                                          // ensure no help for out of limits
  if fHelpId <> 0 then                                     // if we have help
    StatusBar1.Panels[0].Text := HelpText[fHelpId]         // update the status bar
  else
    StatusBar1.Panels[0].Text := '';                       // clear the last help
end;

procedure TFlyingMainForm.CheckFigures;                             // OK let's check the figures for validity
var
  fVal1, fVal2 : double;                                   // Local vars for figures
  function CofGOutsideEnvelope(const aCofG,
                               aWeight: double): boolean;  // Check weightr and C of G inside safety envelope
  var
    X, Y    : integer;                                     // X and Y of position
    fRegion : HRGN;                                        // Handle to region cretaed from points that define the envelope
  begin                                                    // JIC
    X := Round(aWeight * 10);                              // Scale up X
    Y := Round(aCofG * 100);                               // Scale up Y
    fRegion := CreatePolygonRgn(fCofGEnvelope[0],
                                fEnvelopeSize, WINDING);   // Create the region
    try
      Result := not PtInRegion(fRegion, X, y);             // Use window to do the work
    finally
      DeleteObject(fRegion);                               // Delete the region
    end;
  end;
begin
  UpdateCofG;                                              // Ensure we are up to date on the graph
  SetCellMessage(0, 10, '', fNormalCellColour, 1);         // Clear the upper error row
  SetCellMessage(0, 20, '', fNormalCellColour, 1);         // Clear the lower error row
  fVal1 := GetCellDouble(3, 8);                            // Get Calculated minimum fuel
  if fVal1 > fMaxFuelCapacity then                         // if we exceed the maximum fuel capacity
  begin
    SetCellMessage(0, 10, Format('Maximum fuel capacity exceeded by %0.2f Ltrs',
      [fVal1 - fMaxFuelCapacity]), 2, 1);                  // Display the error
    Exit;                                                  // No more messages
  end;
  fVal2 := GetCellDouble(3, 9);                            // Get Actual fuel
  if fVal1 > fVal2 then                                    // If actual fuel is less than we need
  begin
    SetCellMessage(0, 10, Format('%0.2f more Ltrs of fuel required', [fVal1 - fVal2]), fErrorCellColour,
      1);                                                  // Display the error
    Exit;                                                  // no more errors
  end;
  if fVal2 > fMaxFuelCapacity then                         // If Actual fuel is more than the capacity ?
  begin
    SetCellMessage(0, 10, 'Maximum Fuel load exceeded', 23, 1); // Display the error
    Exit;                                                  // No more errors
  end;
  fVal1 := GetCellDouble(1, 17);                           // Get Take Off Weight
  if fVal1 > fMaxTakeOffWt then                            // If we are more that certified max
  begin
    SetCellMessage(0, 20, Format('Maximum Take Off Weight exceeded by %0.2f %s',
      [fVal1 - fMaxTakeOffWt, fWeightUnits]), 2, 1);       // Display the error
    Exit;                                                  // No more errors
  end;
  fVal2 := GetCellDouble(2, 17) * fCofgMultiplier;         // Get the Take of C of G
  // Get Take Off C of G
  if CofGOutsideEnvelope(fVal2, fVal1) then                // If outside envelope
  begin
    SetCellMessage(0, 20, 'Take Off C of G outside safe envelope', 2, 1); // Display the error
    Exit;                                                  // No more errors
  end;
  fVal1 := GetCellDouble(1, 19);                           // Get Landing Weight
  if fVal1 > fMaxLandingWt then                            // Check against max allowed
  begin
    SetCellMessage(0, 20, Format('Maximum Landing Weight exceeded by %0.2f %s',
      [fVal1 - fMaxTakeOffWt, fWeightUnits]), 2, 1);       // Display the error
    Exit;                                                  // No more errors
  end;
  fVal2 := GetCellDouble(2, 19) * fCofgMultiplier;         // Get the landing C of G
  // Get Landing C of G
  if CofGOutsideEnvelope(fVal2, fVal1) then                // Check envelope
    SetCellMessage(0, 20, 'Landing C of G outside safe envelope', 2, 1);    // Display the error
end;

procedure TFlyingMainForm.PbPaint(Sender: TObject);                 // Paint the C of G Lines
var
  DepWt, ArrWt: double;                                    // Local Departure Vars
  DepCg, ArrCg: double;                                    // Local Arrival Vars
  procedure PlotPoint(const aWt, aCofG: double;
                      const aColour: TColor);              // Plot a point with axis
  var
    X, Y: integer;                                         // Local X and Y
  begin
    Y := Round(((aCofG * fCofgMultiplier) -
                 fCofGAxisStarts) * fWtStep);              // Get Y
    X := fCofGAxis - Round((aWt - fCofgWeightMin) *
                     fCofgStep);                           // Get X
    with Pb.Canvas do                                      // Draw on the canvas
    begin
      Brush.Color := aColour;                              // Use the supplied colour
      FillRect(Rect(Y - 5, X - 5, Y + 5, X + 5));          // Draw a 5 pixel square around the point
      Pen.Color := aColour;                                // Set the pen colour
      Pen.Width := 3;                                      // 3 pixles wide
      MoveTo(y, fCofGAxis - 1);                            // Set origin
      LineTo(Y, x - 1);                                    // Draw to Axis
      MoveTo(fCofGWeightAxis - 1, x);                      // Move to axis
      LineTo(y - 1, x);                                    // Draw to X
    end;
  end;
begin
  DepWt := GetCellDouble(1, 17);                           // Get the departure Weight
  DepCg := GetCellDouble(2, 17);                           // Get the departure C of G
  ArrWt := GetCellDouble(1, 19);                           // Get the arrival Weight
  ArrCg := GetCellDouble(2, 19);                           // Get the arrival C of G
  PlotPoint(DepWt, DepCg, fDepCofGColour);                 // Plot departure
  PlotPoint(ArrWt, ArrCg, fArrCofGColour);                 // Plot arrival
end;

procedure TFlyingMainForm.cxSpread1SheetPopupMenu(Sender: TObject; X, Y: integer); // They want the right click menu
var
  fCell : TPoint;                                          // The active cell
begin
  fCell := cxSpread.ActiveSheet.ActiveCell;                // Get the cell
  pmWizard.Visible := False;                               // ensure wizard is hidden, it only applies to seats
  if fCell.X = 1 then                                      // If we are in column 2
  begin
    if fCell.Y = 14 then                                   // Front Seats for both planes
      pmWizard.Visible := True                             // Show the wizard option
    else
      pmWizard.Visible := (fCell.Y = 15) and
                          (fMaxPersons = 4)                // Also need the wizard for a 4 seater in the back
  end;
  ssPm.Popup(X, Y);                                        // popup the wizrd
end;

procedure TFlyingMainForm.pmoFormatClick(Sender: TObject);          // The want to format a cell or cells
begin
  cxSpread.ActiveSheet.FormatCells(cxSpread.SelectionRect);// Format
  fDepCofGColour := GetCellTColour(2, 17);                 // Get new colour JIC it changed
  fArrCofGColour := GetCellTColour(2, 19);                 // Get new colour JIC it changed
  pb.Refresh;                                              // repaint the graph
end;


procedure TFlyingMainForm.mmExitClick(Sender: TObject);             // Exit the App
begin
  Close;                                                   // Bye Bye cruel world
end;

procedure TFlyingMainForm.moTodayClick(Sender: TObject);            // Want todays date
begin
  with cxSpread.ActiveSheet.GetCellObject(2, 0) do         // Get the Date Cell object
    try
      Text := '=now()';                                    // Set formula
    finally
      Free;                                                // Free the cell object
    end;
  cxSpread.Recalc;                                     // Recalc
end;

procedure TFlyingMainForm.moFuelTabsClick(Sender: TObject);         // Want fuel to tabs (markers in the fuel tanks for approx 2/3 capacity)
begin
  moFuelTabs.Enabled := False; 
  with cxSpread.ActiveSheet.GetCellObject(3, 9) do         // Get the Cell object
    try
      Text := Format('%0.2f', [fTabsFuel]);                // Set the fuel
    finally
      Free;                                                // Free the cell object
    end;
  cxSpread.Recalc;                                     // Recalc
  Pb.Repaint;                                          // Update the graph
  CheckFigures;                                        // Check figures for validity
end;

procedure TFlyingMainForm.moSelectPlaneClick(Sender: TObject);      // They selected aplane from the menu
begin
  If cxSpread.ActivePage <> (Sender as TMenuItem).Tag then
  begin
    cxSpread.ActivePage := (Sender as TMenuItem).Tag;        // Get the sheet they selected
    Application.ProcessMessages;                             // breath a while
    SetupPlane;                                              // read the plane variables
    Caption := Format('ExpressSpreadSheet Demo : %s' +
                    ' Load Sheet',[fPlaneReg]);            // Set the form title
    moFuelTabs.Enabled := True;
  End;
end;

procedure TFlyingMainForm.SetupPlane;                               // Set a plane up
begin
  LoadPlaneVars;                                           // Load the plane variables
  Image1.Picture.Bitmap.LoadFromResourceName(hInstance,
                                        fPlaneCofgBitmap); // Load the C of G bitmap
  LoadImage(fPlanePhoto, Image2);                          // Load the photo
  try
    cxSpread.ActiveCell := Point(2, 3);                    // Set the Fuel cell
  except;
  end;
  moTodayClick(Self);                                      // Set toadys date
end;

procedure TFlyingMainForm.LoadPlaneVars;                            // Load all the variables for this plane from the data block in the spreadhseet
var
  I : integer;                                             // Local loop variable
begin
  fPlaneReg        := GetCellString(1, 23);                // Read the Plane callsign
  fPlaneCofgBitmap := GetCellString(1, 24);                // Get the name of the C of G bitmap
  fPlanePhoto      := GetCellString(1, 25);                // Get the name of the plane photo
  fMaxPersons      := GetCellInt(1, 26);                   // Get the max persons this plane can carry
  fMaxBaggageWt    := GetCellDouble(1, 27);                // Get the Max baggage weight in compartment 1
  fMaxBaggageWt2   := GetCellDouble(1, 28);                // Get the Max baggage weight in compartment 2
  fMaxTakeOffWt    := GetCellDouble(1, 29);                // Get maximum takeoff weight
  fMaxLandingWt    := GetCellDouble(1, 30);                // Get maximum landing weight
  fMinAftCofG      := GetCellDouble(1, 31);                // Get Minimum aft C of G
  fMaxAftCofG      := GetCellDouble(1, 32);                // Get Max Atf C of G
  fMaxFuelCapacity := GetCellDouble(1, 33);                // Get Maximum fuel capacity
  fTabsFuel        := GetCellDouble(1, 34);                // Get fuel when filled to the 'tabs'
  fWeightUnits     := GetCellString(1, 35);                // Get units for weights
  fCofGAxisStarts  := GetCellDouble(1, 36);                // Get the C of G at the left edge of the graph
  fCofGAxis        := GetCellInt(1, 37);                   // Get the position on the graph where the CofG axis starts (from top)
  fCofGWeightMin   := GetCellDouble(1, 38);                // Get the minimum Weight on the weight axis
  fCofGWeightAxis  := GetCellInt(1, 39);                   // Get the position of the weight axis from the left hand edge of the graph
  fCofgStep        := GetCellDouble(1, 40);                // Get the units between each C of G tick
  fWtStep          := GetCellDouble(1, 41);                // Get the units between weight ticks
  fCofgMultiplier  := GetCellDouble(1, 42);                // Get the C of G Multiplier
  fEnvelopeSize    := GetCellInt(1, 43);                   // Get the number of 'points' that comprise the C of G safety envelope
  SetLength(fCofGEnvelope, fEnvelopeSize);                 // Set the Dynamic array length
  for I := 0 to fEnvelopesize - 1 do                       // For each of the 'points'
  begin
    fCofgEnvelope[I].X := GetCellInt(1, 44 + I);           // Get X
    fCofgEnvelope[I].Y := GetCellInt(2, 44 + I);           // Get Y
  end;
end;

procedure TFlyingMainForm.pmWizardClick(Sender: TObject);           // Run the seat wizard
var
  fCell: TPoint;                                           // The active Cell
begin
  with TFlyingSeatCalcForm.Create(Self) do                 // Create the wizard
    try
      CallSign := fPlaneReg;                               // Set the Aircraft callsign
      ResultInKgs := UpperCase(fWeightUnits) = 'KGS';      // Set which units we require the result in
      if ShowModal = idOk then                             // Run the wizard and if they selected OK
      begin
        fCell := cxSpread.ActiveSheet.ActiveCell;          // Get the active Cell
        with cxSpread.ActiveSheet.GetCellObject(fCell.X, fCell.y) do // Get the Cell object
          try
            Text := efFormula.Text;                        // Copy the forumla in
          finally
            Free;                                          // Free the cell object
          end;
          cxSpread.Recalc;                               // recalc the sheet
          Pb.Repaint;                                    // Update the graph
          CheckFigures;                                  // Check figures for validity
      end;
    finally
      Free;                                                // Free the wizard
    end;
end;

procedure TFlyingMainForm.cxSpreadTopLeftChanging(Sender: TcxSSBookSheet;
  var ATopLeft: TPoint);
begin
  ATopLeft.X := 0;                                         // Don't move from top cell
  ATopLeft.Y := 0;
end;

procedure TFlyingMainForm.cxSpreadAfterCalculation(Sender: TObject);
begin
  Pb.Repaint;                                              // Update the graph
  CheckFigures;                                            // Check figures for validity
end;

procedure TFlyingMainForm.cxSpreadActiveCellChanging(
  Sender: TcxSSBookSheet; const ActiveCell: TPoint;
  var CanSelect: Boolean);
begin
  CanSelect := (ActiveCell.X <= 3) and
    (ActiveCell.Y <= 20);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -