Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 3 years ago.
Improve this question
I am creating a custom component, a button-switch like this :
In my "form activate" function, I wrote a for loop in which I call 3 times the button function with a different position parameter like : SwitchButton(30); where 30 is the top position.
What I want to do is assign at these 3 buttons different actions, here some code.
Code for button creation :
procedure TFMain.SwitchButton(posPulsante: Integer);
var
i: Integer;
posDescrizionePulsante: Integer;
strDescrizione: String;
begin
posDescrizionePulsante := 32;
lastPressed := 1;
Pulsante := TPanel.Create(FMain);
BordoPulsante := TShape.Create(self);
LevaPulsante := TPanel.Create(self);
DescrizionePulsante := TLabel.Create(self);
//Proprietà Descrizione
with DescrizionePulsante do
begin
Parent := PComandi;
Top := posDescrizionePulsante;
Left := 100;
Caption := 'Visualizza finestra utenti';
Font.Name := 'Tahoma';
Font.Size := 12;
Font.Style := [fsBold];
Font.Color := clWhite;
end;
//Proprietà Pulsante
with Pulsante do
begin
Parent := PComandi;
ParentColor := false;
ParentBackground := false;
BevelOuter := bvNone;
Color := clWhite;
Width := 57;
Height := 25;
Top := posPulsante;
Left := 20;
Visible := true;
end;
//Proprietà Bordo
with BordoPulsante do
begin
Parent := Pulsante;
Align := alClient;
Brush.Style := bsClear;
Brush.Color := RGB(122,136,201);
Pen.Color := clWhite;
Pen.Style := psSolid;
Pen.Width := 3;
end;
//Proprietà Leva
with LevaPulsante do
begin
Parent := Pulsante;
ParentBackground := false;
ParentColor := false;
BevelOuter := bvNone;
Color := clWhite;
Cursor := crHandPoint;
Width := 23;
Height := 13;
Top := 6;
Left := 28;
LevaPulsante.OnClick := SwitchState;
end;
end;
Code for creating Button object :
procedure TFMain.FormActivate(Sender: TObject);
var
i: Integer;
posPulsante: Integer;
begin
posPulsante := 30;
for i := 1 to 3 do
begin
SwitchButton(posPulsante);
posPulsante := posPulsante + 50;
end;
end;
Would be nice to have some : if SwitchButton 1 is clicked then do something. if SwitchButton 2 is clicked then do something else.
I think this is an acceptable use of the Tag property. You can specify some number, for example the index of the for loop, in each of the panels:
procedure TFMain.FormActivate(Sender: TObject);
var
i: Integer;
posPulsante: Integer;
begin
posPulsante := 30;
for i := 1 to 3 do
begin
SwitchButton(posPulsante, i {For example, add the tag as extra parameter});
posPulsante := posPulsante + 50;
end;
end;
And then set that tag in the button, here using the added parameter indexPulsante.
procedure TFMain.SwitchButton(posPulsante: Integer; indexPulsante: Integer);
var
i: Integer;
posDescrizionePulsante: Integer;
strDescrizione: String;
begin
...
LevaPulsante.Tag := indexPulsante;
end;
And then, in the event handler (which I think you called SwitchState), you'll have the Sender, which is the control that was clicked (the panel, in your case).
procedure TFMain.SwitchState(Sender: TObject);
begin
case (Sender as TComponent).Tag of
1: ShowMessage('You clicked the first. Do something.')
2: ShowMessage('Do something else.')
else
ShowMessage('You clicked another button than 1 or 2');
end;
end;
NB: Tag is introduced in TComponent and therefore also available in TPanel. In the code above I only typecast to TComponent, because it doesn't matter that it's a panel to get the tag, but if you want to use other properties, a more specific cast may be needed. I like to keep the cast generic, to make it easier to make changes like switching to another type than TPanel, for instance when you actually gonna make a component out of this (inherited from TCustomControl?), or use a third party component.
I would like to show in a DBGRID as follows:
Imagine "Grid" as follows:
ID - DESCRIPTION
1 - Line 1 of the grid
2 - Line 2 of the grid
3 - Line 3 of the grid
Now, suppose the size of the DESCRIPTION column is changed and no longer appear the words "GRID";
I would like to stay as well DBGRID
ID - DESCRIPTION
1 - Line 1 of the
grid
2 - Line 2 of the
grid
3 - Line 3 of the
grid
is there any possibility that ??
Not what you're asking, but might help... I once used this code to show complete Memo fields in the standard DBGrid:
TMyForm = class(TForm)
...
private
FormMemoRect: TRect;
MemoGrid: TDBGrid;
BMemo: TBitBtn;
...
Procedure TMyForm.FormMemoDeactivate(Sender: TObject);
Begin
(Sender As TForm).Close;
Sender.Free;
End;
Procedure TMyForm.BMemoClick(Sender: TObject);
Var FormMemo: TForm;
Begin
MemoGrid.SetFocus;
FormMemo := TForm.Create(Self);
With TMemo.Create(FormMemo) Do Begin
Parent := FormMemo;
Align := alClient;
ReadOnly := True;
WordWrap := True;
ScrollBars := ssVertical;
Lines.Text := MemoGrid.DataSource.DataSet.Fields[TComponent(Sender).Tag].AsString;
End;
With FormMemo Do Begin
OnDeactivate := FormMemoDeactivate;
Left := FormMemoRect.Left;
Top := FormMemoRect.Top;
Width := Max(FormMemoRect.Right - FormMemoRect.Left, 300);
Height := FormMemoRect.Bottom - FormMemoRect.Top;
BorderStyle := bsNone;
Show;
End;
End;
Procedure TMyForm.GrdMemoDrawColumnCell(Sender: TObject; Const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
Begin
If (gdFocused In State) Then Begin
If Column.Field.DataType In [ftBlob, ftMemo] Then Begin
{Desenha botão para visualização do Memo}
FormMemoRect.Left := TWinControl(Sender).ClientToScreen(Rect.TopLeft).X;
FormMemoRect.Right := TWinControl(Sender).ClientToScreen(Rect.BottomRight).X;
FormMemoRect.Top := TWinControl(Sender).ClientToScreen(Rect.BottomRight).Y;
FormMemoRect.Bottom := FormMemoRect.Top + 100;
If Not Assigned(BMemo) Then
BMemo := TBitBtn.Create(Self);
BMemo.Parent := TWinControl(Sender).Parent;
BMemo.Width := 16;
BMemo.Height := 16;
BMemo.Caption := '...';
BMemo.OnClick := BMemoClick;
BMemo.Tag := Column.Field.Index;
BMemo.Left := TWinControl(Sender).Left + Rect.Right - BMemo.Width + 1;
BMemo.Top := TWinControl(Sender).Top + Rect.Top + 2;
MemoGrid := TDBGrid(Sender);
End
Else
FreeAndNil(BMemo);
End;
End;
For Blob/Memo Fields, you may also find it useful to do some custom GetText to show something directly in the Grid:
Procedure TMyForm.DataSetMemoGetText(Sender: TField; var Text: String; DisplayText: Boolean);
Begin
Text := Copy(Sender.AsString, 1, 50);
If Text <> Sender.AsString Then
Text := Text + '...';
End;
This is how the result looks like.
PS: Sorry for non-standard code style.
i wanto dynamic add 5 TLable in my iOS app.
like this
Procedure Form1.FormCreate(Sender: TObject)
var
I: Integer;
begin
for I := 1 to 5 do
begin
with TLabel.Create(Self) do
begin
Parent := self;
Align := TAlignLayout.Top;
Height := 50;
Text := IntToStr(I);
end;
end;
end;
i think the order is 12345, but I get 15432.
What can I do to get the desired results?
You must give a chance to the aligning algorithm to do what you want.
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
begin
for I := 1 to 5 do
begin
with TLabel.Create(Self) do
begin
Parent := self;
Align := TAlignLayout.alTop;
Height := 50;
Position.Y := I*Height; //add this line
Text := IntToStr(I);
end;
end;
end;
How to change text size in stringgrid header?
You could write an OnApplyStyleLookup event handler similar to this:
procedure TForm1.StringGrid1ApplyStyleLookup(Sender: TObject);
var
Header: THeader;
I: Integer;
begin
Header := THeader((Sender as TStringGrid).FindStyleResource('header'));
if Assigned(Header) then
begin
for I := 0 to Header.Count - 1 do
with Header.Items[I].Font do
begin
Size := 32;
Style := [TFontStyle.fsBold];
end;
Header.Height := 48;
end;
TStringGrid(Sender).Realign;
end;
I am trying to display a table using ShowMessage that looks like this:
short | Description for "short"
verylongtext | Description for "verylongtext"
How do I get two correctly aligned columns like that in a simple message dialog?
I tried to align the columns using spaces, but the font of ShowMessage is variable. Then I tried to align them using tab characters, but I do not know how to calculate the proper tab count for each row.
Is there a reliable way to calculate the tab count?
PS: I would like to avoid writing a custom dialog for this purpose.
You could use a list view in a custom dialog box, as well.
My class supports the standard Windows icons (and sounds): information, warning, error, confirmation, none. Here is the icon-less version:
It is easy to use:
TTableDialog.ShowTable
(
Self,
'Audio Properties',
['Duration', 'Samples per channel', 'Total data size', 'Channels', 'Bits per sample', 'Sample rate', 'Bitrate'],
['1 h 15 min 0 s', '216 000 000', '824 MB', '1', '32', '48 kHz', '1 536 kbit/sec'],
mtInformation
)
It supports DPI scaling (high DPI) and all Windows versions from Windows XP (it might work on Windows 2000 as well, I just haven't tested that) to Windows 10:
The table is a list view, so you get all its benefits, like a scrollbar, truncation ellipses, and tooltips:
You can also specify the dialog's size to make it fit the contents:
TTableDialog.ShowTable
(
Self,
'Audio Properties',
['Duration', 'Samples per channel', 'Total data size', 'Channels', 'Bits per sample', 'Sample rate', 'Bitrate', 'Maximum fractional sample value'],
['1 h 15 min 0 s', '216 000 000', '824 MB', '1', '32', '48 kHz', '1 536 kbit/sec', '0.1'],
mtInformation,
360,
240
)
Of course, the OK button is both Default and Cancel, so you can dismiss the dialog with Enter or Escape.
Finally, pressing Ctrl+C will copy the table to clipboard.
Full source code:
uses
ComCtrls, Math, Clipbrd;
type
TTableDialog = class
strict private
type TFormData = class(TComponent)
public
ListView: TListView;
IconKind: PWideChar;
Icon: HICON;
LIWSD: Boolean;
end;
class function Scale(X: Integer): Integer;
class procedure FormShow(Sender: TObject);
class procedure FormDestroy(Sender: TObject);
class procedure FormPaint(Sender: TObject);
class procedure FormKeyPress(Sender: TObject; var Key: Char);
class procedure LVToClipboard(AListView: TListView);
public
class procedure ShowTable(AOwner: TCustomForm; const ACaption: string;
const ANames, AValues: array of string;
ADialogType: TMsgDlgType = mtInformation;
const AWidth: Integer = 360; const AHeight: Integer = 200);
end;
class procedure TTableDialog.FormShow(Sender: TObject);
var
FormData: TFormData;
ComCtl: HMODULE;
LoadIconWithScaleDown: function(hinst: HINST; pszName: LPCWSTR; cx: Integer;
cy: Integer; var phico: HICON): HResult; stdcall;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
TForm(Sender).OnShow := nil;
FormData := TFormData(TForm(Sender).Tag);
if FormData.IconKind = nil then
Exit;
ComCtl := LoadLibrary('ComCtl32.dll');
if ComCtl <> 0 then
begin
try
LoadIconWithScaleDown := GetProcAddress(ComCtl, 'LoadIconWithScaleDown');
if Assigned(LoadIconWithScaleDown) then
FormData.LIWSD := Succeeded(LoadIconWithScaleDown(0, FormData.IconKind,
Scale(32), Scale(32), FormData.Icon));
finally
FreeLibrary(ComCtl);
end;
end;
if not FormData.LIWSD then
FormData.Icon := LoadIcon(0, FormData.IconKind);
end;
class procedure TTableDialog.FormDestroy(Sender: TObject);
var
FormData: TFormData;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
FormData := TFormData(TForm(Sender).Tag);
if (FormData.Icon <> 0) and FormData.LIWSD then
DestroyIcon(FormData.Icon);
end;
class procedure TTableDialog.FormKeyPress(Sender: TObject; var Key: Char);
var
FormData: TFormData;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
FormData := TFormData(TForm(Sender).Tag);
case Key of
^C:
LVToClipboard(FormData.ListView);
end;
end;
class procedure TTableDialog.FormPaint(Sender: TObject);
var
FormData: TFormData;
Frm: TForm;
Y: Integer;
begin
if not (Sender is TForm) then
Exit;
if not (TObject(TForm(Sender).Tag) is TFormData) then
Exit;
Frm := TForm(Sender);
FormData := TFormData(TForm(Sender).Tag);
Y := Frm.ClientHeight - Scale(25 + 8 + 8);
Frm.Canvas.Brush.Color := clWhite;
Frm.Canvas.FillRect(Rect(0, 0, Frm.ClientWidth, Y));
Frm.Canvas.Pen.Color := $00DFDFDF;
Frm.Canvas.MoveTo(0, Y);
Frm.Canvas.LineTo(Frm.ClientWidth, Y);
if FormData.Icon <> 0 then
DrawIconEx(Frm.Canvas.Handle, Scale(8), Scale(8), FormData.Icon,
Scale(32), Scale(32), 0, 0, DI_NORMAL);
end;
class procedure TTableDialog.LVToClipboard(AListView: TListView);
function GetRow(AIndex: Integer): string;
begin
if InRange(AIndex, 0, AListView.Items.Count - 1) and (AListView.Items[AIndex].SubItems.Count = 1) then
Result := AListView.Items[AIndex].Caption + #9 + AListView.Items[AIndex].SubItems[0]
else
Result := '';
end;
var
S: string;
i: Integer;
begin
if AListView = nil then
Exit;
S := GetRow(0);
for i := 1 to AListView.Items.Count - 1 do
S := S + sLineBreak + GetRow(i);
Clipboard.AsText := S;
end;
class function TTableDialog.Scale(X: Integer): Integer;
begin
Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;
class procedure TTableDialog.ShowTable(AOwner: TCustomForm; const ACaption: string;
const ANames, AValues: array of string;
ADialogType: TMsgDlgType = mtInformation;
const AWidth: Integer = 360; const AHeight: Integer = 200);
const
Sounds: array[TMsgDlgType] of Integer =
(MB_ICONWARNING, MB_ICONERROR, MB_ICONINFORMATION, MB_ICONQUESTION, 0);
Icons: array[TMsgDlgType] of MakeIntResource =
(IDI_WARNING, IDI_ERROR, IDI_INFORMATION, IDI_QUESTION, nil);
var
dlg: TForm;
lv: TListView;
btn: TButton;
i: Integer;
snd: Integer;
begin
if Length(ANames) <> Length(AValues) then
raise Exception.Create('The lengths of the columns don''t match.');
dlg := TForm.Create(AOwner);
try
dlg.BorderStyle := bsDialog;
dlg.Caption := ACaption;
dlg.Width := Scale(AWidth);
dlg.Height := Scale(AHeight);
dlg.Position := poOwnerFormCenter;
dlg.Scaled := False;
dlg.Font.Name := 'Segoe UI';
dlg.Font.Size := 9;
dlg.Tag := NativeInt(TFormData.Create(dlg));
TFormData(dlg.Tag).IconKind := Icons[ADialogType];
dlg.OnShow := FormShow;
dlg.OnDestroy := FormDestroy;
dlg.OnPaint := FormPaint;
dlg.OnKeyPress := FormKeyPress;
dlg.KeyPreview := True;
btn := TButton.Create(dlg);
btn.Parent := dlg;
btn.Caption := 'OK';
btn.Default := True;
btn.Cancel := True;
btn.ModalResult := mrOk;
btn.Width:= Scale(75);
btn.Height := Scale(25);
btn.Left := dlg.ClientWidth - btn.Width - Scale(8);
btn.Top := dlg.ClientHeight - btn.Height - Scale(8);
lv := TListView.Create(dlg);
TFormData(dlg.Tag).ListView := lv;
lv.Parent := dlg;
lv.DoubleBuffered := True;
lv.ReadOnly := True;
lv.BorderStyle := bsNone;
lv.Left := Scale(8) + IfThen(Icons[ADialogType] <> nil, Scale(32 + 8));
lv.Top := Scale(8);
lv.Width := dlg.ClientWidth - Scale(16) - IfThen(Icons[ADialogType] <> nil, Scale(32 + 8));
lv.Height := dlg.ClientHeight - Scale(16 + 8 + 4) - btn.Height;
lv.ViewStyle := vsReport;
lv.RowSelect := True;
lv.ShowColumnHeaders := False;
with lv.Columns.Add do
begin
Caption := 'Name';
Width := Scale(150);
end;
with lv.Columns.Add do
begin
Caption := 'Value';
Width := lv.ClientWidth - lv.Columns[0].Width -
GetSystemMetricsForWindow(SM_CXVSCROLL, dlg.Handle) - scale(2);
end;
for i := 0 to High(ANames) do
with lv.Items.Add do
begin
Caption := ANames[i];
SubItems.Add(AValues[i]);
end;
snd := Sounds[ADialogType];
if snd <> 0 then
MessageBeep(snd);
dlg.ShowModal;
finally
dlg.Free;
end;
end;
If you're not writing a custom dialog for this, when will you? It's not that hard. Just create a form, drop a TMemo on it and make that memo readonly. You can set a monospaced font like Courier New, and your problem is solved. You got the advantage of scrollbars and selection too, and you can choose to make it non-modal.
I would even recommend showing this type of data in a grid (like TStringGrid) instead of a memo or label.
Calculating how to display this text in a messagebox will require much more effort than just creating a custom dialog.
Just created something that shows a popup like this:
Just call the procedure below, and add a TStringList as a parameter.
Of course you could pimp this by using a TListView, icons, scrollbars, etc.
Put it in a separate unit, and you'll always be able to easily show stuff like this.
uses ..., StdCtrls, ExtCtrls;
procedure ShowTablePopup(SL:TStringList);
var
LButtonOK: TButton;
LMemo: TMemo;
LPanel: TPanel;
LForm: TForm;
begin
LForm := TForm.Create(Application);
LMemo := TMemo.Create(LForm);
LPanel := TPanel.Create(LForm);
LButtonOK := TButton.Create(LForm);
LForm.Left := 0;
LForm.Top := 0;
LForm.Caption := 'Values';
LForm.ClientHeight := 250;
LForm.ClientWidth := 400;
LMemo.Parent := LForm;
LMemo.AlignWithMargins := True;
LMemo.Left := 3;
LMemo.Top := 3;
LMemo.Width := 295;
LMemo.Height := 226;
LMemo.Align := alClient;
LMemo.Font.Name := 'Courier New';
LMemo.Lines.Assign(SL);
LPanel.Parent := LForm;
LPanel.Caption := '';
LPanel.Left := 0;
LPanel.Top := 232;
LPanel.Width := 301;
LPanel.Height := 37;
LPanel.Align := alBottom;
LPanel.BevelOuter := bvNone;
LButtonOK.Parent := LPanel;
LButtonOK.AlignWithMargins := True;
LButtonOK.Left := 223;
LButtonOK.Top := 3;
LButtonOK.Width := 75;
LButtonOK.Height := 31;
LButtonOK.Align := alRight;
LButtonOK.Caption := '&OK';
LButtonOK.ModalResult := mrOk;
LButtonOK.Default := True;
LForm.ShowModal;
end;
Example on how to use it:
var
SL:TStringList;
begin
SL := TStringList.Create;
try
SL.Add('short | Description for "short"');
SL.Add('verylongtext | Description for "verylongtext"');
ShowTablePopup(SL);
finally
SL.Free;
end;
end;