Anyone use delphi here? need some help...

toon_mad

toon_mad

toon_mad

Soldato
Joined
8 Jan 2009
Posts
4,819
Location
North East
Anyone use delphi here? need some help... [RESOLVED]

Im trying to turn some code found from planet source code into a vcl component, original source found here: http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=1989&lngWId=7

I keep getting access violations, im sort of new to component creation :confused:, this it what i have conjured up so far:

Uses Windows, .., .., ExtCtrls;

type
TGradDir = (tGLeftRight, tGTopBottom); //vista panel

var
VistaBMP: TBitmap;

type
TVistaPanel = class(TPaintBox)
private
TBrightness: Integer;
TCenter: Boolean;
TColor: TColor;
TColorTo: TColor;
TContrast: Integer;
procedure SetBrightness(i: Integer);
procedure SetCenter(B: Boolean);
procedure SetColor(Color: TColor);
procedure SetColorTo(Color: TColor);
procedure SetContrast(i: Integer);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure VistaGradient(const Canvas: TCanvas; const ARect: TRect; const c1, c2: Byte; const c3, c4: TColor; const Center: Boolean);
published
property Brightness: Integer read TBrightness write TBrightness default 30;
property Center: Boolean read TCenter write TCenter;
property Color: TColor read TColor write SetColor default $00614F00;
property ColorTo: TColor read TColorTo write SetColorTo default $001DD9FF;
property Contrast: Integer read TContrast write TContrast default 63;
end;

constructor TVistaPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
TBrightness:= 30;
TCenter:= False;
TColor:= $00614F00;
TColorTo:= $001DD9FF;
TContrast:= 63;
end;

procedure TVistaPanel.SetBrightness(i: Integer);
begin
TBrightness:= i;
Invalidate;
end;

procedure TVistaPanel.SetCenter(B: Boolean);
begin
TCenter:= B;
Invalidate;
end;

procedure TVistaPanel.SetColor(Color: TColor);
begin
TColor:= ColorToRGB(Color);
Invalidate;
end;

procedure TVistaPanel.SetColorTo(Color:TColor);
begin
TColorTo:= ColorToRGB(Color);
Invalidate;
end;

procedure TVistaPanel.SetContrast(i: Integer);
begin
TContrast:= i;
Invalidate;
end;

procedure TVistaPanel.VistaGradient(const Canvas: TCanvas; const ARect: TRect; const c1, c2: Byte; const c3, c4: TColor; const Center: Boolean);
type
PRGB = ^TRGB;
TRGB = record b, g, r : Byte; end;
PRGBArray = ^TRGBArray;
TRGBARRAY = array[0..0] of TRGB;
var
rc1, gc1, bc1, rc2, gc2, bc2, rc3, gc3, bc3: Integer;
x, y, w, h: Integer;
i, w1: Integer;
Row: PRGBArray;
C: TRGB;
slMain, slSize, slPtr: Integer;
Color: Integer;
QCol: Array of Byte;
g: Byte;
begin
VistaBMP.Width := (ARect.Right - ARect.Left) - 1;
VistaBMP.Height := (ARect.Bottom - ARect.Top) - 1;
h:= VistaBMP.Height;
w:= VistaBMP.Width;
Color:= ColorToRGB(c3);
rc1 := Byte(Color);
gc1 := Byte(Color shr 8);
bc1 := Byte(Color shr 16);
Color:= ColorToRGB(c4);
rc2 := Byte(Color);
gc2 := Byte(Color shr 8);
bc2 := Byte(Color shr 16);
SetLength(QCol, h);
gc3 := c1 + (((c2 - c1) * 15) div 9);
if gc3 < 0 then gc3 := 0 else if gc3 > 255 then gc3 := 255;
y:= h div 2;
for i := 0 to h - 1 do // Calc profile
if i < y then QCol:= Byte(c1 + (((c2 - c1) * (i)) div y))
else QCol:= Byte(gc3 + (((c2 - gc3) * (i)) div h));
w1:= w - 1;
if Center then w:= (w shr 1) + (w and 1);
slMain:= Integer(VistaBMP.ScanLine[0]); // Init scanline accsess
slSize:= Integer(VistaBMP.ScanLine[1]) - slMain;
for x:= 0 to w - 1 do begin // Paint gradient
C.b:= Byte(bc1 + (((bc2 - bc1) * x) div w));
C.g:= Byte(gc1 + (((gc2 - gc1) * x) div w));
C.r:= Byte(rc1 + (((rc2 - rc1) * x) div w));
slPtr:= slMain;
for y := 0 to h - 1 do begin
Row := PRGBArray(slPtr);
g:= QCol[y];
Row[x].r:= (C.r - g) shr 1 + g;
Row[x].g:= (C.g - g) shr 1 + g;
Row[x].b:= (C.b - g) shr 1 + g;
if (Center) and (x < (w1 - x)) then begin
Row[w1 - x].r:= (C.r - g) shr 1 + g;
Row[w1 - x].g:= (C.g - g) shr 1 + g;
Row[w1 - x].b:= (C.b - g) shr 1 + g;
end;
slPtr:= slPtr + slSize;
end;
end;
QCol:= nil;
Canvas.Draw(ARect.Left, Arect.Top, VistaBMP);
end;

procedure TVistaPanel.Paint;
var
cv, cb, c1, c2: Byte;
r: TRect;
begin
r:= Rect(0,0, ClientWidth, ClientHeight);
VistaGradient(Canvas, r, Contrast , Brightness, Color, ColorTo, Center);
Canvas.Pen.Color:= $00C8BA90;
Canvas.Brush.Style:= bsClear;
Canvas.Rectangle(r);
end;
Click to expand...

As soon as i add the component to a form, or click on it i get Access Violation errors, as of yet i know i have not added any Free or Destroy procedures in there. Im pretty sure it has something to do with the Paint or VistaGradient procedure.

Appreciate any help thanks :cool:
 
Last edited:
Hi,
Your Vars in TVistaPanel

TBrightness: Integer;
TCenter: Boolean;
TColor: TColor;
TColorTo: TColor;
TContrast: Integer;

all start with 'T' the normal way is to start them with 'F'. This is just a preference but you use TColor as a var name of a TColor type. I have not run the code yet but think this should be changed.

FredFlint.
 
thanks, ive changed that, it still crashes but ive noticed a few errors myself which i can maybe fix. i noticed the VistaBMP variable has not been created, and the property declarations in the types are written wrong:

i had

type
TVistaPanel = class(TPaintBox)
private
TBrightness: Integer;
TCenter: Boolean;
TColor: TColor;
TColorTo: TColor;
TContrast: Integer;
procedure SetBrightness(i: Integer);
procedure SetCenter(B: Boolean);
procedure SetColor(Color: TColor);
procedure SetColorTo(Color: TColor);
procedure SetContrast(i: Integer);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure VistaGradient(const Canvas: TCanvas; const ARect: TRect; const c1, c2: Byte; const c3, c4: TColor; const Center: Boolean);
published
property Brightness: Integer read TBrightness write TBrightness default 30;
property Center: Boolean read TCenter write TCenter;
property Color: TColor read TColor write SetColor default $00614F00;
property ColorTo: TColor read TColorTo write SetColorTo default $001DD9FF;
property Contrast: Integer read TContrast write TContrast default 63;
end;
Click to expand...

it should be:

type
TVistaPanel = class(TPaintBox)
private
FBrightness: Integer;
FCenter: Boolean;
FColor: TColor;
FColorTo: TColor;
FContrast: Integer;
procedure SetBrightness(i: Integer);
procedure SetCenter(B: Boolean);
procedure SetColor(Color: TColor);
procedure SetColorTo(Color: TColor);
procedure SetContrast(i: Integer);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure VistaGradient(const Canvas: TCanvas; const ARect: TRect; const c1, c2: Byte; const c3, c4: TColor; const Center: Boolean);
published
property Brightness: Integer read FBrightness write SetBrightness default 30;
property Center: Boolean read FCenter write SetCenter;
property Color: TColor read FColor write SetColor default $00614F00;
property ColorTo: TColor read FColorTo write SetColorTo default $001DD9FF;
property Contrast: Integer read FContrast write SetContrast default 63;
end;
Click to expand...

ill see if i can fix this up...
 
thanks mate, ive looked through some of them sites, but it doesnt pin point the problem i have. and i cant really debug the package because i just get access violation error.

It may be best either coding it from scratch, if not please do modify what i have so far:

unit Unit1;

interface

uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls;

type
TVistaPanel = class(TPaintBox)
private
FBrightness: Byte;
FCenter: Boolean;
FColor: TColor;
FColorTo: TColor;
FContrast: Byte;
VistaBMP: TBitmap;
procedure SetBrightness(i: Byte);
procedure SetCenter(B: Boolean);
procedure SetColor(Color: TColor);
procedure SetColorTo(Color: TColor);
procedure SetContrast(i: Byte);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure VistaGradient(const Canvas: TCanvas; const ARect: TRect; const c1, c2: Byte; const c3, c4: TColor; const Center: Boolean);
published
property Brightness: Byte read FBrightness write SetBrightness default 30;
property Center: Boolean read FCenter write SetCenter;
property Color: TColor read FColor write SetColor default $00614F00;
property ColorTo: TColor read FColorTo write SetColorTo default $001DD9FF;
property Contrast: Byte read FContrast write SetContrast default 63;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('Standard', [TVistaPanel]);
end;

constructor TVistaPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FBrightness:= 30;
FCenter:= False;
FColor:= $00614F00;
FColorTo:= $001DD9FF;
FContrast:= 63;
end;

procedure TVistaPanel.SetBrightness(i: Byte);
begin
FBrightness:= i;
Invalidate;
end;

procedure TVistaPanel.SetCenter(B: Boolean);
begin
FCenter:= B;
Invalidate;
end;

procedure TVistaPanel.SetColor(Color: TColor);
begin
FColor:= ColorToRGB(Color);
Invalidate;
end;

procedure TVistaPanel.SetColorTo(Color:TColor);
begin
FColorTo:= ColorToRGB(Color);
Invalidate;
end;

procedure TVistaPanel.SetContrast(i: Byte);
begin
FContrast:= i;
Invalidate;
end;

procedure TVistaPanel.VistaGradient(const Canvas: TCanvas; const ARect: TRect; const c1, c2: Byte; const c3, c4: TColor; const Center: Boolean);
type
PRGB = ^TRGB;
TRGB = record b, g, r : Byte; end;
PRGBArray = ^TRGBArray;
TRGBARRAY = array[0..0] of TRGB;
var
rc1, gc1, bc1, rc2, gc2, bc2, rc3, gc3, bc3: Integer;
x, y, w, h: Integer;
i, w1: Integer;
Row: PRGBArray;
C: TRGB;
slMain, slSize, slPtr: Integer;
Color: Integer;
QCol: Array of Byte;
g: Byte;
begin
try
VistaBMP.Create;

VistaBMP.Width := (ARect.Right - ARect.Left) - 1;
VistaBMP.Height := (ARect.Bottom - ARect.Top) - 1;
h:= VistaBMP.Height;
w:= VistaBMP.Width;
Color:= ColorToRGB(c3);
rc1 := Byte(Color);
gc1 := Byte(Color shr 8);
bc1 := Byte(Color shr 16);
Color:= ColorToRGB(c4);
rc2 := Byte(Color);
gc2 := Byte(Color shr 8);
bc2 := Byte(Color shr 16);
SetLength(QCol, h);
gc3 := c1 + (((c2 - c1) * 15) div 9);
if gc3 < 0 then gc3 := 0 else if gc3 > 255 then gc3 := 255;
y:= h div 2;
for i := 0 to h - 1 do // Calc profile
if i < y then QCol:= Byte(c1 + (((c2 - c1) * (i)) div y))
else QCol:= Byte(gc3 + (((c2 - gc3) * (i)) div h));
w1:= w - 1;
if Center then w:= (w shr 1) + (w and 1);
slMain:= Integer(VistaBMP.ScanLine[0]); // Init scanline accsess
slSize:= Integer(VistaBMP.ScanLine[1]) - slMain;
for x:= 0 to w - 1 do begin // Paint gradient
C.b:= Byte(bc1 + (((bc2 - bc1) * x) div w));
C.g:= Byte(gc1 + (((gc2 - gc1) * x) div w));
C.r:= Byte(rc1 + (((rc2 - rc1) * x) div w));
slPtr:= slMain;
for y := 0 to h - 1 do begin
Row := PRGBArray(slPtr);
g:= QCol[y];
Row[x].r:= (C.r - g) shr 1 + g;
Row[x].g:= (C.g - g) shr 1 + g;
Row[x].b:= (C.b - g) shr 1 + g;
if (Center) and (x < (w1 - x)) then begin
Row[w1 - x].r:= (C.r - g) shr 1 + g;
Row[w1 - x].g:= (C.g - g) shr 1 + g;
Row[w1 - x].b:= (C.b - g) shr 1 + g;
end;
slPtr:= slPtr + slSize;
end;
end;
QCol:= nil;
Canvas.Draw(ARect.Left, Arect.Top, VistaBMP);
finally
VistaBMP.Free;
end;
end;

procedure TVistaPanel.Paint;
var
cv, cb, c1, c2: Byte;
r: TRect;
begin
r:= Rect(0,0, ClientWidth, ClientHeight);
VistaGradient(Canvas, r, Contrast , Brightness, Color, ColorTo, Center);
Canvas.Pen.Color:= $00C8BA90;
Canvas.Brush.Style:= bsClear;
Canvas.Rectangle(r);
end;

end.
Click to expand...


Cheers ;)
 
Hi toon_mad

I have just run the code and the access violation is where you are creating the VistaBMP.
Its because you are not creating it correctly.

It should be:

VistaBMP := TBitmap.Create;

Not

VistaBMP.Create;

After I changed that the access violation stopped.

The output is a white square with an darker outline, not a gradient?

add this after creating the VistaBMP:

VistaBMP.PixelFormat := pf24bit;

this sorts the gradient out.

FredFlint.
 
Last edited:
its always the simple things that catch you out, well it was a good attempt at my first biggish component.

thanks for the help mate, much appreciated ;)
 
You must log in or register to reply here.
Back
Top Bottom