I have put icons in the string grid but I ran into a problem with not all the graphics are aligned. I have tried to rework the centering the text to make the icons align but no luck. I have tried to research the bitmap and its functionality but I havent (so I think) found anything that will help me. Can anyone help me please?
EDIT (from code added in answer to question by mistake):
bitmap := Tbitmap.Create;
bitmap.LoadFromFile('equal.bmp');
bitmap.SetSize(150,60);
stringgrid1.Canvas.StretchDraw(stringgrid1.CellRect(3,J), bitmap);
SetTextAlign(StringGrid1.Canvas.Handle, TA_CENTER);
StringGrid1.Canvas.TextRect(stringgrid1.CellRect(3,J),
(stringgrid1.CellRect(3,J).Left+stringgrid1.CellRect(3,J).Right) div 2,
stringgrid1.CellRect(3,J).Top + 5,StringGrid1.Cells[3,J]);
SetTextAlign(StringGrid1.Canvas.Handle, TA_LEFT);
Here's an example (Delphi 7, since it's what I had handy, but the code should work in D2010):
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
Bmp: TBitmap;
CellText: string;
R: TRect;
const
L_PAD = 5; // Amount between right side of image and start of text
T_PAD = 5; // Amount between top of cell and top of text
begin
// Some text to display in cells.
CellText := Format('Row: %d Col: %d', [ARow, ACol]);
// Draw an image along the left side of each cell in the first
// col (not the fixed ones, which we'll leave alone)
if ((ACol = 1) or (ACol = 3)) and (ARow > 0) then
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile('C:\glyfx\common\bmp\24x24\favorites24.bmp');
if ACol = 1 then // left align image
begin
R.Top := Rect.Top + 1;
R.Left := Rect.Left + 1;
R.Right := R.Left + Bmp.Width;
R.Bottom := R.Top + Bmp.Height;
StringGrid1.Canvas.StretchDraw(R, Bmp);
StringGrid1.Canvas.TextOut(R.Right + L_PAD, R.Top + T_PAD, CellText);
end
else
begin // right align image
StringGrid1.Canvas.TextOut(Rect.Left + L_PAD,
Rect.Top + L_PAD,
CellText);
R.Top := Rect.Top + 1;
R.Left := Rect.Right - Bmp.Width - 1;
R.Right := Rect.Right - 1;
R.Bottom := R.Top + L_PAD + Bmp.Height;
StringGrid1.Canvas.StretchDraw(R, Bmp);
end;
finally
Bmp.Free;
end;
end
else
StringGrid1.Canvas.TextOut(Rect.Left + L_PAD, Rect.Top + T_PAD, CellText);
end;
Here's what it looks like:
Related
I searched a lot in google to get a clearer info on how I could solve my current issue, but I got scalability of components as the best answer, that's... not yet my issue.
So, long story short: I want to realign components on my form after the user resizes the window, the form is populated dinamically from a SQL query, this is the constructor code:
procedure TForm2.MakeWindow;
var
dummyMaskedit, dummyEdit: TEdit;
dummyMemo: TMemo;
dummyCombobox: TComboBox;
dummyLabel: TLabel;
dummyLBox: TListBox;
dummybutton: TButton;
i, f: integer;
buffer, workarea: double;
begin
FDQDB.Close;
FDQDB.Open('SELECT * FROM Defs WHERE active = 1');
i := 0;
f := 1;
buffer := Layout1.Width;
workarea := Layout1.Width;
SetLength(aMasks, 0);
while not FDQDB.Eof do
begin
case AnsiIndexStr(FDQDB.FieldByName('comptype').AsString,
['tedit', 'tcombobox', 'tmaskedit', 'tlistbox']) of
0: // TEdit
begin
dummyEdit := TEdit.Create(self);
dummyEdit.Parent := Form2.Layout1;
dummyEdit.Width := FDQDB.FieldByName('size').AsInteger;
if buffer - dummyEdit.Width >= 0 then
begin
buffer := buffer - dummyEdit.Width - 8;
dummyEdit.Position.Y := Panel2.Position.Y + 22 + (45 * i);
dummyEdit.Position.X := workarea - buffer - dummyEdit.Width + 5;
end
else
begin
inc(i);
buffer := workarea;
buffer := buffer - dummyEdit.Width - 8;
dummyEdit.Position.Y := Panel2.Position.Y + 22 + (45 * i);
dummyEdit.Position.X := workarea - buffer - dummyEdit.Width + 5;
end;
dummyEdit.Name := 'field' + IntToStr(f);
inc(f);
dummyLabel := TLabel.Create(self);
with dummyLabel do
begin
Parent := dummyEdit.Parent;
Text := FDQDB.FieldByName('Descricao').AsString;
Position.Y := dummyEdit.Position.Y - 17;
Position.X := dummyEdit.Position.X;
end;
end;
1: // TComboBox
begin
dummyCombobox := TComboBox.Create(self);
dummyCombobox.Parent := Form2.Layout1;
dummyCombobox.Width := FDQDB.FieldByName('size').AsInteger;
if buffer - dummyCombobox.Width >= 0 then
begin
buffer := buffer - dummyCombobox.Width - 8;
dummyCombobox.Position.Y := Panel2.Position.Y + 22 + (45 * i);
dummyCombobox.Position.X := workarea - buffer -
dummyCombobox.Width + 5;
end
else
begin
inc(i);
buffer := workarea;
buffer := buffer - dummyCombobox.Width - 8;
dummyCombobox.Position.Y := Panel2.Position.Y + 22 + (45 * i);
dummyCombobox.Position.X := workarea - buffer -
dummyCombobox.Width + 5;
end;
dummyCombobox.Name := 'field' + IntToStr(f);
dummyCombobox.Items.Delimiter := '|';
dummyCombobox.Items.StrictDelimiter := true;
dummyCombobox.Items.DelimitedText :=
AnsiUpperCase(FDQDB.FieldByName('combovalue').AsString);
inc(f);
dummyLabel := TLabel.Create(self);
with dummyLabel do
begin
Parent := dummyCombobox.Parent;
Text := FDQDB.FieldByName('Descricao').AsString;
Position.Y := dummyCombobox.Position.Y - 17;
Position.X := dummyCombobox.Position.X;
end;
end;
2: // TMaskEdit
begin
dummyMaskedit := TEdit.Create(self);
dummyMaskedit.Parent := Form2.Layout1;
dummyMaskedit.Width := FDQDB.FieldByName('size').AsInteger;
if buffer - dummyMaskedit.Width >= 0 then
begin
buffer := buffer - dummyMaskedit.Width - 8;
dummyMaskedit.Position.Y := Panel2.Position.Y + 22 + (45 * i);
dummyMaskedit.Position.X := workarea - buffer -
dummyMaskedit.Width + 5;
end
else
begin
inc(i);
buffer := workarea;
buffer := buffer - dummyMaskedit.Width - 8;
dummyMaskedit.Position.Y := Panel2.Position.Y + 22 + (45 * i);
dummyMaskedit.Position.X := workarea - buffer -
dummyMaskedit.Width + 5;
end;
dummyMaskedit.Name := 'field' + IntToStr(f);
inc(f);
SetLength(aMasks, length(aMasks) + 1);
Masks.field := dummyMaskedit.Name;
Masks.mask := FDQDB.FieldByName('mask').AsString;
aMasks[length(aMasks) - 1] := Masks;
dummyMaskedit.OnExit := MaskTextExit;
dummyLabel := TLabel.Create(self);
with dummyLabel do
begin
Parent := dummyMaskedit.Parent;
Text := FDQDB.FieldByName('Descricao').AsString;
Position.Y := dummyMaskedit.Position.Y - 17;
Position.X := dummyMaskedit.Position.X;
end;
end;
3: // TListBox
begin
dummyLBox := TListBox.Create(self);
dummyLBox.Parent := Form2.Layout1;
dummyLBox.Width := FDQDB.FieldByName('size').AsInteger;
inc(i);
buffer := workarea;
if buffer - dummyLBox.Width >= 0 then
begin
buffer := buffer - dummyLBox.Width - 8;
dummyLBox.Position.Y := Panel2.Position.Y + 22 + (45 * i);
dummyLBox.Position.X := workarea - buffer - dummyLBox.Width + 5;
end
else
begin
inc(i);
buffer := workarea;
buffer := buffer - dummyLBox.Width - 8;
dummyLBox.Position.Y := Panel2.Position.Y + 22 + (45 * i);
dummyLBox.Position.X := workarea - buffer - dummyLBox.Width + 5;
end;
dummyLBox.Name := 'field' + IntToStr(f);
inc(f);
SetLength(aMasks, length(aMasks) + 1);
Masks.field := dummyLBox.Name;
Masks.mask := FDQDB.FieldByName('mask').AsString;
aMasks[length(aMasks) - 1] := Masks;
dummyLabel := TLabel.Create(self);
with dummyLabel do
begin
Parent := dummyLBox.Parent;
Text := FDQDB.FieldByName('Descricao').AsString;
Position.Y := dummyLBox.Position.Y - 17;
Position.X := dummyLBox.Position.X;
end;
dummybutton := TButton.Create(self);
with dummybutton do
begin
Parent := dummyLBox.Parent;
Text := '+';
Width := 20;
Position.X := dummyLBox.Width + dummyLBox.Position.X + 3;
Position.Y := dummyLBox.Position.Y;
Name := 'ba' + dummyLBox.Name;
OnClick := ButtonsAddClick;
end;
dummybutton := TButton.Create(self);
with dummybutton do
begin
Parent := dummyLBox.Parent;
Text := '-';
Width := 20;
Position.X := dummyLBox.Width + dummyLBox.Position.X + 3;
Position.Y := dummyLBox.Position.Y + 28;
Name := 'br' + dummyLBox.Name;
OnClick := ButtonsRemClick;
end;
end;
end;
FDQDB.Next;
end;
FDQDB.Close;
end;
That works nice and pretty on the windowed state of the application, this code is applied to the onCreate event of the form:
procedure TForm2.FormCreate(Sender: TObject);
begin
FDCDB.Params.Database := ExtractFilePath(ParamStr(0)) + 'window.db';
MakeWindow;
end;
The first form, main form of the application, is the one that summons the new form that has the components built in runtime:
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Application.CreateForm(TForm2, Form2);
Form2.Layout1.parent := Self.Layout1.Parent;
Form2.Layout1.Width := Self.Layout1.Width;
end;
The second form has a TLayout, just like the first form. Then, when I create the form I bring the TLayout of the second form to the first. So far so good, it works when the application is launched in windowed mode.
But when I put form1 in fullscreen mode, then click the Button that creates the form2, the components stays on the same position as in windowed mode. I've tried changing the workarea variable to these:
Screen.width, //components behave as the application were in fullscreen the whole time
Screen.WorkAreaWidth, //same as screen.width
(Layout1.Parent as TLayout).Width, //invalid typecast
(Layout1.GetParentComponent as TLayout).Width //invalid typecast
None of them worked.
I wanna be able to adjust the position of the components on the screen based on its visual width, so if the user resizes the window before creating the new form, the components gets aligned properly.
Anyone knows a solution for that? Thanks in advance
But when I put form1 in fullscreen mode, then click the Button that
creates the form2, the components stays on the same position as in
windowed mode.
At TForm1.SpeedButton1Click() you call Application.CreateForm(TForm2, Form2); which triggers TForm2.FormCreate(Sender: TObject); which calls MakeWindow. At this point Form2 knows only about the design time size.
After MakeWindow is done, the TForm1.SpeedButton1Click() continues:
Form2.Layout1.parent := Self.Layout1.Parent;
Form2.Layout1.Width := Self.Layout1.Width;
but these do not anymore affect the layout of the controls.
You need to set Form2.Layout1.Width before you call MakeWindow, for example:
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
Application.CreateForm(TForm2, Form2);
Form2.Layout1.parent := Self.Layout1.Parent;
Form2.Layout1.Width := Self.Layout1.Width;
MakeWindow; // remove it from TForm2.FormCreate()
end;
The form has ClientWidth and ClientHeight properties which work well in OnResize to dynamically size a control based on the area available. The OnResize fires before the form is made visible. For example to have a Memo1 with a 100 border around it:
procedure TForm1.FormResize(Sender: TObject);
begin
memo1.Position.X := 100; // Only needs to be done once but here so all code is in one spot
memo1.Position.Y := 100;
memo1.Width := form1.ClientWidth - 200;
memo1.Height := form1.ClientHeight - 200;
end;
I am trying to figure out how to position a Form to open at a given mouse location, despite my monitor settings.
In the Form's OnCreate event, I have this:
procedure TSplashScreen.FormCreate(Sender: TObject);
Var
oMousePos: TPoint;
nLeft, nTop: Integer;
begin
Scaled := false;
PixelsPerInch := Screen.PixelsPerInch;
Scaled := true;
//Position:=poScreenCenter;
//center form for 2nd monitor //zzz
if (Screen.MonitorCount > 1) then //zzz
begin
GetCursorPos(oMousePos);
if (oMousePos.X > Screen.Width) or (oMousePos.X < 0) then
begin
Self.Position := poDesigned;
nLeft := Screen.Monitors[1].Left + Round(Screen.Monitors[1].Width / 2) - Round(Self.Width / 2);
nTop := Screen.Monitors[1].Top + Round(Screen.Monitors[1].Height / 2) - Round(Self.Height / 2);
Self.Left := nLeft;
Self.Top := nTop;
end;
end;
end;
When I have 2 monitors, and monitor 1 is set as primary monitor, the Form will open at the mouse cursor.
However, if I set monitor 2 to primary, the Form will always open on monitor 2.
If you just want to position the Form on the same monitor that the mouse cursor is currently in, use the Win32 API MonitorFromPoint() function (which is wrapped by the VCL's TScreen.MonitorFromPoint() method), eg:
procedure TSplashScreen.FormCreate(Sender: TObject);
var
r: TRect;
begin
if (Screen.MonitorCount > 1) then
begin
r := Screen.MonitorFromPoint(Mouse.CursorPos).WorkareaRect;
Self.Position := poDesigned;
Self.Left := r.Left + ((r.Width - Width) div 2);
Self.Top := r.Top + ((r.Height - Height) div 2);
{ alternatively:
Self.SetBounds(
r.Left + ((r.Width - Width) div 2),
r.Top + ((r.Height - Height) div 2),
Width, Height);
}
end else begin
Self.Position := poScreenCenter;
end;
end;
i am drawing text and image in tvirtuailstringtree as following in onbeforecellpaint event
begin
Textrectplace := NewRect;
Textrectplace.Left := Textrectplace.Left + 2;
Textrectplace.Width := 24;
Textrectplace.Height := Data.image.height;
Textrectplace.Top := Textrectplace.Top;
Textrectplace.Bottom := Textrectplace.Bottom;
xOfftext := Textrectplace.Left + Textrectplace.Width + 4;
yOfftext := Textrectplace.Top - 3 + ((Data.image.height - TargetCanvas.TextHeight('H')) div 2);
TargetCanvas.font.color := clgray;
TargetCanvas.font.Size := 10;
TargetCanvas.TextOut(xOfftext, yOfftext, Data.text);
end;
end;
begin
imgrect:= Textrectplace;
imgrect.Left := imgrect.Left + 150;
imgrect.Width := 24;
imgrect.Height := 36;
imgrect.Top := imgrect.Top - 6 + ((Data.image.height - TargetCanvas.TextHeight('H')) div 2);
imgrect.Bottom := imgrect.Bottom;
TargetCanvas.Draw(imgrect.Left, imgrect.Top, Data.image);
end;
I have one problem in text and image alignment I wanted the text to be aligned to left and that part is handled . the image has align problem I wanted to make it aligned to the Right with the text without textoverflow currently if the node has short text its all good and the image showing correctly with the text . but if the text is too long its overflow the image .
here is example image
in the image example It shows how the long texted node looks like and how it should be if the text is too long and the list width is small for the alignment of the image with text it should show I am long nod... until the list become bigger then show the full text which is I am long node text how can I achieve that
Updated Code
procedure TForm1.virtuailtreeBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
Data: ^PnodeData;
NewRect: TRect;
Textrectplace: TRect;
imgrect : TRect;
begin
if not Assigned(Node) then
begin
exit;
end;
Data := virtuailtree.GetNodeData(Node);
NewRect := CellRect;
//text
begin
Textrectplace := NewRect;
Textrectplace.Left := Textrectplace.Left + 2;
Textrectplace.Width := 70;
Textrectplace.Height := 30;
Textrectplace.Top := Textrectplace.Top;
Textrectplace.Bottom := Textrectplace.Bottom;
TargetCanvas.font.color := clgray;
TargetCanvas.font.Size := 10;
DrawText(TargetCanvas.Handle, pChar(Data.text), Length(Data.text)
, Textrectplace, DT_End_Ellipsis );
end;
end;
//right image that should be stay at the right position
begin
imgrect := Textrectplace;
imgrect.left := imgrect.left + 150;
imgrect.Width := 24;
imgrect.Height := 36;
imgrect.Top := imgrect.Top - 6 + ((30 - TargetCanvas.TextHeight('H')) div 2);
imgrect.Bottom := imgrect.Bottom;
TargetCanvas.Draw(imgrect.left, imgrect.Top, Data.image);
end;
end;
To shorten the text to fit within a TRect you can use the WinApi DrawText() function, with DT_END_ELLIPSIS format specifier.
To adjust the space for text when the TVirtualStringTree is resized (e.g. with a TSplitter) simply use:
TextRectPlace.Right := CellRect - imgRect.width;
imgRect.Left := TextRectPlace.Right;
This example shows how to make the column cell and heading text aligned to the left and cell image to the right :
VirtualStringTree1.Alignment := taLeftJustify;
VirtualStringTree1.BiDiMode := bdLeftToRight;
VirtualStringTree1.Header.Columns[ 0 ].Alignment := taRightJustify;
VirtualStringTree1.Header.Columns[ 0 ].BiDiMode := bdRightToLeftNoAlign;
VirtualStringTree1.Header.Columns[ 0 ].CaptionAlignment := taRightJustify;
image
I want to disable the gridlines in a drawgrid and draw the grid lines myself for every other columns. Row lines are not needed.
I want to merge two cells in the fixed area so that it looks like as it is one column, like in this picture:
I have added this code to the ondrawcell event of the drawgrid to achieve this:
procedure Tbookings3_Frm.bgridDrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
CellIndex: Integer;
s:string;
x:integer;
begin
CellIndex := (ARow * bgrid.ColCount) + ACol;
if gdFixed in State then
begin
bgrid.Canvas.Brush.Color := clskyblue;
end
else if (State * [gdSelected, gdHotTrack]) <> [] then
begin
bgrid.Canvas.Brush.Color := clHighlight;
end
else
begin
bgrid.Canvas.Brush.Color := Cells[CellIndex].BkColor;
end;
bgrid.Canvas.FillRect(Rect);
if gdFixed in State then
Frame3D(bgrid.Canvas, Rect, clHighlight, clBtnShadow, 1);
if gdFocused in State then
bgrid.Canvas.DrawFocusRect(Rect);
//---------------
with (Sender as TDrawGrid).Canvas do
begin
// set font
Font.Color := CLblack;
FillRect(Rect);
if ARow = 2 then
begin
x := (Rect.Right - Rect.Left - TextWidth(days_h[ACol])) div 2;
TextOut(Rect.Left + x, Rect.Top + 2, days_h[ACol]);
end;
if ARow = 1 then
begin
x := (Rect.Right - Rect.Left - TextWidth(sun_mon[ACol])) div 2;
TextOut(Rect.Left + x, Rect.Top + 2, sun_mon[ACol]);
end;
if ARow = 0 then
begin
x := (Rect.Right - Rect.Left - TextWidth(mon[ACol])) div 2;
TextOut(Rect.Left + x, Rect.Top + 2, mon[ACol]);
end;
if (Acol = 0) and (ARow > 2) then
begin
s:=rooms[Arow];
x := (Rect.Right - Rect.Left - TextWidth(s)) div 2;
TextOut(Rect.Left + x, Rect.Top + 2, s);
end;
//-------------------------------------------------
end; //end canvas
//----------------
if gdFocused in State then
bgrid.Canvas.DrawFocusRect(Rect);
end;
You need to disable the grid's native gridlines, and then you can draw your own gridlines surrounding each cell in the OnDrawCell event as needed. The TRect represents the inside area of the cell being drawn, but you can draw outside of that Rect as well. To make two cells appear merged, you would simply not draw a gridline between them.
I'm using a class for custom messageboxes. But my problem is that, icon background is always white. Code below displays the icons. Can somebody tell me what is wrong in this code? I want icon background to be transparent.
try
if not custb then
case i of
MB_ICONINFORMATION:ico.Handle := LoadIcon( 0, IDI_INFORMATION);
MB_ICONEXCLAMATION:ico.Handle := LoadIcon( 0, IDI_EXCLAMATION);
MB_ICONQUESTION:ico.Handle := LoadIcon( 0, IDI_QUESTION);
MB_ICONERROR:ico.Handle := LoadIcon( 0, IDI_ERROR);
end;
with timage.Create( frm) do
begin
parent := frm;
transparent := True;
if custb then
begin
height := glyph.Height;
width := Glyph.Width;
end
else
begin
height := ico.Height;
width := ico.Width;
end;
ih := height;
top := Height div 2 + 2;
it := Top;
left := Width div 2 + 2;
il := Left + width + width div 2;
if width <= 16 then
begin
il := il + 16;
left := left + 8;
end;
if height <= 16 then
begin
it := it + 8;
top := top + 8;
end;
if custb then picture := Glyph else canvas.Draw( 0, 0, ico);
end;
finally
end;
if not custb then ico.Free;
end
Best wishes,
evilone
My code to do this very thing looks like this:
function StandardDialogIcon(DlgType: TMsgDlgType): PChar;
begin
case DlgType of
mtWarning:
Result := IDI_WARNING;
mtError:
Result := IDI_ERROR;
mtInformation:
Result := IDI_INFORMATION;
mtConfirmation:
Result := IDI_QUESTION;
else
Result := nil;
end;
end;
...
Image.Picture.Icon.Handle := LoadIcon(0, StandardDialogIcon(DlgType));
There's no need to set any properties on Image, you can simply ignore Transparent.
Extract from online help for TImage.Transparent:
Setting Transparent sets the
Transparent property of the Picture.
Note: Transparent has no effect
unless the Picture property specifies
a TBitmap object.
This means two things for you:
only set transparent property after the picture has been assigned
Use TBitmap for your image and assign thtat to the picture property.
Have a look at the following link, that describes a function that converts an icon to a bitmap: Delph-Library: Convert icon to bitmap.
Excerpt:
// Konvertiert Ico zu Bitmap
procedure IcoToBmpA(Ico: TIcon; Bmp: TBitmap; SmallIcon: Boolean);
var
WH: Byte; // Width and Height
begin
with Bmp do begin
Canvas.Brush.Color := clFuchsia;
TransparentColor := clFuchsia;
Width := 32; Height := 32;
Canvas.Draw(0, 0, Ico);
if SmallIcon then WH := 16 else WH := 32;
Canvas.StretchDraw(Rect(0, 0, WH, WH), Bmp);
Width := WH; Height := WH;
Transparent := True;
end;
end;