Källkod för Trigonometriska grafer - mainWin.pas

unit mainWin;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Math, ExtCtrls, FlatButton, StdCtrls, IntegerEdit,
  ColorContainer, XPMan, Hyperlink, StrUtils;

type

  TFuncGraph = record
    RelXPos, YPos: integer;
    IntervalLength: integer;
    GraphColor: TColor;
    k: integer;
    RandomParameters: set of (rpIntervalLength, rpGraphColor, rpK);
  end;

  Tmain = class(TForm)
    RT: TTimer;
    pnToolbar: TPanel;
    btnToggleAutoK: TFlatButton;
    ieK: TIntegerEdit;
    lblK: TLabel;
    lblIntervalLength: TLabel;
    ieIntervalLength: TIntegerEdit;
    lblColor: TLabel;
    ccColor: TColorContainer;
    XPManifest: TXPManifest;
    btnApply: TFlatButton;
    btnToggleAutoIntervalLength: TFlatButton;
    btnToggleAutoGraphColor: TFlatButton;
    lblCopyright: TLabel;
    hlRejbrand: THyperlink;
    leftLine: TShape;
    btnClose: TFlatButton;
    lblCommands: TLabel;
    lblNumGraphs: TLabel;
    ieNumGraphs: TIntegerEdit;
    pnInfo: TPanel;
    lblInfo: TLabel;
    lblPaused: TLabel;
    lblBkColor: TLabel;
    ccBkColor: TColorContainer;
    shControlsBk: TShape;
    sepLine2: TShape;
    lblGraphSettings: TLabel;
    sepLine1: TShape;
    stPause: TLabel;
    sepLine3: TShape;
    ieGraphIndex: TIntegerEdit;
    lblGraphIndex: TLabel;
    shieGraphIndexBk: TShape;
    lblGraphIndexInterval: TLabel;
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CallRepaint(Sender: TObject);
    procedure RecreateGraph(GraphIndex: integer);
    procedure FormClick(Sender: TObject);
    procedure Clear;
    procedure ApplyNow(Sender: TObject);
    procedure ToggleDown(Sender: TObject);
    procedure UserClose(Sender: TObject);
    procedure SetNumGraphs(newNumGraphs: integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure UpdateIntervalData(Sender: TObject);
    procedure InitDefaultManualParameters(FromIndex: integer; CopyCurrentGraph: boolean);
    procedure UpdateGraphSettings(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  main: Tmain;
  NumGraphs: integer;
  FuncGraphs,
  ManualSettings: array of TFuncGraph;
  GraphColors: array[0..4] of TColor = (clWhite, clGreen, clRed, clBlue, clYellow);
  SettingsIndex: integer;

implementation

{$R *.dfm}

procedure Tmain.FormPaint(Sender: TObject);

  function DelPos(x, IntervalLength: integer): integer;
  begin
    DelPos := x-IntervalLength
  end;

  var
    i: integer;  

begin

  for i := 0 to NumGraphs-1 do
    with FuncGraphs[i] do
    begin

      if RelXPos < (width+IntervalLength) then
        inc(RelXPos)
      else
      begin
        RecreateGraph(i);
        RelXPos := 0;
      end;

      // Add new pixel
      Canvas.Pixels[RelXPos,
                    YPos + Round((sin((RelXPos)*0.01)-0.5)*k)
                   ] := GraphColor;
      Canvas.Pixels[RelXPos,
                    YPos + Round((cos((RelXPos)*0.01)-0.5)*k)
                   ] := GraphColor;

      // Clear old pixel
      Canvas.Pixels[(DelPos(RelXPos, IntervalLength)),
                    YPos + Round((sin((DelPos(RelXPos, IntervalLength))*0.01)-0.5)*k)
                   ] := Color;
      Canvas.Pixels[(DelPos(RelXPos, IntervalLength)),
                    YPos + Round((cos((DelPos(RelXPos, IntervalLength))*0.01)-0.5)*k)
                   ] := Color;

    end;

end;

procedure Tmain.FormCreate(Sender: TObject);
var
  i: integer;
begin

  Randomize;

  Top := 0;
  Left := 0;
  Height := Screen.Height;
  Width := Screen.Width;

  SettingsIndex := 0;

  NumGraphs := 0;
  SetNumGraphs(3);

  for i := 0 to NumGraphs-1 do
    RecreateGraph(i);   

end;

procedure Tmain.RecreateGraph(GraphIndex: integer);
begin
  with FuncGraphs[GraphIndex] do
  begin
    RelXPos := Random(Width);
    if rpIntervalLength in ManualSettings[GraphIndex].RandomParameters then
      IntervalLength := Random(700)
    else
      IntervalLength := ManualSettings[GraphIndex].IntervalLength;
    if rpGraphColor in ManualSettings[GraphIndex].RandomParameters then
      GraphColor := GraphColors[Random(length(GraphColors))]
    else
      GraphColor := ManualSettings[GraphIndex].GraphColor;
    if rpK in ManualSettings[GraphIndex].RandomParameters then
      k := 50+Random(80)
    else
      k := ManualSettings[GraphIndex].k;
    YPos := (k div 2)+Random(Height-k);
  end;
end;

procedure Tmain.CallRepaint(Sender: TObject);
begin
  FormPaint(sender);  
end;

procedure Tmain.FormClick(Sender: TObject);
begin
  pnToolbar.Visible := not pnToolbar.Visible;
  if not pnToolbar.Visible then
  begin
    UpdateGraphSettings(sender);
    Clear;
  end;
  RT.Enabled := not pnToolbar.Visible;
  lblPaused.Visible := not RT.Enabled;  
end;

procedure Tmain.Clear;
var
  i: integer;
begin
  Color := ccBkColor.CurrentColor;
  with Canvas do
  begin
    Brush.Color := self.Color;
    Brush.Style := bsSolid;
    FillRect(Rect(0, 0, width, height));
  end;
  for i := 0 to NumGraphs-1 do
    RecreateGraph(i);
end;

procedure Tmain.ApplyNow(Sender: TObject);
begin

  // Close and restart
  FormClick(Sender);

end;

procedure Tmain.ToggleDown(Sender: TObject);
begin
  (sender as TFlatButton).down := not (sender as TFlatButton).down;
end;

procedure Tmain.UserClose(Sender: TObject);
begin
  Close;
end;

procedure Tmain.SetNumGraphs(newNumGraphs: integer);
var
  oldNumGraphs: integer;
begin

  SetLength(FuncGraphs, newNumGraphs);
  SetLength(ManualSettings, newNumGraphs);

  oldNumGraphs := NumGraphs;
  NumGraphs := newNumGraphs;

  if newNumGraphs > oldNumGraphs then
    InitDefaultManualParameters(oldNumGraphs,
                                MessageBox(Application.Handle,
                                           PChar(IntToStr(newNumGraphs-oldNumGraphs) + ' ny' + IFTHEN((newNumGraphs - oldNumGraphs) = 1, '', 'a') + ' graf' + IFTHEN((newNumGraphs - oldNumGraphs) = 1, '', 'er') + ' kommer att skapas. Vill du att ' + IFTHEN((newNumGraphs - oldNumGraphs) = 1, 'denna', 'dessa') + ' ska kopiera den aktuella grafens (index ' + IntToStr(SettingsIndex) + ') inställningar istället för att få standardinställningarna?'),
                                           PChar(Caption),
                                           MB_YESNO) = idYes);

  if StrToInt(ieGraphIndex.Text) > High(FuncGraphs) then
    ieGraphIndex.Text := IntToStr(High(FuncGraphs));

  lblGraphIndexInterval.Caption := '(' + IntToStr(Low(FuncGraphs)) + '~' + IntToStr(High(FuncGraphs)) + ')';
  ieGraphIndex.Max := High(FuncGraphs);  

end;

procedure Tmain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case key of
    VK_PAUSE: begin
                if not pnToolbar.Visible then
                begin
                  RT.Enabled := not RT.Enabled;
                  lblPaused.Visible := not RT.Enabled;
                end;
              end;
    VK_RETURN: FormClick(sender);
    VK_F1: pnInfo.Visible := not pnInfo.Visible;
  end;
end;

procedure Tmain.FormShow(Sender: TObject);
begin
  MessageBox(Application.Handle, PChar(lblInfo.Caption + #13#10#13#10 + 'Visa detta hjälpmeddelande med F1 (Help).'), PChar(Caption), MB_OK);
end;

procedure Tmain.UpdateIntervalData(Sender: TObject);
begin
  SetNumGraphs(StrToInt(ieNumGraphs.Text));
end;

procedure Tmain.InitDefaultManualParameters(FromIndex: integer; CopyCurrentGraph: boolean);
var
  i: integer;
begin

  for i := FromIndex to NumGraphs-1 do
    if CopyCurrentGraph then
      with ManualSettings[i] do
      begin
        k := StrToInt(ieK.Text);
        IntervalLength := StrToInt(ieIntervalLength.Text);
        GraphColor := ccColor.CurrentColor;
        RandomParameters := [];
        if btnToggleAutoK.Down then
          RandomParameters := RandomParameters + [rpK];
        if btnToggleAutoIntervalLength.Down then
          RandomParameters := RandomParameters + [rpIntervalLength];
        if btnToggleAutoGraphColor.Down then
          RandomParameters := RandomParameters + [rpGraphColor];
      end
    else
      with ManualSettings[i] do
      begin
        k := 90;
        IntervalLength := 350;
        GraphColor := clGreen;
        RandomParameters := [rpIntervalLength, rpGraphColor, rpK];
      end;

end;

procedure Tmain.UpdateGraphSettings(Sender: TObject);
begin

  // Save old graph parameters
  if ((Low(ManualSettings) <= SettingsIndex) and (High(ManualSettings) >= SettingsIndex)) then
    with ManualSettings[SettingsIndex] do
    begin
      k := StrToInt(ieK.Text);
      IntervalLength := StrToInt(ieIntervalLength.Text);
      GraphColor := ccColor.CurrentColor;
      RandomParameters := [];
      if btnToggleAutoK.Down then
        RandomParameters := RandomParameters + [rpK];
      if btnToggleAutoIntervalLength.Down then
        RandomParameters := RandomParameters + [rpIntervalLength];
      if btnToggleAutoGraphColor.Down then
        RandomParameters := RandomParameters + [rpGraphColor];
    end;

  // Update index of setup graph
  SettingsIndex := StrToInt(ieGraphIndex.Text);

  // Read new graph parameters
  if ((Low(ManualSettings) <= SettingsIndex) and (High(ManualSettings) >= SettingsIndex)) then
    with ManualSettings[SettingsIndex] do
    begin
      ieK.Text := IntToStr(k);
      ieIntervalLength.Text := IntToStr(IntervalLength);
      ccColor.CurrentColor := GraphColor;
      btnToggleAutoK.Down := rpK in RandomParameters;
      btnToggleAutoIntervalLength.Down := rpIntervalLength in RandomParameters;
      btnToggleAutoGraphColor.Down := rpGraphColor in RandomParameters;
    end;

end;

end.

Copyright © 2004 Andreas Rejbrand