开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 行业应用 > 医药行业 > 查看源码
Uac.pas
资源名称：连锁药店源码.rar　[点击查看]
上传用户：jiete_yjc
上传日期：2010-02-11
资源大小：422k
文件大小：2k
源码类别：

医药行业

开发平台：

Delphi

Uac.pas：源码内容
  1. unit Uac;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ExtCtrls, StdCtrls, ElCLabel, ElURLLabel, Buttons;
  9. type
  10.   Tfac = class(TForm)
  11.     Image1: TImage;
  12.     Button1: TButton;
  13.     Label1: TLabel;
  14.     Label2: TLabel;
  15.     Label3: TLabel;
  16.     ElURLLabel1: TElURLLabel;
  17.     BitBtn1: TBitBtn;
  18.     Label4: TLabel;
  19.     procedure Button1Click(Sender: TObject);
  20.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  21.       Shift: TShiftState);
  22.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  23.     procedure BitBtn1Click(Sender: TObject);
  24.     procedure FormActivate(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.   public
  28.     { Public declarations }
  29.   end;
  31. var
  32.   fac: Tfac;
  34. implementation
  36. {$R *.dfm}
  38. procedure Tfac.Button1Click(Sender: TObject);
  39. var
  40. newbmp:tbitmap;
  41. i,j,bmpheight,bmpwidth:integer;
  42. begin
  43. newbmp:= tbitmap.create;
  44. newbmp.width:=image1.width;
  45. newbmp.height:=image1.height;
  46. bmpheight:=image1.height;
  47. bmpwidth:=image1.width;
  48. i:=0;
  49. while i<=bmpwidth do
  50. begin
  51. j:=i;
  52. while j >0 do
  53. begin
  54.   newbmp.canvas.copyrect(rect(j-1,0,j,bmpheight),
  55.   image1.canvas,
  56.   rect(bmpwidth-i+j-1,0,bmpwidth-i+j,bmpheight));
  57.   newbmp.canvas.copyrect(rect
  58.   (bmpwidth-j,0,bmpwidth-j+1,bmpheight),
  59.   image1.canvas,
  60.   rect(i-j,0,i-j+1,bmpheight));
  61.   j:=j-2;
  63. end;
  64. canvas.draw(2,10,newbmp);
  65. i:=i+2;
  66. ;
  67. end;
  68. newbmp.free;
  70. end;
  72. procedure Tfac.FormKeyDown(Sender: TObject; var Key: Word;
  73.   Shift: TShiftState);
  74. begin
  75. button1.Click;
  76. end;
  78. procedure Tfac.FormClose(Sender: TObject; var Action: TCloseAction);
  79. begin
  80. action:=cafree;
  81. end;
  83. procedure Tfac.BitBtn1Click(Sender: TObject);
  84. begin
  85. close;
  86. end;
  88. procedure Tfac.FormActivate(Sender: TObject);
  89. begin
  90. BUTTON1.Click;
  91. end;
  93. end.