main.pas

来自「FlexGraphics是一套创建矢量图形的VCL组件」· PAS 代码 · 共 294 行

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  FlexBase, FlexUtils, FlexControls, ComCtrls, ExtCtrls;

type
  TfmMain = class(TForm)
    Timer1: TTimer;
    Flex: TFlexPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FlexNotify(Sender: TObject; Control: TFlexControl;
      Notify: TFlexNotify);
    procedure FlexMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FlexMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FlexMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    FIsOn: boolean;
    FGaugeScroll: boolean;
    FScrollingGauge: TFlexBox;
    FGaugeWidth: integer;
    FLastControl: TFlexControl;
    function  FindParentTemp(Control: TFlexControl): integer;
    procedure SetTempStyle(Control: TFlexControl; Value: double; Hide: boolean);
    function  CalcGaugeValue(Gauge: TFlexBox; MouseX: integer): Double;
    procedure MoveTo(Index: integer; Value: Double);
    function  GetLampIndex(const Value: string; IsLight: boolean): integer;
    function  GetLampColor(const Value: string; IsLight: boolean): TColor;
    function GetTemp(Index: integer): TFlexControl;
  public
    { Public declarations }
    TempIndex: integer;
    TempControls: TList;
    BtnON, BtnCopyright: TFlexText;
    property  Temps[Index: integer]: TFlexControl read GetTemp;
  end;

var
  fmMain: TfmMain;

implementation

uses fAboutPrg;

{$R *.DFM}

procedure TfmMain.FormCreate(Sender: TObject);
var RS: TResourceStream;
    Filer: TFlexFiler;
begin
 TempControls := TList.Create;
 Flex.OnNotify := FlexNotify;
 // Load document from resource
 RS := Nil;
 Filer := Nil;
 try
  RS := TResourceStream.Create(HInstance, 'Document', RT_RCDATA);
  Filer := TFlexFiler.Create(RS);
  Flex.LoadFromFiler(Filer, lfNew);
  (Flex.ActiveScheme as TFlexScheme).BrushProp.BitmapCache := true;
 finally
  Filer.Free;
  RS.Free;
 end;
 //Flex.LoadFromFile(ExpandFilename('Analog.fxd'));
 Flex.Parent := Self;
 // Adjust window size
 Flex.AutoSize;
 ClientHeight := ScaleValue(Flex.DocHeight, 100) +4;
 ClientWidth := ScaleValue(Flex.DocWidth, 100) +4;
 Flex.Align := alClient;
 Randomize;
 TempIndex := -1;
end;

procedure TfmMain.FormDestroy(Sender: TObject);
begin
 Flex.Free;
 TempControls.Free;
end;

procedure TfmMain.FlexNotify(Sender: TObject; Control: TFlexControl;
  Notify: TFlexNotify);
var AName: string;
begin
 if Notify = fnLoaded then begin
  // Define control
  AName := Control.Name;
  if CompareText(AName, 'btON') = 0 then begin
   BtnON := TFlexText(Control);
  end else
  if CompareText(AName, 'Copyright') = 0 then begin
   BtnCopyright := TFlexText(Control);
  end else
  if CompareText('Temp', copy(AName, 1, 4)) = 0 then begin
   TempControls.Add(Control);
   if FGaugeWidth = 0 then FGaugeWidth := Control.FindByName('Gauge').Width;
   TFlexText(Control.FindByName('AnalogData')).TextProp.Text :=
     Format('%.3f', [9.999]);
   SetTempStyle(Control, 0, True);
  end;
 end;
end;

function TfmMain.GetTemp(Index: integer): TFlexControl;
begin
 Result := TFlexControl(TempControls[Index]);
end;

function TfmMain.FindParentTemp(Control: TFlexControl): integer;
begin
 Result := -1;
 while Assigned(Control) do begin
  Result := TempControls.IndexOf(Control);
  if Result >= 0 then break;
  Control := Control.Parent;
 end;
end;

function TfmMain.GetLampIndex(const Value: string; IsLight: boolean): integer;
const Max = 9.999;
      Step = Max / 4;
var V: Double;
begin
 V := StrToFloat(Value);
 if V < 1*Step then Result := 3 else
 if V < 2*Step then Result := 0 else
 if V < 3*Step then Result := 2
               else Result := 1;
 if IsLight then inc(Result, 4);
end;

function TfmMain.GetLampColor(const Value: string; IsLight: boolean): TColor;
var V: integer;
begin
 V := GetLampIndex(Value, IsLight);
 case V of
  0: Result := clGreen;
  1: Result := clMaroon;
  2: Result := clOlive;
  3: Result := clTeal;
  4: Result := clLime;
  5: Result := clRed;
  6: Result := clYellow;
  7: Result := clAqua;
  else Result := clBlack;
 end;
end;

procedure TfmMain.SetTempStyle(Control: TFlexControl; Value: double;
  Hide: boolean);
var s: string;
begin
 with Control do begin
  with TFlexText(FindByName('AnalogData')) do begin
   if Value < 0 then
    Value := StrToFloat(TextProp.Text);
   if Hide then begin
    s := TextProp.Text;
    FontProp.Color := clBlue;
   end else begin
    s := Format('%.3f', [Value]);
    TextProp.Text := s;
    FontProp.Color := clYellow;
   end;
  end;
  with TFlexPicture(FindByName('Lamp')) do begin
   FrameIndexProp.Value := GetLampIndex(s, not Hide);
  end;
  with TFlexBox(FindByName('Gauge')) do begin
   BrushProp.Color := GetLampColor(s, not Hide);
   if not Hide then
    Width := Round(FGaugeWidth * Value / 10);
  end;
 end;
end;

function TfmMain.CalcGaugeValue(Gauge: TFlexBox; MouseX: integer): Double;
var P: TPoint;
begin
 P := Gauge.OwnerToClient(Point(MouseX, MouseX));
 if P.X < 0 then P.X := 0 else
 if P.X > FGaugeWidth then P.X := FGaugeWidth;
 Result := 9.999 * P.X / FGaugeWidth;
end;

procedure TfmMain.MoveTo(Index: integer; Value: Double);
var TempNow, TempPrev: TFlexControl;
begin
 // Hide last element
 if (TempIndex >= 0) and (TempIndex <> Index) then begin
  TempPrev := TFlexControl(TempControls[TempIndex]);
  SetTempStyle(TempPrev, 0, True);
 end;
 // Light new element
 TempNow := Temps[Index];
 SetTempStyle(TempNow, Value, False);
 TempIndex := Index;
end;

procedure TfmMain.Timer1Timer(Sender: TObject);
var NewIndex: integer;
begin
 if FIsOn then begin
  if TempIndex = TempControls.Count-1
   then NewIndex := 0
   else NewIndex := TempIndex + 1;
  MoveTo(NewIndex, 9.999*Random);
 end;
end;

procedure TfmMain.FlexMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var TempIdx: integer;
begin
 if not Assigned(Flex.MouseSubControl) then exit;
 TempIdx := FindParentTemp(Flex.MouseSubControl);
 if TempIdx >= 0 then begin
  if (Flex.MouseSubControl.Name = 'Gauge') or
     (Flex.MouseSubControl.Name = 'BkGauge') then begin
   FScrollingGauge := TFlexBox(Temps[TempIdx].FindByName('Gauge'));
   MoveTo(TempIdx, CalcGaugeValue(FScrollingGauge, X));
   FGaugeScroll := true;
  end else
   MoveTo(TempIdx, -1);
 end else
 if Flex.MouseSubControl = BtnOn then begin
  FIsOn := not FIsOn;
  if FIsOn
   then BtnON.TextProp.Text := 'OFF'
   else BtnON.TextProp.Text := 'ON';
 end else
 if Flex.MouseSubControl = BtnCopyright then begin
  ShowAbout;
 end;
end;

procedure TfmMain.FlexMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if FGaugeScroll then begin
  Application.CancelHint;
  MoveTo(FindParentTemp(FScrollingGauge), CalcGaugeValue(FScrollingGauge, X));
 end;
 if FLastControl <> Flex.MouseControl then begin
  with TFlexText(FLastControl) do begin
   if FLastControl = BtnON then begin
    FontProp.Color := clWhite;
    FontProp.Style := FontProp.Style - [fsUnderline];
   end else
   if FLastControl = BtnCopyright then begin
    FontProp.Color := clBlack;
    FontProp.Style := FontProp.Style - [fsUnderline];
   end;
  end;
  with TFlexText(Flex.MouseControl) do begin
   if Flex.MouseControl = BtnON then begin
    FontProp.Color := clYellow;
    FontProp.Style := FontProp.Style + [fsUnderline];
   end else
   if Flex.MouseControl = BtnCopyright then begin
    FontProp.Color := clRed;
    FontProp.Style := FontProp.Style + [fsUnderline];
   end;
  end;
  FLastControl := Flex.MouseControl;
 end;
end;

procedure TfmMain.FlexMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 FGaugeScroll := False;
end;

procedure TfmMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = vk_F1 then ShowAbout;
end;

end.