La TImage ne s'affiche pas dans le Tpanel à l'exécution
Résolu
louiwahl
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019
-
10 avril 2007 à 01:04
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019 - 11 avril 2007 à 02:58
louiwahl Messages postés 103 Date d'inscription vendredi 20 février 2004 Statut Membre Dernière intervention 16 mai 2019 - 11 avril 2007 à 02:58
A voir également:
- La TImage ne s'affiche pas dans le Tpanel à l'exécution
- Erreur d'exécution 424 ✓ - Forum Visual Basic
- Erreur 424 "Objet requis" ✓ - Forum Visual Basic 6
- Message d'erreur 424: objet requis ✓ - Forum VBA Office (Excel, Word ...)
- Erreur d'execution 9 ✓ - Forum Visual Basic 6
- "Url de la page, sur votre site, où est affiché le lien vers" ✓ - Forum PHP
5 réponses
f0xi
Messages postés
4205
Date d'inscription
samedi 16 octobre 2004
Statut
Modérateur
Dernière intervention
12 mars 2022
35
10 avril 2007 à 16:20
10 avril 2007 à 16:20
il ne faut pas inclure TImage mais TPicture :
uses JPeg, Consts;
type
TPanelCtrl = class(TPanel)
private
FPicture : TPicture;
FOnProgress : TProgressEvent;
FStretch : Boolean;
FCenter : Boolean;
FIncrementalDisplay: Boolean;
FTransparent : Boolean;
FDrawing : Boolean;
FProportional: Boolean;
function GetCanvas: TCanvas;
procedure PictureChanged(Sender: TObject);
procedure SetCenter(Value: Boolean);
procedure SetPicture(Value: TPicture);
procedure SetStretch(Value: Boolean);
procedure SetTransparent(Value: Boolean);
procedure SetProportional(Value: Boolean);
protected
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function DestRect: TRect;
function DoPaletteChange: Boolean;
function GetPalette: HPALETTE; override;
procedure Paint; override;
procedure Progress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas : TCanvas read GetCanvas;
published
property Center : Boolean read FCenter write SetCenter default False;
property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
property Picture : TPicture read FPicture write SetPicture;
property Proportional: Boolean read FProportional write SetProportional default False;
property Stretch : Boolean read FStretch write SetStretch default False;
property Transparent : Boolean read FTransparent write SetTransparent default False;
property OnProgress : TProgressEvent read FOnProgress write FOnProgress;
end;
constructor TPanelCtrl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := inherited ControlStyle + [csReplicatable];
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
FPicture.OnProgress := Progress;
Height := 105;
Width := 105;
end;
destructor TPanelCtrl.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
function TPanelCtrl.GetPalette: HPALETTE;
begin
Result := 0;
if FPicture.Graphic <> nil then
Result := FPicture.Graphic.Palette;
end;
function TPanelCtrl.DestRect: TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
w := Picture.Width;
h := Picture.Height;
cw := ClientWidth;
ch := ClientHeight;
if Stretch or (Proportional and ((w > cw) or (h > ch))) then
begin
if Proportional and (w > 0) and (h > 0) then
begin
xyaspect := w / h;
if w > h then
begin
w := cw;
h := Trunc(cw / xyaspect);
if h > ch then // woops, too big
begin
h := ch;
w := Trunc(ch * xyaspect);
end;
end
else
begin
h := ch;
w := Trunc(ch * xyaspect);
if w > cw then // woops, too big
begin
w := cw;
h := Trunc(cw / xyaspect);
end;
end;
end
else
begin
w := cw;
h := ch;
end;
end;
with Result do
begin
Left := 0;
Top := 0;
Right := w;
Bottom := h;
end;
if Center then
OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;
procedure TPanelCtrl.Paint;
var
Save: Boolean;
begin
inherited Paint;
if csDesigning in ComponentState then
with inherited Canvas do
begin
Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
Save := FDrawing;
FDrawing := True;
try
with inherited Canvas do
StretchDraw(DestRect, Picture.Graphic);
finally
FDrawing := Save;
end;
end;
function TPanelCtrl.DoPaletteChange: Boolean;
var
ParentForm: TCustomForm;
Tmp: TGraphic;
begin
Result := False;
Tmp := Picture.Graphic;
if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil) and (Tmp.PaletteModified) then
begin
if (Tmp.Palette = 0) then
Tmp.PaletteModified := False
else
begin
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
begin
if FDrawing then
ParentForm.Perform(wm_QueryNewPalette, 0, 0)
else
PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
Result := True;
Tmp.PaletteModified := False;
end;
end;
end;
end;
procedure TPanelCtrl.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
if FIncrementalDisplay and RedrawNow then
begin
if DoPaletteChange then
Update
else
Paint;
end;
if Assigned(FOnProgress) then
FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;
function TPanelCtrl.GetCanvas: TCanvas;
var
Bitmap: TBitmap;
begin
if Picture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
if Picture.Graphic is TBitmap then
Result := TBitmap(Picture.Graphic).Canvas
else
raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;
procedure TPanelCtrl.SetCenter(Value: Boolean);
begin
if FCenter <> Value then
begin
FCenter := Value;
PictureChanged(Self);
end;
end;
procedure TPanelCtrl.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;
procedure TPanelCtrl.SetStretch(Value: Boolean);
begin
if Value <> FStretch then
begin
FStretch := Value;
PictureChanged(Self);
end;
end;
procedure TPanelCtrl.SetTransparent(Value: Boolean);
begin
if Value <> FTransparent then
begin
FTransparent := Value;
PictureChanged(Self);
end;
end;
procedure TPanelCtrl.SetProportional(Value: Boolean);
begin
if FProportional <> Value then
begin
FProportional := Value;
PictureChanged(Self);
end;
end;
procedure TPanelCtrl.PictureChanged(Sender: TObject);
var
G: TGraphic;
D : TRect;
begin
if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
SetBounds(Left, Top, Picture.Width, Picture.Height);
G := Picture.Graphic;
if G <> nil then
begin
if not ((G is TMetaFile) or (G is TIcon)) then
G.Transparent := FTransparent;
D := DestRect;
if (not G.Transparent) and (D.Left <= 0) and (D.Top <= 0) and
(D.Right >= Width) and (D.Bottom >= Height) then
ControlStyle := ControlStyle + [csOpaque]
else
ControlStyle := ControlStyle - [csOpaque];
if DoPaletteChange and FDrawing then
Update;
end
else
ControlStyle := ControlStyle - [csOpaque];
if not FDrawing then
Invalidate;
end;
function TPanelCtrl.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if not (csDesigning in ComponentState) or (Picture.Width > 0) and (Picture.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := Picture.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := Picture.Height;
end;
end;
<hr size="2" width="100%" />Croc (click me)
uses JPeg, Consts;
type
TPanelCtrl = class(TPanel)
private
FPicture : TPicture;
FOnProgress : TProgressEvent;
FStretch : Boolean;
FCenter : Boolean;
FIncrementalDisplay: Boolean;
FTransparent : Boolean;
FDrawing : Boolean;
FProportional: Boolean;
function GetCanvas: TCanvas;
procedure PictureChanged(Sender: TObject);
procedure SetCenter(Value: Boolean);
procedure SetPicture(Value: TPicture);
procedure SetStretch(Value: Boolean);
procedure SetTransparent(Value: Boolean);
procedure SetProportional(Value: Boolean);
protected
function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
function DestRect: TRect;
function DoPaletteChange: Boolean;
function GetPalette: HPALETTE; override;
procedure Paint; override;
procedure Progress(Sender: TObject; Stage: TProgressStage; PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string); dynamic;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas : TCanvas read GetCanvas;
published
property Center : Boolean read FCenter write SetCenter default False;
property IncrementalDisplay: Boolean read FIncrementalDisplay write FIncrementalDisplay default False;
property Picture : TPicture read FPicture write SetPicture;
property Proportional: Boolean read FProportional write SetProportional default False;
property Stretch : Boolean read FStretch write SetStretch default False;
property Transparent : Boolean read FTransparent write SetTransparent default False;
property OnProgress : TProgressEvent read FOnProgress write FOnProgress;
end;
constructor TPanelCtrl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := inherited ControlStyle + [csReplicatable];
FPicture := TPicture.Create;
FPicture.OnChange := PictureChanged;
FPicture.OnProgress := Progress;
Height := 105;
Width := 105;
end;
destructor TPanelCtrl.Destroy;
begin
FPicture.Free;
inherited Destroy;
end;
function TPanelCtrl.GetPalette: HPALETTE;
begin
Result := 0;
if FPicture.Graphic <> nil then
Result := FPicture.Graphic.Palette;
end;
function TPanelCtrl.DestRect: TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
w := Picture.Width;
h := Picture.Height;
cw := ClientWidth;
ch := ClientHeight;
if Stretch or (Proportional and ((w > cw) or (h > ch))) then
begin
if Proportional and (w > 0) and (h > 0) then
begin
xyaspect := w / h;
if w > h then
begin
w := cw;
h := Trunc(cw / xyaspect);
if h > ch then // woops, too big
begin
h := ch;
w := Trunc(ch * xyaspect);
end;
end
else
begin
h := ch;
w := Trunc(ch * xyaspect);
if w > cw then // woops, too big
begin
w := cw;
h := Trunc(cw / xyaspect);
end;
end;
end
else
begin
w := cw;
h := ch;
end;
end;
with Result do
begin
Left := 0;
Top := 0;
Right := w;
Bottom := h;
end;
if Center then
OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;
procedure TPanelCtrl.Paint;
var
Save: Boolean;
begin
inherited Paint;
if csDesigning in ComponentState then
with inherited Canvas do
begin
Pen.Style := psDash;
Brush.Style := bsClear;
Rectangle(0, 0, Width, Height);
end;
Save := FDrawing;
FDrawing := True;
try
with inherited Canvas do
StretchDraw(DestRect, Picture.Graphic);
finally
FDrawing := Save;
end;
end;
function TPanelCtrl.DoPaletteChange: Boolean;
var
ParentForm: TCustomForm;
Tmp: TGraphic;
begin
Result := False;
Tmp := Picture.Graphic;
if Visible and (not (csLoading in ComponentState)) and (Tmp <> nil) and (Tmp.PaletteModified) then
begin
if (Tmp.Palette = 0) then
Tmp.PaletteModified := False
else
begin
ParentForm := GetParentForm(Self);
if Assigned(ParentForm) and ParentForm.Active and Parentform.HandleAllocated then
begin
if FDrawing then
ParentForm.Perform(wm_QueryNewPalette, 0, 0)
else
PostMessage(ParentForm.Handle, wm_QueryNewPalette, 0, 0);
Result := True;
Tmp.PaletteModified := False;
end;
end;
end;
end;
procedure TPanelCtrl.Progress(Sender: TObject; Stage: TProgressStage;
PercentDone: Byte; RedrawNow: Boolean; const R: TRect; const Msg: string);
begin
if FIncrementalDisplay and RedrawNow then
begin
if DoPaletteChange then
Update
else
Paint;
end;
if Assigned(FOnProgress) then
FOnProgress(Sender, Stage, PercentDone, RedrawNow, R, Msg);
end;
function TPanelCtrl.GetCanvas: TCanvas;
var
Bitmap: TBitmap;
begin
if Picture.Graphic = nil then
begin
Bitmap := TBitmap.Create;
try
Bitmap.Width := Width;
Bitmap.Height := Height;
Picture.Graphic := Bitmap;
finally
Bitmap.Free;
end;
end;
if Picture.Graphic is TBitmap then
Result := TBitmap(Picture.Graphic).Canvas
else
raise EInvalidOperation.Create(SImageCanvasNeedsBitmap);
end;
procedure TPanelCtrl.SetCenter(Value: Boolean);
begin
if FCenter <> Value then
begin
FCenter := Value;
PictureChanged(Self);
end;
end;
procedure TPanelCtrl.SetPicture(Value: TPicture);
begin
FPicture.Assign(Value);
end;
procedure TPanelCtrl.SetStretch(Value: Boolean);
begin
if Value <> FStretch then
begin
FStretch := Value;
PictureChanged(Self);
end;
end;
procedure TPanelCtrl.SetTransparent(Value: Boolean);
begin
if Value <> FTransparent then
begin
FTransparent := Value;
PictureChanged(Self);
end;
end;
procedure TPanelCtrl.SetProportional(Value: Boolean);
begin
if FProportional <> Value then
begin
FProportional := Value;
PictureChanged(Self);
end;
end;
procedure TPanelCtrl.PictureChanged(Sender: TObject);
var
G: TGraphic;
D : TRect;
begin
if AutoSize and (Picture.Width > 0) and (Picture.Height > 0) then
SetBounds(Left, Top, Picture.Width, Picture.Height);
G := Picture.Graphic;
if G <> nil then
begin
if not ((G is TMetaFile) or (G is TIcon)) then
G.Transparent := FTransparent;
D := DestRect;
if (not G.Transparent) and (D.Left <= 0) and (D.Top <= 0) and
(D.Right >= Width) and (D.Bottom >= Height) then
ControlStyle := ControlStyle + [csOpaque]
else
ControlStyle := ControlStyle - [csOpaque];
if DoPaletteChange and FDrawing then
Update;
end
else
ControlStyle := ControlStyle - [csOpaque];
if not FDrawing then
Invalidate;
end;
function TPanelCtrl.CanAutoSize(var NewWidth, NewHeight: Integer): Boolean;
begin
Result := True;
if not (csDesigning in ComponentState) or (Picture.Width > 0) and (Picture.Height > 0) then
begin
if Align in [alNone, alLeft, alRight] then
NewWidth := Picture.Width;
if Align in [alNone, alTop, alBottom] then
NewHeight := Picture.Height;
end;
end;
<hr size="2" width="100%" />Croc (click me)
japee
Messages postés
1727
Date d'inscription
vendredi 27 décembre 2002
Statut
Modérateur
Dernière intervention
6 novembre 2021
8
10 avril 2007 à 22:47
10 avril 2007 à 22:47
f0xi, c'est la classe.
Avec et sans jeu de mots.
Avec et sans jeu de mots.
jelume
Messages postés
120
Date d'inscription
mardi 3 avril 2007
Statut
Membre
Dernière intervention
15 novembre 2007
1
10 avril 2007 à 09:46
10 avril 2007 à 09:46
bjr,
tout d' abord, je remplacerais:
With FImgH do
begin
FImgH.Picture.Assign(value);
end;
par
Picture.Bitmap.Assign(value);
Ensuite, les lignes
with FImgH do
begin
FImgH.Parent := Self;
end;
sont inutiles puisque tu as déjà défini le parent dans le create.
pour finir (juste pour le fun), les parenthèses autour de Self sont inutiles:
with FImgH do
begin
Parent := (Self);
Sinon, je ne vois pas ce qui pourrais "clocher" dans ton code
tout d' abord, je remplacerais:
With FImgH do
begin
FImgH.Picture.Assign(value);
end;
par
Picture.Bitmap.Assign(value);
Ensuite, les lignes
with FImgH do
begin
FImgH.Parent := Self;
end;
sont inutiles puisque tu as déjà défini le parent dans le create.
pour finir (juste pour le fun), les parenthèses autour de Self sont inutiles:
with FImgH do
begin
Parent := (Self);
Sinon, je ne vois pas ce qui pourrais "clocher" dans ton code
cs_Loda
Messages postés
814
Date d'inscription
vendredi 3 novembre 2000
Statut
Membre
Dernière intervention
30 juillet 2009
3
10 avril 2007 à 12:00
10 avril 2007 à 12:00
salut,
dans la mesure ou ton autre post porte le même titre et que tu y dit "je n'arrive qu'a les cree je ne les vois pas dans le TPanel" je pensais qu'il s'agisait du même problème....
oui:
une question par topic
et
un topic par question
Loda
<hr size="2" width="100%" />Se poser les bonnes questions est le premier pas pour trouver les bonnes réponses.
dans la mesure ou ton autre post porte le même titre et que tu y dit "je n'arrive qu'a les cree je ne les vois pas dans le TPanel" je pensais qu'il s'agisait du même problème....
oui:
une question par topic
et
un topic par question
Loda
<hr size="2" width="100%" />Se poser les bonnes questions est le premier pas pour trouver les bonnes réponses.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
louiwahl
Messages postés
103
Date d'inscription
vendredi 20 février 2004
Statut
Membre
Dernière intervention
16 mai 2019
11 avril 2007 à 02:58
11 avril 2007 à 02:58
Un GRAND Merci merci a f0xi, comme dit japee C'est la grande classe.
Maintenant il faut que j'essaye de comprendre un peut quand meme.
Encore merci car a mon niveau je n'y serais jamais arriver.
A+
Louis
Maintenant il faut que j'essaye de comprendre un peut quand meme.
Encore merci car a mon niveau je n'y serais jamais arriver.
A+
Louis