SpTBX panels have X close buttons, which have 2 state: usual and mouse-over. I want to draw same bitmaps on my canvas, on TPageControl (owner-drawn).
Left yellow X icon is SpTBX (when Office Silver theme is used). Right X icon is my current one. I want to draw the same as on the left. How to get these bitmaps?
The 'X'-close button is one of the four built-in patterns which you can summon by calling SpDrawGlyphPattern. Starting with '0', the four patterns are 'close', 'maximize', 'minimize' and 'restore', as you can also see in the procedure's source code.
The background is a toolbar button background as you'd guess, since the glyphs are used on internal toolbars attached to dockable panels. That you can draw with SpDrawXPToolbarButton.
The below code will generate the glyph as shown in your picture (if the currently selected skin is 'Office 2007 Silver') on the form's canvas. Note that when the state is not hot, the button background is clear.
In general, if you want to find out how an 'item' gets painted in sptbxlib, put a breakpoint at the start of TSpTBXItemViewer.Paint in 'sptbxitem.pas' and follow the code path.
procedure TForm1.Button1Click(Sender: TObject);
var
R: TRect;
begin
R := Rect(20, 20, 35, 35);
SpDrawXPToolbarButton(Canvas, R, sknsHotTrack, sknSkin, cpNone);
SpDrawGlyphPattern(Canvas, R, 0,
CurrentSkin.GetTextColor(skncToolbarItem, sknsNormal));
end;
Related
I have a tool bar and I am using the following procedure to change the color of a rectangle in one of the tool buttons. The ColorDepth of the ImageList is cl24Bit and the DrawingStyle is dsTransparent. The procedure works fine.
procedure TANewMain.BtReplaceHighOnClick(Sender: TObject);
var
ABitmap: TBitmap;
ARect: TRect;
begin
ABitmap := TBitmap.Create;
try
ImgList.GetBitmap(1, ABitmap);
ABitmap.Canvas.Brush.Color := ColorToRGB(clRed); // S04
ABitmap.Canvas.Pen.Color := ColorToRGB(clBlue);
ARect := Rect(5, 1, 11, 15);
ABitmap.Canvas.Rectangle(ARect);
ImgList.ReplaceMasked(1, ABitmap, clWhite);
finally
ABitmap.Free;
end;
end;
If I add the program to the repository for reuse it works fine. However, if I start a new program from scratch and use the exact same procedure, I get a white button. I made sure that the properties for the image list and the tool bar are the same in both programs. The program that works was written some time ago. Could the problem have anything to do with Windows updates? I am using Windows 10 and Delphi 10.
There are two solutions to your problem.
1) Disabling themeing of your application
Disable by unticking the 'Enable Runtime themes' checkbox in 'Project - Options - Application'.
The downside of this is that the application looks as developed for Windows 95.
2) Change following properties of the ImageList
ColorDepth: cdDeviceDependent
DrawingStyle: dsNormal
ImageType: itMask
The result looks like this on Windows 10 (and with respect to the toolbuttons, the same also on Windows 7):
I modified your code to act as a toggle for the buttons, therefore two buttons have the red rectangle.
The numbers are simply 64 x 64 pixel bitmaps with black text on white background.
Caveat: The principle of copying - modifying - copy back repeatedly might lead to reduced quality of the images. A better way could be to have two imagelists, one with the original images and one with the rectangle readily drawn.
Having said that, it appears that the purpose of the rectangle is to indicate some kind of 'active' state. That can be achived also with Down property of the buttons.
I already know and have used these methods to create a form without boders that can be moved.
Move form without border style
I'm using the WMNCHitTest override.
The MouseDown event don't work at all.
This form is very simple it is displaying a countdown, a number that changes very second and that's all. The number being painted using a big TLabel with big fonts.
But I also made this form transparent by using Delphi's standard form properties.
Now, if I try to click on the form to move it, the only area I can use is the lines drawing the changing numbers, even if they are not so thin, this is not practical.
I'd like the user to be able to move the numbers to any position of the screen by clicking anywhere near the numbers, let's say inside a "0" or an "8".
I'd think about drawing a transparent rectangle over the numbers and be that the clickable area, but the effect would be the same, the click would go throu.
I know an application that does this, so it is possible, but how?
procedure TfrmCountDown.Timer1Timer(Sender: TObject);
begin
iCount := iCount - 1;
lblTime.Caption := FormatFloat('00', iCount);
end;
procedure TfrmCountDown.FormCreate(Sender: TObject);
begin
iCount := 60;
BorderStyle:=bsNone;
Self.Color := clGray;
Self.TransparentColor := true;
Self.TransparentColorValue := clGray;
end;
procedure TfrmCountDown.WMNCHitTest(var Message: TWMNCHitTest);
var
Pt: TPoint;
begin
Pt := ScreenToClient(SmallPointToPoint(Message.Pos));
if Pt.Y < 160 then
Message.Result := HTCAPTION
else
inherited;
end;
VCL Form Transparency (by which presume you to mean the TransparentColor property, as opposed to the Alpha properties) uses Layered Windows to achieve the transparent drawing. Using this technique any transparent area of the window is not only transparent visually but also with respect to hit testing.
i.e. Using VCL form transparency, the transparent areas in your form may as well not exist at all.
What could work is to turn off the VCL form transparency and instead implement your form using the WS_EX_TRANSPARENT window style. This enables visual transparency but allows you to handle hit testing to make different areas of your form transparent, or not, with respect to clicks.
Unfortunately WS_EX_TRANSPARENT is not a complete "transparency" solution - it only tells Windows that your form is transparent, but you also then have to take additional steps to actually be properly transparent, or to interpret what "transparent" means for your specific form.
This means it complicates the visual rendering of your form and you will also have to override the paint mechanism to properly draw your form. From how you describe the content on your form this does not sound like it will be too arduous however, though it is far some straightforward (I do not have a working example unfortunately).
At the very least you will probably be best to replace your TLabel with calls to select an appropriate font and render text into the window client area with a transparent background. But there will be additional house keeping required.
In your WM_NCHITTEST handler, respond with HTNOWHERE for those areas of your form which you wish to be interpreted as "click through" areas, and HTCAPTION for the areas that you wish to support dragging (i.e. from what you describe, within a region defined by the bounds of your text).
Unfortunately I think you will find that there are lots of fiddly aspects to the implementation of painting a transparent window.
I use Delphi7, PageControl with owner-draw. I can't get so plain and nice look of tabs, as I see on not-owner-drawn PageControls. What's bad:
when using owner-draw, I can't draw on "entire" tab header area, small 1-2px frame around tab header is painted by OS.
1) Delphi not owner-draw, look is OK too (XPMan used):
2) Delphi owner-draw, you see not entire tab header can be colored (XPMan used):
I draw current tab with blue and others with white, here. Only example.
Code:
procedure TForm1.PageControl1DrawTab(Control: TCustomTabControl;
TabIndex: Integer; const Rect: TRect; Active: Boolean);
var
c: TCanvas;
begin
c:= (Control as TPageControl).Canvas;
if Active then
c.Brush.Color:= clBlue
else
c.Brush.Color:= clWhite;
c.FillRect(Rect);
end;
2b) Delphi owner-draw in real app (XPMan used):
Why do i need to use owner-draw? Simple. To draw X button on tab headers, to paint upper-line with custom color, to paint icons from imagelists.
I'm looking for a way to paint ENTIRE rect of tab headers, not decreased rect which is given to PageControl owner-draw events. I tried to increase the rect given by owner-draw events, but this doesn't help, OS repaints this thin 1-2px frame around tab headers anyway.
The tabs of an owner drawn native "tab control" (TPageControl in VCL, although its ascendant is appropriately named TCustomTabControl - it is anyone's guess why the creative naming..), is expected to be painted by its parent control while processing WM_DRAWITEM messages, as documented here.
The VCL takes the burden from the parent by mutating the message to a CN_DRAWITEM message and sending it to the control itself. In this process the VCL has no further intervention. It just calls the OnDrawTab message handler if it is assigned by user code, passing appropriate parameters.
So, it's not the VCL that draws the borders around tabs, but the OS itself. Also, evidently, it doesn't do this during processing of WM_DRAWITEM messages but later in the painting process. You can verify this by putting an empty WM_DRAWITEM handler on the parent of a page control. Result is, whatever we paint in the event handler, it will later get borders by the OS.
What we might try is to try to prevent what the OS draws take effect, we have the device context (as Canvas.Handle) after all. Unfortunately this route also is a dead end because the VCL, after the event handler returns, restores the device context's state.
The only way, then, we have is to completely abandon handling an OnDrawTab event, and acting upon CN_DRAWITEM message. Below sample code use an interposer class, but you can subclass the control any way you like. Make sure that OwnerDrawn is set.
type
TPageControl = class(comctrls.TPageControl)
protected
procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
end;
TForm1 = class(TForm)
..
..
procedure TPageControl.CNDrawitem(var Message: TWMDrawItem);
var
Color: TColor;
Rect: TRect;
Rgn: HRGN;
begin
Color := 0;
// draw in different colors so we see where we've drawn
case Message.DrawItemStruct.itemID of
0: Color := $D0C0BF;
1: Color := $D0C0DF;
2: Color := $D0C0FF;
end;
SetDCBrushColor(Message.DrawItemStruct.hDC, Color);
// we don't want to get clipped in the passed rectangle
SelectClipRgn(Message.DrawItemStruct.hDC, 0);
// magic numbers corresponding to where the OS draw the borders
Rect := Message.DrawItemStruct.rcItem;
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then begin
Inc(Rect.Left, 2);
// Inc(Rect.Top, 1);
Dec(Rect.Right, 2);
Dec(Rect.Bottom, 3);
end else begin
Dec(Rect.Left, 2);
Dec(Rect.Top, 2);
Inc(Rect.Right, 2);
Inc(Rect.Bottom);
end;
FillRect(Message.DrawItemStruct.hDC, Rect,
GetStockObject(DC_BRUSH));
// just some indication for the active tab
SetROP2(Message.DrawItemStruct.hDC, R2_NOTXORPEN);
if Bool(Message.DrawItemStruct.itemState and ODS_SELECTED) then
Ellipse(Message.DrawItemStruct.hDC, Rect.Left + 4, Rect.Top + 4,
Rect.Left + 12, Rect.Top + 12);
// we want to clip the DC so that the borders to be drawn are out of region
Rgn := CreateRectRgn(0, 0, 0, 0);
SelectClipRgn(Message.DrawItemStruct.hDC, Rgn);
DeleteObject(Rgn);
Message.Result := 1;
inherited;
end;
Here is how the above looks here:
From what I can tell, you are simply looking to have themed painting of your application. In Delphi 7, all you need to do to achieve that is to add an application manifest that specifies the use of comctl32 version 6. The simple way to do so is to add a TXPManifest component to one of your forms or data modules, or just to reference the XPMan unit in your project.
Since you want the system to paint your page control, you must not do any owner drawing.
When I use zooming with mouse on a chart (TeeChart) (left button and drag bottom right) cursor draws a marquee rectangle for zoom area. Marquee line is barely visible in light-grey color. Is there any way to change the color of marquee line (something like black, red etc) to make it more contrast and easy to see?
I'm using VCL TChart 4.04.
I think this is not possible in TChart v.4.04, or at least haven't found any property which might do this.
At least in TChart v.8.03 (the one shipped with Delphi 2009) there are properties TChart.Zoom.Brush and TChart.Zoom.Pen where you can set the colors and other properties for the selection rectangle. So, if you would have the newer version of TChart you might use something like this:
procedure TForm1.FormCreate(Sender: TObject);
begin
Chart1.Zoom.Pen.Width := 2;
Chart1.Zoom.Pen.Color := clRed;
end;
I've narrowed a problem I have drawing on TImage.Canvas in Delphi 2009 down to the following reproducible case:
Given: a form, a TImage, TLabel and TButton on it. The TImage is anchored to all four edges so that resizing the form will resize the TImage. What I want to be able to do is draw on the maximal area of Image1 available to me after resizing. So in my test case I have the following code in my the Button's OnClick handler:
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:= IntToStr (Image1.Width)+' x '+IntToStr(Image1.Height);
Image1.Canvas.Pen.Color:= 0;
Image1.Canvas.Rectangle(0,0,Image1.Width, Image1.Height);
end;
You'll see that if the form is resized, Image1.Width and .Height change as expected, however the rectangle that is drawn if the resized form is larger than the original one, will be incomplete, only drawing on the same area that was there previously.
How do I get it do use the entire resized area?
For what it's worth, in my original problem I had played with Image1.Stretch, which allows me to use more of the area upon resizing but will result in my drawings being distorted (not desired). If I also use Image1.Proportional, then it's better but I still can't use the full area available. Image1.AutoSize doesn't seem to be doing anything useful to me either.
Any help appreciated.
Add an OnResize-event to your form:
procedure TForm1.FormResize(Sender: TObject);
begin
Image1.Picture.Bitmap.Width := Image1.Width;
Image1.Picture.Bitmap.Height := Image1.Height;
end;
Also, if you are using the component to draw on, rather than displaying images from file etc, consider using the TPaintBox rather than TImage.
Maybe you have to also adjust Image1.Picture.Width/Height or Image1.Picture.Bitmap.Width/Height.