高人都到那里去啦?关于TPictureProperty的问题,那位牛人可以解决啊,分好商量! (200分)

  • 主题发起人 主题发起人 BADBOYNET
  • 开始时间 开始时间
B

BADBOYNET

Unregistered / Unconfirmed
GUEST, unregistred user!
下面这个控件可以编译,但在运行时虽说找不到Libhelp.dcu.各位帮帮忙啊!


unit MeetingRoom;

interface

uses
Graphics, Chair, Designintf, DesignEditors, PicEdit, StrEdit, Types, Door, Desk, IniFiles,
SysUtils, Classes, Controls, ExtCtrls;

type
TMeetingRoom = class(TPanel)
private
IsFocused:Boolean;
FDoors: TStringList;
FDesks: TStringList;
FChairs: TStringList;
FGroupName: TStringList;
FGroups: TStringList;
FBackGround: TPicture;
FRoomName: String;
FPanelColor: TColor;
FPanelFont: TFont;
CaptionPanel: TPanel;
procedure SetDoors(const Value: TStringList);
procedure SetChairs(const Value: TStringList);
procedure SetGroupName(const Value: TStringList);
procedure SetGroups(const Value: TStringList);
procedure SetDesks(const Value: TStringList);
procedure SetBackGround(const Value: TPicture);
procedure Paint;override;
procedure SetRoomName(const Value: String);
function DoorCount:Integer;
function DeskCount:Integer;
function ChairCount:Integer;
function MakeRect(StartPoint,EndPoint:TPoint):TRect;overload;
function MakeRect(StartX,StartY,EndX,EndY:Integer):TRect;overload;
function FindClassCount(AClass:TClass):integer;
procedure DrawPanelBar;
procedure SetPanelColor(const Value: TColor);
procedure SetPanelFont(const Value: TFont);
procedure FreeComponentMem(AComponent:TObject);
{ Private declarations }
protected
Constructor Create(AOwner:TComponent);override;
Destructor Destroy;override;
{ Protected declarations }
public
procedure Show;
procedure FindChair(FindWhoID,FindWho:String);
function ClickChair(x,y:integer):TChair;
procedure SaveMeetingRoomToFile(AFileName:String);
procedure LoadMeetionRoomFromFile(AFileName:String);
{ Public declarations }
published
property Caption;
property PanelColor:TColor read FPanelColor write SetPanelColor ;
property PanelFont:TFont read FPanelFont write SetPanelFont;
property RoomName:String read FRoomName write SetRoomName;
property BackGround:TPicture read FBackGround write SetBackGround;
property Doors:TStringList read FDoors write SetDoors;
property Chairs:TStringList read FChairs write SetChairs;
property Desks:TStringList read FDesks write SetDesks;
property Groups:TStringList read FGroups write SetGroups;
property GroupName:TStringList read FGroupName write SetGroupName;

{ Published declarations }
end;

procedure Register;

implementation

procedure Register;
begin
RegisterComponents('badboy', [TMeetingRoom]);
RegisterPropertyEditor(typeInfo(TPicture),TMeetingRoom,'BackGround',TPictureProperty);
RegisterPropertyEditor(typeInfo(TStringList),TMeetingRoom,'Chairs',TStringListProperty);
RegisterPropertyEditor(typeInfo(TStringList),TMeetingRoom,'Desks',TStringListProperty);
RegisterPropertyEditor(typeInfo(TStringList),TMeetingRoom,'Doors',TStringListProperty);
end;

{ TMeetingRoom }

function TMeetingRoom.ChairCount: Integer;
begin
Result := FindClassCount(TChair);
end;

function TMeetingRoom.ClickChair(x, y: integer):TChair;
var
i:integer;
begin
Result := nil;
for i:= 0 to ComponentCount do
begin
if (Components.ClassType=TChair) and
(TChair(Components).Left in [x-5..x+5]) and (TChair(Components).Top in [y-5..y+5]) then
Result := TChair(Components);
end;
end;

constructor TMeetingRoom.Create(AOwner: TComponent);
begin
//initializtion all property
FBackGround := TPicture.Create;
FPanelFont := TFont.Create;
FGroupName := TStringList.Create;
FGroups := TStringList.Create;
FDoors := TStringList.Create;
FChairs := TStringList.Create;
FDesks := TStringList.Create;
inherited;
//initializtion MeetingRoom property;
BevelOuter := bvLowered;
Caption := '';
//initializtion CaptionBar;
CaptionPanel := TPanel.Create(nil);
DrawPanelBar;
end;

destructor TMeetingRoom.Destroy;
begin
FreeComponentMem(FBackGround);
FreeComponentMem(CaptionPanel);
FreeComponentMem(FDoors);
FreeComponentMem(FDesks);
FreeComponentMem(FChairs);
FreeComponentMem(FGroupName);
FreeComponentMem(FGroups);
inherited;
end;

function TMeetingRoom.DoorCount: Integer;
begin
Result := FindClassCount(TDoor);
end;

procedure TMeetingRoom.FindChair(FindWhoID,FindWho:String);
var
i:integer;
begin
for i:=0 to ComponentCount-1 do
begin
if (ClassType=TChair) and ((TChair(Components).WhoID=FindWhoID) or (TChair(Components).Who=FindWho)) then
begin
Exit;
end;
end;
end;

function TMeetingRoom.MakeRect(StartPoint, EndPoint: TPoint): TRect;
var
TempRect:TRect;
begin
TempRect.Left := StartPoint.X;
TempRect.Top := StartPoint.Y;
TempRect.Right := EndPoint.X;
TempRect.Bottom := EndPoint.Y;
Result := TempRect;
end;

function TMeetingRoom.FindClassCount(AClass: TClass): integer;
var i,RCount:Integer;
begin
RCount := 0;
for i:=0 to componentCount-1 do
begin
if Components.ClassType=AClass then
RCount := RCount+1;
end;
Result := RCount;
end;

function TMeetingRoom.MakeRect(StartX, StartY, EndX, EndY: Integer): TRect;
var
TempRect:TRect;
begin
TempRect.Left := StartX;
TempRect.Top := StartY;
TempRect.Right := EndX;
TempRect.Bottom := EndY;
Result := TempRect;
end;

procedure TMeetingRoom.Paint;
var SourceRect,DestRect:TRect;
begin
inherited;
if Assigned(FBackGround.Bitmap) then
begin
SourceRect := MakeRect(0,0,BackGround.Bitmap.Width,BackGround.Bitmap.Height);
DestRect := MakeRect(0,0,Width,Height);
Canvas.BrushCopy(DestRect,BackGround.Bitmap,SourceRect,clwhite);
end;
end;

procedure TMeetingRoom.SetBackGround(const Value: TPicture);
begin
FBackGround.Assign(Value);
end;

procedure TMeetingRoom.SetChairs(const Value: TStringList);
begin
FChairs.Assign(Value);
end;

procedure TMeetingRoom.SetDoors(const Value: TStringList);
begin
FDoors.Assign(Value);
end;

procedure TMeetingRoom.SetGroupName(const Value: TStringList);
begin
FGroupName.Assign(Value);
end;

procedure TMeetingRoom.SetGroups(const Value: TStringList);
begin
FGroups.Assign(Value)
end;

procedure TMeetingRoom.SetRoomName(const Value: String);
begin
FRoomName := Value;
DrawPanelBar;
end;

procedure TMeetingRoom.SetDesks(const Value: TStringList);
begin
FDesks.Assign(Value);
end;

procedure TMeetingRoom.Show;
begin
Paint;
end;

function TMeetingRoom.DeskCount: Integer;
begin
Result := FindClassCount(TDesk);
end;

procedure TMeetingRoom.DrawPanelBar;
begin
with CaptionPanel do
begin
Parent := self;
Align := alTop;
Caption := RoomName;
Color := PanelColor;
Font := PanelFont;
end;
end;

procedure TMeetingRoom.SetPanelColor(const Value: TColor);
begin
FPanelColor := Value;
DrawPanelBar;
end;

procedure TMeetingRoom.SetPanelFont(const Value: TFont);
begin
FPanelFont.Assign(Value);
DrawPanelBar;
end;

procedure TMeetingRoom.FreeComponentMem(AComponent: TObject);
begin
if Assigned(AComponent) then
AComponent.Free;
end;

procedure TMeetingRoom.LoadMeetionRoomFromFile(AFileName: String);
begin
end;

procedure TMeetingRoom.SaveMeetingRoomToFile(AFileName: String);
var i:integer;
TempIni:TIniFile;
begin
try
TempIni := TIniFile.Create(AFileName);
for i:= 0 to ComponentCount-1 do
begin
TempIni.WriteString(Components.Name,'ClassName',Components.ClassName);
if Components.ClassType = TChair then
begin
TempIni.WriteString(Components.Name,'Who',TChair(Components).Who);
TempIni.WriteString(Components.Name,'WhoID',TChair(Components).WhoID);
TempIni.WriteInteger(Components.Name,'Left',TChair(Components).Left);
TempIni.WriteInteger(Components.Name,'Top',TChair(Components).Top);
TempIni.WriteInteger(Components.Name,'Width',TChair(Components).Width);
TempIni.WriteInteger(Components.Name,'Height',TChair(Components).Height);
TempIni.WriteInteger(Components.Name,'Direction',TChair(Components).Direction);
end;
TempIni.WriteString(Components.Name,'ClassName',Components.ClassName);
TempIni.WriteString(Components.Name,'ClassName',Components.ClassName);
end;
except
end;
end;

end.
 
libhelp.dcu 在delphi/lib目录下,use进去看看
 
我用的是Delphi7,搜遍硬盘都没有找到这个文件啊!
to jlutt-sadan:
你用的是什么版本呢?如果你有请发给我一份.
30452570@elong.com
 
我用的是delphi5,不知道7下面能不能使用,发给你先
您的信件已经成功发送到 30452570@elong.com
 
还是不行啊,
难到Delphi7居然犯这样的错误?我想应该有其它方法解决的吧
 
哦,没用过d7,sorry
 
后退
顶部