Is it possible to remove a border of TabSheet (~4px)? I am using PageControl as a switch-panel instead of frames, windows etc. I want everything will be straight.
unit Unit1;
interface
uses
...,
CommCtrl;
type
TPageControl = class(ComCtrls.TPageControl)
private
procedure TCMAdjustRect(var Msg: TMessage); message TCM_ADJUSTRECT;
end;
TForm1 = class(TForm)
...
end;
...
procedure TPageControl.TCMAdjustRect(var Msg: TMessage);
begin
inherited;
if Msg.WParam = 0 then
InflateRect(PRect(Msg.LParam)^, 4, 4)
else
InflateRect(PRect(Msg.LParam)^, -4, -4);
end;
...
end.
If you don't mind using third-party tools then the easiest solution would probably be to use TjvPageControl from JVCL. It has ClientBorderWidth property which you are looking for.
An alternative is to use a TTabSet with a TPageControl: In the onCreate event of the form, place this code to hide the tab.
procedure TMainForm.FormCreate(Sender: TObject);
var
I : Integer;
begin
for I := 0 to Pred(PageControl1.PageCount) do
PageControl1.Pages[I].TabVisible := False;
PageControl1.Style := tsFlatButtons;
PageControl1.ActivePageIndex := 0;
TabSet1.Style := tsModernPopout;
TabSet1.SelectedColor := clMoneyGreen;
TabSet1.UnselectedColor := clGradientActiveCaption;
TabSet1.SelectedColor := clGradientActiveCaption;
end;
procedure TMainForm.TabSet1Change(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
begin
PageControl1.ActivePageIndex := NewTab;
end;
nowadays, that is the answer. No need any code hacks Probably you use themes, if not, you should use that technology:
Project Options > Application> Appearance
Check on one of them as Default Style) than :
Tools > Bitmap Style Designer > Open Style
Navigate your vsf style file
(probably right here
"C:\Users\Public\Documents\Embarcadero\Studio[VERSION]\Styles
Now In Bitmap Style Designer.. navigate to:
Objects > Tabs > Frame > Bitmap
Click [...] three dot button of Bitmap In Inspector
Zoom to 800%
Pan/Scroll and Focus on to bitmap rectangle range.
Right Mouse Click to change Upper-Left, Left Mouse Click to change Lower-Right
region.
(so select inner rectangle to eliminate border bitmap
now you have borderless page controls)
Related
i try to maximize width and hold height. i use delphi xe4, windows 7, 1,440 * 900 2 monitors.
height constraint usually works well but when it exceeds certain value which is 859 it doesn't work.
i guessed that it was because of windows snap feature but even after the turning off that it's same.
when i do this in the sub monitor which doesn't have taskbar and in the main monitor with taskbar auto hide it works well. it seems the trouble with taskbar.
any help to solve this please. thanks.
procedure TForm1.Button1Click(Sender: TObject);
begin
Constraints.MaxHeight := 859; // works well
WindowState := wsMaximized;
Caption := IntToStr(Height);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Constraints.MaxHeight := 860; // doesn't work
WindowState := wsMaximized;
Caption := IntToStr(Height); // maximized as 876
end;
procedure TForm1.FormConstrainedResize(Sender: TObject; var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer);
begin
MaxHeight := 860; // doesn't works and is maximized as 876
end;
If you are trying to restrict the maximum size of the form when the user tries to maximise it then this will work. I have my own Form class descended from TForm called TRGNewForm and all my forms descend from that. However the scheme will work for the form you put the code in.
In the Interface section, in your Form class Public definition
{ Trap Sys Commands }
procedure WMSysCommand (var Msg: TWMSysCommand); message WM_SYSCOMMAND;
In the Implementation
procedure TRGNewForm.WMSysCommand (var Msg : TWMSysCommand);
begin
{ If MdiChild and Maximize button pressed, then use our own routine,
as Windows has a bug }
if (Msg.CmdType = SC_MAXIMIZE) and
(FormStyle = fsMDIChild)
then Maximise_Child_Form
else DefaultHandler (Msg);
end;
In Maximise_Child_Form you set the height and width as required.
I've recently started converting an application to FireMonkey, and started with the simple controls. For some reason, their position is off, compared to dropped components on the form like say TPanel or TButton. From my tests, it appears the position is doubled.
My test project is simple: (in Delphi XE5)
create a new firemonkey HD application
drop a panel on the form at position (100,100) right click on it and "send to back"
paste the following code (adapt names where needed) for the custom component
code:
type
TTest = class(TPaintBox)
private
FBitmap: TBitmap;
public
Constructor Create(AOwner:TComponent); override;
Destructor Destroy; override;
procedure Paint; override;
end;
{ TTest }
constructor TTest.Create(AOwner: TComponent);
begin
inherited;
FBitmap := TBitmap.Create;
FBitmap.LoadFromFile('c:\test.png');
Width := FBitmap.Width;
Height := FBitmap.Height;
end;
destructor TTest.Destroy;
begin
FreeAndNil(FBitmap);
inherited;
end;
procedure TTest.Paint;
begin
Canvas.DrawBitmap(FBitmap,
TRectf.Create(0, 0, FBitmap.Width, FBitmap.Height),
AbsoluteRect,
1);
end;
paste the following code to dynamically create the above component
code:
procedure TForm2.FormCreate(Sender: TObject);
var t: TTest;
begin
t := TTest.Create(self);
t.Parent := self;
t.Position.X := 50;
t.Position.Y := 50;
end;
Build it for Win32.
On my end, the image appears in the upper left corner for the panel, which is at 100,100 but the control is clearly set to position itself at 50,50
Debugging shows correct values on positions and rects.
I can't figure out what is going on. Maybe somebody has some suggestions/explanations.
Thanks.
AbsoluteRect ist the rectangle of the Control relative to it's Form. If you want to paint something you have to use local coordinates, in this case LocalRect.
Canvas.DrawBitmap(FBitmap, TRectf.Create(0, 0, FBitmap.Width, FBitmap.Height), LocalRect, 1);
I'm attempting to switch from using Toolbar2000 to the regular toolbar because there doesn't seem to be a Delphi XE2 version and it looks like it uses some Assembly and I just don't really want to deal with it if I don't have to. (and I really like the fade-in effect with the Delphi Toolbar)
But, what I don't like is that the background of the button gets the regular blueish button treatment. I know how to change the color, but can I just not make the color change and not have a border painted around the button?
I've implemented the 'OnAdvancedCustomDrawButton' but the flags available don't seem to work right and I'm not sure how they interact with the gradient color and the hot track color and I wind up having some weird flashing or weird black backgrounds.
Here's how I'm creating the Toolbar
ToolBar1 := TToolBar.Create(Self);
ToolBar1.DoubleBuffered := true;
ToolBar1.OnAdvancedCustomDrawButton := Toolbar1CustomDrawButton;
ToolBar1.Transparent := false;
ToolBar1.Parent := Self;
ToolBar1.GradientEndColor := $7ca0c2; //RGB(194, 160, 124);
ToolBar1.GradientStartColor := $edeeed; //RGB(237, 238, 124);
ToolBar1.Indent := 5;
ToolBar1.Images := Normal;
ToolBar1.DrawingStyle := dsGradient;
ToolBar1.HotImages := Over;
ToolBar1.AutoSize := True;
ToolBar1.Visible := False;
and here's how I'm creating the buttons (in a loop):
ToolButton := TToolButton.Create(ToolBar1);
ToolButton.Parent := ToolBar1;
ToolButton.ImageIndex := ToolButtonImages[Index].ImageIndex;
ToolButton.OnClick := ToolButtonClick;
and here's my AdvancedCustomDrawButton function
procedure TMyForm.Toolbar1CustomDrawButton(Sender: TToolBar; Button: TToolButton;
State: TCustomDrawState; Stage: TCustomDrawStage;
var Flags: TTBCustomDrawFlags; var DefaultDraw: Boolean);
begin
Flags := [tbNoEdges, tbNoOffset];
DefaultDraw := True;
end;
Set drawing style of the toolbar to dsNormal and set Flags to [tbNoEdges] in custom draw handler.
update:
While the above works for 2K and XP, Vista and 7 seem to not to draw the border when button background is not drawn. Unfortunately achieving this with the VCL supplied TTBCustomDrawFlags is impossible, so we cannot get rid of the borders in a custom drawing handler.
If the toolbar is on the form itself we can put a handler for WM_NOTIFY since notification messages are sent to the parent window:
type
TForm1 = class(TForm)
..
private
procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
..
..
procedure TForm1.WMNotify(var Msg: TWMNotify);
begin
inherited;
if (Msg.NMHdr.code = NM_CUSTOMDRAW) and
Assigned(Toolbar1) and (Toolbar1.HandleAllocated) and
(Msg.NMHdr.hwndFrom = ToolBar1.Handle) then
case PNMTBCustomDraw(Msg.NMHdr).nmcd.dwDrawStage of
CDDS_PREPAINT: Msg.Result := Msg.Result or CDRF_NOTIFYITEMDRAW;
CDDS_ITEMPREPAINT: Msg.Result := TBCDRF_NOEDGES or TBCDRF_NOBACKGROUND;
// NOEDGES for 2K, XP, // NOBACKGROUND for Vista 7
end;
end;
If the toolbar is parented in another window, like a panel, then we need to subclass the toolbar:
type
TForm1 = class(TForm)
..
private
FSaveToolbarWndProc: TWndMethod;
procedure ToolbarWndProc(var Msg: TMessage);
..
..
uses
commctrl;
procedure TForm1.FormCreate(Sender: TObject);
begin
..
FSaveToolbarWndProc := ToolBar1.WindowProc;
ToolBar1.WindowProc := ToolbarWndProc;
end;
procedure TForm1.ToolbarWndProc(var Msg: TMessage);
begin
FSaveToolbarWndProc(Msg);
if (Msg.Msg = CN_NOTIFY) and
(TWMNotify(Msg).NMHdr.hwndFrom = ToolBar1.Handle) and
(TWMNotify(Msg).NMHdr.code = NM_CUSTOMDRAW) then begin
case PNMTBCustomDraw(TWmNotify(Msg).NMHdr)^.nmcd.dwDrawStage of
CDDS_PREPAINT: Msg.Result := CDRF_NOTIFYITEMDRAW;
CDDS_ITEMPREPAINT: Msg.Result := TBCDRF_NOEDGES or TBCDRF_NOBACKGROUND;
end;
end;
end;
(Note that drawing style still needs to be dsNormal.)
With this solution you don't need to put a handler for custom drawing. But if you need/want to anyway, you might need to 'or' the Msg.Result with the one VCL's window procedure returns, i.e the 'case' would look like:
CDDS_PREPAINT: Msg.Result := Msg.Result or CDRF_NOTIFYITEMDRAW;
CDDS_ITEMPREPAINT: Msg.Result :=
Msg.Result or TBCDRF_NOEDGES or TBCDRF_NOBACKGROUND;
same goes for when we handle WM_NOTIFY on the form.
There may be other ways to achieve the same, custom drawing is a broad topic. If you want to delve into it, I suggest you to start from the links below for the problem at hand:
About Custom Draw
NM_CUSTOMDRAW (toolbar) notification code
NMCUSTOMDRAW structure
NMTBCUSTOMDRAW structure
I'm trying to build a simple script editor with the ability to show errors. I've searched the web for a component that can show/underline the errors for me, but i couldn't found one. So i've decided to build one myself based on the memo control that's included in Delphi.
I was planning to add the following function to the memo control:
function Underline(startline, startchar, endline, endchar : integer);
Being the first time for me to enhance a visual control like this i'm asking if someone could broadly outline for me how to do this. No need to go into specific details :)
ps: I don't want to use a richedit control.
Below is some D2007 code sample using regular winapi, that would show you how to find where to draw in a scrollable memo and how to draw a simple underline. For brevity it has no error catching/handling. Also lets only one underline scope, since usability as a component is not the purpose of the sample. Tried with a vertical-scrolling memo but if you want you should be able to fine tune details if problems arise otherwise.
Tested on 2K, XP and 7, the look on XP is like this:
memo with underlined text http://img687.imageshack.us/img687/8176/20101210061602.png
And the code:
type
TMemo = class(stdctrls.TMemo)
private
FStartChar, FEndChar: Integer;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
public
procedure Underline(StartLine, StartChar, EndLine, EndChar: Integer);
end;
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TMemo }
procedure TMemo.Underline(StartLine, StartChar, EndLine, EndChar: Integer);
begin
FStartChar := SendMessage(Handle, EM_LINEINDEX, StartLine, 0) + StartChar;
FEndChar := SendMessage(Handle, EM_LINEINDEX, EndLine, 0) + EndChar;
Invalidate;
end;
procedure TMemo.WMPaint(var Msg: TWMPaint);
function GetLine(CharPos: Integer): Integer;
begin
Result := SendMessage(Handle, EM_LINEFROMCHAR, CharPos, 0);
end;
procedure DrawLine(First, Last: Integer);
var
LineHeight: Integer;
Pt1, Pt2: TSmallPoint;
DC: HDC;
Rect: TRect;
ClipRgn: HRGN;
begin
// font height approximation (compensate 1px for internal leading)
LineHeight := Abs(Font.Height) - Abs(Font.Height) div Font.Height;
// get logical top-left coordinates for line bound characters
Integer(Pt1) := SendMessage(Handle, EM_POSFROMCHAR, First, 0);
Integer(Pt2) := SendMessage(Handle, EM_POSFROMCHAR, Last, 0);
DC := GetDC(Handle);
// clip to not to draw to non-text area (internal margins)
SendMessage(Handle, EM_GETRECT, 0, Integer(#Rect));
ClipRgn := CreateRectRgn(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom);
SelectClipRgn(DC, ClipRgn);
DeleteObject(ClipRgn); // done with region
// set pen color to red and draw line
SelectObject(DC, GetStockObject(DC_PEN));
SetDCPenColor(DC, RGB(255, 0 ,0));
MoveToEx(DC, Pt1.x, Pt1.y + LineHeight, nil);
LineTo(DC, Pt2.x, Pt2.y + LineHeight);
ReleaseDC(Handle, DC); // done with dc
end;
var
StartChar, CharPos, LinePos: Integer;
begin
inherited;
if FEndChar > FStartChar then begin
// Find out where to draw.
// Can probably optimized a bit by using EM_LINELENGTH
StartChar := FStartChar;
CharPos := StartChar;
LinePos := GetLine(CharPos);
while True do begin
Inc(CharPos);
if GetLine(CharPos) > LinePos then begin
DrawLine(StartChar, CharPos - 1);
StartChar := CharPos;
Dec(CharPos);
Inc(LinePos);
Continue;
end else
if CharPos >= FEndChar then begin
DrawLine(StartChar, FEndChar);
Break;
end;
end;
end;
end;
{ --end TMemo-- }
procedure TForm1.Button1Click(Sender: TObject);
begin
Memo1.Underline(7, 14, 8, 17);
end;
edit: Forgot to mention, when typing you would probably remove underlining. I don't have any idea how it should behave when typing, and probably it would be difficult to achieve that desired behavior.
The "default memo control" in Delphi is just a wrapper for a Windows standard text box control. As such, there is no way to implement custom behaviour in this control. (If you need really custom behaviour, you can always write your own text box control from scratch. I have done so in my text editor, which also supports syntax highlighting. Or, you could use a third-party control. There are plenty of advanced text editor controls for Delphi out there.) You can only use functions provided by the operating system when it comes to this control.
You should really use a TRichEdit instead. This is a wrapper for the standard Windows Rich Edit control, which supports formatting such as underlining. (And, it also supports a lot of other stuff not presented by the Delphi wrapper, such as automatic URL highlighting, among other things, but that's another story.)
I am using Delphi, and I want to show custom text in the buttons of a MessageDlg, as described here. What is the best way to do that?
Answering my own question.... I wrote the below unit which works well for me.
Delphi provides CreateMessageDialog() to give you a dialog template, which you can modify before displaying. I used that to create a function I called MessageDlgCustom, which takes the same parameters as a standard MessageDlg, but adds one more for replacement button titles.
It correctly handles custom fonts and automatically adjusts buttons to be wide enough for their message. If the buttons overflow the dialog, then that gets adjusted too.
After using that unit, the below sample works:
case MessageDlgCustom('Save your changes?',mtConfirmation,
[mbYes,mbNo,mbCancel],
['&Yes, I would like to save them with this absurdly long button',
'&No, I do not care about my stupid changes',
'&Arg! What are you talking about? Do not close the form!'],
nil) //nil = no custom font
of
mrYes:
begin
SaveChanges;
CloseTheForm;
end; //mrYes (save & close)
mrNo:
begin
CloseForm;
end; //mrNo (close w/o saving)
mrCancel:
begin
//do nothing
end; //mrCancel (neither save nor close)
end; //case
If someone else knows a better way, please share it.
unit CustomDialog;
interface
uses
Dialogs, Forms, Graphics, StdCtrls;
function MessageDlgCustom(const Msg: string; DlgType: TMsgDlgType;
Buttons: TMsgDlgButtons; ToCaptions: array of string;
customFont: TFont) : integer;
procedure ModifyDialog(var frm: TForm; ToCaptions : array of string;
customFont : TFont = nil);
implementation
uses
Windows, SysUtils;
function GetTextWidth(s: string; fnt: TFont; HWND: THandle): integer;
var
canvas: TCanvas;
begin
canvas := TCanvas.Create;
try
canvas.Handle := GetWindowDC(HWND);
canvas.Font := fnt;
Result := canvas.TextWidth(s);
finally
ReleaseDC(HWND,canvas.Handle);
FreeAndNil(canvas);
end; //try-finally
end;
function MessageDlgCustom(const Msg: string;
DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; ToCaptions: array of string;
customFont: TFont): integer;
var
dialog : TForm;
begin
try
dialog := CreateMessageDialog(Msg, DlgType, Buttons);
dialog.Position := poScreenCenter;
ModifyDialog(dialog,ToCaptions,customFont);
Result := dialog.ShowModal;
finally
dialog.Release;
end; //try-finally
end;
procedure ModifyDialog(var frm: TForm; ToCaptions: array of string;
customFont: TFont);
const
c_BtnMargin = 10; //margin of button around caption text
var
i,oldButtonWidth,newButtonWidth,btnCnt : integer;
begin
oldButtonWidth := 0;
newButtonWidth := 0;
btnCnt := 0;
for i := 0 to frm.ComponentCount - 1 do begin
//if they asked for a custom font, assign it here
if customFont <> nil then begin
if frm.Components[i] is TLabel then begin
TLabel(frm.Components[i]).Font := customFont;
end;
if frm.Components[i] is TButton then begin
TButton(frm.Components[i]).Font := customFont;
end;
end;
if frm.Components[i] is TButton then begin
//check buttons for a match with a "from" (default) string
//if found, replace with a "to" (custom) string
Inc(btnCnt);
//record the button width *before* we changed the caption
oldButtonWidth := oldButtonWidth + TButton(frm.Components[i]).Width;
//if a custom caption has been provided use that instead,
//or just leave the default caption if the custom caption is empty
if ToCaptions[btnCnt - 1]<>'' then
TButton(frm.Components[i]).Caption := ToCaptions[btnCnt - 1];
//auto-size the button for the new caption
TButton(frm.Components[i]).Width :=
GetTextWidth(TButton(frm.Components[i]).Caption,
TButton(frm.Components[i]).Font,frm.Handle) + c_BtnMargin;
//the first button can stay where it is.
//all other buttons need to slide over to the right of the one b4.
if (1 < btnCnt) and (0 < i) then begin
TButton(frm.Components[i]).Left :=
TButton(frm.Components[i-1]).Left +
TButton(frm.Components[i-1]).Width + c_BtnMargin;
end;
//record the button width *after* changing the caption
newButtonWidth := newButtonWidth + TButton(frm.Components[i]).Width;
end; //if TButton
end; //for i
//whatever we changed the buttons by, widen / shrink the form accordingly
frm.Width := Round(frm.Width + (newButtonWidth - oldButtonWidth) +
(c_BtnMargin * btnCnt));
end;
end.
As an alternative you can use the Open Source SynTaskDialog unit. SynTaskDialog uses the Windows TaskDialog API natively on newer Windows versions and emulates it on older versions. You even can use it with FireMonkey.
For an example of a customizable MessageDlg function have a look at this answer.
You may have a look at the TDam component available on GitHub (https://github.com/digao-dalpiaz/Dam).
This component allows you to create customized Message Dialogs with pre-defined buttons, using formatted text (HTML Text), and allowing to customize a lot of aspects of dialogs.
Besides that, you can manage all your app dialogs into a "container", which stores all dialogs as objects (TDamMsg).
TDam Message Example
TDamMsg properties allows to customize message dialog, like:
Button1 - button 1 caption
Button2 - button 2 caption
Button3 - button 3 caption
Buttons: TDamMsgButtons = Defines the buttons in the message dialog:
dbOK: Defines one button OK
dbYesNo: Defines two buttons Yes/No
dbOne: Defines one button by Button1 defined caption
dbTwo: Defines two buttons by Button1 and Button2 defined captions
dbThree: Defines three buttons by Button1, Button2 and Button3 defined captions
Also, make sure that your 3rd party controls also
call your custom message dlg and not standard
MessageDlg function. That is if they're actually
using it. It is possible that 3rd party controls
do not use the Delphi messagedlg and call the
MessageBox API directly. If that's case, you might
end up with inconsistencies in showing message
boxes.