Archivado/Componentes.Terceros.DevExpressVCL
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b2e7942eef
Componentes.Terceros.DevExp.../official/x.38/ExpressSpreadSheet/Demos/Delphi/FlyingDemo/FlyingMain.pas
david fd289722e5 Sin Skins. 
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@29 05c56307-c608-d34a-929d-697000501d7a
2008-08-27 11:56:15 +00:00

599 lines
27 KiB
ObjectPascal
Raw Blame History

unit FlyingMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, cxSSheet, cxControls, ExtCtrls, StdCtrls,
ComCtrls, Jpeg, Menus, cxssPainters;
type
TFlyingMainForm = class(TForm)
cxSpread: TcxSpreadSheetBook;
Image1: TImage;
StatusBar1: TStatusBar;
Pb: TPaintBox;
Image2: TImage;
ssPm: TPopupMenu;
pmoFormat: TMenuItem;
MainMenu1: TMainMenu;
File1: TMenuItem;
mmAircraft: TMenuItem;
mmExit: TMenuItem;
mmOptions: TMenuItem;
moToday: TMenuItem;
moFuelTabs: TMenuItem;
Bevel1: TBevel;
pmWizard: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure cxSpread1SetSelection(Sender: TObject;
ASheet: TcxSSBookSheet);
procedure PbPaint(Sender: TObject);
procedure cxSpread1SheetPopupMenu(Sender: TObject; X, Y: integer);
procedure pmoFormatClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mmExitClick(Sender: TObject);
procedure moTodayClick(Sender: TObject);
procedure moFuelTabsClick(Sender: TObject);
procedure pmWizardClick(Sender: TObject);
procedure cxSpreadTopLeftChanging(Sender: TcxSSBookSheet;
var ATopLeft: TPoint);
procedure cxSpreadAfterCalculation(Sender: TObject);
procedure cxSpreadActiveCellChanging(Sender: TcxSSBookSheet;
const ActiveCell: TPoint; var CanSelect: Boolean);
private
fMenuItems: array of TMenuItem;
fDepCofGColour: TColor;
fArrCofGColour: TColor;
fPlaneReg: string;
fPlaneCofgBitmap: string;
fPlanePhoto: string;
fWeightUnits: string;
fMaxPersons: integer;
fMaxTakeOffWt: double;
fMaxLandingWt: double;
fMaxBaggageWt: double;
fMaxBaggageWt2: double;
fMaxFuelCapacity: double;
fTabsFuel: double;
fMinAftCofG: double;
fMaxAftCofG: double;
fCofGAxisStarts: double;
fCofgStep: double;
fWtStep: double;
fCofgMultiplier: double;
fCofGAxis: integer;
fCofGWeightMin: double;
fCofGWeightAxis: integer;
fEnvelopeSize: integer;
fNormalCellColour: integer;
fErrorCellColour: Integer;
fCofGEnvelope: array of TPoint;
procedure moSelectPlaneClick(Sender: TObject);
function GetCellDouble(const aCol, aRow: integer): double;
function GetCellString(const aCol, aRow: integer): string;
function GetCellInt(const aCol, aRow: integer): integer;
function GetCellColour(const aCol, aRow: integer): integer;
procedure SetCellMessage(const aCol, aRow: integer;
const aMessage: string; const aBackgroundColour,
aFontColour: Word);
function GetCellTColour(const aCol, aRow: integer): TColor;
procedure CheckFigures;
procedure LoadImage(const aResJpg: string; AnImage: TImage);
procedure LoadPlaneVars;
procedure SetupPlane;
public
IsChecked: Boolean;
procedure UpdateCofG;
{ Public declarations }
end;
type
THelpIds = array[0..20, 0..3] of integer;
// An array that provides a HelpId for each cell on the
// input sheet. Here these are mapped to a static string
// array, it would be simple to map these to ID's in a
// help file
const // A B C D
HelpIds: THelpIds = ((0, 0, 1, 0), // 1
(0, 0, 0, 0), // 2
(0, 0, 0, 0), // 3
(0, 0, 2, 0), // 4
(0, 0, 0, 0), // 5
(0, 0, 0, 0), // 6
(0, 0, 0, 0), // 7
(0, 0, 0, 0), // 8
(0, 0, 0, 3), // 9
(0, 0, 0, 4), // 10
(0, 0, 0, 0), // 11
(0, 0, 0, 0), // 12
(0, 0, 0, 0), // 13
(0, 0, 0, 0), // 14
(0, 5, 0, 0), // 15
(0, 5, 0, 0), // 16
(0, 6, 0, 0), // 17
(0, 0, 7, 0), // 18
(0, 0, 0, 0), // 19
(0, 0, 8, 0), // 20
(0, 0, 0, 0)); // 21
// Test strings for Cell Help
const
HelpText: array[1..9] of string = ('The date the flight is being made',
'Flight duration in Hrs (ie 210 Nm @ 95 Knts Enter = 210 / 95 or 2.21)',
'The minimum required fuel for the flight',
'The actual fuel onboard the aircraft on departure',
'Wt of seat occupants (Right click for a Wizard)',
'Total weight of those items in the baggage compartment 1',
'The C of G on Take-off',
'The C of G on Landing',
'Total weight of those items in the baggage compartment 2'
);
var
FlyingMainForm: TFlyingMainForm;
implementation
{$R *.dfm}
//{$R DEFAULT.RES}
uses
FlyingSeatCalc;
procedure TFlyingMainForm.FormCreate(Sender: TObject);
var
Rs : TResourceStream; // Resource Stream
I, Mi : integer; // Local Int Vars
begin
Rs := TResourceStream.Create(hInstance,
'DEFAULTSHEET',
RT_RCDATA); // Load the Spreadsheet into a resource stream
try
cxSpread.LoadFromStream(Rs); // Load the sheet from the resource stream
cxSpread.ShowHeaders := False; // No Headers
cxSpread.ShowGrid := False; // No Grid
finally
Rs.Free; // Free the Resource stream
end;
Mi := cxSpread.PageCount; // Get the number of pages in the book
SetLength(fMenuItems, Mi); // Set the dynamic array up
for I := 0 to Mi - 1 do // For each Page
begin
fMenuItems[I] := TMenuItem.Create(nil); // Create the menu item
with fMenuItems[I] do // With the new item
begin
Caption := cxSpread.Pages[I].Caption;; // Set the caption
Tag := I; // Set the tag
OnClick := moSelectPlaneClick; // Set the event
end;
mmAircraft.Add(fMenuItems[I]); // Now add the menu item to the aircraft menu
end;
fDepCofGColour := clRed; // Set default departure C of G Colour
fArrCofGColour := clYellow; // Set default arrival C of G Colour
fNormalCellColour := GetCellColour(0, 0); // Get the normal cell colour
fErrorCellColour := GetCellColour(2, 17); // Get the error cell colour
SetupPlane; // Read the variables for this plane
end;
procedure TFlyingMainForm.FormShow(Sender: TObject); // For is being shown
begin
moTodayClick(Sender); // Set today's date
cxSpread.ActiveCell := Point(2, 3); // Set the active cell
cxSpread1SetSelection(Sender, cxSpread.ActiveSheet); // Trigger the display of cell hints
end;
// Helpers
procedure TFlyingMainForm.LoadImage(const aResJpg: string;
AnImage: TImage); // Load an JPG image from a resource
var
Rs: TResourceStream; // Resource Stream
Jpi: TJpegImage; // Jpeg Image
begin
Jpi := TJpegImage.Create; // Create the Jpeg
Rs := TResourceStream.Create(hInstance,
aResJpg, RT_RCDATA); // Load the Image
try
Jpi.LoadFromStream(Rs); // Load from the resource string
AnImage.Picture.Bitmap.Assign(JPI); // Assign to the image control
finally
Jpi.Free; // Free the Jpeg
Rs.Free; // Free the resource stream
end;
end;
procedure TFlyingMainForm.SetCellMessage(const aCol, aRow: integer; // Display a message in cell at row, col
const aMessage: string; // The message
const aBackgroundColour: Word; // The background color
const aFontColour: Word); // The font color
begin
with cxSpread.ActiveSheet.GetCellObject(aCol, aRow) do // Get the cell object
try
try
Style.Brush.BackgroundColor := aBackgroundColour; // Set the background colour
Style.Font.FontColor := aFontColour; // set the font colour
Text := aMessage; // Set the text
except
end;
finally
Free; // Free the Cell object
end;
end;
function TFlyingMainForm.GetCellTColour(const aCol,
aRow: integer): TColor; // Get a cell Colour
begin
with cxSpread.ActiveSheet.GetCellObject(aCol, aRow) do // Get the Cell object
try
try
Result := cxSpread.Palette[Style.Brush.BackgroundColor]; // Return the colour
except
Result := 0; // JIC
end;
finally
Free; // Free the cell object
end;
end;
function TFlyingMainForm.GetCellColour(const aCol,
aRow: integer): integer; // Get the Cell colour as a plaette entry
begin
with cxSpread.ActiveSheet.GetCellObject(aCol, aRow) do // Get the cell object
try
try
Result := Style.Brush.BackgroundColor; // Return the entry
except
Result := 0; // JIC
end;
finally
Free; // Free the cell object
end;
end;
function TFlyingMainForm.GetCellString(const aCol,
aRow: integer): string; // Get a string from a cell
begin
with cxSpread.ActiveSheet.GetCellObject(aCol, aRow) do // Get the Cell Object
try
try
Result := DisplayText; // Get the Text
except
Result := ''; // JIC
end;
finally
Free; // Free the cell object
end;
end;
function TFlyingMainForm.GetCellInt(const aCol,
aRow: integer): integer; // Get the value of a cell as an integer
begin
with cxSpread.ActiveSheet.GetCellObject(aCol, aRow) do // Get the cell object
try
try
Result := CellValue; // Get the Display text (not the formula) and convert
except
Result := 0; // JIC
end;
finally
Free; // Free the cell object
end;
end;
function TFlyingMainForm.GetCellDouble(const aCol,
aRow: integer): double; // Get the value of a cell as a double
begin
with cxSpread.ActiveSheet.GetCellObject(aCol, aRow) do // Get the cell object
try
try
Result := CellValue; // Get the display text (not the formula) and convert
except
Result := 0.0; // JIC
end;
finally
Free; // Free the cell object
end;
end;
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
if IsChecked then Exit;
IsChecked := True;
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
IsChecked := False;
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;
end;
procedure TFlyingMainForm.moFuelTabsClick(Sender: TObject); // Want fuel to tabs (markers in the fuel tanks for approx 2/3 capacity)
begin
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;
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
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;
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.
Reference in New Issue View Git Blame Copy Permalink