Error with Inno Setup!

ko-kylling · Post by **ko-kylling** » Wed Dec 14, 2005 5:50 pm

Hi folks...

I have a problem. I will compile Inno Setup (source files),
but Delphi says that I need somethnig in the MadIWSupport:

IWAppForm, IWCompLabel, IWCompButton, IWCompMemo

What is it?

Take a look at this picture and maybe you have the answer!
http://www.iosoftgame.frac.dk/source_errror.bmp

From ko-kylling

Post by **madshi** » Wed Dec 14, 2005 6:04 pm

Hmmmm... Can you please list the uses clause of your project file (*.dpr)?

madExcept seems to believe that you're compiling an IntraWeb application.

ko-kylling · Post by **ko-kylling** » Wed Dec 14, 2005 6:19 pm

My madIWSupport.pas is:

// ***************************************************************
// madIWSupport.pas version: 1.0b · date: 2005-06-04
// -------------------------------------------------------------
// exception trapping support for IntraWeb 5 - 7
// -------------------------------------------------------------
// Copyright (C) 1999 - 2005 www.madshi.net, All Rights Reserved
// ***************************************************************

// 2005-06-04 1.0b (1) necessary changes for madExcept 3.0
// (2) bug report is only transported to client when needed
// (3) IW 7.2.33 has changed parameters of some internal methods
// 2004-05-19 1.0a (1) "HandleException" parameters changed
// (2) ServerController removed from uses clause
// 2004-03-08 1.0 initial version

unit madIWSupport;

{$I mad.inc}

interface

uses IWAppForm, IWCompLabel, IWCompButton, IWCompMemo;

// ***************************************************************

type
TIWExceptForm = class(TIWAppForm)
MsgLabel : TIWLabel;
ContinueBtn : TIWButton;
ShowBtn : TIWButton;
BugReportMemo : TIWMemo;
procedure ContinueBtnClick(Sender: TObject);
procedure ShowBtnClick(Sender: TObject);
private
BugRepText : string;
end;

// ***************************************************************

implementation

{$R *.dfm}

uses Windows, SysUtils, Graphics, TypInfo, IWServerControllerBase,
IWApplication, madExcept, madDisAsm, madStrings;

// ***************************************************************

procedure TIWExceptForm.ContinueBtnClick(Sender: TObject);
begin
Release;
end;

procedure TIWExceptForm.ShowBtnClick(Sender: TObject);
begin
ShowBtn.Visible := false;
BugReportMemo.Lines.Text := BugRepText;
BugReportMemo.Visible := true;
end;

procedure ShowExceptionForm(application: TIWApplication; exceptMsg, bugReport: string; settings: IMESettings);
var form_ : TIWExceptForm;
p1 : TSize;
bmp : TBitmap;
s1 : string;
i1 : integer;
begin
form_ := TIWExceptForm.Create(application);
with form_ do begin
with MsgLabel do begin
s1 := settings.ExceptMsg;
ExpandVars(settings.Module, s1, exceptMsg, bugReport);
Caption := s1;
AutoSize := true;
end;
bmp := TBitmap.Create;
bmp.Canvas.Font.Name := 'MS Sans Serif';
bmp.Canvas.Font.Size := 10;
with ContinueBtn do begin
Caption := settings.ContinueBtnCaption;
p1 := bmp.Canvas.TextExtent(Caption);
SetBounds(Left, MsgLabel.Top + MsgLabel.Height + 16, p1.cx + 28, p1.cy + 10);
end;
with ShowBtn do begin
Caption := settings.ShowBtnCaption;
p1 := bmp.Canvas.TextExtent(Caption);
SetBounds(ContinueBtn.Left + ContinueBtn.Width + 14, ContinueBtn.Top, p1.cx + 28, ContinueBtn.Height);
Visible := (not settings.AutoShowBugReport) and settings.ShowBtnVisible;
end;
bmp.Free;
if settings.ShowBtnVisible or settings.AutoShowBugReport then
with BugReportMemo do begin
i1 := ContinueBtn.Top + ContinueBtn.Height + 16 - Top;
Top := Top + i1;
Height := Height - i1;
if settings.AutoShowBugReport then
Lines.Text := bugReport
else BugRepText := bugReport;
Visible := settings.AutoShowBugReport;
if GetPropInfo(BugReportMemo, 'ReadOnly') <> nil then
SetEnumProp(BugReportMemo, 'ReadOnly', 'true')
else
Editable := false;
end;
Show;
end;
end;

function TIWServerControllerBaseDoExceptionCallbackOld(Self: TIWServerControllerBase; AApplication: TIWApplication; AException: Exception) : boolean;
var exceptMsg, bugReport : string;
begin
bugReport := '';
if AException <> nil then
exceptMsg := AException.Message
else exceptMsg := 'Unknown.';
HandleException(etNormal, AException, nil, true, Esp, Ebp, nil, esIntraweb, AApplication, 0, @bugReport);
if bugReport <> '' then
ShowExceptionForm(AApplication, exceptMsg, bugReport, MESettings);
result := true;
end;

function TIWServerControllerBaseDoExceptionCallbackNew(Self: TIWServerControllerBase; AApplication: TIWApplication; AException: Exception; var handled: boolean) : boolean;
var exceptMsg, bugReport : string;
begin
bugReport := '';
if AException <> nil then
exceptMsg := AException.Message
else exceptMsg := 'Unknown.';
HandleException(etNormal, AException, nil, true, Esp, Ebp, nil, esIntraweb, AApplication, 0, @bugReport);
if bugReport <> '' then
ShowExceptionForm(AApplication, exceptMsg, bugReport, MESettings);
result := true;
handled := true;
end;

// ***************************************************************

procedure Init;
var fi : TFunctionInfo;
begin
fi := ParseFunction(@TIWServerControllerBase.DoException);
if fi.IsValid then
if dword(pointer(dword(fi.CodeBegin) + dword(fi.CodeLen) - 4)^) and $ffffff00 = $0004c200 then begin
// IntraWeb 7.2.33
PatchJmp(fi.EntryPoint, @TIWServerControllerBaseDoExceptionCallbackNew);
end else
if byte(pointer(dword(fi.CodeBegin) + dword(fi.CodeLen) - 1)^) = $c3 then
// older IntraWeb versions
PatchJmp(fi.EntryPoint, @TIWServerControllerBaseDoExceptionCallbackOld);
end;

initialization
AmHttpServer := true;
Init;
end.

I hope it helps

Post by **madshi** » Wed Dec 14, 2005 6:27 pm

I know that unit, it's mine.

What I wanted to know is the uses clause of your project file (*.dpr).

ko-kylling · Post by **ko-kylling** » Wed Dec 14, 2005 6:31 pm

I'm sorry! But the message comes when I try to add a componet with this code:

unit NewTabSet;

{
Inno Setup
Copyright (C) 1997-2004 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.

TNewTabSet - modern VS.NET-style tabs

$jrsoftware: issrc/Components/NewTabSet.pas,v 1.2 2004/12/17 03:43:54 jr Exp $
}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

type
TNewTabSet = class(TCustomControl)
private
FTabs: TStrings;
FTabIndex: Integer;
function GetTabRect(Index: Integer): TRect;
procedure InvalidateTab(Index: Integer);
procedure ListChanged(Sender: TObject);
procedure SetTabs(Value: TStrings);
procedure SetTabIndex(Value: Integer);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Font;
property ParentFont;
property TabIndex: Integer read FTabIndex write SetTabIndex;
property Tabs: TStrings read FTabs write SetTabs;
property OnClick;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('JR', [TNewTabSet]);
end;

{
The RGBToHSV and HSVToRGB functions below are based on code from
http://www.efg2.com/Lab/Graphics/Colors/HSV.htm
which, in turn, was:
Based on C Code in "Computer Graphics -- Principles and Practice,"
Foley et al, 1996, p. 592.
}

procedure RGBToHSV(const R, G, B: Integer; var H, S: Double; var V: Integer);
var
Min, Delta: Integer;
begin
Min := R;
if G < Min then Min := G;
if B < Min then Min := B;
V := R;
if G > V then V := G;
if B > V then V := B;

Delta := V - Min;

// Calculate saturation: saturation is 0 if r, g and b are all 0
if V = 0 then
S := 0
else
S := Delta / V;

if S = 0.0 then
H := 0 // Achromatic: When s = 0, h is undefined
else begin // Chromatic
if R = V then // between yellow and magenta [degrees]
H := 60.0 * (G - B) / Delta
else if G = V then // between cyan and yellow
H := 120.0 + 60.0 * (B - R) / Delta
else if B = V then // between magenta and cyan
H := 240.0 + 60.0 * (R - G) / Delta;
if H < 0.0 then
H := H + 360.0;
end;
end;

procedure HSVtoRGB(const H, S: Double; const V: Integer; var R, G, B: Integer);
var
f: Double;
i: Integer;
hTemp: Double;
p, q, t: Integer;
begin
if S = 0.0 then begin // color is on black-and-white center line
R := V; // achromatic: shades of gray
G := V;
B := V;
end
else begin // chromatic color
if H = 360.0 then // 360 degrees same as 0 degrees
hTemp := 0.0
else
hTemp := H;

hTemp := hTemp / 60; // h is now IN [0,6)
i := Trunc(hTemp); // largest integer <= h
f := hTemp - i; // fractional part of h

p := Trunc(V * (1.0 - S));
q := Trunc(V * (1.0 - (S * f)));
t := Trunc(V * (1.0 - (S * (1.0 - f))));

case i of
0: begin R := V; G := t; B := p; end;
1: begin R := q; G := V; B := p; end;
2: begin R := p; G := V; B := t; end;
3: begin R := p; G := q; B := V; end;
4: begin R := t; G := p; B := V; end;
5: begin R := V; G := p; B := q; end;
else
{ Should never get here }
R := 0;
G := 0;
B := 0;
end;
end;
end;

function LightenColor(const Color: TColorRef; const Amount: Integer): TColorRef;
var
H, S: Double;
V, R, G, B: Integer;
begin
RGBtoHSV(Byte(Color), Byte(Color shr 8), Byte(Color shr 16), H, S, V);
Inc(V, Amount);
if V > 255 then
V := 255;
if V < 0 then
V := 0;
HSVtoRGB(H, S, V, R, G, B);
Result := R or (G shl 8) or (B shl 16);
end;

{ TNewTabSet }

const
TabPaddingX = 5;
TabPaddingY = 3;
TabSpacing = 1;

constructor TNewTabSet.Create(AOwner: TComponent);
begin
inherited;
FTabs := TStringList.Create;
TStringList(FTabs).OnChange := ListChanged;
ControlStyle := ControlStyle + [csOpaque];
Width := 129;
Height := 20;
end;

procedure TNewTabSet.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params.WindowClass do
style := style and not (CS_HREDRAW or CS_VREDRAW);
end;

destructor TNewTabSet.Destroy;
begin
FTabs.Free;
inherited;
end;

function TNewTabSet.GetTabRect(Index: Integer): TRect;
var
I: Integer;
Size: TSize;
begin
Canvas.Font.Assign(Font);
Result.Right := 4;
for I := 0 to FTabs.Count-1 do begin
Size := Canvas.TextExtent(FTabs);
Result := Bounds(Result.Right, 0, Size.cx + (TabPaddingX * 2) + TabSpacing,
Size.cy + (TabPaddingY * 2));
if Index = I then
Exit;
end;
SetRectEmpty(Result);
end;

procedure TNewTabSet.InvalidateTab(Index: Integer);
var
R: TRect;
begin
if HandleAllocated and (Index >= 0) and (Index < FTabs.Count) then begin
R := GetTabRect(Index);
{ Inc R.Right since the trailing separator of a tab overwrites the first
pixel of the next tab }
Inc(R.Right);
InvalidateRect(Handle, @R, False);
end;
end;

procedure TNewTabSet.ListChanged(Sender: TObject);
begin
Invalidate;
end;

procedure TNewTabSet.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
I: Integer;
R: TRect;
begin
if Button = mbLeft then begin
for I := 0 to FTabs.Count-1 do begin
R := GetTabRect(I);
if (X >= R.Left) and (X < R.Right) then begin
TabIndex := I;
Break;
end;
end;
end;
end;

procedure TNewTabSet.Paint;
var
HighColorMode: Boolean;

procedure DrawTabs(const SelectedTab: Boolean);
var
I: Integer;
R: TRect;
begin
for I := 0 to FTabs.Count-1 do begin
R := GetTabRect(I);
if SelectedTab and (FTabIndex = I) then begin
Dec(R.Right, TabSpacing);
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(R);
Canvas.Pen.Color := clBtnHighlight;
Canvas.MoveTo(R.Left, R.Top);
Canvas.LineTo(R.Left, R.Bottom-1);
Canvas.Pen.Color := clBtnText;
Canvas.LineTo(R.Right-1, R.Bottom-1);
Canvas.LineTo(R.Right-1, R.Top-1);
Canvas.Font.Color := clBtnText;
Canvas.TextOut(R.Left + TabPaddingX, R.Top + TabPaddingY, FTabs);
ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
Break;
end;
if not SelectedTab and (FTabIndex <> I) then begin
if HighColorMode and (ColorToRGB(clBtnFace) <> clBlack) then
Canvas.Font.Color := LightenColor(ColorToRGB(clBtnShadow), -43)
else begin
{ Like VS.NET, if the button face color is black, or if running in
low color mode, use plain clBtnHighlight as the text color }
Canvas.Font.Color := clBtnHighlight;
end;
Canvas.TextOut(R.Left + TabPaddingX, R.Top + TabPaddingY, FTabs);
if HighColorMode then
Canvas.Pen.Color := clBtnShadow
else
Canvas.Pen.Color := clBtnFace;
Canvas.MoveTo(R.Right, R.Top+3);
Canvas.LineTo(R.Right, R.Bottom-2);
end;
end;
end;

var
CR: TRect;
begin
Canvas.Font.Assign(Font);

HighColorMode := (GetDeviceCaps(Canvas.Handle, BITSPIXEL) *
GetDeviceCaps(Canvas.Handle, PLANES)) >= 15;

CR := ClientRect;

{ Work around an apparent NT 4.0/2000/??? bug. If the width of the DC is
greater than the width of the screen, then any call to ExcludeClipRect
inexplicably shrinks the DC's clipping rectangle to the screen width.
Calling IntersectClipRect first with the entire client area as the
rectangle solves this (don't ask me why). }
IntersectClipRect(Canvas.Handle, CR.Left, CR.Top, CR.Right, CR.Bottom);

{ Selected tab }
DrawTabs(True);

{ Top line }
Canvas.Pen.Color := clBtnText;
Canvas.MoveTo(0, 0);
Canvas.LineTo(CR.Right, 0);

{ Background fill }
if HighColorMode then
Canvas.Brush.Color := LightenColor(ColorToRGB(clBtnFace), 35)
else
Canvas.Brush.Color := clBtnShadow;
Inc(CR.Top);
Canvas.FillRect(CR);

{ Non-selected tabs }
DrawTabs(False);
end;

procedure TNewTabSet.SetTabIndex(Value: Integer);
begin
if FTabIndex <> Value then begin
InvalidateTab(FTabIndex);
FTabIndex := Value;
InvalidateTab(Value);
Click;
end;
end;

procedure TNewTabSet.SetTabs(Value: TStrings);
begin
FTabs.Assign(Value);
end;

end.

ko-kylling · Post by **ko-kylling** » Wed Dec 14, 2005 6:48 pm

If this don't helps, then try to download Inno Setup source here:

www.innosetup.com

From ko-kylling

Post by **madshi** » Wed Dec 14, 2005 6:55 pm

It seems that you don't understand me.

Look, every Delphi project has a project file (e.g. "Project1.dpr") and one or more units (e.g. "Unit1.pas"). Some units might have forms (e.g. "Unit.dfm"). Each unit can have one or two uses clauses (in the interface or implementation part under the name "uses"). The project file also has a uses clause. Now what I want to know is how your project's uses clause looks like. So please open up your project file (e.g. "Project1.dpr") and search for "uses" and post here which units are listed there.

Understood now?

ko-kylling · Post by **ko-kylling** » Wed Dec 14, 2005 7:04 pm

the file Compil32.dpr it look like this:

uses
XPTheme,
Windows,
SysUtils,
Forms,
PathFunc,
CompForm in 'CompForm.pas' {CompileForm},
CmnFunc in 'CmnFunc.pas',
CmnFunc2 in 'CmnFunc2.pas',
CompMsgs in 'CompMsgs.pas',
CompInt in 'CompInt.pas',
CompOptions in 'CompOptions.pas' {OptionsForm},
CompStartup in 'CompStartup.pas' {StartupForm},
CompWizard in 'CompWizard.pas' {WizardForm},
CompWizardFile in 'CompWizardFile.pas' {WizardFileForm},
CompFileAssoc in 'CompFileAssoc.pas',
TmSchemaISX in '..\Components\TmSchemaISX.pas',
UxThemeISX in '..\Components\UxThemeISX.pas',
DebugStruct in 'DebugStruct.pas',
BrowseFunc in 'BrowseFunc.pas';

Post by **madshi** » Wed Dec 14, 2005 7:26 pm

Looks alright to me.

Could you please search through your whole project to find out where "madIWSupport" is listed? In your specific project the file "madIWSupport" is *not* needed. The big error here is that somehow Delphi thinks it has to compile this file. It shouldn't! You don't need this file!

You didn't open it manually and you also didn't manually add it to any of your uses clauses, or did you?

ko-kylling · Post by **ko-kylling** » Thu Dec 15, 2005 1:06 pm

Hi madshi...

The error (look at the picture) comes when I try to install a componet called NewTabSet.pas and it look like this:

unit NewTabSet;

{
Inno Setup
Copyright (C) 1997-2004 Jordan Russell
Portions by Martijn Laan
For conditions of distribution and use, see LICENSE.TXT.

TNewTabSet - modern VS.NET-style tabs

$jrsoftware: issrc/Components/NewTabSet.pas,v 1.2 2004/12/17 03:43:54 jr Exp $
}

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms;

type
TNewTabSet = class(TCustomControl)
private
FTabs: TStrings;
FTabIndex: Integer;
function GetTabRect(Index: Integer): TRect;
procedure InvalidateTab(Index: Integer);
procedure ListChanged(Sender: TObject);
procedure SetTabs(Value: TStrings);
procedure SetTabIndex(Value: Integer);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Align;
property Font;
property ParentFont;
property TabIndex: Integer read FTabIndex write SetTabIndex;
property Tabs: TStrings read FTabs write SetTabs;
property OnClick;
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('JR', [TNewTabSet]);
end;

{
The RGBToHSV and HSVToRGB functions below are based on code from
http://www.efg2.com/Lab/Graphics/Colors/HSV.htm
which, in turn, was:
Based on C Code in "Computer Graphics -- Principles and Practice,"
Foley et al, 1996, p. 592.
}

procedure RGBToHSV(const R, G, B: Integer; var H, S: Double; var V: Integer);
var
Min, Delta: Integer;
begin
Min := R;
if G < Min then Min := G;
if B < Min then Min := B;
V := R;
if G > V then V := G;
if B > V then V := B;

Delta := V - Min;

// Calculate saturation: saturation is 0 if r, g and b are all 0
if V = 0 then
S := 0
else
S := Delta / V;

if S = 0.0 then
H := 0 // Achromatic: When s = 0, h is undefined
else begin // Chromatic
if R = V then // between yellow and magenta [degrees]
H := 60.0 * (G - B) / Delta
else if G = V then // between cyan and yellow
H := 120.0 + 60.0 * (B - R) / Delta
else if B = V then // between magenta and cyan
H := 240.0 + 60.0 * (R - G) / Delta;
if H < 0.0 then
H := H + 360.0;
end;
end;

procedure HSVtoRGB(const H, S: Double; const V: Integer; var R, G, B: Integer);
var
f: Double;
i: Integer;
hTemp: Double;
p, q, t: Integer;
begin
if S = 0.0 then begin // color is on black-and-white center line
R := V; // achromatic: shades of gray
G := V;
B := V;
end
else begin // chromatic color
if H = 360.0 then // 360 degrees same as 0 degrees
hTemp := 0.0
else
hTemp := H;

hTemp := hTemp / 60; // h is now IN [0,6)
i := Trunc(hTemp); // largest integer <= h
f := hTemp - i; // fractional part of h

p := Trunc(V * (1.0 - S));
q := Trunc(V * (1.0 - (S * f)));
t := Trunc(V * (1.0 - (S * (1.0 - f))));

case i of
0: begin R := V; G := t; B := p; end;
1: begin R := q; G := V; B := p; end;
2: begin R := p; G := V; B := t; end;
3: begin R := p; G := q; B := V; end;
4: begin R := t; G := p; B := V; end;
5: begin R := V; G := p; B := q; end;
else
{ Should never get here }
R := 0;
G := 0;
B := 0;
end;
end;
end;

function LightenColor(const Color: TColorRef; const Amount: Integer): TColorRef;
var
H, S: Double;
V, R, G, B: Integer;
begin
RGBtoHSV(Byte(Color), Byte(Color shr 8), Byte(Color shr 16), H, S, V);
Inc(V, Amount);
if V > 255 then
V := 255;
if V < 0 then
V := 0;
HSVtoRGB(H, S, V, R, G, B);
Result := R or (G shl 8) or (B shl 16);
end;

{ TNewTabSet }

const
TabPaddingX = 5;
TabPaddingY = 3;
TabSpacing = 1;

constructor TNewTabSet.Create(AOwner: TComponent);
begin
inherited;
FTabs := TStringList.Create;
TStringList(FTabs).OnChange := ListChanged;
ControlStyle := ControlStyle + [csOpaque];
Width := 129;
Height := 20;
end;

procedure TNewTabSet.CreateParams(var Params: TCreateParams);
begin
inherited;
with Params.WindowClass do
style := style and not (CS_HREDRAW or CS_VREDRAW);
end;

destructor TNewTabSet.Destroy;
begin
FTabs.Free;
inherited;
end;

function TNewTabSet.GetTabRect(Index: Integer): TRect;
var
I: Integer;
Size: TSize;
begin
Canvas.Font.Assign(Font);
Result.Right := 4;
for I := 0 to FTabs.Count-1 do begin
Size := Canvas.TextExtent(FTabs);
Result := Bounds(Result.Right, 0, Size.cx + (TabPaddingX * 2) + TabSpacing,
Size.cy + (TabPaddingY * 2));
if Index = I then
Exit;
end;
SetRectEmpty(Result);
end;

procedure TNewTabSet.InvalidateTab(Index: Integer);
var
R: TRect;
begin
if HandleAllocated and (Index >= 0) and (Index < FTabs.Count) then begin
R := GetTabRect(Index);
{ Inc R.Right since the trailing separator of a tab overwrites the first
pixel of the next tab }
Inc(R.Right);
InvalidateRect(Handle, @R, False);
end;
end;

procedure TNewTabSet.ListChanged(Sender: TObject);
begin
Invalidate;
end;

procedure TNewTabSet.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
I: Integer;
R: TRect;
begin
if Button = mbLeft then begin
for I := 0 to FTabs.Count-1 do begin
R := GetTabRect(I);
if (X >= R.Left) and (X < R.Right) then begin
TabIndex := I;
Break;
end;
end;
end;
end;

procedure TNewTabSet.Paint;
var
HighColorMode: Boolean;

procedure DrawTabs(const SelectedTab: Boolean);
var
I: Integer;
R: TRect;
begin
for I := 0 to FTabs.Count-1 do begin
R := GetTabRect(I);
if SelectedTab and (FTabIndex = I) then begin
Dec(R.Right, TabSpacing);
Canvas.Brush.Color := clBtnFace;
Canvas.FillRect(R);
Canvas.Pen.Color := clBtnHighlight;
Canvas.MoveTo(R.Left, R.Top);
Canvas.LineTo(R.Left, R.Bottom-1);
Canvas.Pen.Color := clBtnText;
Canvas.LineTo(R.Right-1, R.Bottom-1);
Canvas.LineTo(R.Right-1, R.Top-1);
Canvas.Font.Color := clBtnText;
Canvas.TextOut(R.Left + TabPaddingX, R.Top + TabPaddingY, FTabs);
ExcludeClipRect(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
Break;
end;
if not SelectedTab and (FTabIndex <> I) then begin
if HighColorMode and (ColorToRGB(clBtnFace) <> clBlack) then
Canvas.Font.Color := LightenColor(ColorToRGB(clBtnShadow), -43)
else begin
{ Like VS.NET, if the button face color is black, or if running in
low color mode, use plain clBtnHighlight as the text color }
Canvas.Font.Color := clBtnHighlight;
end;
Canvas.TextOut(R.Left + TabPaddingX, R.Top + TabPaddingY, FTabs);
if HighColorMode then
Canvas.Pen.Color := clBtnShadow
else
Canvas.Pen.Color := clBtnFace;
Canvas.MoveTo(R.Right, R.Top+3);
Canvas.LineTo(R.Right, R.Bottom-2);
end;
end;
end;

var
CR: TRect;
begin
Canvas.Font.Assign(Font);

HighColorMode := (GetDeviceCaps(Canvas.Handle, BITSPIXEL) *
GetDeviceCaps(Canvas.Handle, PLANES)) >= 15;

CR := ClientRect;

{ Work around an apparent NT 4.0/2000/??? bug. If the width of the DC is
greater than the width of the screen, then any call to ExcludeClipRect
inexplicably shrinks the DC's clipping rectangle to the screen width.
Calling IntersectClipRect first with the entire client area as the
rectangle solves this (don't ask me why). }
IntersectClipRect(Canvas.Handle, CR.Left, CR.Top, CR.Right, CR.Bottom);

{ Selected tab }
DrawTabs(True);

{ Top line }
Canvas.Pen.Color := clBtnText;
Canvas.MoveTo(0, 0);
Canvas.LineTo(CR.Right, 0);

{ Background fill }
if HighColorMode then
Canvas.Brush.Color := LightenColor(ColorToRGB(clBtnFace), 35)
else
Canvas.Brush.Color := clBtnShadow;
Inc(CR.Top);
Canvas.FillRect(CR);

{ Non-selected tabs }
DrawTabs(False);
end;

procedure TNewTabSet.SetTabIndex(Value: Integer);
begin
if FTabIndex <> Value then begin
InvalidateTab(FTabIndex);
FTabIndex := Value;
InvalidateTab(Value);
Click;
end;
end;

procedure TNewTabSet.SetTabs(Value: TStrings);
begin
FTabs.Assign(Value);
end;

end.

So I can't see why you need my .dpr file !

I hope it will help you!

If it doesn't then write your mail adress and I will send my files or you can download them here:
http://www.jrsoftware.org/download.php/issrc.zip

Post by **madshi** » Thu Dec 15, 2005 1:24 pm

How can I reproduce the problem? I've downloaded those files, created an empty application and then added that NewTabSet unit to the project. Nothing bad happened here...

ko-kylling · Post by **ko-kylling** » Thu Dec 15, 2005 7:51 pm

hi madshi...

I have tryed on an other pc and it worked, so there are somthing wrong with my pc... But thanks anyways