home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / ALIGRID.ZIP / ICONGRID.PAS < prev    next >
Pascal/Delphi Source File  |  2000-02-06  |  8KB  |  280 lines
  1. unit icongrid;
  2. (*@/// interface *)
  3. interface
  4.   (*$x+ *)
  5.  
  6. (*@/// uses *)
  7. uses
  8.   windows,
  9.   sysutils,
  10.   classes,
  11.   graphics,
  12.   grids,
  13.   aligrid;
  14. (*@\\\000000030C*)
  15.  
  16. type
  17. (*@///   TCellPropertiesIcon=class(TCellProperties) *)
  18. TCellPropertiesIcon=class(TCellProperties)
  19. protected
  20.   f_icon: TIcon;
  21.   procedure SetIcon(value: TIcon);
  22.   procedure ReadSingleProperty(Proptype:integer; Reader:TReader; grid:TStringAlignGrid);  override;
  23.   procedure WriteToWriter(writer:TWriter); override;
  24. public
  25.   property Icon:TIcon read f_icon write SetIcon;
  26.   destructor destroy;                      override;
  27.   procedure assign(value:TCellProperties); override;
  28.   function isempty: boolean;               override;
  29.   function clone:TCellProperties;          override;
  30. end;
  31. (*@\\\*)
  32. (*@///   TIconGrid=class(TStringAlignGrid) *)
  33. TIconGrid=class(TStringAlignGrid)
  34. protected
  35.   procedure DrawCellBack(ACol,ARow:Longint; var ARect:TRect; AState:TGridDrawState); override;
  36.   procedure Initialize;  override;
  37. protected
  38. (*@///   property read/write for the icons *)
  39. function GetIconCell(ACol,ARow: longint):TIcon;
  40. procedure SetIconCell(ACol,ARow: longint; const Value: TIcon);
  41. (*@\\\0000000201*)
  42.   procedure IconChanged(AIcon: TObject);
  43. public
  44.   property CellIcon[ACol,ARow:longint]: TIcon read GetIconCell write SetIconCell;
  45.   end;
  46. (*@\\\0032000401000401000401000401*)
  47.  
  48. procedure Register;
  49. (*@\\\0000000801*)
  50. (*@/// implementation *)
  51. implementation
  52.  
  53. const
  54.   prop_icon     = 100;  (* save value to keep space for basic class to expand *)
  55.  
  56. type
  57.   tp_char=^char;
  58. (*@/// function buf2hexstring(p:tp_char, size:longint):string; *)
  59. function buf2hexstring(p:tp_char; size:longint):string;
  60. begin
  61.   result:='';
  62.   while size>0 do begin
  63.     result:=result+inttohex(ord(p^),2);
  64.     dec(size);
  65.     inc(p);
  66.     end;
  67.   end;
  68. (*@\\\0000000401*)
  69. (*@/// procedure WriteStream(Writer: TWriter; v:TStream); *)
  70. procedure WriteStream(Writer: TWriter; v:TStream);
  71. const
  72.   linesize=100;
  73. var
  74.   buf: pointer;
  75.   size: integer;
  76. begin
  77.   buf:=NIL;
  78.   try
  79.     getmem(buf,linesize);
  80.     size:=linesize;
  81.     while size>0 do begin
  82.       size:=v.read(buf^,linesize);
  83.       if size>0 then
  84.         writer.writestring(buf2hexstring(buf,size));
  85.       end;
  86.     writer.writestring('.');
  87.   finally
  88.     if buf<>NIL then
  89.       freemem(buf,linesize);
  90.     end;
  91.   end;
  92. (*@\\\0000000F01*)
  93. (*@/// function ReadStream(Reader: TReader):TMemoryStream; *)
  94. function ReadStream(Reader: TReader):TMemoryStream;
  95. var
  96.   s: string;
  97.   h: char;
  98. begin
  99.   result:=NIL;
  100.   try
  101.     result:=TMemoryStream.Create;
  102.     repeat
  103.       s:=reader.readstring;
  104.       if s<>'.' then
  105.         while length(s)>0 do begin
  106.           h:=chr(strtoint('$'+copy(s,1,2)));
  107.           result.write(h,1);
  108.           s:=copy(s,3,length(s));
  109.           end;
  110.     until s='.';
  111.     result.seek(0,0);
  112.   except
  113.     result.free;
  114.     RAISE;
  115.     end;
  116.   end;
  117. (*@\\\0000001216*)
  118.  
  119.  
  120. (*@/// destructor TCellPropertiesIcon.destroy; *)
  121. destructor TCellPropertiesIcon.destroy;
  122. begin
  123.   f_icon.free;
  124.   inherited destroy;
  125.   end;
  126. (*@\\\0000000415*)
  127. (*@/// procedure TCellPropertiesIcon.ReadSingleProperty(Proptype:integer; Reader:TReader; grid:TStringAlignGrid); *)
  128. procedure TCellPropertiesIcon.ReadSingleProperty(Proptype:integer; Reader:TReader; grid:TStringAlignGrid);
  129. var
  130.   f: TIcon;
  131.   s: TStream;
  132. begin
  133.   case proptype of
  134.     prop_icon   : begin
  135.       f:=NIL;
  136.       s:=NIL;
  137.       try
  138.         f:=TIcon.Create;
  139.         s:=ReadStream(Reader);
  140.         f.loadfromstream(s);
  141.         self.icon:=f;
  142.         self.icon.OnChange:=TIconGrid(grid).iconchanged;
  143.       finally
  144.         f.free;
  145.         s.free;
  146.         end;
  147.       end;
  148.     else inherited ReadSingleProperty(Proptype,Reader,grid);
  149.     end;
  150.   end;
  151. (*@\\\0000000C09*)
  152. (*@/// procedure TCellPropertiesIcon.WriteToWriter(writer:TWriter); *)
  153. procedure TCellPropertiesIcon.WriteToWriter(writer:TWriter);
  154. var
  155.   h: TMemoryStream;
  156. begin
  157. (*@///   if self.icon<>NIL then *)
  158. if self.icon<>NIL then begin
  159.   writer.writeinteger(prop_icon);
  160.   h:=NIL;
  161.   try
  162.     h:=TMemoryStream.Create;
  163.     icon.savetostream(h);
  164.     h.seek(0,0);
  165.     WriteStream(writer,h);
  166.   finally
  167.     h.free;
  168.     end;
  169.   end;
  170. (*@\\\0000000305*)
  171.   inherited WriteToWriter(writer);
  172.   end;
  173. (*@\\\0000000514*)
  174. (*@/// procedure TCellPropertiesIcon.SetIcon(value: TIcon); *)
  175. procedure TCellPropertiesIcon.SetIcon(value: TIcon);
  176. begin
  177.   if value=NIL then begin
  178.     f_icon.free;
  179.     f_icon:=NIL;
  180.     end
  181.   else begin
  182.     if f_icon=NIL then
  183.       f_icon:=TIcon.Create;
  184.     f_icon.assign(value);
  185.     end;
  186.   end;
  187. (*@\\\*)
  188. (*@/// procedure TCellPropertiesIcon.assign(value:TCellProperties); *)
  189. procedure TCellPropertiesIcon.assign(value:TCellProperties);
  190. begin
  191.   inherited assign(value);
  192.   if value is TCellPropertiesIcon then
  193.     SetIcon(TCellPropertiesIcon(value).icon)
  194.   else
  195.     SetIcon(NIL);
  196.   end;
  197. (*@\\\0000000501*)
  198. (*@/// function TCellPropertiesIcon.isempty: boolean; *)
  199. function TCellPropertiesIcon.isempty: boolean;
  200. begin
  201.   result:=inherited isempty and ((f_icon=NIL) or (f_icon.handle=0));
  202.   end;
  203. (*@\\\0000000344*)
  204. (*@/// function TCellPropertiesIcon.clone:TCellProperties; *)
  205. function TCellPropertiesIcon.clone:TCellProperties;
  206. begin
  207.   result:=TCellPropertiesIcon.Create(self.f_grid);
  208.   result.assign(self);
  209.   end;
  210. (*@\\\*)
  211.  
  212. (*@/// procedure TIconGrid.Initialize; *)
  213. procedure TIconGrid.Initialize;
  214. begin
  215.   inherited Initialize;
  216.   CellPropertiesClass:=TCellPropertiesIcon;
  217.   end;
  218. (*@\\\000C000501000501000501*)
  219. (*@/// procedure TIconGrid.IconChanged(AIcon: TObject); *)
  220. procedure TIconGrid.IconChanged(AIcon: TObject);
  221. begin
  222.   invalidate;
  223.   end;
  224. (*@\\\*)
  225. (*@/// function TIconGrid.GetIconCell(ACol,ARow: longint):TIcon; *)
  226. function TIconGrid.GetIconCell(ACol,ARow: longint):TIcon;
  227. var
  228.   v,w: TCellProperties;
  229. begin
  230.   w:=NIL;
  231.   try
  232.     v:=GetItemCell(ACol,ARow,FPropCell);
  233.     if (v=NIL) or not (v is TCellPropertiesIcon)  then begin
  234.       w:=v;
  235.       v:=CellPropertiesClass.Create(self);
  236.       if w<>NIL then
  237.         v.assign(w);
  238.       setitemcell(ACol,ARow,FPropCell,v);
  239.       end;
  240.     if TCellPropertiesIcon(v).icon=NIL then begin
  241.       TCellPropertiesIcon(v).f_icon:=TIcon.Create;
  242.       TCellPropertiesIcon(v).icon.OnChange:=iconchanged;
  243.       end;
  244.     result:=TCellPropertiesIcon(v).icon;
  245.   finally
  246.     w.free;
  247.     end;
  248.   end;
  249. (*@\\\0000000801*)
  250. (*@/// procedure TIconGrid.SetIconCell(ACol,ARow: longint; const Value: TIcon); *)
  251. procedure TIconGrid.SetIconCell(ACol,ARow: longint; const Value: TIcon);
  252. begin
  253.   (ObjectCell[ACol,ARow] as TCellPropertiesIcon).icon:=value;
  254.   Invalidate;
  255.   end;
  256. (*@\\\0000000301*)
  257. (*@/// procedure TIconGrid.DrawCellBack(ACol,ARow:Longint; ARect:TRect; AState:TGridDrawState); *)
  258. procedure TIconGrid.DrawCellBack(ACol,ARow:Longint; var ARect:TRect; AState:TGridDrawState);
  259. var
  260.   v: TCellProperties;
  261. begin
  262.   inherited DrawCellBack(ACol,ARow,ARect,AState);
  263.   v:=GetItemCell(ACol,ARow,FPropCell);
  264.   if (v<>NIL) and (v is TCellPropertiesIcon) and (TCellPropertiesIcon(v).icon<>NIL) and (TCellPropertiesIcon(v).icon.handle<>0) then begin
  265.     Canvas.Draw(Arect.Left,Arect.Top,TCellPropertiesIcon(v).icon);
  266.     Arect.Left:=ARect.Left+TCellPropertiesIcon(v).icon.width;
  267.     end;
  268.   end;
  269. (*@\\\0000000701*)
  270.  
  271. (*@/// procedure Register; *)
  272. procedure Register;
  273. begin
  274.   RegisterComponents('Custom', [TIconGrid]);
  275.   end;
  276. (*@\\\*)
  277. (*@\\\0000001601*)
  278. end.
  279. (*@\\\0001000011000201*)
  280.