home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d56 / RMCTL.ZIP / rmImageListGraphic.pas < prev    next >
Pascal/Delphi Source File  |  2001-06-22  |  12KB  |  404 lines
  1. {================================================================================
  2. Copyright (C) 1997-2001 Mills Enterprise
  3.  
  4. Unit     : rmImageListGraphic
  5. Purpose  : This is a visual interface for a TimageList.  Could be used for simple
  6.            animation purposes or for displaying different images from an
  7.            imagelist via an imageindex.
  8. Date     : 05-03-2000
  9. Author   : Ryan J. Mills
  10. Version  : 1.80
  11. ================================================================================}
  12.  
  13. unit rmImageListGraphic;
  14.  
  15. interface
  16.  
  17. {$I CompilerDefines.INC}
  18.  
  19. uses
  20.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  21.   imglist, buttons, StdCtrls;
  22.  
  23. type
  24.   TrmCustomImageListGraphic = class(TGraphicControl)
  25.   private
  26.     { Private declarations }
  27.     FImageChangeLink: TChangeLink;
  28.     FImages: TCustomImageList;
  29.     fImageIndex: integer;
  30.     fAutosize: boolean;
  31.     fCentered: boolean;
  32.     procedure ImageListChange(Sender: TObject);
  33.     procedure SetImages(Value: TCustomImageList);
  34.     procedure SetImageIndex(const Value: integer);
  35.     procedure SetCentered(const Value: boolean);
  36.   protected
  37.     { Protected declarations }
  38.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  39.     property ImageIndex : integer read fImageIndex write SetImageIndex default -1;
  40.     property Images: TCustomImageList read FImages write SetImages;
  41.     property AutoSize : boolean read fAutosize write fautosize default true;
  42.     property Centered : boolean read fCentered write SetCentered default false;
  43.   public
  44.     { Public declarations }
  45.     constructor create(AOwner:TComponent); override;
  46.     destructor destroy; override;
  47.   published
  48.     { Published declarations }
  49.   end;
  50.  
  51.   TrmImageListGraphic = class(TrmCustomImageListGraphic)
  52.   protected
  53.     { Protected declarations }
  54.     procedure Paint; override;
  55.   published
  56.     { Published declarations }
  57.     property Align;
  58.     property Anchors;
  59.     property Autosize;
  60.     property Centered;
  61.     property Enabled;
  62.     property ImageIndex;
  63.     property Images;
  64.   end;
  65.  
  66.   TGlyphLayout = (glGlyphLeft, glGlyphRight, glGlyphTop, glGlyphBottom);
  67.  
  68.   TrmCustomImageListGlyph = class(TrmCustomImageListGraphic)
  69.   private
  70.     fCaption: string;
  71.     fGLayout: TGlyphLayout;
  72.     procedure SetCaption(const Value: string);
  73.     procedure SetGlyphLayout(const Value: TGlyphLayout);
  74.     procedure CalcLayout( const Client: TRect; const Caption: string; Layout: TGlyphLayout;
  75.                                 Margin, Spacing: Integer; var GlyphPos: TPoint;
  76.                                 var TextBounds: TRect; BiDiFlags: LongInt );
  77.     function TextFlags : integer;
  78.   protected
  79.     { Protected declarations }
  80.     procedure InternalDrawGlyph(const GlyphPos: TPoint); virtual;
  81.     procedure InternalDrawText(const Caption: string; TextBounds: TRect; BiDiFlags: Integer); virtual;
  82.     procedure Paint; override;
  83.     property Caption : string read fCaption write SetCaption;
  84.     property GlyphLayout : TGlyphLayout read fGLayout write SetGlyphLayout;
  85.   public
  86.     { Public declarations }
  87.     constructor create(AOwner:TComponent); override;
  88.   end;
  89.  
  90.   TrmImageListGlyph = class(TrmCustomImageListGlyph)
  91.   published
  92.     { Published declarations }
  93.     property Caption;
  94.     property GlyphLayout;
  95.     property BiDiMode;
  96.     property Enabled;
  97.     property Font;
  98.     property Align;
  99.     property Anchors;
  100.     property ImageIndex;
  101.     property Images;
  102.   end;
  103.  
  104. implementation
  105.  
  106. { TrmCustomImageListGraphic }
  107.  
  108. procedure TrmCustomImageListGraphic.ImageListChange(Sender: TObject);
  109. begin
  110.    Invalidate;
  111. end;
  112.  
  113. procedure TrmCustomImageListGraphic.SetImages(Value: TCustomImageList);
  114. begin
  115.   if Images <> nil then
  116.     Images.UnRegisterChanges(FImageChangeLink);
  117.   FImages := Value;
  118.   if Images <> nil then
  119.   begin
  120.     if fAutosize then
  121.        SetBounds(left, top, Images.Width, Images.Height);
  122.     Images.RegisterChanges(FImageChangeLink);
  123.     Images.FreeNotification(Self);
  124.   end;
  125.   invalidate;
  126. end;
  127.  
  128. procedure TrmCustomImageListGraphic.Notification(AComponent: TComponent;
  129.   Operation: TOperation);
  130. begin
  131.   inherited Notification(AComponent, Operation);
  132.   if (Operation = opRemove) and (AComponent = Images) then
  133.     Images := nil;
  134. end;
  135.  
  136. procedure TrmCustomImageListGraphic.SetImageIndex(const Value: integer);
  137. begin
  138.   if (value < -1) then
  139.      fImageIndex := -1
  140.   else
  141.      fImageIndex := Value;
  142.   RePaint;
  143. end;
  144.  
  145. constructor TrmCustomImageListGraphic.create(AOwner: TComponent);
  146. begin
  147.   inherited;
  148.   height := 16;
  149.   width := 16;
  150.   fImageIndex := -1;
  151.   fAutoSize := true;
  152.   fCentered := false;
  153.   FImageChangeLink := TChangeLink.Create;
  154.   FImageChangeLink.OnChange := ImageListChange;
  155. end;
  156.  
  157. procedure TrmCustomImageListGraphic.SetCentered(const Value: boolean);
  158. begin
  159.   if fCentered <> Value then
  160.      fCentered := Value;
  161.   Invalidate;
  162. end;
  163.  
  164. destructor TrmCustomImageListGraphic.destroy;
  165. begin
  166.   FImageChangeLink.Free;
  167.   inherited;
  168. end;
  169.  
  170. { TrmImageListGraphic }
  171.  
  172. procedure TrmImageListGraphic.Paint;
  173. var
  174.    xPos, yPos : integer;
  175. begin
  176.   inherited;
  177.   if assigned(fimages) then
  178.   begin
  179.      if fCentered then
  180.      begin
  181.         xPos := (Width div 2) - (FImages.Width div 2);
  182.         yPos := (Height div 2) - (fImages.Height div 2);
  183.      end
  184.      else
  185.      begin
  186.         xPos := 0;
  187.         yPos := 0;
  188.      end;
  189.      if (fimageindex > -1) and (fImageIndex < FImages.Count) then
  190.         fimages.Draw(canvas, xPos, yPos, fimageindex, enabled)
  191.      else
  192.      begin
  193.         with canvas do
  194.         begin
  195.            brush.style := bsclear;
  196.            fillrect(clientrect);
  197.         end;
  198.      end;
  199.   end;
  200.  
  201.   if csdesigning in componentstate then
  202.   begin
  203.      with canvas do
  204.      begin
  205.         brush.Style := bsclear;
  206.         pen.style := psDash;
  207.         pen.color := clWindowtext;
  208.         rectangle(clientrect);
  209.      end;
  210.   end;
  211. end;
  212.  
  213. { TrmCustomImageListGlyph }
  214.  
  215. procedure TrmCustomImageListGlyph.Paint;
  216. var
  217.    wrect : TRect;
  218.    GlyphPos: TPoint;
  219. begin
  220.   inherited;
  221.   CalcLayout(ClientRect, Caption, GlyphLayout, -1, 4, GlyphPos, wRect, DrawTextBiDiModeFlags(0));
  222.   InternalDrawGlyph(GlyphPos);
  223.   InternalDrawText(Caption, wRect, DrawTextBiDiModeFlags(0));
  224.  
  225.   if csdesigning in componentstate then
  226.   begin
  227.      with canvas do
  228.      begin
  229.         brush.Style := bsclear;
  230.         pen.style := psDash;
  231.         pen.color := clWindowtext;
  232.         rectangle(clientrect);
  233.      end;
  234.   end;
  235. end;
  236.  
  237. procedure TrmCustomImageListGlyph.SetCaption(const Value: string);
  238. begin
  239.   fCaption := Value;
  240.   repaint;
  241. end;
  242.  
  243. procedure TrmCustomImageListGlyph.SetGlyphLayout(const Value: TGlyphLayout);
  244. begin
  245.   fGLayout := Value;
  246.   invalidate;
  247. end;
  248.  
  249. procedure TrmCustomImageListGlyph.CalcLayout( const Client: TRect;
  250.           const Caption: string; Layout: TGlyphLayout; Margin, Spacing: Integer;
  251.           var GlyphPos: TPoint; var TextBounds: TRect; BiDiFlags: LongInt );
  252. var
  253.   TextPos: TPoint;
  254.   ClientSize, GlyphSize, TextSize: TPoint;
  255.   TotalSize: TPoint;
  256. begin
  257.   if (BiDiFlags and DT_RIGHT) = DT_RIGHT then
  258.     if Layout = glGlyphLeft then Layout := glGlyphRight
  259.     else
  260.       if Layout = glGlyphRight then Layout := glGlyphLeft;
  261.   { calculate the item sizes }
  262.   ClientSize := Point(Client.Right - Client.Left, Client.Bottom -
  263.     Client.Top);
  264.  
  265.   if assigned(FImages) and (fimageindex > -1) and (fimageindex < fimages.count) then
  266.     GlyphSize := Point(fimages.Width, fimages.Height)
  267.   else
  268.     GlyphSize := Point(0, 0);
  269.  
  270.   if Length(Caption) > 0 then
  271.   begin
  272.     TextBounds := Rect(0, 0, Client.Right - Client.Left, 0);
  273.     DrawText(Canvas.Handle, PChar(Caption), Length(Caption), TextBounds,
  274.       DT_CALCRECT or TextFlags or BiDiFlags);
  275.     TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
  276.       TextBounds.Top);
  277.   end
  278.   else
  279.   begin
  280.     TextBounds := Rect(0, 0, 0, 0);
  281.     TextSize := Point(0,0);
  282.   end;
  283.  
  284.   { If the layout has the glyph on the right or the left, then both the
  285.     text and the glyph are centered vertically.  If the glyph is on the top
  286.     or the bottom, then both the text and the glyph are centered horizontally.}
  287.   if Layout in [glGlyphLeft, glGlyphRight] then
  288.   begin
  289.     GlyphPos.Y := (ClientSize.Y - GlyphSize.Y + 1) div 2;
  290.     TextPos.Y := (ClientSize.Y - TextSize.Y + 1) div 2;
  291.   end
  292.   else
  293.   begin
  294.     GlyphPos.X := (ClientSize.X - GlyphSize.X + 1) div 2;
  295.     TextPos.X := (ClientSize.X - TextSize.X + 1) div 2;
  296.   end;
  297.  
  298.   { if there is no text or no bitmap, then Spacing is irrelevant }
  299.   if (TextSize.X = 0) or (GlyphSize.X = 0) then
  300.     Spacing := 0;
  301.  
  302.   { adjust Margin and Spacing }
  303.   if Margin = -1 then
  304.   begin
  305.     if Spacing = -1 then
  306.     begin
  307.       TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
  308.       if Layout in [glGlyphLeft, glGlyphRight] then
  309.         Margin := (ClientSize.X - TotalSize.X) div 3
  310.       else
  311.         Margin := (ClientSize.Y - TotalSize.Y) div 3;
  312.       Spacing := Margin;
  313.     end
  314.     else
  315.     begin
  316.       TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
  317.         Spacing + TextSize.Y);
  318.       if Layout in [glGlyphLeft, glGlyphRight] then
  319.         Margin := (ClientSize.X - TotalSize.X + 1) div 2
  320.       else
  321.         Margin := (ClientSize.Y - TotalSize.Y + 1) div 2;
  322.     end;
  323.   end
  324.   else
  325.   begin
  326.     if Spacing = -1 then
  327.     begin
  328.       TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
  329.         (Margin + GlyphSize.Y));
  330.       if Layout in [glGlyphLeft, glGlyphRight] then
  331.         Spacing := (TotalSize.X - TextSize.X) div 2
  332.       else
  333.         Spacing := (TotalSize.Y - TextSize.Y) div 2;
  334.     end;
  335.   end;
  336.  
  337.   case GlyphLayout of
  338.     glGlyphLeft:
  339.       begin
  340.         GlyphPos.X := Margin;
  341.         TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
  342.       end;
  343.     glGlyphRight:
  344.       begin
  345.         GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
  346.         TextPos.X := GlyphPos.X - Spacing - TextSize.X;
  347.       end;
  348.     glGlyphTop:
  349.       begin
  350.         GlyphPos.Y := Margin;
  351.         TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
  352.       end;
  353.     glGlyphBottom:
  354.       begin
  355.         GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
  356.         TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
  357.       end;
  358.   end;
  359.   OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top);
  360. end;
  361.  
  362. procedure TrmCustomImageListGlyph.InternalDrawGlyph(const GlyphPos: TPoint);
  363. begin
  364.   if Not (assigned(fimages) and (fimageindex > -1) and (fimageindex < fimages.count)) then exit;
  365.   FImages.draw(Canvas, GlyphPos.X, GlyphPos.Y, fimageindex, enabled);
  366. end;
  367.  
  368. procedure TrmCustomImageListGlyph.InternalDrawText(const Caption: string;
  369.   TextBounds: TRect; BiDiFlags: LongInt);
  370. begin
  371.   with Canvas do
  372.   begin
  373.     Brush.Style := bsClear;
  374.     if not enabled then
  375.     begin
  376.       OffsetRect(TextBounds, 1, 1);
  377.       Font.Color := clBtnHighlight;
  378.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, TextFlags or BiDiFlags);
  379.       OffsetRect(TextBounds, -1, -1);
  380.       Font.Color := clBtnShadow;
  381.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, TextFlags or BiDiFlags);
  382.     end
  383.     else
  384.     begin
  385.       Font.Color := clBtnText;
  386.       DrawText(Handle, PChar(Caption), Length(Caption), TextBounds, TextFlags or BiDiFlags);
  387.     end;
  388.   end;
  389. end;
  390.  
  391. constructor TrmCustomImageListGlyph.create(AOwner: TComponent);
  392. begin
  393.   inherited;
  394.   AutoSize := false;
  395.   Centered := false;
  396. end;
  397.  
  398. function TrmCustomImageListGlyph.TextFlags: integer;
  399. begin
  400.   Result := DT_CENTER or DT_VCENTER or DT_SINGLELINE;
  401. end;
  402.  
  403. end.
  404.