Платные хостинги     Раскрутка сайта     Книги по программированию

Хочется написать компоненту

- Не мог ли кто нибудь прислать (slaur@narod.ru) исходники какой-нибудь простенькой компоненты - с целью изучения как это делается.Например обьеденение ListBox и ChecBox ( чтобы на каждой линии listboxa присутствовал CheckBox)Заранее благодарен.

- Ну, например так...Код unit SuperLabel;{-------------------------------------------------------------------------------This component is the 4th generation of this component. As far as I know I'm theforth person to make major changes to this component. My contribution consist ofadding hiperlink capabilities, a frame around it, faded lines on several positionsand gradient properties in several directions.Major properties : - Autosizing : it resizes so as to fit best in rectangle. Autosize must be set                to False before it works. - 3D Effects : usual 3D effects such as normal, resit, raised, shadowedNew properties ( 4th generation ) : - Hiperlink : http, mail, ftp, news - SuperScript and SubScript capabilities - Gradient style : horizontal, vertical, elliptic, rectangle, vertical center,                    horizontal center - Frame : draw a rectangle around the label. - Faded line : top, bottom, middle.The idea of faded lines is based on MenuBar by Bluecave Components. I studiedthis property and adapted it to this component so as to draw faded lines at thetop, at the bottom and in the middle taking into account the text alignment.On the other hand, I added hiperlink capabilities so as to avoid to use anotherTLabel Component exclusively for it. So I made a mix of several properties.Besides, I made a small change in the autosizing procedure because in some casesthe bottom of the component cut the lowest part of letters such as "p" or "g".Finally, I added many comments to the source code for better study. In additionI've made on-line help.History :  1st Release : Louis Louw : louw@gcs.co.za www.gcs.co.za/mbs/mbs.htm  2nd Release : Durrin Hynes-Christensen : dxh@gv.dk  3rd Release : I don't know  4th Release : Maximo Yarritu Arnaez : myarritu@gmx.net-------------------------------------------------------------------------------}interfaceuses Windows, Classes, Graphics, Controls, StdCtrls, messages;type{-------------------------------------------------------------------------------3D Label Effects : - Normal3d : like VCL TLabel - Resit3d : resit TLabel - Raised3d : raised TLabel - Shadowed3d : shadowed TLabel with selectable direction-------------------------------------------------------------------------------}  T3DEffect = (Normal3d, Resit3d, Raised3d, Shadowed3d);  {Fit Type inside rectagle}  TFitType = (ftNormalFit, ftBestFitVert, ftBestFithorz, ftBestFitBoth);  { Gradient Style: If gsNone is selected no gradient style is applied }  TGradientStyle = (gsNone, gsHorizontal, gsVertical, gsElliptic, gsRectangle,                    gsVertCenter, gsHorizCenter);  { Label Type: if ltNormal is selected the behaviour is like VCL Label }  TLabelType = (ltNormal, ltSubSuperScript, ltHttp, ltMail, ltFtp, ltNews);  { Line Style: if lsNone is selected no line is drawn }  TLineStyle = (lsNone, lsTop, lsBottom, lsMiddle);  TColorQuad = record    Red, Green, Blue, Alpha: Byte;  end;  TmyaSuperLabel = class(TLabel)  private    fColorNormal, fColorSelected, fShadowColor: TColor;    fWhiteColor, fLast, fBeginColor, fEndColor: TColor;    fLabelType: TLabelType;    fEffect98, fFrame, fShadeLTSet: Boolean;    fOnMouseEnter, fOnMouseLeave: TNotifyEvent;    fUrl, fMailSubject: string;    fLineStyle: TLineStyle;    fOldWidth, fOldHeight, fOldSize, fhOffSet,fvOffSet : integer;    fFitType: TFitType;    f3DEffect: T3DEffect;    fGradientStyle: TGradientStyle;    procedure setStyleEffect(Value: T3DEffect);    procedure SetShadowColor(Value:TColor);    procedure SetWhiteColor(Value:TColor);    procedure SetFhOffSet(value: integer);    procedure SetFvOffSet(value: integer);    procedure SetShadeLT(value: boolean);    procedure SetFitType(Value: TFitType);    procedure SetBeginColor(Value: TColor);    procedure SetEndColor(Value: TColor);    procedure SetGradient(Value: TGradientStyle);    procedure SetLabelType(const Value: TLabelType);    procedure SetEffect98(const Value: Boolean);    procedure SetFrame(const Value: Boolean);    procedure SetLineStyle(const Value: TLineStyle);    procedure SuperLabelMouseEnter(var Message: TMessage); message CM_MOUSEENTER;    procedure SuperLabelMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;    procedure DoDrawText(var Area: TRect; Flags: Word);    procedure NewDrawText(Text: PChar; var Area: TRect; Flags: Word);    function ExtractCaption(Value: string): string;    procedure DoHorizontal(fr, fg, fb, dr, dg, db: Integer); //These all draw    procedure DoVertical(fr, fg, fb, dr, dg, db: Integer); // the gradients.    procedure DoElliptic(fr, fg, fb, dr, dg, db: Integer); // The fr fg fb etc    procedure DoRectangle(fr, fg, fb, dr, dg, db : Integer); // are color values.    procedure DoVertCenter(fr, fg, fb, dr, dg, db: Integer);    procedure DoHorizCenter(fr, fg, fb, dr, dg, db: Integer);    procedure UpdateDesigner;    procedure DrawLeftFadeLine(APoint: TPoint; ALength, AFadeWidth: Integer;                               AFadeColor: TColor);    procedure DrawRightFadeLine(APoint: TPoint; ALength, AFadeWidth: Integer;                                AFadeColor: TColor);  protected    procedure Click; override;    procedure Paint; override;  public    constructor Create(AOwner: TComponent); override;    destructor Destroy; override;    procedure OpenObject(sObjectPath: PChar); {Related to hiperlink}  published    property Align;    property Caption;    Property AFitType: TFitType read FFitType write SetFitType;    property AStyle3D: T3DEffect read F3DEffect write setStyleEffect default Normal3d;    property AShadeRightBottom: TColor read FShadowColor write SetShadowColor default clGray;    property AShadeLeftTop: TColor read FWhiteColor write SetWhiteColor default clWhite;    property AHShadeOffSet: integer read FhOffSet write SetFhOffSet default 5;    property AVShadeOffSet: integer read FvOffSet write SetFvOffSet default -5;    property AShadeLTSet: boolean read FShadeLTSet write setShadeLT default true;    property GradientStyle: TGradientStyle read FGradientStyle write SetGradient default gsNone;    property BeginColor: TColor read FBeginColor write SetBeginColor default clNavy;    property EndColor: TColor read FEndColor write SetEndColor default clAqua;    property Frame: Boolean read fFrame write SetFrame default False;    property LineStyle: TLineStyle read fLineStyle write SetLineStyle default lsNone;    property LabelType: TLabelType read fLabelType write SetLabelType default ltNormal;    property Effect98: Boolean read fEffect98 write SetEffect98 default True;    property ColorSelected: TColor read fColorSelected write fColorSelected default clGreen;    property MailSubject: string read fMailSubject write fMailSubject;    property Url: string read fUrl write fUrl;    property OnMouseEnter: TNotifyEvent read fOnMouseEnter write fOnMouseEnter;    property OnMouseLeave: TNotifyEvent read fOnMouseLeave write fOnMouseLeave;    property DragCursor;    property DragMode;    property Enabled;    property Font;    property ParentColor;    property ParentFont;    property ParentShowHint;    property PopupMenu;    property ShowHint;    property Visible;    property Transparent;    property Width;    property Top;    property Left;    property Height;    property OnClick;    property OnDblClick;    property OnDragDrop;    property OnDragOver;    property OnEndDrag;    property OnMouseDown;    property OnMouseUp;  end;procedure Register;implementationuses SysUtils, ShellApi, Dialogs, Forms;const  HTTP = 'http://';  MAIL = 'mailto:';  FTP = 'ftp://';  NEWS = 'news://';  SUB = '_';  SUPER = '^';procedure TmyaSuperLabel.UpdateDesigner;var  ParentForm: TCustomForm;begin  if (csDesigning in ComponentState) and not (csUpdating in ComponentState) then  begin    ParentForm := GetParentForm(Self);    if Assigned(ParentForm) and Assigned(ParentForm.Designer) then      ParentForm.Designer.Modified;  end;end;constructor TmyaSuperLabel.Create(AOwner: TComponent);begin  inherited Create(AOwner);  //ControlStyle := ControlStyle + [csDesignInteractive];  Transparent := True;  ParentColor := False;  fShadowColor := clGray;  fWhiteColor := clWhite;  fhOffSet := 5;  fvOffSet := -5;  fLast := clWhite;  Autosize := False;  fFitType := ftBestFitBoth;  fOldSize := Canvas.Font.Size;  fOldWidth := Width;  fOldHeight := Height;  fGradientStyle := gsNone;  fBeginColor := clNavy;  fEndColor := clAqua;  fFrame := False;  fLineStyle := lsNone;  fLabelType := ltNormal;  fEffect98 := True;  fColorSelected := clGreen;end;destructor TmyaSuperLabel.Destroy;begin  inherited Destroy;end;{Procedure TEZLabel.DoEdit;var  LabelEditor: TLabelEditor;begin  LabelEditor := TLabelEditor.Create(Application);  try    LabelEditor.ShowModal;  finally    LabelEditor.Free;  end;end;}procedure TmyaSuperLabel.DoDrawText(var Area: TRect; Flags: Word);var  Text: PChar;  Size: Byte;  TmpRect: TRect;  UpperColor, LowerColor: TColor;begin  Size := GetTextLen;     { Get length of string in Edit1 }  Inc(Size);              { Add room for null character }  GetMem(Text, Size);  GetTextBuf(Text, Size); { Creates Buffer dynamic variable }  if (Flags and DT_CALCRECT<>0) and     ((Text[0]=#0) or ShowAccelChar and (Text[0]='&') and (Text[1]=#0)) then      StrCopy(Text, ' ');  if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;  Canvas.Font := Font;  case AStyle3D of    Resit3d:    begin      UpperColor := fShadowColor;      LowerColor := fWhiteColor;      TmpRect := Area;      OffsetRect(TmpRect, 1, 1);      Canvas.Font.Color := LowerColor;      NewDrawText(Text, TmpRect, Flags);      TmpRect := Area;      OffsetRect(TmpRect, -1, -1);      Canvas.Font.Color := UpperColor;      NewDrawText(Text, TmpRect, Flags);    end;    Raised3d:    begin      UpperColor := fWhiteColor;      LowerColor := fShadowColor;      TmpRect := Area;      OffsetRect(TmpRect, 1, 1);      Canvas.Font.Color := LowerColor;      NewDrawText(Text, TmpRect, Flags);      TmpRect := Area;      OffsetRect(TmpRect, -1, -1);      Canvas.Font.Color := UpperColor;      NewDrawText(Text, TmpRect, Flags);    end;    Shadowed3D:    begin      UpperColor := fWhiteColor;      LowerColor := fShadowColor;      TmpRect := Area;      OffsetRect(TmpRect, FhOffSet, FvOffSet);      Canvas.Font.Color := LowerColor;      NewDrawText(Text, TmpRect, Flags);    end;  end;  Canvas.Font.Color := Font.Color;  if not AutoSize then    if (fOldSize<>Canvas.Font.Size) or (fOldWidth<>Width) or (fOldHeight<>Height) then    begin      case AFitType of        ftBestFitBoth:        begin          Canvas.Font.Size := 0;          while (abs(Canvas.font.height)<Area.Bottom-6) and (Canvas.textwidth(String(text))<Area.Right) do            Canvas.Font.Size := Canvas.Font.Size+1;          Canvas.Font.Size := Canvas.Font.Size-1;          Font.Size := Canvas.Font.Size;        end;        ftBestFitVert: Font.Height := Area.Bottom-2;        ftBestFitHorz :        begin          Canvas.Font.Size := 0;          while (Canvas.TextWidth(String(Text))<Area.Right) do Canvas.Font.Size:=Canvas.Font.Size+1;          Canvas.Font.Size:=Canvas.Font.Size-1;          Font.Size:=Canvas.Font.Size;        end;      end;      fOldSize := Canvas.Font.Size;      fOldWidth := Width;      fOldHeight := Height;    end;  if not Enabled then Canvas.Font.Color := clGrayText;  NewDrawText(Text, Area, Flags);  FreeMem(Text, Size);end;procedure TmyaSuperLabel.NewDrawText(Text: PChar; var Area: TRect; Flags: Word);var  nFor, XChar : Integer;  SubScript, SuperScript: Boolean;  DefaultFont: TFont;begin  if LabelType=ltSubSuperScript then  begin    { the font is changed when a SubScript or SuperScript is drawn }    DefaultFont := TFont.Create;    DefaultFont.Assign(Canvas.Font);    { Calculate the X position for each char }    case Alignment of      taRightJustify: XChar := Area.Right-Canvas.TextWidth(ExtractCaption(Text));      taLeftJustify: XChar := Area.Left;      taCenter: XChar := Area.Left+(Area.Right-Canvas.TextWidth(ExtractCaption(Text))) div 2;    end;    { Each char is drawn taking into account the previous char which indicates the way of drawing }    for nFor:=0 to Length(Text)-1 do    begin      if (nFor>0) and (Text[nFor-1]=SUB) then SubScript := True else SubScript := False;      if (nFor>0) and (Text[nFor-1]=SUPER) then SuperScript := True else SuperScript := False;      if (Text[nFor]<>SUB) and (Text[nFor]<>SUPER) then      begin        if SubScript then        begin          { Recalculate the height font }          Canvas.Font.Height := Canvas.Font.Height*8 div 10;          { Calculate de X position to draw the char }          Canvas.TextRect(Rect(XChar,Area.Top,XChar+Canvas.TextWidth(Text[nFor]),Area.Bottom),                          XChar,                          Area.Top+Abs(8*Canvas.Font.Height-10*DefaultFont.Height) div 10, Text[nFor]);          { Calculate the next X position }          XChar := XChar+Canvas.TextWidth(Text[nFor]);        end;        if SuperScript then        begin          { Recalculate the height font }          Canvas.Font.Height := Canvas.Font.Height*8 div 10;          { Calculate de X position to draw the char }          Canvas.TextRect(Rect(XChar,Area.Top,XChar+Canvas.TextWidth(text[nFor]),Area.Bottom),                          XChar,                          Area.Top-Abs(8*Canvas.Font.Height-10*DefaultFont.Height) div 20, Text[nFor]);          { Calculate the next X position }          XChar := XChar+Canvas.TextWidth(Text[nFor]);        end;        if (not SubScript) and (not SuperScript) then        begin          { if the actual font is different the default font is loaded }          Canvas.Font.Assign(DefaultFont);          Canvas.TextRect(Rect(XChar,Area.Top,XChar+Canvas.TextWidth(Text[nFor]),Area.Bottom),                          XChar,                          Area.Top,                          Text[nFor]);          XChar := XChar+Canvas.TextWidth(Text[nFor]);        end;        Canvas.Font.Assign(DefaultFont);      end;    end;  end  else DrawText(Canvas.Handle, Text, StrLen(Text), Area, Flags);end;procedure TmyaSuperLabel.Paint;const  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);var  Area: TRect;  { These are the separate color values for RGB of color values }  FromR, FromG, FromB : Integer;  DiffR, DiffG, DiffB : Integer;  ALength: Integer;  AuxPoint: TPoint;  AuxCaption: String;  { Useful to draw the bevel around the TEdit }  procedure BevelRect(Color1, Color2: TColor; const R: TRect);  begin    with Canvas do    begin      Pen.Color := Color1;      PolyLine([Point(R.Left, R.Bottom), Point(R.Left, R.Top), Point(R.Right, R.Top)]);      Pen.Color := Color2;      PolyLine([Point(R.Right, R.Top), Point(R.Right, R.Bottom), Point(R.Left, R.Bottom)]);    end;  end;begin  with Canvas do  begin    FromR := TColorQuad(fBeginColor).Red;    FromG := TColorQuad(fBeginColor).Green;    FromB := TColorQuad(fBeginColor).Blue;    DiffR := TColorQuad(fEndColor).Red-FromR;    DiffG := TColorQuad(fEndColor).Green-FromG;    DiffB := TColorQuad(fEndColor).Blue-FromB;    { FromR := FBeginColor and $000000ff;    FromG := (FBeginColor shr 8) and $000000ff;    FromB := (FBeginColor shr 16) and $000000ff;    DiffR := (FEndColor and $000000ff) - FromR;    DiffG := ((FEndColor shr 8) and $000000ff) - FromG;    DiffB := ((FEndColor shr 16) and $000000ff) - FromB; }    { Depending on gradient style selected, go draw it on the Bitmap canvas }    case FGradientStyle of      gsHorizontal: DoHorizontal(FromR, FromG, FromB, DiffR, DiffG, DiffB);      gsVertical: DoVertical(FromR, FromG, FromB, DiffR, DiffG, DiffB);      gsElliptic: DoElliptic(FromR, FromG, FromB, DiffR, DiffG, DiffB);      gsRectangle: DoRectangle(FromR, FromG, FromB, DiffR, DiffG, DiffB);      gsVertCenter: DoVertCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);      gsHorizCenter: DoHorizCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);      gsNone:        if not Transparent then        begin          Brush.Style := bsSolid;          Brush.Color := Self.Color;          FillRect(ClientRect);        end;    end;    Brush.Style := bsClear;    Area := ClientRect;    if Frame then    begin      BevelRect(clBtnShadow, clBtnShadow, Rect(Area.Left+1, Area.Top+1, Area.Right-1, Area.Bottom-1));      BevelRect(clBtnHighlight, clBtnHighlight, Rect(Area.Left, Area.Top, Area.Right-2, Area.Bottom-2));    end;    Area := Rect(Area.Left,Area.Top,Area.Right,Area.Bottom-2);    DoDrawText(Area, (DT_EXPANDTABS or DT_WORDBREAK) or Alignments[Alignment]);  end;  { Depending on Line Style line is drawn }  ALength := (Area.Right-Area.Left-4) div 2;  case LineStyle of    lsTop:      with AuxPoint do      begin        X := Area.Left+2;        Y := Area.Top+2;        DrawLeftFadeLine(AuxPoint, ALength, ALength div 3, clBtnShadow);        Y := Y+1;        DrawLeftFadeLine(AuxPoint, ALength, ALength div 3, clBtnHighLight);        Y := Y-1;        X := X+ALength;        DrawRightFadeLine(AuxPoint, ALength, ALength div 3, clBtnShadow);        Y := Y+1;        DrawRightFadeLine(AuxPoint, ALength, ALength div 3, clBtnHighLight);      end;    lsBottom:      with AuxPoint do      begin        X := Area.Left+2;        Y := Area.Bottom-3;        DrawLeftFadeLine(AuxPoint, ALength, ALength div 3, clBtnShadow);        Y := Y+1;        DrawLeftFadeLine(AuxPoint, ALength, ALength div 3, clBtnHighLight);        Y := AuxPoint.Y-1;        X := X+ALength;        DrawRightFadeLine(AuxPoint, ALength, ALength div 3, clBtnShadow);        Y := Y+1;        DrawRightFadeLine(AuxPoint, ALength, ALength div 3, clBtnHighLight);      end;    lsMiddle:      begin        AuxPoint.Y := Area.Top+(Area.Bottom-Area.Top) div 2;        AuxCaption := Caption;        if LabelType=ltSubSuperScript then AuxCaption := ExtractCaption(Caption);        case Alignment of          taCenter:            begin              AuxPoint.X := Area.Left+2;              ALength := ((Area.Right-2)-(Area.Left+2)-Canvas.TextWidth(AuxCaption)-12) div 2;              DrawLeftFadeLine(AuxPoint, ALength, ALength div 3, clBtnShadow);              AuxPoint.Y := AuxPoint.Y+1;              DrawLeftFadeLine(AuxPoint, ALength, ALength div 3, clBtnHighLight);              AuxPoint.X := Area.Right-2-ALength;              AuxPoint.Y := AuxPoint.Y-1;              DrawRightFadeLine(AuxPoint, ALength, ALength div 3, clBtnShadow);              AuxPoint.Y := AuxPoint.Y+1;              DrawRightFadeLine(AuxPoint, ALength, ALength div 3, clBtnHighLight);            end;          taLeftJustify:            begin              AuxPoint.X := Area.Left+Canvas.TextWidth(AuxCaption)+6;              ALength := Area.Right-AuxPoint.X-2;              DrawRightFadeLine(AuxPoint, ALength, ALength div 3, clBtnShadow);              AuxPoint.Y := AuxPoint.Y+1;              DrawRightFadeLine(AuxPoint, ALength, ALength div 3, clBtnHighLight);            end;          taRightJustify:            begin              AuxPoint.X := Area.Left+2;              ALength := Area.Right-Canvas.TextWidth(AuxCaption)-6-AuxPoint.X;              DrawLeftFadeLine(AuxPoint, ALength, ALength div 3, clBtnShadow);              AuxPoint.Y := AuxPoint.Y+1;              DrawLeftFadeLine(AuxPoint, ALength, ALength div 3, clBtnHighLight);            end;        end;      end;  end;end;procedure TmyaSuperLabel.SetShadowColor(Value: TColor);begin  if fShadowColor=Value then exit;  fShadowColor := value;  Invalidate;end;procedure TmyaSuperLabel.SetFitType(Value: TFitType);begin  if fFitType=Value then exit;  fFitType := Value;  fOldSize := fOldSize+1;  Invalidate;end;procedure TmyaSuperLabel.SetFhOffSet(value: integer);begin  if value=fhOffSet then exit;  fhOffSet := value;  Invalidate;end;procedure TmyaSuperLabel.SetFvOffSet(value: integer);begin  if value=fvOffSet then exit;  fvOffSet := value;  Invalidate;end;procedure TmyaSuperLabel.SetWhiteColor(value: TColor);begin  if not (fWhiteColor=value) and (not fShadeLTSet) then  begin    fWhiteColor := value;    Invalidate;  end;end;procedure TmyaSuperLabel.setStyleEffect(Value: T3DEffect);begin  if f3DEffect=Value then exit;  f3DEffect := value;  Invalidate;end;procedure TmyaSuperLabel.SetShadeLT(Value: boolean);begin  if fShadeLTSet=Value then exit;  fShadeLTSet := value;  if fShadeLTSet then  begin    fLast := fWhiteColor;    fWhiteColor := clWhite;  end  else fWhiteColor := Flast;  Invalidate;end;procedure TmyaSuperLabel.SetBeginColor(Value: TColor);begin  if fBeginColor=Value then exit;  fBeginColor := Value;  Invalidate;end;procedure TmyaSuperLabel.SetEndColor(Value: TColor);begin  if fEndColor=Value then exit;  fEndColor := Value;  Invalidate;end;procedure TmyaSuperLabel.SetGradient(Value: TGradientStyle);begin  if fGradientStyle=Value then exit;  fGradientStyle := Value;  Invalidate;end;procedure TmyaSuperLabel.SuperLabelMouseEnter(var Message: TMessage);begin  if LabelType in [ltHttp, ltFtp, ltNews, ltMail] then  begin    if Effect98 then    begin      fColorNormal := Font.Color;      Font.Color := ColorSelected;      Font.Style := font.Style+[fsUnderline];      Invalidate;    end;  end;  if Assigned(fOnMouseEnter) then fOnMouseEnter(Self);end;procedure TmyaSuperLabel.SuperLabelMouseLeave(var Message: TMessage);begin  if LabelType in [ltHttp, ltFtp, ltNews, ltMail] then  begin    if Effect98 then    begin      Font.Color := fColorNormal;      Font.Style := font.Style-[fsUnderline];      Invalidate;    end;  end;  if Assigned(fOnMouseLeave) then fOnMouseLeave(Self);end;procedure TmyaSuperLabel.SetLabelType(const Value: TLabelType);begin  if fLabelType=Value then exit;  fLabelType := Value;  if LabelType in [ltHttp, ltFtp, ltNews, ltMail] then    Cursor := crHandPoint  else    Cursor := crDefault;  Invalidate;end;procedure TmyaSuperLabel.SetEffect98(const Value: Boolean);begin  if fEffect98=Value then exit;  fEffect98 := Value;end;procedure TmyaSuperLabel.SetFrame(const Value: Boolean);begin  if fFrame=Value then exit;  fFrame := Value;  Invalidate;end;procedure TmyaSuperLabel.SetLineStyle(const Value: TLineStyle);begin  if fLineStyle=Value then exit;  fLineStyle := Value;  Invalidate;end;procedure TmyaSuperLabel.Click;var  Choice, App: string;  TempPChar: array[0..79] of Char;begin  inherited Click;  if Url='' then Choice := Caption else Choice := Url;  case LabelType of    ltHttp: App := HTTP+Choice;    ltFtp: App := FTP+Choice;    ltNews: App := NEWS+Choice;    ltMail: App := MAIL+Choice+'?subject='+MailSubject;  end;  if LabelType in [ltHttp, ltFtp, ltNews, ltMail] then  begin    StrPCopy(TempPChar,App);    OpenObject(TempPChar)  end;end;procedure TmyaSuperLabel.OpenObject(sObjectPath: PChar);begin  if LabelType in [ltNormal, ltSubSuperScript] then exit;  if LabelType<>ltHttp then    ShellExecute(0, Nil, sObjectPath, Nil, Nil, SW_NORMAL)  else begin    if ShellExecute(Application.Handle,PChar('open'),sObjectPath,PChar(''),nil, SW_NORMAL)<33 then      if ShellExecute(Application.Handle,PChar('open'),PChar('netscape.exe'),sObjectPath, nil,SW_NORMAL)<32 then        if ShellExecute(Application.Handle,PChar('open'),PChar('iexplore.exe'),sObjectPath,nil,SW_NORMAL)<32 then          ShowMessage ('Sorry your browser could not be found');  end;end;procedure TmyaSuperLabel.DrawLeftFadeLine(APoint: TPoint;                                          ALength, AFadeWidth: Integer;                                          AFadeColor: TColor);var  I, R1, G1, B1, R2, G2, B2: Integer;  C: TColor;begin  C := ColorToRGB(AFadeColor);  R1 := TColorQuad(C).Red;  G1 := TColorQuad(C).Green;  B1 := TColorQuad(C).Blue;  for I:=APoint.X to APoint.X+ALength do  begin    if I<(APoint.X+AFadeWidth) then    begin      C := Canvas.Pixels[I, APoint.Y];      R2 := TColorQuad(C).Red;      G2 := TColorQuad(C).Green;      B2 := TColorQuad(C).Blue;      R2 := R2+(((R1-R2)*(I-APoint.X)) div AFadeWidth);      G2 := G2+(((G1-G2)*(I-APoint.X)) div AFadeWidth);      B2 := B2+(((B1-B2)*(I-APoint.X)) div AFadeWidth);      C := RGB(R2, G2, B2);      Canvas.Pixels[I,APoint.Y] := C;    end    else Canvas.Pixels[I,APoint.Y] := AFadeColor;  end;end;procedure TmyaSuperLabel.DrawRightFadeLine(APoint: TPoint;                                           ALength, AFadeWidth: Integer;                                           AFadeColor: TColor);var  I, R1, G1, B1, R2, G2, B2: Integer;  C: TColor;begin  C := ColorToRGB(AFadeColor);  R1 := TColorQuad(C).Red;  G1 := TColorQuad(C).Green;  B1 := TColorQuad(C).Blue;  for I:=APoint.X to APoint.X+ALength do  begin    if I>(APoint.X+Alength-AFadeWidth) then    begin      C := Canvas.Pixels[I, APoint.Y];      R2 := TColorQuad(C).Red;      G2 := TColorQuad(C).Green;      B2 := TColorQuad(C).Blue;      R2 := R2+(((R1-R2)*(APoint.X+ALength-I)) div AFadeWidth);      G2 := G2+(((G1-G2)*(APoint.X+ALength-I)) div AFadeWidth);      B2 := B2+(((B1-B2)*(APoint.X+ALength-I)) div AFadeWidth);      C := RGB(R2, G2, B2);      Canvas.Pixels[I,APoint.Y] := C;    end    else Canvas.Pixels[I,APoint.Y] := AFadeColor;  end;end;{I'll explain a little about the Horizontal gradient, the other styles are all consistent with their logic.  The six R, G, and B values are passed to us. We define some local variables we'll need: a rectangle, a FOR loop counter, and our own RGB numbers.  For a horizontal gradient, we'll draw a series of rectangles, each one a little closer in color to the EndClr value.  A horizontal gradient rectangle will always be from the top to the bottom of the canvas, so we set top to 0 and bottom to however tall our control is.  Then, we draw a series of 255 rectangles.  The starting point and width of each will depend on the actual width of our control.  It starts out on the left, draws the first rectangle in a color that's a percentage of the difference plus the starting color.  As I increments through the loop, the rectangles move to the right and the color gets closer and closer to the EndClr.}procedure TmyaSuperLabel.DoHorizontal(fr, fg, fb, dr, dg, db: Integer);var  ColorRect: TRect;  I: Integer;  R, G, B : Byte;begin  ColorRect.Top := 0;                     { Set rectangle top }  ColorRect.Bottom := Height;  for I:=0 to 255 do  begin                                   { Make lines (rectangles) of color }    ColorRect.Left := MulDiv(I, Width, 256);      { Find left for this color }    ColorRect.Right := MulDiv(I+1, Width, 256);   { Find Right }    R := fr+MulDiv(I, dr, 255);           { Find the RGB values }    G := fg+MulDiv(I, dg, 255);    B := fb+MulDiv(I, db, 255);    Canvas.Brush.Color := RGB(R, G, B);   { Plug colors into brush }    Canvas.FillRect(ColorRect);           { Draw on Bitmap }  end;end;procedure TmyaSuperLabel.DoVertical(fr, fg, fb, dr, dg, db: Integer);var  ColorRect: TRect;  I: Integer;  R, G, B : Byte;begin  ColorRect.Left := 0;                    { Set rectangle left & right }  ColorRect.Right := Width;  for I := 0 to 255 do  begin                                   { Make lines (rectangles) of color }    ColorRect.Top := MulDiv(I, Height, 256);        { Find top for this color }    ColorRect.Bottom:= MulDiv(I+1, Height, 256);    { Find Bottom }    R := fr+MulDiv(I, dr, 255);                     { Find the RGB values }    G := fg+MulDiv(I, dg, 255);    B := fb+MulDiv(I, db, 255);    Canvas.Brush.Color := RGB(R, G, B);             { Plug colors into brush }    Canvas.FillRect(ColorRect);                     { Draw on Bitmap }  end;end;procedure TmyaSuperLabel.DoElliptic(fr, fg, fb, dr, dg, db: Integer);var  R, G, B: Byte;  Pw, Ph, x1,y1,x2,y2: Real;  I, cWidth, cHeight : Integer;{The elliptic is a bit different, since I had to use real numbers. I cut down on the number (to 155 instead of 255) of iterations in an attempt to speed things up, to no avail.  I think it just takes longer for windows to draw an ellipse as opposed to a rectangle.}begin  cWidth := Width;  cHeight := Height;//  cWidth := Canvas.ClipRect.Right-Canvas.ClipRect.Left;//  cHeight := Canvas.ClipRect.Bottom-Canvas.ClipRect.Top;  Canvas.Pen.Style := psClear;  Canvas.Pen.Mode := pmCopy;  x1 := 0 - (cWidth / 4);  x2 := cWidth + (cWidth / 4)+4;  y1 := 0 - (cHeight / 4);  y2 := cHeight + (cHeight / 4)+4;  Pw := ((cWidth / 4) + (cWidth / 2)) / 155;  Ph := ((cHeight / 4) + (cHeight / 2)) / 155;  for I := 0 to 155 do  begin         { Make ellipses of color }    x1 := x1 + Pw;    x2 := X2 - Pw;    y1 := y1 + Ph;    y2 := y2 - Ph;    R := fr + MulDiv(I, dr, 155);                       { Find the RGB values }    G := fg + MulDiv(I, dg, 155);    B := fb + MulDiv(I, db, 155);    Canvas.Brush.Color := R or (G shl 8) or (b shl 16); { Plug colors into brush }    Canvas.Ellipse(Trunc(x1),Trunc(y1),Trunc(x2),Trunc(y2));  end;  Canvas.Pen.Style := psSolid;end;procedure TmyaSuperLabel.DoRectangle(fr, fg, fb, dr, dg, db: Integer);var  R, G, B : Byte;  Pw, Ph, x1,y1,x2,y2 : Real;  I, cWidth, cHeight : Integer;begin//  cWidth := Canvas.ClipRect.Right-Canvas.ClipRect.Left;//  cHeight := Canvas.ClipRect.Bottom-Canvas.ClipRect.Top;  cWidth := Width;  cHeight := Height;  Canvas.Pen.Style := psClear;  Canvas.Pen.Mode := pmCopy;  x1 := 0;  x2 := cWidth+2;  y1 := 0;  y2 := cHeight+2;  Pw := (cWidth / 2) / 255;  Ph := (cHeight / 2) / 255;  for I := 0 to 255 do  begin         { Make rectangles of color }    x1 := x1 + Pw;    x2 := X2 - Pw;    y1 := y1 + Ph;    y2 := y2 - Ph;    R := fr + MulDiv(I, dr, 255);    { Find the RGB values }    G := fg + MulDiv(I, dg, 255);    B := fb + MulDiv(I, db, 255);    Canvas.Brush.Color := RGB(R, G, B);   { Plug colors into brush }    Canvas.FillRect(Rect(Trunc(x1),Trunc(y1),Trunc(x2),Trunc(y2)));  end;  Canvas.Pen.Style := psSolid;end;procedure TmyaSuperLabel.DoVertCenter(fr, fg, fb, dr, dg, db: Integer);var  ColorRect: TRect;  R, G, B : Byte;  I, Haf, cWidth, cHeight : Integer;begin//  cWidth := Canvas.ClipRect.Right-Canvas.ClipRect.Left;//  cHeight := Canvas.ClipRect.Bottom-Canvas.ClipRect.Top;  cWidth := Width;  cHeight := Height;  Haf := cHeight Div 2;  ColorRect.Left := 0;  ColorRect.Right := cWidth;  for I := 0 to Haf do  begin    ColorRect.Top := MulDiv (I, Haf, Haf);    ColorRect.Bottom := MulDiv (I + 1, Haf, Haf);    R := fr + MulDiv(I, dr, Haf);    G := fg + MulDiv(I, dg, Haf);    B := fb + MulDiv(I, db, Haf);    Canvas.Brush.Color := RGB(R, G, B);    Canvas.FillRect(ColorRect);    ColorRect.Top := Height - (MulDiv (I, Haf, Haf));    ColorRect.Bottom := Height - (MulDiv (I + 1, Haf, Haf));    Canvas.FillRect(ColorRect);  end;end;procedure TmyaSuperLabel.DoHorizCenter(fr, fg, fb, dr, dg, db: Integer);var  ColorRect: TRect;  R, G, B : Byte;  I, Haf, cWidth, cHeight : Integer;begin//  cWidth := Canvas.ClipRect.Right-Canvas.ClipRect.Left;//  cHeight := Canvas.ClipRect.Bottom-Canvas.ClipRect.Top;  cWidth := Width;  cHeight := Height;  Haf := cWidth Div 2;  ColorRect.Top := 0;  ColorRect.Bottom := cHeight;  for I := 0 to Haf do begin    ColorRect.Left := MulDiv (I, Haf, Haf);    ColorRect.Right := MulDiv (I + 1, Haf, Haf);    R := fr + MulDiv(I, dr, Haf);    G := fg + MulDiv(I, dg, Haf);    B := fb + MulDiv(I, db, Haf);    Canvas.Brush.Color := RGB(R, G, B);    Canvas.FillRect(ColorRect);    ColorRect.Left := Width - (MulDiv (I, Haf, Haf));    ColorRect.Right := Width - (MulDiv (I + 1, Haf, Haf));    Canvas.FillRect(ColorRect);  end;end;function TmyaSuperLabel.ExtractCaption(Value: string): string;var  nFor: Byte;  AuxString: string;begin  AuxString := '';  for nFor:=1 to Length(Value) do    if (Value[nFor]<>SUB) and (Value[nFor]<>SUPER) then AuxString := AuxString+Value[nFor];  ExtractCaption := AuxString;end;procedure register;begin  RegisterComponents('Yarri 1',[TmyaSuperLabel]);end;end.highlightSyntax('delphiWNkYjY','delphi');

- keshСпасибо.Неужели придется с этим разбираться :-)

- можно и покороче стандартный лейбл с тенью:Код type  TFbLabel = class(TLabel)  private    fShadowColor: TColor;    fShadowOffsetX: integer;    fShadowOffsetY: integer;    procedure SetShadowColor(const Value: TColor);    procedure SetShadowOffsetX(const Value: integer);    procedure SetShadowOffsetY(const Value: integer);    { Private declarations }  protected    { Protected declarations }    procedure DoDrawText(var Rect: TRect; Flags: Longint); override;  public    { Public declarations }    constructor Create (AOwner: TComponent); override;  published    { Published declarations }    property ShadowColor: TColor read fShadowColor write SetShadowColor;    property ShadowOffsetX: integer read fShadowOffsetX write SetShadowOffsetX;    property ShadowOffsetY: integer read fShadowOffsetY write SetShadowOffsetY;  end;implementation{ TFbLabel }constructor TFbLabel.Create(AOwner: TComponent);begin  inherited;  Font.Color := clNavy;  fShadowColor := clWhite;  fShadowOffsetX := -1;  fShadowOffsetY := -1;end;procedure TFbLabel.DoDrawText(var Rect: TRect; Flags: Integer);var  Text: string;begin  Text := GetLabelText;  if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and    (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';  if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;  Flags := DrawTextBiDiModeFlags(Flags);  Canvas.Font := Font;  if not Enabled then  begin    OffsetRect(Rect, 1, 1);    Canvas.Font.Color := clBtnHighlight;    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);    OffsetRect(Rect, -1, -1);    Canvas.Font.Color := clBtnShadow;    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);  end  else begin    OffsetRect(Rect, fShadowOffsetX, fShadowOffsetY);    Canvas.Font.Color := fShadowColor;    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);    OffsetRect(Rect, - fShadowOffsetX, - fShadowOffsetY);    Canvas.Font.Color := Self.Font.Color;    DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);  end;end;procedure TFbLabel.SetShadowColor(const Value: TColor);begin  fShadowColor := Value;  Invalidate;end;procedure TFbLabel.SetShadowOffsetX(const Value: integer);begin  fShadowOffsetX := Value;  Invalidate;end;procedure TFbLabel.SetShadowOffsetY(const Value: integer);begin  fShadowOffsetY := Value;  Invalidate;end;end.highlightSyntax('delphiM2U4ZG','delphi');хотя я не знаю, чего ты мучаешься. возьми справку, там классные, разжёванные по самое "мама, не горюй", примеры.

Интернет казино     Онлайн игры     Увеличение члена     Купить DVD