Delph做的百叶窗小程序

做了一个百叶窗小程序
碰到了几个问题，比如说两个用到LoadFromFile函数的地方第一次可以识别相对路径
而如果我更改了其中一个的路径使其变为硬盘上某个绝对路径
那另外一个LoadFromFile就不能识别原先的相对路径了，很奇怪
我采取了加判断绕过这个问题的方法
先上代码，主要的是shutter单元，是作为一个组件来编写的
另外还写了个测试单元。主要针对Shutter的某些属性进行设置从而测试Shutter

unit Shutter;
{ CopyRight@ Swetter }
interface

uses
SysUtils, Windows, Classes, Forms, Controls, Graphics,
Messages, ExtCtrls, Dialogs;

const
{位图344*500,沿Y轴等分成10块
yInc存储了每块的高度
BitMapWid存储了位图的宽度
BitMapHei存储了位图的高度
ShowPixels为随Timer每次递增的行宽度
TimerInterval为Timer的时间间隔}
YInc = 50;
// ShowPixels = 1;
BitMapWid = 344;
BitMapHei = 500;
// TimerInterval = 50;

type
EShutterError = class(Exception);

TShutter = class(TCustomPanel)
private
FMemBitMap: TBitmap;
FMemMskBtMp: TBitmap;
FTimer: TTimer;
FActive: Boolean;
FCurrHei: Integer;
FVRect: TRect;
{FOpen指示百叶窗打开与关闭效果,true则百叶窗打开，false则百叶窗关闭
FDone指示位图是否显示完毕
FViewPic指示是否要查看原图
true为查看原图，此时FCurrHei值直接为yInc而不置0
false为不查看原图，此时在SetActive为false后FCurrHei置0
FNFrstm指示在百叶窗打开模式下（即清空图像）是否已贴上原图
false为未贴上原图，需重新贴一次；true为已贴上原图，可以开始贴屏蔽图}
FOpen: Boolean;
FDone: Boolean;
FViewPic: Boolean;
FOnDone: TNotifyEvent;
FNFrstm: Boolean;
FBkFileName: string;
FFgFileName: string;
ShowPixels: Integer;
TimerInterval: Integer;
procedure IncWid;
procedure SetActive(AValue: Boolean);
procedure ActOnTimer(Sender: TObject);
procedure DoTimer;
protected
procedure Paint; override;
procedure FillBitmap; virtual;
public
procedure CoordinateTimer;
procedure ImageChanged;
property Pixel: Integer read ShowPixels write ShowPixels;
property Interval: Integer read TimerInterval write TimerInterval;
property BkFileName: string read FBkFileName write FBkFileName;
property FgFileName: string read FFgFileName write FFgFileName;
property NFrstm: Boolean read FNFrstm write FNFrstm;
property Open: Boolean read FOpen write FOpen;
property ViewPic: Boolean read FViewPic write FViewPic;
property Active: Boolean read FActive write SetActive;
property Done: Boolean read FDone write FDone;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
{ Publish inherited properties: }
property OnDone: TNotifyEvent read FOnDone write FOnDone;
property Align;
property Alignment;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderWidth;
property BorderStyle;
property Color;
property Ctl3D;
property Font;
property Locked;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
end;

implementation

{ TShutter }

procedure TShutter.DoTimer;
begin
with FTimer do
begin
Enabled := False;
Interval := TimerInterval;
OnTimer := ActOnTimer;
end;
end;

constructor TShutter.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
TimerInterval := 50;
ShowPixels := 1;
FTimer := TTimer.Create(Self);
DoTimer;
{ 实例初始化的值 }
Width := 344;
Height := 500;
FActive := False;
BevelWidth := 3;
FFgFileName := '.\pics\pic.bmp';
FBkFileName := '.\pics\view.bmp';
end;

destructor TShutter.Destroy;
begin
SetActive(False);
FTimer.Free;
inherited Destroy;
end;

procedure TShutter.ActOnTimer(Sender: TObject);
begin
IncWid;
InvalidateRect(Handle, @FVRect, false);
end;

procedure TShutter.FillBitmap;
begin
//FVRect存储了整张内存位图的区域大小
FVRect := Rect(0, 0, BitMapWid, BitMapHei);
//初始化FMemBitMap的宽度和高度
FMemMskBtMp:= TBitmap.Create;
FMemBitMap := TBitmap.Create;
FMemMskBtMp.Width := BitMapWid;
FMemMskBtMp.Height:= BitMapHei;
FMemBitMap.Width := BitMapWid;
FMemBitMap.Height := BitMapHei;
try
if FBkFileName <> '.\pics\view.bmp' then
FMemMskBtMp.LoadFromFile(FBkFileName);
if FFgFileName <> '.\pics\pic.bmp' then
FMemBitMap.LoadFromFile(FFgFileName);
except
on EFOpenError DO
MessageBox(Handle,'打开文件出错，请重试','提示',MB_OK);
end;
end;

procedure TShutter.IncWid;
begin
if not FOpen and (not FDone) then
begin
if FCurrHei + ShowPixels <= yInc then Inc(FCurrHei, ShowPixels) //为保存位图，不要SetActive(False) else FDone := True; end else if FOpen and(not FDone) then begin if FCurrHei - ShowPixels >= 0 then
Dec(FCurrHei, ShowPixels)
else
FDone := True;
end;
end;

procedure TShutter.Paint;
var
i: Integer;
begin
//如果要查看背景图，直接贴上去
if FViewPic then
BitBlt(Canvas.Handle, 0, 0, BitMapWid, BitMapHei,
FMemBitMap.Canvas.Handle, 0, 0, srcCopy);

if FActive and not FOpen then
for i := 0 to 9 do
BitBlt(Canvas.Handle, 0, i*YInc, BitMapWid, FCurrHei,
FMemBitMap.Canvas.Handle, 0, i*YInc, srcCopy)
else if FActive and FOpen then
begin
if not NFrstm then
begin
for i := 0 to 9 do
BitBlt(Canvas.Handle, 0, i*YInc, BitMapWid, YInc,
FMemBitMap.Canvas.Handle, 0, i*YInc, SRCCOPY);
NFrstm := True;
end
else
for i := 0 to 9 do
BitBlt(Canvas.Handle, 0, i*YInc , BitMapWid, YInc - FCurrHei,
FMemMskBtMp.Canvas.Handle, 0, i*YInc, SRCCOPY);
end
else inherited Paint;
end;

procedure TShutter.SetActive(AValue: Boolean);
begin
if AValue and (not FActive) then
begin
FActive := True;
FillBitmap;
{FViewPic,true则查看位图
FOpen,True则为百叶窗打开模式}
if not FOpen then
FCurrHei := 0
else
FCurrHei := YInc;

try
FTimer.Enabled := True; 
except
EShutterError.Create('Timer初始化出错');
end;
end
else if (not AValue) and FActive then
begin
FTimer.Enabled := False; //停止计时
if Assigned(FOnDone) // fire OnDone event,
then FOnDone(Self);
FActive := False; //停止组件
FMemBitMap.Free; //释放内存位图
FMemMskBtMp.Free; //释放屏蔽位图
Invalidate; //清空组件窗口内容
end;
end;

procedure TShutter.ImageChanged;
begin
if (FMemMskBtMp <> nil) and (FMemBitMap <> nil) then
begin
FMemMskBtMp.FreeImage; //释放所占用的位图资源免得重新加载错误
FMemBitMap.FreeImage;
end;
FillBitmap;
end;

procedure TShutter.CoordinateTimer;
begin
DoTimer;
end;

end.

基本上运行效果还是可以的
但是从代码中可以看到很多的boolean值的参数
它们是用来判断功能从而有选择的调用BitBlt函数
设计还是不够好，其实可以用case语句来区分不同功能
我用了太多的boolean来判断导致扩展起来很不方便，容易出BUG