rm_insp.pas

进销存·完整的·有数据库的·非常完整·只得参考

{******************************************}
{                                          }
{             Report Machine v2.0          }
{             Object Inspector             }
{                                          }
{******************************************}

unit RM_insp;

interface

{$I RM.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Buttons, RM_Class, RM_Pars, RM_Common
{$IFDEF USE_TB2K}
  , TB2Item, TB2Dock, TB2Toolbar
{$ELSE}
{$IFDEF USE_INTERNALTB97}
  , RM_TB97Ctls, RM_TB97Tlbr, RM_TB97
{$ELSE}
  , TB97Ctls, TB97Tlbr, TB97
{$ENDIF}
{$ENDIF}
{$IFDEF Delphi6}, Variants{$ENDIF};

type
  TModifyEvent = procedure(Item: Integer) of object;
  TGetObjectsEvent = procedure(List: TStrings) of object;
  TSelectionChangedEvent = procedure(ObjName: string) of object;
  TRMInspForm = class;

  { TProp }
  TProp = class(TObject)
  private
    procedure SetValue(Value: Variant);
    function GetValue: Variant;
    function IsEnumNull: Boolean;
  public
    Text: string;
    DataType: TRMDataTypes;
    Editor: TNotifyEvent;
    Enum: TStringList;
    EnumValues: Variant;
    constructor Create(PropValue: Variant; PropType: TRMDataTypes;
      PropEnum: TStringList; PropEnumValues: Variant; PropEditor: TNotifyEvent); virtual;
    destructor Destroy; override;
    property Value: Variant read GetValue write SetValue;
  end;

  { TRMPopupListBox }
  TRMPopupListbox = class(TCustomListbox)
  private
    FInspForm: TRMInspForm;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
  end;

  { TRMInspForm }
  TRMInspForm = class(TRMToolWin)
  private
    { Private declarations }
    Box: TScrollBox;
    PaintBox1: TPaintBox;
    Edit1: TEdit;
    EditPanel: TPanel;
    ComboPanel: TPanel;
    ComboBtn: TSpeedButton;
    EditBtn: TSpeedButton;
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Panel3: TPanel;
    cmbObjects: TComboBox;
    Splitter1: TSplitter;

    FListVisible: Boolean;
    FItems: TStringList;
    FItemIndex: Integer;
    FOnModify: TModifyEvent;
    FRowHeight: Integer;
    Fw, Fw1: Integer;
    Fb: TBitmap;
    FBusyFlag, FBusyFlag1: Boolean;
    FDefHeight: Integer;
    FLB1: TRMPopupListBox;
    FTickCount: Integer;
    FPanel1: TPanel;
    FDown: Boolean;
    FLastProp: string;
    FPropAliases: TRMVariables;

    FOnHeightChanged: TNotifyEvent;
    FOnGetObjects: TGetObjectsEvent;
    FOnSelectionChanged: TSelectionChangedEvent;

    procedure OnResizeEvent(Sender: TObject);
    procedure OnVisibleChangedEvent(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EditBtnClick(Sender: TObject);
    procedure Edit1DblClick(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure cmbObjectsDropDown(Sender: TObject);
    procedure cmbObjectsClick(Sender: TObject);
    procedure cmbObjectsDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
    procedure ComboBtnClick(Sender: TObject);
    procedure LB1Click(Sender: TObject);
    procedure Edit1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure Panel2Resize(Sender: TObject);

    procedure SetItems(Value: TStringList);
    procedure SetItemIndex(Value: Integer);
    function GetCount: Integer;
    procedure DrawOneLine(index: Integer; a: Boolean);
    procedure SetItemValue(Value: string);
    function GetItemValue(i: Integer): string;
    function CurItem: TProp;
    function GetPropValue(Index: Integer): Variant;
    procedure SetPropValue(Index: Integer; Value: Variant);
    function GetClassName(ObjName: string): string;
    procedure FillPropAliases;
    //WHF Add
    function GetPropName(Index: Integer; aCommon: Boolean): string;
    function GetItemType(i: Integer): TRMDataTypes;
    procedure OnEventDrawItemColor(Control: TWinControl; AIndex: Integer;
      ARect: TRect; State: TOwnerDrawState);
    procedure Localize;

    procedure SetSplitterPos(Value: Integer);
  public
    { Public declarations }
    CurObject: TObject;
    ObjectName: string;
    HideProperties: Boolean;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ClearProperties;
    procedure AddProperty(PropName: string; PropValue: Variant; PropType: TRMDataTypes;
      PropEnum: TStringList; PropEnumValues: Variant; PropEditor: TNotifyEvent);
    procedure CloseUp(Accept: Boolean);
    procedure ItemsChanged;

    property PropValue[Index: Integer]: Variant read GetPropValue write SetPropValue;
    property Items: TStringList read FItems write SetItems;
    property ItemIndex: Integer read FItemIndex write SetItemIndex;
    property Count: Integer read GetCount;
    property SplitterPos: Integer read Fw1 write SetSplitterPos;

    property OnModify: TModifyEvent read FOnModify write FOnModify;
    property OnHeightChanged: TNotifyEvent read FOnHeightChanged write FOnHeightChanged;
    property OnGetObjects: TGetObjectsEvent read FOnGetObjects write FOnGetObjects;
    property OnSelectionChanged: TSelectionChangedEvent read FOnSelectionChanged write FOnSelectionChanged;
  end;

implementation

uses RM_Desgn, RM_Utils, RM_Const, RM_Const1;

{$R RM_LNG5.RES}

type
  TInspPanel = class(TPanel)
  protected
    procedure WMEraseBackground(var Message: TMessage); message WM_ERASEBKGND;
    procedure Paint; override;
  end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TInspPanel }

procedure TInspPanel.WMEraseBackground(var Message: TMessage);
begin
end;

procedure TInspPanel.Paint;
begin
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMPopupListBox }

procedure TRMPopupListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_BORDER;
    ExStyle := WS_EX_TOOLWINDOW;
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TRMPopupListbox.CreateWnd;
begin
  inherited CreateWnd;
  Windows.SetParent(Handle, 0);
  CallWindowProc(DefWndProc, Handle, wm_SetFocus, 0, 0);
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TProp }

constructor TProp.Create(PropValue: Variant; PropType: TRMDataTypes;
  PropEnum: TStringList; PropEnumValues: Variant; PropEditor: TNotifyEvent);
begin
  inherited Create;
  DataType := PropType;
  Editor := PropEditor;
  Enum := PropEnum;
  EnumValues := PropEnumValues;
  Value := PropValue;
end;

destructor TProp.Destroy;
begin
  EnumValues := 0;
  inherited Destroy;
end;

function TProp.IsEnumNull: Boolean;
begin
  Result := TVarData(EnumValues).VType < varArray;
end;

procedure TProp.SetValue(Value: Variant);

  function ConvertToFloat(s: string): string;
  var
    v: Double;
  begin
    v := StrToFloat(s);
    Result := FloatToStrF(v, ffFixed, 4, 2);
  end;

  function ConvertToColor(s: string): string;
  var
    i, v: Integer;
  begin
    v := StrToInt(s);
    Result := '$' + IntToHex(v, 6);
    for i := 0 to 41 do
    begin
      if v = RMColors[i] then
      begin
        Result := RMColorNames[i];
        Break;
      end;
    end;
  end;

  function ConvertToBoolean(s: string): string;
  var
    v: Integer;
  begin
    if AnsiCompareText(s, 'True') = 0 then
      v := 1
    else if AnsiCompareText(s, 'False') = 0 then
      v := 0
    else
      v := StrToInt(s);
    if v <> 0 then
      Result := 'True'
    else
      Result := 'False';
  end;

  function ConvertFromEnum(s: string): string;
  var
    i: Integer;
  begin
    Result := s;
    for i := 0 to VarArrayHighBound(EnumValues, 1) do
    begin
      if EnumValues[i] = StrToInt(s) then
        Result := Enum[i];
    end;
  end;

begin
  Text := Value;
  if Text <> '' then
  begin
    if RMdtFloat in DataType then
      Text := ConvertToFloat(Text)
    else if RMdtBoolean in DataType then
      Text := ConvertToBoolean(Text)
    else if RMdtColor in DataType then
      Text := ConvertToColor(Text)
    else if (RMdtEnum in DataType) and (not IsEnumNull) then
      Text := ConvertFromEnum(Text);
  end;
end;

function TProp.GetValue: Variant;
var
  n: integer;

  function ConvertFromColor(s: string): Integer;
  var
    i: Integer;
  begin
    for i := 0 to 41 do
    begin
      if AnsiCompareText(s, RMColorNames[i]) = 0 then
      begin
        Result := RMColors[i];
        Exit;
      end;
    end;
    if Length(s) > 0 then
      Result := StrToInt(s)
    else
      Result := 16;
  end;

  function ConvertFromBoolean(s: string): Boolean;
  begin
    s := AnsiUpperCase(s);
    Result := False;
    if s = 'TRUE' then
      Result := True
    else if s = 'FALSE' then
      Result := False
    else if (s <> '') and (s <> '0') then
      Result := True;
  end;

  function ConvertFromDate(s: string): TDateTime;
  var
    SaveFormat: string;
    SaveDateSeparator: char;
  begin
    SaveFormat := SysUtils.ShortDateFormat;
    SaveDateSeparator := SysUtils.DateSeparator;
    SysUtils.ShortDateFormat := 'yyyy/mm/dd';
    SysUtils.DateSeparator := '/';
    Result := StrToDate(Text);
    SysUtils.ShortDateFormat := SaveFormat;
    SysUtils.DateSeparator := SaveDateSeparator;
  end;

begin
  Result := Null;
  if (RMdtString in DataType) or ((RMdtEnum in DataType) and IsEnumNull) then
    Result := Text
  else if RMdtInteger in DataType then
    Result := StrToInt(Text)
  else if RMdtFloat in DataType then
    Result := RMStrToFloat(Text)
  else if RMdtBoolean in DataType then
    Result := ConvertFromBoolean(Text)
  else if RMdtColor in DataType then
    Result := ConvertFromColor(Text)
  else if rmdtDate in DataType then
    Result := ConvertFromDate(Text)
  else if RMdtEnum in DataType then
  begin
    n := Enum.IndexOf(Text);
    if n <> -1 then
      Result := EnumValues[n]
    else
      Result := StrToInt(Text);
  end;
end;

{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
{ TRMInspForm }
//WHF Add

constructor TRMInspForm.Create(AOwner: TComponent);
begin
	Inherited Create(AOwner);

  Panel3 := TPanel.Create(Self);
  with Panel3 do
  begin
  	Parent := Self;
    Align := alTop;
    Height := 26;
    BevelOuter := bvNone;
  end;
  cmbObjects := TComboBox.Create(Self);
  with cmbObjects do
  begin
  	Parent := Panel3;
    SetBounds(0, 2, 21, 169);
    Style := csOwnerDrawFixed;
    DropDownCount := 12;
    ItemHeight := 15;
    Sorted := True;
    OnClick := cmbObjectsClick;
    OnDrawItem := cmbObjectsDrawItem;
    OnDropDown := cmbObjectsDropDown;
  end;

  Box := TScrollBox.Create(Self);
  with Box do
  begin
  	Parent := Self;
    HorzScrollBar.Visible := False;
    Align := alClient;
  end;
  PaintBox1 := TPaintBox.Create(Self);
  with PaintBox1 do
  begin
  	Parent := Box;
    Align := alClient;
    OnMouseDown := PaintBox1MouseDown;
    OnMouseMove := PaintBox1MouseMove;
    OnMouseUp := PaintBox1MouseUp;
    OnPaint := PaintBox1Paint;
  end;
  Edit1 := TEdit.Create(Self);
  with Edit1 do
  begin
		Parent := Box;
  	BorderStyle := bsNone;
    Visible := False;
    OnDblClick := Edit1DblClick;
    OnKeyDown := Edit1KeyDown;
    OnKeyPress := Edit1KeyPress;
    OnMouseDown := Edit1MouseDown;
  end;
  EditPanel := TPanel.Create(Self);
  with EditPanel do
  begin