[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 176
  • Last Modified:

Convert this Logic & PHP to Delphi please!

I need the following converted to Delphi. Please send example unit/form to my email address in profile. (please also post unit code to EE).

Rating System
http://www.clayjar.com/gcrs/


If this will help you, here is the PHP source
http://www.clayjar.com/gcrs/index.php?source


IELite
0
IElite
Asked:
IElite
1 Solution
 
TheRealLokiSenior DeveloperCommented:
MAIN.PAS
=======

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Math (* for max *);

type
  TfMain = class(TForm)
    ScrollBox1: TScrollBox;
    Label1: TLabel;
    Label2: TLabel;
    rgLengthOfHike: TRadioGroup;
    Label3: TLabel;
    rgTrailLike: TRadioGroup;
    Label4: TLabel;
    rgPathBushyOrOvergrown: TRadioGroup;
    rgTerrainElevation: TRadioGroup;
    Label5: TLabel;
    Label6: TLabel;
    rgHowEasyToFind: TRadioGroup;
    Label7: TLabel;
    bRateCache: TButton;
    rgSpecializedEquipment: TRadioGroup;
    rgOvernightStay: TRadioGroup;
    procedure bRateCacheClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fMain: TfMain;

IMPLEMENTATION

{$R *.DFM}
uses ResultsDialog;

procedure TfMain.bRateCacheClick(Sender: TObject);
    var
        maximum: integer;
        terrain: Double;
        specequip: integer;
        ons: integer;
    begin
        if rgSpecializedEquipment.Itemindex = 1 then specequip := 4 else specequip := 0;
        if rgOvernightStay.Itemindex = 1 then ons := 3 else ons := 0;
        maximum := Max(specequip, ons);
        maximum := Max(maximum, rgLengthOfHike.ItemIndex);
        maximum := Max(maximum, rgTrailLike.ItemIndex);
        maximum := Max(maximum, rgPathBushyOrOvergrown.ItemIndex);
        maximum := Max(maximum, rgTerrainElevation.ItemIndex);
        terrain := 0;
       
        if maximum > 0 then
        begin
            terrain := maximum;
            if maximum = specequip then terrain := terrain + 0.25;
            if maximum = ons then terrain := terrain + 0.25;
            if maximum = rgLengthOfHike.ItemIndex then terrain := terrain + 0.25;
            if maximum = rgTrailLike.ItemIndex then terrain := terrain + 0.25;
            if maximum = rgPathBushyOrOvergrown.ItemIndex then terrain := terrain + 0.25;
            if maximum = rgTerrainElevation.ItemIndex then terrain := terrain + 0.25;
            if maximum = rgTerrainElevation.ItemIndex then terrain := terrain + 0.25;
            terrain := terrain - 0.25;
           
        end;
       
        with TfResultsDialog.Create(application) do
        try
            DificultyRating := self.rgHowEasyToFind.ItemIndex + 1;
            TerrainRating := terrain + 1;
            ShowModal;
        finally
            free;
        end;
    end;

end.

 MAIN FORM
========
object fMain: TfMain
  Left = 274
  Top = 213
  Width = 870
  Height = 621
  Caption = 'Main'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object ScrollBox1: TScrollBox
    Left = 0
    Top = 0
    Width = 846
    Height = 1000
    TabOrder = 0
    object Label1: TLabel
      Left = 16
      Top = 72
      Width = 412
      Height = 13
      Caption =
        'Specialized equipment includes: Boats, 4WD vehicles, rock climbi' +
        'ng gear, SCUBA, etc.'
    end
    object Label2: TLabel
      Left = 16
      Top = 160
      Width = 348
      Height = 13
      Caption =
        'Will it take more than a day to hike in, find the cache, and hik' +
        'e out again?'
    end
    object Label3: TLabel
      Left = 16
      Top = 312
      Width = 357
      Height = 13
      Caption =
        'This is the length of the hike from the most logical parking are' +
        'a to the cache'
    end
    object Label4: TLabel
      Left = 16
      Top = 472
      Width = 577
      Height = 13
      Caption =
        'How is the the most difficult part of the cache? If the cache is' +
        ' within a few feet of a trail, don'#39't worry about the last few fe' +
        'et.'
    end
    object Label5: TLabel
      Left = 16
      Top = 612
      Width = 800
      Height = 13
      Caption =
        'Overgrowth refers to any plant or other substance that impedes t' +
        'he path. Keep in mind that conditions change; rate based on your' +
        ' understanding of worst-case conditions.'
    end
    object Label6: TLabel
      Left = 16
      Top = 766
      Width = 207
      Height = 13
      Caption = 'How hard is the steepest part of the cache?'
    end
    object Label7: TLabel
      Left = 16
      Top = 926
      Width = 632
      Height = 13
      Caption =
        'Please consider visibility, accessibility, and relative signal s' +
        'trength due to tree cover or other obstructions when answering t' +
        'his question'
    end
    object rgLengthOfHike: TRadioGroup
      Left = 16
      Top = 192
      Width = 225
      Height = 113
      Caption = 'What is the length of the hike?'
      ItemIndex = 0
      Items.Strings = (
        'Less than 1/2 mile (Less than 1 km)'
        '1/2 mile to 2 miles (About 1 to 3 km)'
        '2 miles to 10 miles (About 3 to 16 km)'
        'Over 10 miles (Over 16 km)')
      TabOrder = 0
    end
    object rgTrailLike: TRadioGroup
      Left = 16
      Top = 344
      Width = 681
      Height = 113
      Caption = 'What is the trail like?'
      ItemIndex = 0
      Items.Strings = (
        'Paved pathways (Asphalt, concrete, or boardwalks.)'
       
          'Well marked/defined hardpack (Well packed dirt. You could ride a' +
          ' standard bicycle or push a stroller on this trail without too m' +
          'uch effort.)'
       
          'Other trail types (Could be gravel, sand, mud, etc. May be an an' +
          'imal trail. If you'#39're riding a bike, it had better be a mountain' +
          ' bike.)'
       
          'Trail? What trail? (There is no real trail. Wheels are out. May ' +
          'be following a stream bed or be very rocky.)')
      TabOrder = 1
    end
    object rgPathBushyOrOvergrown: TRadioGroup
      Left = 16
      Top = 504
      Width = 817
      Height = 105
      Caption = 'Is the path bushy or overgrown?'
      ItemIndex = 0
      Items.Strings = (
        'Not at all (There is no overgrowth at all.)'
        'Some light overgrowth (An adult could step over or around this.)'
       
          'Yeah, it'#39's pretty overgrown (It'#39's waist-high or so, or it may be' +
          ' thorny or have poison plants.)'
       
          'The overgrowth is very heavy (I can'#39't see the other side! Some t' +
          'ype of machete or other cutting device is probably needed. Very ' +
          'likely to have thorns or poison plants.)')
      TabOrder = 2
    end
    object rgTerrainElevation: TRadioGroup
      Left = 16
      Top = 644
      Width = 641
      Height = 113
      Caption = 'What is the terrain elevation like?'
      ItemIndex = 0
      Items.Strings = (
       
          'Basically flat (Only slight elevation changes. Easy to do in a w' +
          'heelchair, stroller, bike, etc.)'
       
          'Some elevation changes (Changes are slight enough that someone c' +
          'ould ride a bike up such a slope.)'
       
          'Steep elevation changes (Change is steep. Probably could not rid' +
          'e a bike up this slope, but could push it up.)'
       
          'Severe elevation changes (The only way up the slope is to use yo' +
          'ur hands. Going down may require the use of your backside.)')
      TabOrder = 3
    end
    object rgHowEasyToFind: TRadioGroup
      Left = 16
      Top = 798
      Width = 649
      Height = 121
      Caption = 'How easy is it to find the cache?'
      ItemIndex = 0
      Items.Strings = (
        'Cache is in plain sight or location is fairly obvious.'
       
          'Cache could be in one of several locations. Hunter may have to l' +
          'ook for a while.'
       
          'Cache may be very well hidden, may be multi-leg, or may use clue' +
          's to location.'
       
          'Cache likely requires special skills, knowledge, or in-depth pre' +
          'paration to find. May require multiple days or trips to find'
       
          'Finding this cache requires very specialized knowledge, skills, ' +
          'or equipment. This is a serious mental or physical challenge')
      TabOrder = 4
    end
    object bRateCache: TButton
      Left = 16
      Top = 958
      Width = 75
      Height = 25
      Caption = 'Rate Cache'
      TabOrder = 5
      OnClick = bRateCacheClick
    end
    object rgSpecializedEquipment: TRadioGroup
      Tag = 4
      Left = 16
      Top = 8
      Width = 185
      Height = 57
      Caption = 'Is specialized equipment required?'
      ItemIndex = 0
      Items.Strings = (
        'No'
        'Yes')
      TabOrder = 6
    end
    object rgOvernightStay: TRadioGroup
      Tag = 3
      Left = 16
      Top = 96
      Width = 185
      Height = 57
      Caption = 'Is an overnight stay likely?'
      ItemIndex = 0
      Items.Strings = (
        'No'
        'Yes')
      TabOrder = 7
    end
  end
end

RESULTSDIALOG.PAS
=============
unit ResultsDialog;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons;

type
  TfResultsDialog = class(TForm)
    BitBtn1: TBitBtn;
    lYourCacheHasBeenRated: TLabel;
    lDifficultyrating: TLabel;
    lDif1: TLabel;
    lDif2: TLabel;
    lDif3: TLabel;
    lDif4: TLabel;
    lDif5: TLabel;
    lTerrainRating: TLabel;
    lTer1: TLabel;
    lTer2: TLabel;
    lTer3: TLabel;
    lTer4: TLabel;
    lTer5: TLabel;
    lTer3_2: TLabel;
    lTer4_2: TLabel;
  private
    fDificultyRating: integer;
    fTerrainRating: Double;
    procedure SerDificultyRating(const Value: integer);
    procedure SetTerrainRating(const Value: Double);
    { Private declarations }
  public
    { Public declarations }
        property DificultyRating: integer read fDificultyRating write SerDificultyRating;
        property TerrainRating: Double read fTerrainRating write SetTerrainRating;
  end;

var
  fResultsDialog: TfResultsDialog;

IMPLEMENTATION

{$R *.DFM}

{ TfResultsDialog }

procedure TfResultsDialog.SerDificultyRating(const Value: integer);
    begin
        fDificultyRating := Value;
        lYourCacheHasBeenRated.Caption := 'Your cache has been rated ' + IntToStr(fDificultyRating) + '/' + FloatToStr(fTerrainRating);
        case fDificultyRating of
            1: lDif1.Font.Style := [fsBold];
            2: lDif2.Font.Style := [fsBold];
            3: lDif3.Font.Style := [fsBold];
            4: lDif4.Font.Style := [fsBold];
            5: lDif5.Font.Style := [fsBold];
        end;
    end;

procedure TfResultsDialog.SetTerrainRating(const Value: Double);
    begin
        fTerrainRating := Value;
        lYourCacheHasBeenRated.Caption := 'Your cache has been rated ' + IntToStr(fDificultyRating) + '/' + FloatToStr(fTerrainRating);
        case Trunc(fTerrainRating) of
            1: lTer1.Font.Style := [fsBold];
            2: lTer2.Font.Style := [fsBold];
            3:
            begin
                lTer3.Font.Style := [fsBold];
                lTer3_2.Font.Style := [fsBold];
            end;
            4:
            begin
                lTer4.Font.Style := [fsBold];
                lTer4_2.Font.Style := [fsBold];
            end;
            5: lTer5.Font.Style := [fsBold];
        end;
    end;

end.


RESULTS DIALOG FORM
===============
object fResultsDialog: TfResultsDialog
  Left = 131
  Top = 225
  BorderStyle = bsDialog
  Caption = 'Results'
  ClientHeight = 343
  ClientWidth = 1042
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  Position = poDesktopCenter
  PixelsPerInch = 96
  TextHeight = 13
  object lYourCacheHasBeenRated: TLabel
    Left = 16
    Top = 8
    Width = 132
    Height = 13
    Caption = 'Your cache has been rated '
  end
  object lDifficultyrating: TLabel
    Left = 16
    Top = 32
    Width = 75
    Height = 13
    Caption = 'Difficulty rating: '
  end
  object lDif1: TLabel
    Left = 16
    Top = 64
    Width = 349
    Height = 13
    Caption =
      '    *  '#9'Easy. In plain sight or can be found in a few minutes of' +
      ' searching.'
  end
  object lDif2: TLabel
    Left = 16
    Top = 80
    Width = 496
    Height = 13
    Caption =
      '   **  '#9'Average. The average cache hunter would be able to find ' +
      'this in less than 30 minutes of hunting.'
  end
  object lDif3: TLabel
    Left = 16
    Top = 96
    Width = 603
    Height = 13
    Caption =
      '  ***  '#9'Challenging. An experienced cache hunter will find this ' +
      'challenging, and it could take up a good portion of an afternoon' +
      '.'
  end
  object lDif4: TLabel
    Left = 16
    Top = 112
    Width = 867
    Height = 13
    Caption =
      ' ****  '#9'Difficult. A real challenge for the experienced cache hu' +
      'nter - may require special skills or knowledge, or in-depth prep' +
      'aration to find. May require multiple days / trips to complete.'
  end
  object lDif5: TLabel
    Left = 16
    Top = 128
    Width = 584
    Height = 13
    Caption =
      '*****  '#9'Extreme. A serious mental or physical challenge. Require' +
      's specialized knowledge, skills, or equipment to find cache.'
  end
  object lTerrainRating: TLabel
    Left = 16
    Top = 168
    Width = 68
    Height = 13
    Caption = 'Terrain rating: '
  end
  object lTer1: TLabel
    Left = 16
    Top = 192
    Width = 568
    Height = 13
    Caption =
      '    *  '#9'Handicapped accessible. (Terrain is likely to be paved, ' +
      'is relatively flat, and less than a 1/2 mile hike is required.)'
  end
  object lTer2: TLabel
    Left = 16
    Top = 208
    Width = 790
    Height = 13
    Caption =
      '   **  '#9'Suitable for small children. (Terrain is generally along' +
      ' marked trails, there are no steep elevation changes or heavy ov' +
      'ergrowth. Less than a 2 mile hike required.)'
  end
  object lTer3: TLabel
    Left = 16
    Top = 224
    Width = 856
    Height = 13
    Caption =
      '  ***  '#9'Not suitable for small children. (The average adult or o' +
      'lder child should be OK depending on physical condition. Terrain' +
      ' is likely off-trail. May have one or more of the following:'
  end
  object lTer4: TLabel
    Left = 16
    Top = 256
    Width = 859
    Height = 13
    Caption =
      ' ****  '#9'Experienced outdoor enthusiasts only. (Terrain is probab' +
      'ly off-trail. Will have one or more of the following: very heavy' +
      ' overgrowth, very steep elevation (requiring use of hands),'
  end
  object lTer5: TLabel
    Left = 16
    Top = 288
    Width = 680
    Height = 13
    Caption =
      '*****  '#9'Requires specialized equipment and knowledge or experien' +
      'ce, (boat, 4WD, rock climbing, SCUBA, etc) or is otherwise extre' +
      'mely difficult'
  end
  object lTer3_2: TLabel
    Left = 56
    Top = 240
    Width = 364
    Height = 13
    Caption =
      'some overgrowth, some steep elevation changes, or more than a 2 ' +
      'mile hike.)'
  end
  object lTer4_2: TLabel
    Left = 56
    Top = 272
    Width = 278
    Height = 13
    Caption = 'or more than a 10 mile hike. May require an overnight stay.)'
  end
  object BitBtn1: TBitBtn
    Left = 360
    Top = 312
    Width = 75
    Height = 25
    TabOrder = 0
    Kind = bkOK
  end
end



I have tried to keep it as close to the original html page as I can. Normally I'd rewrite the whole thing. html is yucky :)
0
 
IEliteAuthor Commented:
Nice! ThanX!

IElite
0

Featured Post

Prep for the ITIL® Foundation Certification Exam

December’s Course of the Month is now available! Enroll to learn ITIL® Foundation best practices for delivering IT services effectively and efficiently.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now