|
Registriert seit: 26. Jul 2002 Ort: Sachsen 1.198 Beiträge Delphi XE5 Professional |
#11
Ok, da Du hier Mentortauglich zu sein scheinst, habe ich hier noch was kniffliges. Ich finde den Fehler einfach nicht. ich habe also noch eine Möglichkeit eingabut, um auch ein Bild anzeigen lassen zu können. Das Ganze ist mit dem Rahmen noch nicht abgestimmt und auch den Gradienten muss man nicht zeichnen, wenn man ein Bild drauf zeichnet, aber das Problem ist, dass mir mein Delphi direkt abschmiert, wenn ich ein Bild ausgesucht und im OI hinzufügt habe und er versucht die TGraphic mittels StretchDraw zu zeichnen. Ich poste mal wieder den gesamten Code. Deine Infos aus Deinem letzten Post sind noch nicht mit eingeflossen...Hier und da habe ich schon einiges gerade gezogen und ich bin begeistert, auch wenn es noch nicht ganz das ist, was ich will....Aber der Weg stimmt...
Delphi-Quellcode:
Der Fehler MUSS eigentlich hier liegen:
unit myPanel;
interface uses Windows, Messages, SysUtils, Classes, Controls, Graphics; type TbdStyle = (bdNone, bdSolid, bdDashed, bdClear, bdDotted); TGradientOrientation = (goVertical, goHorizontal); type TPixelRec = packed record case Boolean of true: (Color: TColor); false: (r, g, b, Reserved: Byte); end; type TmyPanel = class(TCustomControl) private FBgColorFrom : TColor; FBgColorTo : TColor; FPaintGradient : Boolean; FGradientDirection : TGradientOrientation; FBorderColor:TColor; FBorderStyle:TPenStyle; FBorderWidth:integer; FRoundEdges:boolean; FCornerWidth:integer; FText:String; FTextAlign:Cardinal; FPicture:TGraphic; procedure SetBgColorFrom(Value : TColor); procedure SetBgColorTo(Value : TColor); procedure SetGradientStatus(Value: Boolean); procedure SetBorderWidth(Value: integer); procedure SetBorderColor(Value : TColor); procedure SetPicture(Pic : TGraphic); procedure SetText(Content : String); procedure SetTextAlign(Alignment : Cardinal); procedure SetGradientDirection(Direction:TGradientOrientation); { Private-Deklarationen } protected { Protected-Deklarationen } procedure Paint; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; { Public-Deklarationen } published //property Align : TAlign read FAlign write FAlign; property Align; property BgColorFrom : TColor read FBgColorFrom write SetBgColorFrom; property BgColorTo : TColor read FBgColorTo write SetBgColorTo; property PaintGradient : boolean read FPaintGradient write SetGradientStatus; property GradientDirection : TGradientOrientation read FGradientDirection write SetGradientDirection; property BorderColor : TColor read FBorderColor write SetBorderColor; property BorderStyle : TPenStyle read FBorderStyle write FBorderStyle; property BorderWidth : integer read FBorderWidth write SetBorderWidth; property RoundEdges : boolean read FRoundEdges write FRoundEdges; property CornerWidth : integer read FCornerWidth write FCornerWidth; property Picture : TGraphic read FPicture write SetPicture; property Text : String read FText write SetText; property TextAlign : Cardinal read FTextAlign write SetTextAlign; { Published-Deklarationen } end; procedure Register; implementation procedure Register; begin RegisterComponents('Standard', [TmyPanel]); end; constructor TmyPanel.Create(AOwner: TComponent); begin inherited Create(AOwner); Align := alNone; BgColorFrom := clWhite; BgColorTo := clSilver; BorderColor := clGray; BorderStyle := psSolid; BorderWidth := 2; end; destructor TmyPanel.Destroy; begin inherited; end; procedure TmyPanel.SetPicture(Pic : TGraphic); begin If Pic = FPicture then Exit; // wenn gleicher Status nichts tun FPicture := Pic; // Status abspeichern Invalidate; // Control neu zeichnen end; procedure TmyPanel.SetGradientStatus(Value:Boolean); begin If Value = FPaintGradient then Exit; // wenn gleicher Status nichts tun FPaintGradient := Value; // Status abspeichern Invalidate; // Control neu zeichnen end; procedure TmyPanel.SetGradientDirection(Direction:TGradientOrientation); begin If Direction = FGradientDirection then Exit; // wenn gleicher Status nichts tun FGradientDirection := Direction; // Status abspeichern Invalidate; // Control neu zeichnen end; procedure TmyPanel.SetBorderWidth(Value:integer); begin If Value = FBorderWidth then Exit; // wenn gleicher Status nichts tun FBorderWidth := Value; // Status abspeichern Invalidate; // Control neu zeichnen end; procedure TmyPanel.SetBorderColor(Value : TColor); // Settermethode begin If Value = FBorderColor then Exit; // wenn gleiche Farbe nichts tun FBorderColor := Value; // Farbe abspeichern Invalidate; // Control neu zeichnen end; procedure TmyPanel.SetBgColorFrom(Value : TColor); // Settermethode begin If Value = FBgColorFrom then Exit; // wenn gleiche Farbe nichts tun FBgColorFrom := Value; // Farbe abspeichern Invalidate; // Control neu zeichnen end; procedure TmyPanel.SetBgColorTo(Value : TColor); begin If Value = FBgColorTo then Exit; FBgColorTo := Value; Invalidate; end; procedure TmyPanel.SetText(Content : String); // Settermethode begin If Content = FText then Exit; // wenn gleicher Inhalt nichts tun FText := Content; // Inhalt abspeichern Invalidate; // Control neu zeichnen end; procedure TmyPanel.SetTextAlign(Alignment : Cardinal); // Settermethode begin If Alignment = FTextAlign then Exit; // wenn gleicher Inhalt nichts tun FTextAlign := Alignment; // Inhalt abspeichern Invalidate; // Control neu zeichnen end; procedure DrawGradient(const Canvas: TCanvas; Color1, Color2: TColor; ARect: TRect; GradientOrientation: TGradientOrientation); var c1, c2, c: TPixelRec; //for easy access to RGB values as well as TColor value x, y: Integer; //current pixel position to be set OldPenWidth: Integer; //Save old settings to restore them properly OldPenStyle: TPenStyle;//see above begin c1.Color := ColorToRGB(Color1); //convert system colors to RGB values c2.Color := ColorToRGB(Color2); //if neccessary OldPenWidth := Canvas.Pen.Width; //get old settings OldPenStyle := Canvas.Pen.Style; Canvas.Pen.Width:=1; //ensure correct pen settings Canvas.Pen.Style:=psInsideFrame; case GradientOrientation of goVertical: begin for y := 0 to ARect.Bottom - ARect.Top do begin c.r := Round(c1.r + (c2.r - c1.r) * y / (ARect.Bottom - ARect.Top)); c.g := Round(c1.g + (c2.g - c1.g) * y / (ARect.Bottom - ARect.Top)); c.b := Round(c1.b + (c2.b - c1.b) * y / (ARect.Bottom - ARect.Top)); Canvas.Brush.Color := c.Color; Canvas.FillRect(Classes.Rect(ARect.Left, ARect.Top + y, ARect.Right, ARect.Top + y + 1)); end; end; goHorizontal: begin for x := 0 to ARect.Right - ARect.Left do begin c.r := Round(c1.r + (c2.r - c1.r) * x / (ARect.Right - ARect.Left)); c.g := Round(c1.g + (c2.g - c1.g) * x / (ARect.Right - ARect.Left)); c.b := Round(c1.b + (c2.b - c1.b) * x / (ARect.Right - ARect.Left)); Canvas.Brush.Color := c.Color; Canvas.FillRect(Rect(ARect.Left + x, ARect.Top, ARect.Left + x + 1, ARect.Bottom)); end; end; end; Canvas.Pen.Width := OldPenWidth; //restore old settings Canvas.Pen.Style := OldPenStyle; end; procedure TmyPanel.Paint; var myRect,TextRect : TRect; begin myRect := GetClientRect; Canvas.FillRect(myRect); Canvas.Brush.Style := bsSolid; Canvas.Brush.Color := FBgColorFrom; Canvas.Pen.Mode := pmCopy; Canvas.Pen.Style := BorderStyle; Canvas.Pen.Width := BorderWidth; Canvas.Pen.Color := BorderColor; //zeichnen des gradients if PaintGradient then DrawGradient(Canvas, BgColorFrom, BgColorTo, myRect, GradientDirection); //zeichnen des rahmens Canvas.MoveTo(0,0); Canvas.LineTo(myRect.Left,myRect.Bottom); Canvas.MoveTo(0,0); Canvas.LineTo(myRect.Right,myRect.Top); Canvas.MoveTo(self.Width,0); Canvas.LineTo(myRect.Right,myRect.Bottom); Canvas.MoveTo(0,self.Height); //links unten Canvas.LineTo(myRect.Right,myRect.Bottom); //zeichnen des bildes, wenn vorhanden if Picture <> nil then Canvas.StretchDraw(myRect,Picture); //schreiben des textes TextRect := Rect(BorderWidth, BorderWidth, self.Width-BorderWidth, self.Height-BorderWidth); SetBkMode(Canvas.Handle, TRANSPARENT); DrawText(self.Canvas.Handle, PChar(FText), -1, TextRect, DT_VCENTER or DT_VCENTER or DT_WORDBREAK); end; end.
Delphi-Quellcode:
da ich den Code soeben testhalber mal deaktiviert habe und da wird ja das Bild nicht gezeichnet. Da war alles ok. Also was mache ich da noch falsch? Denn in meinem Infotool => EasyDelphiHelper stand geschrieben, dass man mit StretchDraw eine TGraphic zeichnen lassen kann und damit fast alles realisieren kann. Also wenigstens Bmp und Jpg. Das würde auch erstmal reichen...
if Picture <> nil then
Canvas.StretchDraw(myRect,Picture);
Danke
Tom |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |