procedure TForm1.Button1Click(Sender: TObject);
var
Ret:string;
begin
if InputQuery('InputQuery', '値を入力：', Ret) then
begin
//ＯＫボタンがクリックされた時
end else begin
//キャンセルボタンがクリックされた時（ESCキーで閉じた場合もFalseになる）
end;
end;
Private Sub CommandButton1_Click()
Dim PrintNo1 As Integer
Dim PrintNo2 As Integer
Dim i As Integer
If UserForm1.TextBox1.Text = "" Then
MsgBox ("開始番号を半角数字で入力してください。")
TextBox1.SetFocus
Exit Sub
End If
If UserForm1.TextBox2.Text = "" Then
MsgBox ("終了番号を半角数字で入力してください。")
TextBox2.SetFocus
Exit Sub
End If
PrintNo1 = UserForm1.TextBox1.Text
PrintNo2 = UserForm1.TextBox2.Text
i = PrintNo1
For i = PrintNo1 To PrintNo2
Range("A2").Select
ActiveCell.FormulaR1C1 = i
Range("B6:AB38").Select
ActiveSheet.PageSetup.PrintArea = "$B$6:$AB$38"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next i
Range("A2").Select
End Sub
Private Sub CommandButton2_Click()
'キャンセルボタンがクリックされた場合
Unload UserForm1
Exit Sub
End Sub
//Formのメンバーにはしていません。
//名前は MyInputQuery に変更
function MyInputQuery(const ACaption, APrompt: string;
var Value: string): Boolean;
var
Form: TForm;
Prompt: TLabel;
Edit: TEdit;
DialogUnits: TPoint;
ButtonTop, ButtonWidth, ButtonHeight: Integer;
function GetAveCharSize(Canvas: TCanvas): TPoint;
var
I: Integer;
Buffer: array[0..51] of Char;
begin
for I := 0 to 25 do Buffer[I] := Chr(I + Ord('A'));
for I := 0 to 25 do Buffer[I + 26] := Chr(I + Ord('a'));
GetTextExtentPoint(Canvas.Handle, Buffer, 52, TSize(Result));
Result.X := Result.X div 52;
end;
begin
Result := False;
Form := TForm.Create(Application);
with Form do begin
try
Canvas.Font := Font;
DialogUnits := GetAveCharSize(Canvas);
BorderStyle := bsDialog;
Caption := ACaption;
ClientWidth := MulDiv(180, DialogUnits.X, 4);
Position := poScreenCenter;
Prompt := TLabel.Create(Form);
with Prompt do
begin
Parent := Form;
Caption := APrompt;
Left := MulDiv(8, DialogUnits.X, 4);
Top := MulDiv(8, DialogUnits.Y, 8);
Constraints.MaxWidth := MulDiv(164, DialogUnits.X, 4);
WordWrap := True;
end;
Edit := TEdit.Create(Form);
with Edit do
begin
Parent := Form;
Left := Prompt.Left;
Top := Prompt.Top + Prompt.Height + 5;
Width := MulDiv(164, DialogUnits.X, 4);
MaxLength := 255;
Text := Value;
SelectAll;
//Password入力用にInputQueryを使用するための設定（Password Mask）
//EditコントロールではPasswordCharに設定した文字が
//入力した文字の代わりに表示される（デフォルトは'#0'）
//パスワードマスクするなら
//PasswordChar:= '*';
//これでマスクしなくなる（'#0'として文字列化しないこと）
PasswordChar := #0;
//Delphi2009からTEditにNumbersOnlyプロパティ（数字だけを入力可能にする）が
//実装されているそうなので、せっかくだからTrueにしてみた！
//全角文字の「１２３」も「数値である」と判断してくれます･･･
NumbersOnly := True;
//IMEは使用不可（この１行がどうしても書きたかった！）
ImeMode := imDisable;
//文字位置
//Alignment := taCenter;
Alignment := taLeftJustify;
//Alignment := taRightJustify;
end;
ButtonTop := Edit.Top + Edit.Height + 15;
ButtonWidth := MulDiv(50, DialogUnits.X, 4);
ButtonHeight := MulDiv(14, DialogUnits.Y, 8);
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'OK';
ModalResult := mrOk;
Default := True;
SetBounds(MulDiv(38, DialogUnits.X, 4), ButtonTop, ButtonWidth,
ButtonHeight);
end;
with TButton.Create(Form) do
begin
Parent := Form;
Caption := 'キャンセル';
ModalResult := mrCancel;
Cancel := True;
SetBounds(MulDiv(92, DialogUnits.X, 4), Edit.Top + Edit.Height + 15,
ButtonWidth, ButtonHeight);
Form.ClientHeight := Top + Height + 13;
end;
if ShowModal = mrOk then
begin
Value := Edit.Text;
Result := True;
end;
finally
Form.Free;
end;
end;
end;
このInputQueryをボタンクリックで呼び出します。
procedure TForm1.Button1Click(Sender: TObject);
var
Ret:string;
begin
if MyInputQuery('Dialog Caption', 'Please Enter the number:', Ret) then
begin
ShowMessage('Entered: '+ Ret);
end else begin
ShowMessage('False!');
end;
end;
var
i, j, k:integer;
begin
//初期化
k:=0;
//合計点を計算
for i := 1 to StringGrid1.RowCount-1 do
begin
for j := 1 to ( 解答欄の数 ) do
begin
if StringGrid1.Cells[j,i] <> '' then
begin
k := K + StrToInt(StringGrid1.Cells[j, i]);
end;
end;
//StringGrid.Cells[列, 行]
StringGrid1.Cells[( 解答欄の数 ) + 1, i]:= IntToStr(k);
//初期化
k:=0;
end;
実は少し工夫すれば100まできちんと表示できます。以前、どこかWeb上の情報で知ったのですが、Loopの中で増加する i の値をそのままProgressBarのPositionに代入せず、現在の i 値より「１大きな値をまず代入」し、その後、「１小さい値をセットしなおす」という技です。どなたが考えた技か知りませんが、これで100まできちんと表示できます。以下に、そのコードを示します（赤文字が追加するコード）。
procedure TForm1.Button1Click(Sender: TObject);
var
i, j:integer;
begin
//表示
StatusBar1.SimpleText:= '進捗状況：';
//ProgressBarの設定
ProgressBar1.Visible:=True;
ProgressBar1.Position:=0;
ProgressBar1.Max:=100;
//初期化
j:= 0;
for i:= 0 to 100 do
begin
//ProgressBar1.Position:= i; // -> MAXまで表示されない
// 100まで表示するコード
inc(j);
If ProgressBar1.Position < ProgressBar1.Max Then
begin
//目的の値より一つ大きくしてから、目的の値にする
ProgressBar1.Position:= j + 1;
ProgressBar1.Position:= j;
end else begin
//最大値にする時
//最大値を1つ増やしてから、元に戻す
ProgressBar1.Max:= 100 + 1;
ProgressBar1.Position:= j + 1;
ProgressBar1.Max:= 100;
ProgressBar1.Position:= j;
end;
Sleep(25);
Application.ProcessMessages;
end;
ProgressBar1.Visible:= False;
ShowMessage('Done!');
end;
StatusBar1DrawPanel手続きの if Panel=StatusBar.Panels[1] then 部分にもProgressBarに関する処理を追加します（赤文字の部分）。
if Panel=StatusBar.Panels[1] then
begin
//文字の表示(このPanel内のみ有効となるようだ)
StatusBar1.Canvas.Font.Color:= clBlack;
//背景色(このPanel内のみ有効となるようだ)
StatusBar1.Canvas.Brush.Color:= clBtnFace;
//矩形を取得
ARect:= Rect;
//表示位置(左寄せ)
DrawText(StatusBar1.Canvas.Handle, PChar(Panel.Text), -1, ARect,
DT_LEFT or DT_VCENTER or DT_SINGLELINE);
//ProgressBarの位置を設定
With ProgressBar1 do begin
Top:=Rect.Top;
Left:=Rect.Left;
Width:=Rect.Right - Rect.Left - 15;
Height:=Rect.Bottom - Rect.Top;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
w:integer;
begin
if not boolInfo then
begin
//制御用フラグを既読扱いに設定
boolInfo:=True;
StatusBar1.Panels[1].Text:= '最初の１回だけは表示したい案内';
//OKボタンを表示する位置を設定
w:= StatusBar1.Canvas.TextWidth('最初の１回だけは表示したい案内');
btnOK.SetBounds(
StatusBar1.Panels[0].Width + w + 5, 0, 40, StatusBar1.ClientHeight);
btnOK.Visible:=True;
StatusBar1.Refresh;
end;
end;
FormCreate手続きに追加する処理です。
procedure TForm1.FormCreate(Sender: TObject);
var
w:integer;
begin
･･･ 省略 ･･･
//案内表示の制御用フラグ
boolInfo:= False;
//OKボタン
btnOK.Parent:= StatusBar1;
btnOK.Visible:= False;
end;
StatusBar1DrawPanel手続きの中の if Panel=StatusBar.Panels[1] then の内容を次のように変更します。
if Panel=StatusBar.Panels[1] then
begin
//文字の表示(このPanel内のみ有効となるようだ)
if not boolInfo then
begin
StatusBar1.Canvas.Font.Color:= clBlack;
end else begin
StatusBar1.Canvas.Font.Color:= clBlue;
end;
//背景色(このPanel内のみ有効となるようだ)
if not boolInfo then
begin
StatusBar1.Canvas.Brush.Color:= clBtnFace;
end else begin
StatusBar1.Canvas.Brush.Color:= clAqua;
end;
･･･ 省略 ･･･
end;
