Gradient Control additional features

Please post bug reports, feature requests, or any question regarding the DELPHI AREA products here.

Gradient Control additional features

Postby JohnGB » November 5th, 2015, 3:06 pm

I am using DELPHI AREA's Gradient Shape control but I would like to add 2 additional features.

I am using the control as the base control for a number of custom controls I am building and would like to add a Solid colour fill and a transparent property to the control or implement it in my custom controls. These controls are created at run time and can be deleted at run time.

I can force a Solid fill by setting both begin and end colours to the same, however, in doing so, if I then delete the object the coIor of the parent form is cleared to blank which causes my application to throw and error.
I have had no success with implementing a transparent fill.

Any suggestions?

John Barrat
JohnGB
Member
Member
 
Posts: 4
Joined: November 5th, 2015, 11:52 am

Re: Gradient Control additional features

Postby JohnGB » November 5th, 2015, 6:14 pm

Update...

I have successfully modified Gradient to support style gsSolid, bit of a hack, I set the begin and end colors to be the solid color then call LinearHorizontal. There is probably a much quicker way to do this.

Also have resolved my error on deletion of component.

Just need some ideas on how I might make the component transparent or at least fill with the parent object's color?
Unfortunately Parent.color is a protected property and not available directly to the control.

John Barrat
JohnGB
Member
Member
 
Posts: 4
Joined: November 5th, 2015, 11:52 am

Re: Gradient Control additional features

Postby Kambiz » November 7th, 2015, 8:18 am

Hi John,

Here is a procedure that copies control's parent canvas into destination canvas.
Code: Select all
procedure CopyParentImage(Control: TControl; Dest: TCanvas);
var
  I, Count, X, Y, SaveIndex: Integer;
  DC: HDC;
  R, SelfR, CtlR: TRect;
begin
  if (Control = nil) or (Control.Parent = nil) then
    Exit;
  Count := Control.Parent.ControlCount;
  DC := Dest.Handle;
  with Control.Parent do
    ControlState := ControlState + [csPaintCopy];
  try
    with Control do
    begin
      SelfR := Bounds(Left, Top, Width, Height);
      X := -Left; Y := -Top;
    end;
    { Copy parent control image }
    SaveIndex := SaveDC(DC);
    try
      SetViewportOrgEx(DC, X, Y, nil);
      IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);
      with TParentControl(Control.Parent) do
      begin
        Perform(WM_ERASEBKGND, DC, 0);
        PaintWindow(DC);
      end;
    finally
      RestoreDC(DC, SaveIndex);
    end;
    { Copy images of graphic controls }
    for I := 0 to Count - 1 do
    begin
      if Control.Parent.Controls[I] = Control then
        Break;
      if (Control.Parent.Controls[I] <> nil) and (Control.Parent.Controls[I] is TGraphicControl) then
      begin
        with TGraphicControl(Control.Parent.Controls[I]) do
        begin
          CtlR := Bounds(Left, Top, Width, Height);
          if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then
          begin
            ControlState := ControlState + [csPaintCopy];
            SaveIndex := SaveDC(DC);
            try
              SetViewportOrgEx(DC, Left + X, Top + Y, nil);
              IntersectClipRect(DC, 0, 0, Width, Height);
              Perform(WM_PAINT, DC, 0);
            finally
              RestoreDC(DC, SaveIndex);
              ControlState := ControlState - [csPaintCopy];
            end;
          end;
        end;
      end;
    end;
  finally
    with Control.Parent do
      ControlState := ControlState - [csPaintCopy];
  end;
end;

And, here is an example, which calls the procedure inside Paint method of a GraphicControl:
Code: Select all
if Transparent then
begin
  CopyParentImage(Self, Canvas);
  Canvas.Brush.Style := bsCLear;
end
else
begin
  Canvas.FillRect(ClientRect);
  Canvas.Brush.Style := bsSolid;
end;
Kambiz
User avatar
Kambiz
Administrator
Administrator
 
Posts: 2408
Joined: March 7th, 2003, 7:10 pm

Re: Gradient Control additional features

Postby JohnGB » February 21st, 2016, 5:36 pm

I have finally gotten round to trying out your suggestion.
I placed your procedure into the Gradient unit but have a problem compiling it.
The TParentControl type is not recognised by the compiler nor are the commands Perform and PaintWindow.
Do I have to add additional Namespaces to uses? I am using Delphi 2007.

JohnB
JohnGB
Member
Member
 
Posts: 4
Joined: November 5th, 2015, 11:52 am

Re: Gradient Control additional features

Postby JohnGB » February 21st, 2016, 5:58 pm

Cancel that, I found an earlier example of the CopyParentImage and realised that TParentControl is a TWinControl

JohnB
JohnGB
Member
Member
 
Posts: 4
Joined: November 5th, 2015, 11:52 am


Return to DELPHI AREA Products

Who is online

Users browsing this forum: No registered users and 1 guest

cron