| 1 | { ******************************************** }
|
|---|
| 2 | { KS_Procs2 ver 1.0 (Oct. 10, 2003) }
|
|---|
| 3 | { }
|
|---|
| 4 | { For Delphi 4, 5 and 6 }
|
|---|
| 5 | { }
|
|---|
| 6 | { Copyright (C) 1999-2003, Kurt Senfer. }
|
|---|
| 7 | { All Rights Reserved. }
|
|---|
| 8 | { }
|
|---|
| 9 | { Support@ks.helpware.net }
|
|---|
| 10 | { }
|
|---|
| 11 | { Documentation and updated versions: }
|
|---|
| 12 | { }
|
|---|
| 13 | { http://KS.helpware.net }
|
|---|
| 14 | { }
|
|---|
| 15 | { ******************************************** }
|
|---|
| 16 | {
|
|---|
| 17 | This library is free software; you can redistribute it and/or
|
|---|
| 18 | modify it under the terms of the GNU Lesser General Public
|
|---|
| 19 | License as published by the Free Software Foundation; either
|
|---|
| 20 | version 2.1 of the License, or (at your option) any later version.
|
|---|
| 21 |
|
|---|
| 22 | This library is distributed in the hope that it will be useful,
|
|---|
| 23 | but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|---|
| 24 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|---|
| 25 | Lesser General Public License for more details.
|
|---|
| 26 |
|
|---|
| 27 | You should have received a copy of the GNU Lesser General Public
|
|---|
| 28 | License along with this library; if not, write to the Free Software
|
|---|
| 29 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|---|
| 30 | }
|
|---|
| 31 |
|
|---|
| 32 | unit KS_Procs2;
|
|---|
| 33 |
|
|---|
| 34 |
|
|---|
| 35 | interface
|
|---|
| 36 |
|
|---|
| 37 | uses
|
|---|
| 38 | Windows;
|
|---|
| 39 |
|
|---|
| 40 | function KSInputQuery(const ACaption, APrompt: string; aDefault: string; NumChars: Integer = 0): String;
|
|---|
| 41 |
|
|---|
| 42 |
|
|---|
| 43 |
|
|---|
| 44 | implementation
|
|---|
| 45 |
|
|---|
| 46 | uses Forms, stdctrls, graphics, Consts, Controls;
|
|---|
| 47 |
|
|---|
| 48 |
|
|---|
| 49 |
|
|---|
| 50 | function KSInputQuery(const ACaption, APrompt: string; aDefault: string; NumChars: Integer = 0): String;
|
|---|
| 51 | var
|
|---|
| 52 | Form: TForm;
|
|---|
| 53 | Prompt: TLabel;
|
|---|
| 54 | Edit: TEdit;
|
|---|
| 55 | DialogUnits: TPoint;
|
|---|
| 56 | ButtonTop, ButtonWidth, ButtonHeight: Integer;
|
|---|
| 57 | aWidth: Integer;
|
|---|
| 58 |
|
|---|
| 59 | //------------------------------------------------
|
|---|
| 60 | function GetAveCharSize(Canvas: TCanvas): TPoint;
|
|---|
| 61 | var
|
|---|
| 62 | I: Integer;
|
|---|
| 63 | Buffer: array[0..51] of Char;
|
|---|
| 64 | begin
|
|---|
| 65 | for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
|
|---|
| 66 | for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
|
|---|
| 67 | GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
|
|---|
| 68 | Result.X := Result.X div 52;
|
|---|
| 69 | end;
|
|---|
| 70 | //------------------------------------------------
|
|---|
| 71 | begin
|
|---|
| 72 | Result := '';
|
|---|
| 73 |
|
|---|
| 74 | Form := TForm.Create(Application);
|
|---|
| 75 | try
|
|---|
| 76 | DialogUnits := GetAveCharSize(Form.Canvas);
|
|---|
| 77 |
|
|---|
| 78 | if (NumChars < 20) or (NumChars > 80)
|
|---|
| 79 | then aWidth := 180 //default 30 * w
|
|---|
| 80 | else aWidth := NumChars * DialogUnits.X;
|
|---|
| 81 |
|
|---|
| 82 | Form.Canvas.Font := Form.Font;
|
|---|
| 83 |
|
|---|
| 84 | Form.BorderStyle := bsDialog;
|
|---|
| 85 | Form.Caption := ACaption;
|
|---|
| 86 | Form.ClientWidth := MulDiv(aWidth, DialogUnits.X, 4);
|
|---|
| 87 | Form.ClientHeight := MulDiv(63, DialogUnits.Y, 8);
|
|---|
| 88 | Form.Position := poScreenCenter;
|
|---|
| 89 |
|
|---|
| 90 | Prompt := TLabel.Create(Form);
|
|---|
| 91 | Prompt.Parent := Form;
|
|---|
| 92 | Prompt.AutoSize := True;
|
|---|
| 93 | Prompt.Left := MulDiv(8, DialogUnits.X, 4);
|
|---|
| 94 | Prompt.Top := MulDiv(8, DialogUnits.Y, 8);
|
|---|
| 95 | Prompt.Caption := APrompt;
|
|---|
| 96 |
|
|---|
| 97 |
|
|---|
| 98 | Edit := TEdit.Create(Form);
|
|---|
| 99 | Edit.Parent := Form;
|
|---|
| 100 | Edit.Left := Prompt.Left;
|
|---|
| 101 | Edit.Top := MulDiv(19, DialogUnits.Y, 8);
|
|---|
| 102 | Edit.Width := MulDiv(aWidth - 16{164}, DialogUnits.X, 4);
|
|---|
| 103 | Edit.MaxLength := 255;
|
|---|
| 104 | Edit.Text := aDefault;
|
|---|
| 105 | Edit.SelectAll;
|
|---|
| 106 |
|
|---|
| 107 |
|
|---|
| 108 | ButtonTop := MulDiv(41, DialogUnits.Y, 8);
|
|---|
| 109 | ButtonWidth := MulDiv(50, DialogUnits.X, 4);
|
|---|
| 110 | ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
|
|---|
| 111 |
|
|---|
| 112 | with TButton.Create(Form) do
|
|---|
| 113 | begin
|
|---|
| 114 | Parent := Form;
|
|---|
| 115 | Caption := SMsgDlgOK;
|
|---|
| 116 | ModalResult := mrOk;
|
|---|
| 117 | Default := True;
|
|---|
| 118 | SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth, ButtonHeight);
|
|---|
| 119 | end;
|
|---|
| 120 |
|
|---|
| 121 | with TButton.Create(Form) do
|
|---|
| 122 | begin
|
|---|
| 123 | Parent := Form;
|
|---|
| 124 | Caption := SMsgDlgCancel;
|
|---|
| 125 | ModalResult := mrCancel;
|
|---|
| 126 | Cancel := True;
|
|---|
| 127 | SetBounds(MulDiv(92, DialogUnits.X, 4), ButtonTop, ButtonWidth, ButtonHeight);
|
|---|
| 128 | end;
|
|---|
| 129 |
|
|---|
| 130 | if Form.ShowModal = mrOk
|
|---|
| 131 | then result := Edit.Text;
|
|---|
| 132 | finally
|
|---|
| 133 | Form.Free;
|
|---|
| 134 | end;
|
|---|
| 135 | end;
|
|---|
| 136 | //------------------------------------------------------------------------------
|
|---|
| 137 |
|
|---|
| 138 | end.
|
|---|
