fperscard.pas

来自「FlexGraphics是一套创建矢量图形的VCL组件」· PAS 代码 · 共 286 行

unit fPersCard;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, FlexBase, FlexUtils, ComCtrls, ExtCtrls, StdCtrls;

type
  TfmPersonCard = class(TForm)
    sbClose: TSpeedButton;
    lbFirstName: TLabel;
    lbCaption: TLabel;
    lbPersonId: TLabel;
    Image1: TImage;
    lbLastName: TLabel;
    procedure sbCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure sbShowClick(Sender: TObject);
  private
    { Private declarations }
    FControl: TFlexControl;
    FPassId: integer;
    FPersonId: integer;
    FMouseAnchor: TPoint;
    FMoving: boolean;
    FTexture: TBitmap;
    FIsAlarm: boolean;
  protected
    procedure UpdateForm;
  public
    { Public declarations }
  end;

var
  fmPersonCard: TfmPersonCard;
  CardForms: TList;

procedure ShowPersonCard(PassId, PersonId: integer; AControl: TFlexControl;
  IsAlarm: boolean = false);
procedure HidePersonCard(AControl: TFlexControl);
procedure HideAllPersonCards;

implementation

{$R *.DFM}

uses
  dMain;

procedure ShowPersonCard(PassId, PersonId: integer; AControl: TFlexControl;
  IsAlarm: boolean = false);
var Form: TfmPersonCard;
    i: integer;
    R: TRect;
    P: TPoint;
begin
 Form := Nil;
 if Assigned(CardForms) then
  for i:=0 to CardForms.Count-1 do
   if TfmPersonCard(CardForms[i]).FControl = AControl then begin
    Form := TfmPersonCard(CardForms[i]);
    break;
   end;
 if not Assigned(Form) then begin
  Form := TfmPersonCard.Create(Application);
  Form.FControl := AControl;
  // Set form position
  R := AControl.PaintRect;
  P := AControl.Owner.ClientToScreen(Point(R.Left, R.Top));
  Form.Left := P.X - (Form.Width - (R.Right - R.Left)) div 2;
  Form.Top := P.Y - Form.Height -5;
 end;
 with Form do begin
  FControl := AControl;
  FPassId := PassId;
  FPersonId := PersonId;
  FIsAlarm := IsAlarm;
  UpdateForm;
  if Application.MainForm.WindowState <> wsMinimized then Show;
  Show;
 end;
end;

procedure HidePersonCard(AControl: TFlexControl);
var i: integer;
begin
 if Assigned(CardForms) then 
 for i:=0 to CardForms.Count-1 do
  if TfmPersonCard(CardForms[i]).FControl = AControl then begin
   TfmPersonCard(CardForms[i]).Close;
   break;
  end;
end;

procedure HideAllPersonCards;
var i: integer;
begin
 if Assigned(CardForms) then 
 for i:=CardForms.Count-1 downto 0 do TfmPersonCard(CardForms[i]).Close;
end;

// TfmPersonCard //////////////////////////////////////////////////////////////

procedure TfmPersonCard.FormCreate(Sender: TObject);
begin
 if not Assigned(CardForms) then CardForms := TList.Create;
 CardForms.Add(Self);
end;

procedure TfmPersonCard.FormDestroy(Sender: TObject);
begin
 FreeAndNil(FTexture);
 CardForms.Remove(Self);
 if CardForms.Count = 0 then FreeAndNil(CardForms);
end;

procedure TfmPersonCard.UpdateForm;
var Index: integer;
begin
 // Create background texture
 if not Assigned(FTexture) then FTexture := TBitmap.Create;
 with FTexture, Canvas do begin
  Width := 1;
  Height := 2;
  if FIsAlarm then begin
   // Alarm backgroound
   Pixels[0, 0] := $00B2B2F1;
   Pixels[0, 1] := $009090EB;
  end else begin
   // Normal background
   Pixels[0, 0] := $0092D4A7;
   Pixels[0, 1] := $0065B860;
  end;
 end;
 // Setup form caption
 Index := dmMain.FindPass(FPassId);
 if Index >= 0
  then lbCaption.Caption := PPass(dmMain.Passes[Index]).Name
  else lbCaption.Caption := '[unknown pass]';
 // Setup person id
 lbPersonId.Caption := IntToStr(FPersonId);
 // Setup up person name
 Index := dmMain.FindPerson(FPersonId);
 if Index >= 0 then with PPerson(dmMain.Personnel[Index])^ do begin
  lbFirstName.Caption := FirstName;
  lbLastName.Caption := LastName;
 end else begin
  lbFirstName.Caption := '[unknown]';
  lbLastName.Caption := '[unknown]';
 end;
 // Refresh form
 Invalidate;
end;

procedure TfmPersonCard.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Action := caFree;
end;

procedure TfmPersonCard.sbCloseClick(Sender: TObject);
begin
 Close;
end;

procedure TfmPersonCard.sbShowClick(Sender: TObject);
const Steps = 10;
var R, FlexRect, WinRect: TRect;
    Pnt: TPoint;
    DC: HDC;
    Pen: HPen;
    i: integer;
begin
 FlexRect := FControl.PaintRect; {
 with FControl.PaintRect do begin
  FlexRect.Left := Left;
  FlexRect.Top := Top;
  FlexRect.Right := Right;
  FlexRect.Bottom := Bottom;
 end;                             }
 with FlexRect do begin
  Pnt := FControl.Owner.ClientToScreen(Point(Left, Top));
  Left := Pnt.X;
  Top := Pnt.Y;
  Pnt := FControl.Owner.ClientToScreen(Point(Right, Bottom));
  Right := Pnt.X;
  Bottom := Pnt.Y;
 end;
 Pnt := ClientToScreen(Point(0, 0));
 with WinRect do begin
  Left := Pnt.X;
  Top := Pnt.Y;
  Right := Pnt.X + Width;
  Bottom := Pnt.Y + Height; 
 end;
 Pen := 0;
 DC := GetDC(0);
 try
 { SelectObject(DC, GetStockObject(BLACK_PEN));
  Rectangle(DC, Pnt.X, Pnt.Y, Pnt.X+Width, Pnt.Y+Height);
  with FlexRect do
   Rectangle(DC, Left, Top, Right, Bottom); }
 //DrawAnimatedRects(0, IDANI_OPEN, FlexRect, WinRect);
  R := FlexRect;
  Pen := CreatePen(PS_SOLID, 3, clBlack);
  SelectObject(DC, GetStockObject(NULL_BRUSH));
  SetROP2(DC, R2_NOT);
  with R do begin
   for i:=1 to Steps+1 do begin
    Rectangle(DC, Left, Top, Right, Bottom);
    Sleep(10);
    Left := FlexRect.Left + Round((WinRect.Left - FlexRect.Left) * i / Steps);
    Top := FlexRect.Top + Round((WinRect.Top - FlexRect.Top) * i / Steps);
    Right := FlexRect.Right + Round((WinRect.Right - FlexRect.Right) * i / Steps);
    Bottom := FlexRect.Bottom + Round((WinRect.Bottom - FlexRect.Bottom) * i / Steps);
   end;
   R := FlexRect;
   Sleep(10);
   for i:=1 to Steps+1 do begin
    Rectangle(DC, Left, Top, Right, Bottom);
    Sleep(10);
    Left := FlexRect.Left + Round((WinRect.Left - FlexRect.Left) * i / Steps);
    Top := FlexRect.Top + Round((WinRect.Top - FlexRect.Top) * i / Steps);
    Right := FlexRect.Right + Round((WinRect.Right - FlexRect.Right) * i / Steps);
    Bottom := FlexRect.Bottom + Round((WinRect.Bottom - FlexRect.Bottom) * i / Steps);
   end;
  end;
 finally
  if Pen <> 0 then DeleteObject(Pen);
  ReleaseDC(0, DC);
 end;
end;

procedure TfmPersonCard.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 FMouseAnchor := ScreenToClient(
   TWinControl(Sender).ClientToScreen(Point(X, Y)) );
 FMoving := true;
end;

procedure TfmPersonCard.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var NewPos: TPoint;
begin
 if FMoving then begin
  NewPos := TWinControl(Sender).ClientToScreen(Point(X, Y));
  dec(NewPos.X, FMouseAnchor.X);
  dec(NewPos.Y, FMouseAnchor.Y);
  Left := NewPos.X;
  Top := NewPos.Y;
 end;
end;

procedure TfmPersonCard.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 FMoving := False;
end;

procedure TfmPersonCard.FormPaint(Sender: TObject);
var R: TRect;
begin
 // Paint background
 R := Rect(0, 0, Width, Height);
 PaintTailed(Canvas, R, R, FTexture);
 // Paint form frame
 DrawEdge(Canvas.Handle, R, EDGE_BUMP{BDR_RAISEDINNER}, BF_RECT or BF_SOFT);
 // Paint caption
 if FIsAlarm
  then Canvas.Brush.Color := $009090EB
  else Canvas.Brush.Color := $0065B860;
 Canvas.FillRect(Rect(2, 2, Width-2, 16));
end;

end.