在线时间:8:00-16:00
迪恩网络APP
随时随地掌握行业动态
扫描二维码
关注迪恩网络微信公众号
unit uMultiInputBox; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Controls, Vcl.Forms, Vcl.StdCtrls; type TFieldType = ( ftNumber, ftHexNumber, ftFloatNumber, ftText ); TInputRec = record Prompt : string; MaxLength : integer; FieldType : TFieldType; FieldValue : Variant; end; TInputRecArray = array of TInputRec; const FORM_CAPTION_HEIGHT = 30; CLIENT_SPACE = 20; BUTTON_HEIGHT = 25; BUTTON_WIDTH = 100; LABEL_H_EDIT = 10; LABEL_V_LEBEL = 35; EDIT_PADDED = 10; EDIT_MAX_WIDTH = 300; EDIT_DELTA_LABEL = 5; function MultiInputBox( Self : TObject; const ACaption : string; InputRecs : TInputRecArray ) : boolean; implementation var Box : TForm; ButtonOK : TButton; ButtonCancel : TButton; Labels : array of TLabel; Edits : array of TEdit; procedure ButtonCancelClick( Self, Sender : TObject ); begin TForm( Self ).ModalResult := mrCancel; // Form will be closed end; procedure ButtonOkClick( Self, Sender : TObject ); var RecCount : integer; InputRecs : TInputRecArray; I : integer; begin InputRecs := TInputRecArray( Self ); RecCount := Length( InputRecs ); for I := 0 to RecCount - 1 do begin case InputRecs[ I ].FieldType of ftNumber : InputRecs[ I ].FieldValue := StrToInt( Edits[ I ].Text ); ftHexNumber : InputRecs[ I ].FieldValue := StrToInt( '$' + Edits[ I ].Text ); ftFloatNumber : InputRecs[ I ].FieldValue := StrToFloat( Edits[ I ].Text ); ftText : InputRecs[ I ].FieldValue := Edits[ I ].Text; end; end; // Form will be closed TForm( TButton( Sender ).Parent ).ModalResult := mrOK; end; procedure EditKeyPress( Self, Sender : TObject; var Key : Char ); var FieldType : TFieldType; begin // Edits[ I ].Tag := Ord( InputRecs[ I ].FieldType ); FieldType := TFieldType( TEdit( Sender ).Tag ); if FieldType = ftNumber then begin if not CharInSet( Key, [ '0' .. '9', '-', #8 ] ) then Key := #0; end else if FieldType = ftHexNumber then begin if not CharInSet( Key, [ '0' .. '9', 'A' .. 'F', 'a' .. 'f', #8 ] ) then Key := #0; end else if FieldType = ftFloatNumber then begin if not CharInSet( Key, [ '0' .. '9', '-', '.', #8 ] ) then Key := #0; end; end; function MultiInputBox( Self : TObject; const ACaption : string; InputRecs : TInputRecArray ) : boolean; var RecCount : integer; Top : integer; Left : integer; M : TMethod; I : integer; MaxLabelWidth, LabelWidth : integer; MaxEditWidth, EditWidth : integer; Number : uint64; FloatNumber : double; begin result := false; RecCount := Length( InputRecs ); if RecCount = 0 then raise Exception.Create( 'Error Input Count' ); SetLength( Labels, RecCount ); SetLength( Edits, RecCount ); Box := TForm.Create( TComponent( Self ) ); // Owner : Destroy it try Box.Parent := TWinControl( Self ); // Parent : Display it Box.BorderStyle := bsDialog; Box.Position := poOwnerFormCenter; Box.Caption := ACaption; // // Box.Canvas.TextWidth Box.Font := TForm( Self ).Font; Top := CLIENT_SPACE; MaxLabelWidth := 0; for I := 0 to RecCount - 1 do begin Labels[ I ] := TLabel.Create( Box ); // Owner : Destroy by Box Labels[ I ].Parent := Box; // Parent : Display in Box Labels[ I ].Top := Top; Labels[ I ].Caption := InputRecs[ I ].Prompt; Top := Top + LABEL_V_LEBEL; LabelWidth := Box.Canvas.TextWidth( Labels[ I ].Caption ); if MaxLabelWidth < LabelWidth then MaxLabelWidth := LabelWidth; end; MaxLabelWidth := MaxLabelWidth + CLIENT_SPACE; for I := 0 to RecCount - 1 do begin Labels[ I ].Left := MaxLabelWidth - Box.Canvas.TextWidth ( Labels[ I ].Caption ); end; Left := MaxLabelWidth + LABEL_H_EDIT; MaxEditWidth := 0; Top := CLIENT_SPACE - EDIT_DELTA_LABEL; for I := 0 to RecCount - 1 do begin Edits[ I ] := TEdit.Create( Box ); Edits[ I ].Parent := Box; Edits[ I ].Left := Left; Edits[ I ].Top := Top; Edits[ I ].TabStop := TRUE; Edits[ I ].TabOrder := I; Edits[ I ].MaxLength := InputRecs[ I ].MaxLength; Edits[ I ].Tag := Ord( InputRecs[ I ].FieldType ); if InputRecs[ I ].FieldType <> ftText then begin M.Data := Box; M.Code := @EditKeyPress; Edits[ I ].OnKeyPress := TKeyPressEvent( M ); end; EditWidth := 0; case InputRecs[ I ].FieldType of ftNumber : begin Number := InputRecs[ I ].FieldValue; Edits[ I ].Text := Format( '%*.*d', [ InputRecs[ I ].MaxLength, InputRecs[ I ].MaxLength, Number ] ); Edits[ I ].Width := Box.Canvas.TextWidth( '0' ) * InputRecs[ I ] .MaxLength + EDIT_PADDED; end; ftHexNumber : begin Number := InputRecs[ I ].FieldValue; Edits[ I ].Text := IntToHex( Number, InputRecs[ I ].MaxLength ); Edits[ I ].Width := Box.Canvas.TextWidth( '0' ) * InputRecs[ I ] .MaxLength + EDIT_PADDED; end; ftFloatNumber : begin FloatNumber := InputRecs[ I ].FieldValue; Edits[ I ].Text := Format( '%-*.2f', [ InputRecs[ I ].MaxLength, FloatNumber ] ); Edits[ I ].Width := Box.Canvas.TextWidth( '0' ) * InputRecs[ I ] .MaxLength + EDIT_PADDED; end; ftText : begin Edits[ I ].Text := InputRecs[ I ].FieldValue; Edits[ I ].Width := Box.Canvas.TextWidth( 'W' ) * InputRecs[ I ] .MaxLength + EDIT_PADDED; if Edits[ I ].Width > EDIT_MAX_WIDTH then Edits[ I ].Width := EDIT_MAX_WIDTH; end; else raise Exception.Create( 'Error Input Type' ); end; if MaxEditWidth < Edits[ I ].Width then MaxEditWidth := Edits[ I ].Width; Top := Top + LABEL_V_LEBEL; end; Top := Top + EDIT_DELTA_LABEL; Box.Width := Left + MaxEditWidth + CLIENT_SPACE; Box.Height := FORM_CAPTION_HEIGHT + Top + BUTTON_HEIGHT + CLIENT_SPACE; ButtonOK := TButton.Create( Box ); ButtonOK.TabStop := false; ButtonOK.Parent := Box; ButtonOK.Height := BUTTON_HEIGHT; ButtonOK.Width := BUTTON_WIDTH; ButtonOK.Caption := 'OK'; M.Data := InputRecs; M.Code := @ButtonOkClick; ButtonOK.OnClick := TNotifyEvent( M ); ButtonCancel := TButton.Create( Box ); ButtonCancel.TabStop := false; ButtonCancel.Parent := Box; ButtonCancel.Height := BUTTON_HEIGHT; ButtonCancel.Width := BUTTON_WIDTH; ButtonCancel.Caption := 'Cancel'; M.Data := Box; M.Code := @ButtonCancelClick; ButtonCancel.OnClick := TNotifyEvent( M ); ButtonOK.Left := ( Box.Width - ( BUTTON_WIDTH * 2 ) ) div 3; ButtonOK.Top := Top; ButtonCancel.Left := Box.Width - BUTTON_WIDTH - ( Box.Width - ( BUTTON_WIDTH * 2 ) ) div 3; ButtonCancel.Top := Top; result := Box.ShowModal = mrOK; finally FreeAndNil( Box ); end; end; end.
|
2023-10-27
2022-08-15
2022-08-17
2022-09-23
2022-08-13
请发表评论