Difference between revisions of "Double Gradient"

From Lazarus wiki
Jump to navigationJump to search
m (Optimized source code)
Line 27: Line 27:
 
   ABitmap.Width:=ARect.Right;
 
   ABitmap.Width:=ARect.Right;
 
   ABitmap.Height:=ARect.Bottom;
 
   ABitmap.Height:=ARect.Bottom;
   if AValue <> 0 then begin
+
   if AValue <> 0 then ARect1:=ARect;
    ARect1:=ARect;
+
   if AValue <> 1 then ARect2:=ARect;
  end;
 
   if AValue <> 1 then begin
 
    ARect2:=ARect;
 
  end;
 
 
   if APos = gdVertical then begin
 
   if APos = gdVertical then begin
 
     ARect1.Bottom:=Round(ARect1.Bottom * AValue);
 
     ARect1.Bottom:=Round(ARect1.Bottom * AValue);
Line 41: Line 37:
 
     ARect2.Left:=ARect1.Right;
 
     ARect2.Left:=ARect1.Right;
 
   end;
 
   end;
   if AValue <> 0 then begin
+
   if AValue <> 0 then ABitmap.Canvas.GradientFill(ARect1,AStart1,AStop1,ADirection1);
    ABitmap.Canvas.GradientFill(ARect1,AStart1,AStop1,ADirection1);
+
   if AValue <> 1 then ABitmap.Canvas.GradientFill(ARect2,AStart2,AStop2,ADirection2);
  end;
 
   if AValue <> 1 then begin
 
    ABitmap.Canvas.GradientFill(ARect2,AStart2,AStop2,ADirection2);
 
  end;
 
 
   Result:=ABitmap;
 
   Result:=ABitmap;
 
end;
 
end;

Revision as of 02:39, 17 February 2011

Unit

sampledoublegd.png

Whit this unit 'doublegradient' you can easy make gradients for toolbars, buttons, etc. Save the above code in a text file 'doublegradient.pas' and add in the 'uses' section of your project.

<delphi>unit doublegradient;

{$mode objfpc}{$H+}

interface

uses

 Classes, Graphics;

function DoubleGradientFill(ARect: TRect; AStart1,AStop1,AStart2,AStop2: TColor;

 ADirection1,ADirection2,APos: TGradientDirection; AValue: Single): TBitmap;

implementation

function DoubleGradientFill(ARect: TRect; AStart1,AStop1,AStart2,AStop2: TColor;

 ADirection1,ADirection2,APos: TGradientDirection; AValue: Single): TBitmap;

var

 ABitmap: TBitmap; ARect1,ARect2: TRect;

begin

 ABitmap := TBitmap.Create;
 ABitmap.Width:=ARect.Right;
 ABitmap.Height:=ARect.Bottom;
 if AValue <> 0 then ARect1:=ARect;
 if AValue <> 1 then ARect2:=ARect;
 if APos = gdVertical then begin
   ARect1.Bottom:=Round(ARect1.Bottom * AValue);
   ARect2.Top:=ARect1.Bottom;
 end
 else if APos = gdHorizontal then begin
   ARect1.Right:=Round(ARect1.Right * AValue);
   ARect2.Left:=ARect1.Right;
 end;
 if AValue <> 0 then ABitmap.Canvas.GradientFill(ARect1,AStart1,AStop1,ADirection1);
 if AValue <> 1 then ABitmap.Canvas.GradientFill(ARect2,AStart2,AStop2,ADirection2);
 Result:=ABitmap;

end;

end.</delphi>

Usage

First you must have a 'TBitmap' to store the gradient, then you can draw the image, for example, in all the 'Form1' visible area:

defaultdbgd.png

<delphi>procedure TForm1.FormPaint(Sender: TObject); var

 ABitmap: TBitmap;

begin

 ABitmap:=DoubleGradientFill(Self.ClientRect,clMedGray,clWhite,clSilver,clGray,gdVertical,gdVertical,gdVertical,0.50);
 Self.Canvas.Draw(0,0,ABitmap);
 ABitmap.Free

end;</delphi>

Editor

Also you can use the 'Double Gradient Editor' that is a GUI to instant see the result, save to a bitmap file, save to '*.doublegradient' session file or just copy code to clipboard to use in lazarus.

dbgedit.png

  • To acces the menu right click the ScrollBox (gradient area):
    • Save bitmap.. Show a dialog to save as a *.bmp file.
    • Load gradient.. Show a dialog to load a *.doublegradient session file.
    • Save gradient.. Show a dialog to save the current session settings to a file.
    • Copy code to clipboard.. Just copy the settings as text in the clipboard, then you can use it to paste in lazarus source editor to call the doublegradientfill procedure.
  • default.doublegradient: this file have the last settings in the editor, is loaded at startup, saved when you close the application.

Downloads

Double Gradient Editor 1.0 Source Code dbgdedit1.0.zip (5.64 KB)

You are free to edit and improve this editor, this is free of charge.