home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / MOON20.ZIP / MOONCOMP.PAS < prev    next >
Pascal/Delphi Source File  |  2001-07-07  |  11KB  |  389 lines
  1. unit mooncomp;
  2.  
  3.  {$i ah_def.inc }
  4.  
  5. { Copyright 1997-2001 Andreas H÷rstemeier            Version 1.3b 2001-01-16 }
  6. { this component is public domain - please check the file moon.hlp for       }
  7. { more detailed info on usage and distributing                               }
  8.  
  9. (*$b-*)   { I may make use of the shortcut boolean eval }
  10.  
  11. (*@/// interface *)
  12. interface
  13.  
  14. (*@/// uses *)
  15. uses
  16. (*$ifndef delphi_1 *)
  17.   windows,
  18. (*$else *)
  19.   winprocs,
  20.   wintypes,
  21. (*$endif *)
  22.   messages,
  23.   graphics,
  24.   classes,
  25.   controls,
  26.   extctrls,
  27.   sysutils,
  28.   ah_math,
  29.   moon;
  30. (*@\\\0000000E0B*)
  31.  
  32. (*$ifdef delphi_1 *)
  33.   {$r moon.r16 }            { The File containing the bitmaps }
  34. (*$else *)
  35.   {$r moon.r32 }            { The File containing the bitmaps }
  36. (*$endif *)
  37.  
  38. type
  39.   TMoonSize=(ms64,ms32,ms16);
  40.   TMoonStyle=(msClassic,msColor);
  41.   TRotate=(rot_none,rot_90,rot_180,rot_270);
  42.   (*@/// TMoon=class(TImage) *)
  43.   TMoon=class(TImage)   (* Borland, why no TCustomImage??? *)
  44.   private
  45.     F_Align: TAlign;
  46.     FBMP : TBitmap;
  47.     FMaxWidth,FMaxHeight: integer;
  48.     FMoonSize: TMoonSize;
  49.     FAngle: extended;
  50.     FDate: TDateTime;
  51.     FDateChanged: boolean;
  52.     FIcon: TIcon;
  53.     FRotate: TRotate;
  54.     fApollo: boolean;
  55.     FApolloDate: TDateTime;
  56.     FStyle: TMoonStyle;
  57.     procedure Set_Size(Value:TMoonSize);
  58.     procedure SetDate(value:TDateTime);
  59.     procedure SetRotate(value:TRotate);
  60.     procedure SetStyle(value:TMoonStyle);
  61.     procedure DoNothing(value:TPicture);
  62.     procedure DoNothingIcon(value:TIcon);
  63.   protected
  64.     procedure SetBitmap;
  65.     procedure Draw_Moon(canvas:TCanvas; offset_x,offset_y,radius,apollo_x,apollo_y:integer);
  66.     procedure WMSize (var Message: TWMSize); message wm_paint;
  67.     function GetIcon:TIcon;
  68.   public
  69.     constructor Create(AOwner:TComponent); override;
  70.     destructor Destroy; override;
  71.   published
  72.     property Align: TAlign read F_Align default alNone;
  73.     property MoonSize:TMoonSize read FMoonSize write Set_Size;
  74.     property Date: TDateTime read FDate write SetDate stored FDateChanged;
  75.     property Picture write donothing stored false;
  76.     property Icon:TIcon read GetIcon write donothingIcon stored false;
  77.     property Rotation:TRotate read FRotate write SetRotate;
  78.     property ShowApollo11:boolean read fApollo write FApollo;
  79.     property MoonStyle:TMoonStyle read fStyle write SetStyle;
  80.     end;
  81.   (*@\\\0000002101*)
  82. (*@\\\0000000F0F*)
  83. (*@/// implementation *)
  84. implementation
  85.  
  86. (*@/// procedure rotate_bitmap(source:TBitmap; rotate:TRotate); *)
  87. procedure rotate_bitmap(source:TBitmap; rotate:TRotate);
  88. var
  89.   tempimage: TBitmap;
  90.   w,h,i,j: integer;
  91.   s_wnd, h_wnd: THandle;
  92. begin
  93.   tempimage:=NIL;
  94.   try
  95.     tempimage:=TBitmap.Create;
  96.     tempimage.assign(source);
  97.     h:=source.height-1;
  98.     w:=source.width-1;
  99.     s_wnd:=source.canvas.handle;
  100.     h_wnd:=tempimage.canvas.handle;
  101.     case rotate of
  102.       rot_none: ;
  103.       (*@/// rot_90:   rotate pixel by pixel *)
  104.       rot_90: begin
  105.         for i:=0 to w do
  106.           for j:=0 to h do begin
  107.             setpixel(s_wnd,i,h-j,getpixel(h_wnd,j,i));
  108.             { Much faster than using canvas.pixels[] }
  109.             end;
  110.           end;
  111.       (*@\\\000000041C*)
  112.       (*@/// rot_180:  rotate via the StretchBlt *)
  113.       rot_180: begin
  114.         source.canvas.copyrect(
  115.           rect(w,h,0,0),
  116.           tempimage.canvas,
  117.           rect(0,0,w,h));
  118.         end;
  119.       (*@\\\*)
  120.       (*@/// rot_270:  rotate pixel by pixel *)
  121.       rot_270: begin
  122.         for i:=0 to w do
  123.           for j:=0 to h do begin
  124.             setpixel(s_wnd,w-i,j,getpixel(h_wnd,j,i));
  125.             end;
  126.         end;
  127.       (*@\\\000000041C*)
  128.       end;
  129.   finally
  130.     tempimage.free;
  131.     end;
  132.   end;
  133. (*@\\\0000001201*)
  134.  
  135. const
  136.   ResString:array[TMoonSize] of string=('MOON_LARGE'#0,'MOON_SMALL'#0,
  137.                                         'MOON_TINY'#0);
  138.   ResStringBW:array[TMoonSize] of string=
  139.     ('MOON_BW_LARGE'#0,'MOON_BW_SMALL'#0,
  140.                                         'MOON_BW_TINY'#0);
  141.   ResStringColor:array[TMoonSize] of string=('MOON_COLOR_LARGE'#0,
  142.                                              'MOON_COLOR_SMALL'#0,
  143.                                              'MOON_COLOR_TINY'#0);
  144.   size_moon:array[TMoonSize,0..6] of integer=
  145.     ((64,64,28,31,28,41,29),
  146.      (32,32,14,15,14,20,15),
  147.      (16,16,7,7,7,9,7));   { max_x,max_y,offset_y,offset_x,radius,xApollo,yApollo }
  148.  
  149. (*@/// constructor TMoon.Create(AOwner: TComponent); *)
  150. constructor TMoon.Create(AOwner: TComponent);
  151. begin
  152.   inherited Create(AOwner);
  153.   FBMP := TBitmap.Create;  {Note dynamic allocation of the pointer}
  154.   SetDate(now);
  155.   FDateChanged:=false;
  156.   ficon:=TIcon.Create;
  157.   Set_Size(ms64);
  158.   f_align:=alNone;
  159.   fApollo:=true;
  160.   FApolloDate:=EncodeDate(1969,7,20)+EncodeTime(20,17,43,0);
  161.   end;
  162. (*@\\\0000000B01*)
  163. (*@/// procedure TMoon.SetBitmap; *)
  164. procedure TMoon.SetBitmap;
  165. begin
  166.   case FStyle of
  167.     msClassic: FBMP.Handle := LoadBitmap(hInstance, @ResString[FMoonSize][1]);
  168.     msColor:   FBMP.Handle := LoadBitmap(hInstance, @ResStringColor[FMoonSize][1]);
  169.     end;
  170.   Self.Picture.Graphic := FBMP as TGraphic;
  171.   draw_moon(self.canvas,size_moon[FMoonSize,3],
  172.     size_moon[FMoonSize,2],size_moon[FMoonSize,4],
  173.     size_moon[FMoonSize,5],size_moon[FMoonSize,6]);
  174.   rotate_bitmap(self.picture.bitmap,frotate);
  175.   end;
  176. (*@\\\0000000701*)
  177. (*@/// procedure TMoon.WMSize(var Message: TWMSize); *)
  178. procedure TMoon.WMSize(var Message: TWMSize);
  179. begin
  180.   inherited;
  181.   if (csDesigning in ComponentState) then begin
  182.     Width := FMaxWidth;
  183.     Height := FMaxHeight;
  184.     end;
  185.   end;
  186. (*@\\\*)
  187. (*@/// procedure TMoon.Set_Size(Value:TMoonSize); *)
  188. procedure TMoon.Set_Size(Value:TMoonSize);
  189. begin
  190.   FMoonSize:=value;
  191.   FMaxHeight:=size_moon[FMoonSize,0];
  192.   FMaxWidth:=size_moon[FMoonSize,1];
  193.   Self.Height := FMaxHeight;
  194.   Self.Width := FMaxWidth;
  195.   setbitmap;
  196.   end;
  197. (*@\\\0000000803*)
  198. (*@/// procedure TMoon.Draw_Moon(canvas:TCanvas; offset_x,offset_y,radius,apollo_x,apollo_y:integer); *)
  199. procedure TMoon.Draw_Moon(canvas:TCanvas; offset_x,offset_y,radius,apollo_x,apollo_y:integer);
  200. var
  201.   y,radius2: integer;
  202.   xm,scale: extended;
  203.   xmax,xmin:integer;
  204. begin
  205.  
  206. (* FAngle = 0   -> New Moon
  207.    FAngle = 90  -> First Quarter
  208.    FAngle = 180 -> Full Moon
  209.    FAngle = 270 -> Last Quarter *)
  210.  
  211.   if fApollo and (FApolloDate<fdate) then begin
  212.     canvas.pixels[apollo_x,apollo_y]:=clRed;
  213.     end;
  214.   canvas.brush.color:=clBlack;
  215.   radius2:=radius*radius;
  216.   scale:=cos_d(fangle);
  217.   for y:=0 to radius do begin
  218.     xm:=sqrt(radius2-y*y);
  219.     xmax:=round(xm);
  220.     xmin:=round(xm*scale);
  221.     if fangle<180 then begin
  222.       xmax:=offset_x-xmax-1;
  223.       xmin:=offset_x-xmin;
  224.       end
  225.     else begin
  226.       xmax:=offset_x+xmax+1;
  227.       xmin:=offset_x+xmin;
  228.       end;
  229.     canvas.moveto(xmin,y+offset_y);
  230.     canvas.lineto(xmax,y+offset_y);
  231.     canvas.moveto(xmin,-y+offset_y);
  232.     canvas.lineto(xmax,-y+offset_y);
  233.     end;
  234.   end;
  235. (*@\\\*)
  236. (*@/// procedure TMoon.SetDate(Value: TDateTime); *)
  237. procedure TMoon.SetDate(Value: TDateTime);
  238. begin
  239.   FDate:=Value;
  240.   FAngle:=put_in_360(moon_phase_angle(Value));
  241.   setbitmap;
  242.   FDateChanged:=true;
  243.   end;
  244. (*@\\\0000000601*)
  245. (*@/// procedure TMoon.SetRotate(value:TRotate); *)
  246. procedure TMoon.SetRotate(value:TRotate);
  247. begin
  248.   if frotate<>value then begin
  249.     frotate:=value;
  250.     setbitmap;
  251.     end;
  252.   end;
  253. (*@\\\0000000301*)
  254. (*@/// procedure TMoon.SetStyle(value:TMoonStyle); *)
  255. procedure TMoon.SetStyle(value:TMoonStyle);
  256. begin
  257.   if fstyle<>value then begin
  258.     fstyle:=value;
  259.     setbitmap;
  260.     end;
  261.   end;
  262. (*@\\\*)
  263. (*@/// procedure TMoon.DoNothing(value:TPicture); *)
  264. procedure TMoon.DoNothing(value:TPicture);
  265. begin
  266.   end;
  267. (*@\\\*)
  268. (*@/// procedure TMoon.DoNothingIcon(value:TIcon); *)
  269. procedure TMoon.DoNothingIcon(value:TIcon);
  270. begin
  271.   end;
  272. (*@\\\*)
  273. (*@/// destructor TMoon.Destroy; *)
  274. destructor TMoon.Destroy;
  275. begin
  276.   FBMP.free;
  277.   ficon.free;
  278.   inherited destroy;
  279.   end;
  280. (*@\\\*)
  281. (*@/// function TMoon.GetIcon:TIcon; *)
  282. function TMoon.GetIcon:TIcon;
  283. var
  284.   IconSizeX : integer;
  285.   IconSizeY : integer;
  286.   AndMask : TBitmap;
  287.   XOrMask : TBitmap;
  288. (*$ifdef delphi_1 *)
  289.   BitmapX,BitmapA: wintypes.TBitmap;
  290.   AndData, XOrData: pointer;
  291.   AndLen, XorLen: integer;
  292. (*$else *)
  293.   IconInfo : TIconInfo;
  294. (*$endif *)
  295.   Size: TMoonSize;
  296. begin
  297.   AndMask:=NIL;
  298.   XOrMask:=NIL;
  299.   try
  300.     {Get the icon size}
  301.     IconSizeX := GetSystemMetrics(SM_CXICON);
  302.     IconSizeY := GetSystemMetrics(SM_CYICON);
  303.  
  304.     Size:=ms32;
  305.     if false then
  306.     else if (IconSizeX=16) and (IconSizeY=16) then
  307.       Size:=ms16
  308.     else if (IconSizeX=32) and (IconSizeY=32) then
  309.       Size:=ms32
  310.     else if (IconSizeX=64) and (IconSizeY=64) then
  311.       size:=ms64
  312.     else
  313.       (* ??? *);
  314.  
  315.     {Create the "And" mask}
  316.     AndMask := TBitmap.Create;
  317.     AndMask.Monochrome := true;
  318.     AndMask.Width := IconSizeX;
  319.     AndMask.Height := IconSizeY;
  320.  
  321.     FBMP.Handle := LoadBitmap(hInstance, @ResStringBW[Size][1]);
  322.     AndMask.canvas.copyrect(Rect(0,0,size_moon[Size,0],size_moon[Size,1]),
  323.                          FBMP.canvas,
  324.                          Rect(0,0,size_moon[Size,0],size_moon[Size,1]));
  325.  
  326.     {Create the "XOr" mask}
  327.     XOrMask := TBitmap.Create;
  328.     XOrMask.Width := IconSizeX;
  329.     XOrMask.Height := IconSizeY;
  330.  
  331.     {Draw on the "XOr" mask}
  332.     case FStyle of
  333.       msClassic: FBMP.Handle := LoadBitmap(hInstance, @ResString[Size][1]);
  334.       msColor:   FBMP.Handle := LoadBitmap(hInstance, @ResStringColor[Size][1]);
  335.       end;
  336.  
  337.     XOrMask.canvas.copyrect(Rect(0,0,size_moon[Size,0],size_moon[Size,1]),
  338.                          FBMP.canvas,
  339.                          Rect(0,0,size_moon[Size,0],size_moon[Size,1]));
  340.  
  341.     draw_moon(XOrMask.Canvas,size_moon[Size,3],
  342.       size_moon[Size,2],size_moon[Size,4],
  343.       size_moon[Size,5],size_moon[Size,6]);
  344.  
  345.     rotate_bitmap(XOrMask,frotate);
  346.     rotate_bitmap(AndMask,frotate);
  347.  
  348.     (*@/// Create a icon *)
  349.     (*$ifdef delphi_1 *)
  350.     AndData:=NIL;
  351.     XorData:=NIL;
  352.     try
  353.       GetObject(AndMask.handle, SizeOf(BitmapA), @BitmapA);
  354.       AndLen := BitmapA.bmWidthBytes * BitmapA.bmHeight * BitmapA.bmPlanes;
  355.       AndData := MemAlloc(AndLen);
  356.       GetBitmapBits(AndMask.handle, AndLen, AndData);
  357.       GetObject(XOrMask.handle, SizeOf(BitmapX), @BitmapX);
  358.       XorLen := BitmapX.bmWidthBytes * BitmapX.bmHeight * BitmapX.bmPlanes;
  359.       XorData := MemAlloc(XorLen);
  360.       GetBitmapBits(XorMask.handle, XorLen, XorData);
  361.  
  362.       FIcon.Handle := CreateIcon(hinstance,IconSizeX,IconSizeY,
  363.         BitmapX.bmPlanes,BitmapX.bmBitsPixel, AndData, XOrData);
  364.     finally
  365.       if AndData<>NIL then  FreeMem(AndData, AndLen);
  366.       if XorData<>NIL then  FreeMem(XorData, XorLen);
  367.       end;
  368.     (*$else *)
  369.     IconInfo.fIcon := true;
  370.     IconInfo.xHotspot := 0;
  371.     IconInfo.yHotspot := 0;
  372.     IconInfo.hbmMask := AndMask.Handle;
  373.     IconInfo.hbmColor := XOrMask.Handle;
  374.     FIcon.Handle := CreateIconIndirect(IconInfo);
  375.     (*$endif *)
  376.     (*@\\\*)
  377.  
  378.     result := FIcon;
  379.   finally
  380.     AndMask.Free;
  381.     XOrMask.Free;
  382.     end;
  383.   end;
  384. (*@\\\0000004A07*)
  385. (*@\\\0000001D01*)
  386. (*$ifdef delphi_ge_2 *) (*$warnings off *) (*$endif *)
  387. end.
  388. (*@\\\003F000D01000D01000D01000E01000E05000011000E05*)
  389.