getdata.pas

Motorola 集群通信系统中SDTS车载台PEI端测试程序

unit Getdata;

interface

uses WinTypes, Classes, StdCtrls, ExtCtrls, Controls, Messages, SysUtils,
  Forms, Graphics, Menus, Buttons, Spin, DsgnIntf;


type
  Float = Extended;

 THistComboBox = class(TComboBox)
  private
    FMaxHistoryLength: Integer;
protected
    { Protected-Deklarationen }
  public
    constructor Create(AOwner: TComponent); Override;
    procedure AddToHist;
    procedure ClearHist;
  published
    property MaxHistoryLength: Integer   read FMaxHistoryLength write FMaxHistoryLength default 9;
  end;

  { TGetLong }

  TGetLong = class(TCustomEdit)
  protected
    FMinValue: LongInt;
    FMaxValue: LongInt;
    FIncrement: LongInt;
    FButton: TSpinButton;
    FEditorEnabled: Boolean;
    function GetMinHeight: Integer;
    function GetValue: LongInt; virtual;
    function CheckValue (NewValue: LongInt): LongInt;
    procedure SetValue (NewValue: LongInt); virtual;
    procedure SetEditRect;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
    procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
    procedure WMCut(var Message: TWMCut);   message WM_CUT;
    function IsValidChar(Key: Char): Boolean; virtual;
    procedure UpClick (Sender: TObject); virtual;
    procedure DownClick (Sender: TObject); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Button: TSpinButton read FButton;
  published
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
    property Enabled;
    property Font;
    property Increment: LongInt read FIncrement write FIncrement;// default 1;
    property MaxLength;
    property MaxValue: LongInt read FMaxValue write FMaxValue;
    property MinValue: LongInt read FMinValue write FMinValue;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Value: LongInt read GetValue write SetValue;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;


  { TGetHexLong }

  TGetHexLong = class(TGetLong)
  protected
    FDigits: Integer;
    function GetValue: LongInt; override;
    procedure SetValue (NewValue: LongInt); override;
    function IsValidChar(Key: Char): Boolean; override;
    procedure SetDigits(NewValue: Integer); virtual;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Digits: Integer read FDigits write SetDigits;
    property CharCase default ecUpperCase;
  end;


  { TGetFloat }

  TGetFloat = class(TCustomEdit)
  protected
    FFormat: TFloatFormat;
    FPrecision: Integer;
    FDigits: Integer;
    FMinValue: Float;
    FMaxValue: Float;
    FEngFormat: Boolean;
    FIncrement: Float;
    FButton: TSpinButton;
    FEditorEnabled: Boolean;
    function GetMinHeight: Integer;
    function GetValue: Float;
    function CheckValue(NewValue: Float): Float;
    procedure SetValue(NewValue: Float);
    procedure SetPrecision(NewValue: Integer);
    procedure SetDigits(NewValue: integer);
    procedure SetFormat(NewValue: TFloatFormat);
    procedure SetEditRect;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
    procedure CMExit(var Message: TCMExit);   message CM_EXIT;
    procedure WMPaste(var Message: TWMPaste);   message WM_PASTE;
    procedure WMCut(var Message: TWMCut);   message WM_CUT;
    function IsValidChar(Key: Char): Boolean; virtual;
    procedure UpClick(Sender: TObject); virtual;
    procedure DownClick(Sender: TObject); virtual;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ConvToEng(s : String) : string;
    property Button: TSpinButton read FButton;
  published
    property Anchors;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property DragCursor;
    property DragMode;
    property EngFormat: Boolean read FEngFormat write FEngFormat default False;
    property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
    property Enabled;
    property Font;
    property Increment: Float read FIncrement write FIncrement;
    property MaxLength;
    property MaxValue: Float read FMaxValue write FMaxValue;
    property MinValue: Float read FMinValue write FMinValue;
    property Precision: Integer read FPrecision write SetPrecision; //FPrecision default 7;
    property Digits: Integer read FDigits write SetDigits; //FDigits default 4;
    property Format: TFloatFormat read FFormat write SetFormat;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Value: Float read GetValue write SetValue;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  TGetString = class(TEdit)
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    function GetMinHeight: Integer;
  end;




procedure Register;


implementation

uses WinProcs;

constructor THistComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMaxHistoryLength := 9;
end;

procedure THistComboBox.AddToHist;
{ Add a string to the Historylistbox }
var
   i: integer;
begin
  if Trim(Text) <> '' then begin
    Text := Trim(Text);
    { Insert in first position }
    Items.Insert(0,Text);
    ItemIndex := 0;
    { Check maximum numer of entries and delete any duplicate }
    for i := 1 to Items.Count-1 do
      if (Items[i] = Text) or (i > FMaxHistoryLength-1) then
        Items.Delete(i);
  end;
end;

procedure THistComboBox.ClearHist;
{ Clears the history list}
var
   i: integer;
begin
  if Trim(Text) <> '' then begin
    ItemIndex := 0;
    { Check maximum numer of entries and delete any duplicate }
    for i := Items.Count-1 downto 0 do
      Items.Delete(i);
  end;
end;


{ TGetLong }

constructor TGetLong.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FButton := TSpinButton.Create (Self);
  FButton.Width := 15;
  FButton.Height := 17;
  FButton.Visible := True;  
  FButton.Parent := Self;
  FButton.FocusControl := Self;
  FButton.OnUpClick := UpClick;
  FButton.OnDownClick := DownClick;
  Text := '0';
  ControlStyle := ControlStyle - [csSetCaption];
  FIncrement := 0;
  FEditorEnabled := True;
end;

destructor TGetLong.Destroy;
begin
  FButton := nil;
  inherited Destroy;
end;

procedure TGetLong.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Key = VK_UP then UpClick (Self)
  else if Key = VK_DOWN then DownClick (Self);
  inherited KeyDown(Key, Shift);
end;

procedure TGetLong.KeyPress(var Key: Char);
begin
  if not IsValidChar(Key) then begin
    Key := #0;
    MessageBeep(0)
  end;
  if Key <> #0 then inherited KeyPress(Key);
end;

function TGetLong.IsValidChar(Key: Char): Boolean;
begin
  Result := (Key in ['-', '0'..'9']) or
    ((Key < #32) and (Key <> Chr(VK_RETURN)));
  if not FEditorEnabled and Result and ((Key >= #32) or
      (Key = Char(VK_BACK)) or (Key = Char(VK_DELETE))) then
    Result := False;
end;

procedure TGetLong.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
{  Params.Style := Params.Style and not WS_BORDER;  }
  Params.Style := Params.Style {or ES_MULTILINE} or WS_CLIPCHILDREN;
end;

procedure TGetLong.CreateWnd;
begin
  inherited CreateWnd;
  SetEditRect;
end;

procedure TGetLong.Loaded;
begin
  inherited Loaded;
  if FIncrement <= 0 then begin
    FButton.Visible := False;
    FIncrement := 0;
  end;
end;

procedure TGetLong.SetEditRect;
var
  Loc: TRect;
begin
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  Loc.Bottom := ClientHeight + 1;
  Loc.Right := ClientWidth - FButton.Width - 2;
  Loc.Top := 0;
  Loc.Left := 0;
  SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));  {debug}
end;

procedure TGetLong.WMSize(var Message: TWMSize);
var
  MinHeight: Integer;
begin
  inherited;
  MinHeight := GetMinHeight;
    { text edit bug: if size to less than minheight, then edit ctrl does
      not display the text }
  if Height < MinHeight then
    Height := MinHeight
  else if FButton <> nil then begin
    if NewStyleControls and Ctl3D then
      FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 4)//5)
    else FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 2);//3);
    {FButton.SetBounds (Width - FButton.Width, 0, FButton.Width, Height);}
    SetEditRect;
  end;
end;

function TGetLong.GetMinHeight: Integer;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  I := SysMetrics.tmHeight;
  if I > Metrics.tmHeight then I := Metrics.tmHeight;
  Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;

procedure TGetLong.UpClick (Sender: TObject);
begin
  if ReadOnly then MessageBeep(0)
  else Value := Value + FIncrement;
end;

procedure TGetLong.DownClick (Sender: TObject);
begin
  if ReadOnly then MessageBeep(0)
  else Value := Value - FIncrement;
end;

procedure TGetLong.WMPaste(var Message: TWMPaste);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;

procedure TGetLong.WMCut(var Message: TWMPaste);
begin
  if not FEditorEnabled or ReadOnly then Exit;
  inherited;
end;

procedure TGetLong.CMExit(var Message: TCMExit);
begin
  inherited;
  if CheckValue (Value) <> Value then
    SetValue (Value);
end;

function TGetLong.GetValue: LongInt;
begin
  try
    Result := StrToInt (Text);
  except
    Result := FMinValue;
  end;
end;

procedure TGetLong.SetValue (NewValue: LongInt);
begin
  Text := IntToStr (CheckValue (NewValue));
end;

function TGetLong.CheckValue (NewValue: LongInt): LongInt;
begin
  Result := NewValue;
  if (FMaxValue <> FMinValue) then begin
    if NewValue < FMinValue then
      Result := FMinValue
    else if NewValue > FMaxValue then
      Result := FMaxValue;
  end;
end;

procedure TGetLong.CMEnter(var Message: TCMGotFocus);