Using Delphi I would like to add another button to the border icon buttons; close, maximize, minimize. Any ideas on how to do this?
This was easy to do prior to Windows Aero. You simply had to listen to the WM_NCPAINT and WM_NCACTIVATE messages to draw on top of the caption bar, and similarly you could use the other WM_NC* messages to respond to mouse clicks etc, in particular WM_NCHITTEST, WM_NCLBUTTONDOWN, and WM_NCLBUTTONUP.
For instance, to draw a string on the title bar, you only had to do
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;
type
TForm1 = class(TForm)
protected
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCACTIVATE;
private
procedure DrawOnCaption;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TForm1 }
procedure TForm1.WMNCActivate(var Msg: TWMNCActivate);
begin
inherited;
DrawOnCaption;
end;
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
begin
inherited;
DrawOnCaption;
end;
procedure TForm1.DrawOnCaption;
var
dc: HDC;
begin
dc := GetWindowDC(Handle);
try
TextOut(dc, 20, 2, 'test', 4);
finally
ReleaseDC(Handle, dc);
end;
end;
end.
Now, this doesn't work with Aero enabled. Still, there is a way to draw on the caption bar; I have done that, but it is far more complicated. See this article for a working example.
Chris Rolliston wrote a detailed blog about creating a custom title bar on Vista and Windows 7.
He also wrote a follow up article and posted example code on CodeCentral.
Yes, set the form's border style property to bsNone and implement your own title bar with all the buttons and custom behaviour you like.
Related
Bitmap.BitmapChanged; is protected in FMX.Graphics so I cannot use the procedure.
Useing a TImage or TImageControler I am drawing a line but the line does not show.
I am using this snippet:
imgc1.Bitmap.Canvas.BeginScene;
imgc1.Bitmap.Canvas.DrawLine(FStartPoint,FEndPoint, 100);
imgc1.Bitmap.Canvas.EndScene;
imgc1.Bitmap.BitmapChanged; // the original example said that this would redraw the image. In my CE Rio IDE the BitmapChanged is undefind. How can I use it?
Draw the line. IDE cannot find BitmapChanged.
BitmapChanged is a protected member. I need to write some code to handle the OnBitmapChanged event.
I understand now. Almost 30 years of developing in Delphi and this is the first time I have run into protected members. The examples I was using must not have been compiled else the writer would have had the same error that I had.
TBitmap.BitmapChanged() is a virtual method that simply fires the public TBitmap.OnChange event. Since it is protected, you can use an accessor class to reach it:
type
TBitmapAccess = class(TBitmap)
end;
TBitmapAccess(imgc1.Bitmap).BitmapChanged;
However, this is not really needed. TImage assigns its own internal OnChange event handler to its Bitmap. So it should react to changes to the Bitmap automatically. But, if for some reason it does not, the correct way to refresh the TImage is to call its Repaint() method:
imgc1.Repaint;
Which is exactly what TImage's internal OnChange handler does:
constructor TImage.Create(AOwner: TComponent);
begin
inherited;
FBitmap := TBitmap.Create(0, 0);
FBitmap.OnChange := DoBitmapChanged;
...
end;
procedure TImage.DoBitmapChanged(Sender: TObject);
begin
Repaint;
UpdateEffects;
end;
I'm trying to draw an image on a TPanel's Canvas in a procedure of this Panel. When I do this in Paint Method of the Panel it works just fine, but when I try to draw on the Canvas in another procedure or in the constructor nothing happens.
This is how I draw on the Panel's Canvas in the Paint Procedure:
procedure TFeld.Paint;
var bmp : TBitmap;
begin
inherited;
bmp := TBitmap.Create;
try
bmp.LoadFromFile('textures\ground.bmp');
self.Canvas.Draw(0,0,bmp);
finally
bmp.Free;
end;
end;
And this is how I try to draw on it in another procedure:
procedure TFeld.setUnsichtbar;
var bmp : TBitmap;
begin
bmp := TBitmap.Create;
try
bmp.LoadFromFile('textures\invisible.bmp');
self.Canvas.Draw(0,0,bmp);
finally
bmp.Free;
end;
end;
But the Panel's Canvas is still the image I applied in the Paint procedure.
I already tried to move the drawing from the Paint procedure to the Constructor which didn't work.
The path is also correct, switched the paths and now the Panels have the 'invisible.bmp' image.
Whole Class/Unit: http://pastebin.com/YhhDr1F9
Any idea why this doesn't work?
Looking at your whole class I asume you desire to controll which image is being shown at which time based on certain condition. Right?
If that is the case first thing that you need is for your class to have a field for storing the image data. In your example above you are only using bmp files so TBitmap would suffice. But if you are using other picture types you might want to use TPicture field instead as this one alows loading of all supported picture images as TImage that you also tried to use component can.
Then you change your component's Paint method to use the above mentioned field for getting picture data instead of creating local picture data variable every time as you do it now.
In fact what you are doing now is terrible as you are forcing your application to read the image data from file into memory every time your component is rendered. This could cause terrible performance.
And finally when you want to change the picture that is shown on your component just load different picture into your picture field.
So with above changes your class should look something like this:
type
TFeld=class(TPanel)
protected
procedure Paint;override;
procedure BitmapChange(Sender: TObject);
private
zSichtbar : Boolean;
zPosHor,zPosVer : Integer; // Position im Array
zEinheit : TEinheit;
Bitmap: TBitmap; //Field for storing picture data
public
// hImage : TImage;
constructor Create(pX,pPosHor,pY,pPosVer,pHoehe,pBreite:integer;pImgPath:String;pForm:Tform); virtual;
destructor Destroy;
procedure ChangeImage(pImgPath: String);
end;
...
implementation
constructor TFeld.Create(pX,pPosHor,pY,pPosVer,pHoehe,pBreite:integer;pImgPath:String;pForm:Tform);
begin
inherited create(pForm);
...
//Creater internal component for storing image data
Bitmap := TBitmap.Create;
//Assign proper method to Bitmaps OnChange event
Bitmap.OnChange := BitmapChange;
//Load initial image data
Bitmap.LoadFromFile(pImgPath);
....
end;
destructor Destroy;
begin
//We need to destroy the internal component for storing image data before
//we destory our own component in order to avoid memory leaks
Bitmap.Free;
end;
procedure TFeld.Paint;
begin
inherited;
//Use local image field to tell the Paint method of what to render
self.Canvas.Draw(0,0,Bitmap);
end;
procedure TFeld.BitmapChange(Sender: TObject);
begin
//Force redrawing of the component on bitmap change
self.Invalidate;
end;
procedure TFeld.ChangeImage(pImgPath: String);
begin
//Load different image into image field
Bitmap.LoadFromFile(pImgPath);
end;
EDIT: Adding necessary code to force component redrawing after bitmap has been changed.
I want to know width and height of Image while it is in Clipboard, because if dimensions are too small then message like "Image is too small" should appear.
How to get width and height?
Unless you are prepared to manually parse the various image formats that you want to support, you can have the VCL simply load the image for you (just make sure suitable TGraphic classes have been registered, such as TGIFImage, TJPEGImage, TPNGImage, etc), and then you can ask the image for its dimensions, eg:
uses
Graphics, Clipbrd, Jpeg, PngImage, ...;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
p: TPicture;
begin
p := TPicture.Create;
try
try
p.Assign(Clipboard);
// use p.Graphic, p.Graphic.Width, p.Graphic.Height as needed...
except
// unable to access Clipboard, or Clipboard
// does not contain a supported image type
end;
finally
p.Free;
end;
end;
If this is about bitmap I think you may try this.
procedure TForm1.BitBtn1Click(Sender: TObject);
var b:TBitmap;
begin
if Clipboard.HasFormat(CF_BITMAP) then begin
b:=TBitmap.Create;
try
b.Assign(Clipboard);
ShowMessage(IntToStr(b.Width)+','+IntToStr(b.Height));
finally
b.Free;
end;
end;
end;
you can instead of showmessage put If-statement and do what ever you want.
I would like to detect when the form is going to be maximized to save certain settings (not related to the size nor position) and modify the size and position a little bit. Is there an universal way to do it ?
I've tried to catch the WM_SYSCOMMAND message like in this article. It works well for maximization from menu, by maximize button, but it's not fired when I press the WIN + UP keystroke. Does anyone know an universal way how to catch the maximization event including the case with WIN + UP keystroke ?
Thanks
You can use the WM_GETMINMAXINFO message to save the state of the window and then use the WMSize message to check if the window was maximized.
in you form declare the mesage handler like so :
procedure WMSize(var Msg: TMessage); message WM_SIZE;
And handle like this :
procedure TForm57.WMSize(var Msg: TMessage);
begin
if Msg.WParam = SIZE_MAXIMIZED then
ShowMessage('Maximized');
end;
WIN+UP does not generate WM_SYSCOMMAND messages, that is why you cannot catch them. It does generate WM_GETMINMAXINFO, WM_WINDOWPOSCHANGING, WM_NCCALCSIZE, WM_MOVE, WM_SIZE, and WM_WINDOWPOSCHANGED messages, though. Like RRUZ said, use WM_GETMINMAXINFO to detect when a maximize operation is about to begin and WM_SIZE to detect when it is finished.
IMO, You cannot use WM_GETMINMAXINFO to "detect when a maximize operation is about to begin" as #Remy stated.
In-fact the only message that can is WM_SYSCOMMAND with Msg.CmdType=SC_MAXIMIZE or undocumented SC_MAXIMIZE2 = $F032 - but it's not being sent via Win+UP, or by using ShowWindow(Handle, SW_MAXIMIZE) for example.
The only way I could detect that a window is about to be maximized is via WM_WINDOWPOSCHANGING which is fired right after WM_GETMINMAXINFO:
type
TForm1 = class(TForm)
private
procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
end;
implementation
const
SWP_STATECHANGED = $8000;
procedure TForm1.WMWindowPosChanging(var Message: TWMWindowPosChanging);
begin
inherited;
if (Message.WindowPos^.flags and (SWP_STATECHANGED or SWP_FRAMECHANGED)) <> 0 then
begin
if (Message.WindowPos^.x < 0) and (Message.WindowPos^.y < 0) then
ShowMessage('Window state is about to change to MAXIMIZED');
end;
end;
In Delphi XE, I'm trying to implement an "instant search" feature - one that resembles Firefox's "search as you type" somewhat, but is better illustrated by a similar feature in an open source clipboard extender, Ditto:
There is a list of items that handles typical navigation events. However, any alphanumeric keys as well as navigation and editing commands (right/left arrows, shift+arrows, backspace, delete etc.) should be rerouted to the edit box below the list. An OnChange event of the edit box will trigger a refresh of the list.
The point of the UI is that user does not have to tab or shift-tab between the controls. The two controls (the list and the edit box) should 'feel" as if they were a single control. The behavior of the search UI should not be contingent on which control has focus.
It seems my best option is to forward certain keyboard events from the list control (I'm using TcxTreeList) to the edit box, and forward a handful of navigation keys from the edit box to the list. How can I achieve that?
Notes:
TcxTreeList supports incremental search of course, but this is not what I'm after. The search goes to an SQLite database and looks for substring matches. The list displays only the matching items from the db.
There is some overlap, e.g. both controls would normally handle VK_HOME and VK_END, but that's OK - in this case the keys would go to the list. I'll need to decide whether to forward each individual keypress, or handle it in the control that received it.
On Edit:
One obvious way seemed to be to invoke the respective KeyDown, KeyUp and KeyPress methods of the edit control, like so:
type
THackEdit = class( TEdit );
procedure TMainForm.cxTreeList1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
THackEdit( edit1 ).KeyDown( Key, Shift );
end;
Unfortunately, this has no effect. My guess is TEdit won't process key events unless it is focused. Using SendMessage( THackEdit( edit1 ).Handle, WM_KEYDOWN, Key, 0 ) has no effect, either.
You can use the message handling capability of a VCL control and send the relevant messages to one another. I don't know about a 'TcxTreeList', but the following demonstrates the idea on an edit control and a memo control responding to keyboard events synchronously (whereever possible of course).
type
TEdit = class(stdctrls.TEdit)
private
FMsgCtrl: TWinControl;
FRecursing: Boolean;
procedure WmChar(var Msg: TWMChar); message WM_CHAR;
procedure WmKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
procedure WmKeyUp(var Msg: TWMKeyUp); message WM_KEYUP;
end;
TMemo = class(stdctrls.TMemo)
private
FMsgCtrl: TWinControl;
FRecursing: Boolean;
procedure WmChar(var Msg: TWMChar); message WM_CHAR;
procedure WmKeyDown(var Msg: TWMKeyDown); message WM_KEYDOWN;
procedure WmKeyUp(var Msg: TWMKeyUp); message WM_KEYUP;
end;
TForm1 = class(TForm)
Edit1: TEdit;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
{ TEdit }
procedure TEdit.WmChar(var Msg: TWMChar);
begin
if not FRecursing then begin
inherited;
// Insert test here to see if the message will be forwarded
// exit/modify accordingly.
if Assigned(FMsgCtrl) then begin
FRecursing := True;
try
FMsgCtrl.Perform(Msg.Msg,
MakeWParam(Msg.CharCode, Msg.Unused), Msg.KeyData);
finally
FRecursing := False;
end;
end;
end;
end;
procedure TEdit.WmKeyDown(var Msg: TWMKeyDown);
begin
// exact same contents as in the above procedure
end;
procedure TEdit.WmKeyUp(var Msg: TWMKeyUp);
begin
// same here
end;
{ TMemo }
procedure TMemo.WmChar(var Msg: TWMChar);
begin
// same here
end;
procedure TMemo.WmKeyDown(var Msg: TWMKeyDown);
begin
// same here
end;
procedure TMemo.WmKeyUp(var Msg: TWMKeyUp);
begin
// same here
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Edit1.FMsgCtrl := Memo1;
Memo1.FMsgCtrl := Edit1;
end;
You might need to intervene additional messages but you get the idea.
If for one reason or another you cannot derive a new control or override message handling, you can consider sub-classing the controls. Answer to this question would show you how to do that.
Not exactly what you are asking for, but for similar results, I use the following trick.
Assume you have one TEdit Edit1 and one TListbox Listbox1.
In the OnEnter event of Listbox1, simply yield focus to Edit1
procedure TForm1.ListBox1Enter(Sender: TObject);
begin
edit1.SetFocus;
end;
And in the OnKeyDown event of Edit1, use the up and down arrows to navigate the items of the listbox and use the enter key to move the selected item to the edit box.
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var k:word;
begin
if (Shift=[]) and (key=VK_DOWN) then
begin
listbox1.ItemIndex:=listbox1.ItemIndex+1;
key:=0;
end
else if (Shift=[]) and (key=VK_UP) then
begin
listbox1.ItemIndex:=listbox1.ItemIndex-1;
key:=0;
end
else if (Shift=[]) and (key=VK_RETURN) then
begin
edit1.text:=listbox1.items[listbox1.itemindex];
end;
end;