toolctrlseh.pas

考勤管理是企业内部管理的重要环节和基础

function TSpecRowEh.GetCellText(Index: Integer): String;
begin
  if (Index < 0) or (Index >= FCellsStrings.Count)
    then Result := ''
    else Result := FCellsStrings[Index];
end;

function TSpecRowEh.IsValueStored: Boolean;
begin
  Result := not VarEquals(FValue,Null);
end;

function TSpecRowEh.IsFontStored: Boolean;
begin
  Result := FFontAssigned;
end;

function TSpecRowEh.IsColorStored: Boolean;
begin
  Result := FColorAssigned;
end;

function TSpecRowEh.LocateKey(KeyValue: Variant): Boolean;
begin
  Result := Visible and VarEquals(Value,KeyValue);
end;

procedure TSpecRowEh.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TSpecRowEh.EndUpdate;
begin
  Dec(FUpdateCount);
  Changed;
end;

procedure GetFieldsProperty(List: TList; DataSet: TDataSet;
   Control: TComponent; const FieldNames: String);
var
  Pos: Integer;
  Field: TField;
  FieldName: String;
begin
  Pos := 1;
  while Pos <= Length(FieldNames) do
  begin
    FieldName := ExtractFieldName(FieldNames, Pos);
    Field := DataSet.FindField(FieldName);
    if Field = nil then
      DatabaseErrorFmt(SFieldNotFound, [FieldName], Control);
    if Assigned(List) then List.Add(Field);
  end;
end;

function GetFieldsProperty(DataSet: TDataSet; Control: TComponent;
   const FieldNames: String): TFieldsArrEh;
var FieldList:TList;
    i:Integer;
begin
  FieldList := TList.Create;
  try
    GetFieldsProperty(FieldList, DataSet, Control, FieldNames);
    SetLength(Result, FieldList.Count);
    for i := 0 to FieldList.Count-1 do Result[i] := FieldList[i];
  finally
    FieldList.Free;
  end;
end;

procedure DataSetSetFieldValues(DataSet: TDataSet; Fields: String; Value:Variant);
var FieldList: TList;
    i: Integer;
begin
  if VarEquals(Value,Null) then
  begin
    FieldList := TList.Create;
    try
      Dataset.GetFieldList(FieldList,Fields);
      for i := 0 to FieldList.Count-1 do
        TField(FieldList[i]).Clear;
    finally
      FieldList.Free;
    end;
  end else
    DataSet.FieldValues[Fields] := Value;
end;

{ TSizeGripEh }

constructor TSizeGripEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := GetSystemMetrics(SM_CXVSCROLL);
  Height := GetSystemMetrics(SM_CYVSCROLL);
  Color := clBtnFace;
  Cursor := crSizeNWSE;
  ControlStyle := ControlStyle + [csCaptureMouse];
  FTriangleWindow := True;
  FPosition := sgpBottomRight;
end;

procedure TSizeGripEh.CreateWnd;
type
  PPoints = ^TPoints;
  TPoints = array[0..0] of TPoint;
var
  Points :array[0..2] of TPoint;
  Region: HRgn;
begin
  inherited CreateWnd;
  if TriangleWindow then
  begin
    if Position = sgpBottomRight then
    begin
      Points[0] := Point(0,Height);
      Points[1] := Point(Width,Height);
      Points[2] := Point(Width,0);
      Cursor := crSizeNWSE;
    end else if Position = sgpBottomLeft then
    begin
      Points[0] := Point(Width,Height);
      Points[1] := Point(0,Height);
      Points[2] := Point(0,0);
      Cursor := crSizeNESW;
    end else if Position = sgpTopLeft then
    begin
      Points[0] := Point(Width-1,0);
      Points[1] := Point(0,0);
      Points[2] := Point(0,Height-1);
      Cursor := crSizeNWSE;
    end else if Position = sgpTopRight then
    begin
      Points[0] := Point(Width,Height-1);
      Points[1] := Point(Width,0);
      Points[2] := Point(1,0);
      Cursor := crSizeNESW;
    end;
    Region:=CreatePolygonRgn(PPoints(@Points)^,3,WINDING);
    SetWindowRgn(Handle, Region, True);
    UpdatePosition;
    //ShowWindow(Handle,SW_SHOW);
  end;
end;

procedure TSizeGripEh.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited MouseDown(Button,Shift,X,Y);
  FInitScreenMousePos := ClientToScreen(Point(X, Y));
  FParentRect.Right := Parent.Width;
  FParentRect.Bottom := Parent.Height;
  FParentRect.Left := Parent.ClientWidth;
  FParentRect.Top := Parent.ClientHeight;
end;

procedure TSizeGripEh.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewMousePos, ParentWidthHeight: TPoint;
  OldPos, NewClientAmount, OutDelta: Integer;
  WorkArea: TRect;
begin
  inherited MouseMove(Shift,X,Y);

  if (ssLeft in Shift) and MouseCapture and not FInternalMove then
  begin
    NewMousePos := ClientToScreen(Point(X, Y));
    ParentWidthHeight.x := Parent.ClientWidth;
    ParentWidthHeight.y := Parent.ClientHeight;

    if (FOldMouseMovePos.x = NewMousePos.x) and
       (FOldMouseMovePos.y = NewMousePos.y) then
       Exit;

    SystemParametersInfo(SPI_GETWORKAREA,0,Pointer(@WorkArea),0);

    if Position in [sgpBottomRight,sgpTopRight] then
    begin
      NewClientAmount := FParentRect.Left + NewMousePos.x - FInitScreenMousePos.x;
      OutDelta := Parent.Width + NewClientAmount - Parent.ClientWidth;
      OutDelta := Parent.ClientToScreen(Point(OutDelta,0)).x - WorkArea.Right;
      if OutDelta <= 0
        then Parent.ClientWidth := NewClientAmount
        else Parent.ClientWidth := NewClientAmount - OutDelta
    end else
    begin
      OldPos := Parent.Width;

      NewClientAmount := FParentRect.Right + FInitScreenMousePos.x - NewMousePos.x;
      OutDelta := NewClientAmount - Parent.Width;
      OutDelta := Parent.ClientToScreen(Point(0,0)).x - WorkArea.Left - OutDelta;
      if OutDelta >= 0
        then Parent.Width := NewClientAmount
        else Parent.Width := NewClientAmount + OutDelta;
//      Parent.Width := FParentRect.Right + FInitScreenMousePos.x - NewMousePos.x;
      Parent.Left := Parent.Left + OldPos - Parent.Width;
    end;

    if Position in [sgpBottomRight,sgpBottomLeft] then
    begin
      NewClientAmount := FParentRect.Top + NewMousePos.y - FInitScreenMousePos.y;
      OutDelta := Parent.Height + NewClientAmount - Parent.ClientHeight; 
      OutDelta := Parent.ClientToScreen(Point(0,OutDelta)).y - WorkArea.Bottom;
      if OutDelta <= 0
        then Parent.ClientHeight := NewClientAmount
        else Parent.ClientHeight := NewClientAmount - OutDelta;
    end else
    begin
      OldPos := Parent.Height;
      NewClientAmount := FParentRect.Bottom + FInitScreenMousePos.y - NewMousePos.y;
      OutDelta := NewClientAmount - Parent.Height;
      OutDelta := Parent.ClientToScreen(Point(0,0)).y - WorkArea.Top - OutDelta;
      if OutDelta >= 0
        then Parent.Height := NewClientAmount
        else Parent.Height := NewClientAmount + OutDelta;
//      Parent.{Client}Height := FParentRect.Bottom + FInitScreenMousePos.y - NewMousePos.y;
      Parent.Top := Parent.Top + OldPos - Parent.Height;
    end;

    FOldMouseMovePos := NewMousePos;
    if (ParentWidthHeight.x <> Parent.ClientWidth) or
       (ParentWidthHeight.y <> Parent.ClientHeight) then
      ParentResized;
    UpdatePosition;
  end;
end;

procedure TSizeGripEh.Paint;
var i,xi,yi:Integer;
    x1,x2,y1,y2:Integer;
    px,py:PInteger;
begin
  i := 1;
  if Position = sgpBottomRight then
  begin
    xi := 1; yi := 1;
    px := @x1; py := @y2;
    x1 := 0; y1 := Width;
    x2 := Width; y2 := 0;
  end else if Position = sgpBottomLeft then
  begin
    xi := -1; yi := 1;
    px := @x2; py := @y1;
    x1 := 0; y1 := 1;
    x2 := Width-1; y2 := Width;
  end else if Position = sgpTopLeft then
  begin
    xi := -1; yi := -1;
    px := @x1; py := @y2;
    x1 := Width-1; y1 := -1;
    x2 := -1; y2 := Width-1;
  end else //  Position = sgpTopRight
  begin
    xi := 1; yi := -1;
    px := @x2; py := @y1;
    x1 := Width; y1 := Width-1;
    x2 := 0; y2 := -1;
  end;

  with Canvas do
    while i < Width do
    begin
      Pen.Color := clBtnHighlight;
      PolyLine([Point(x1,y1),Point(x2,y2)]);
      Inc(i); Inc(px^,xi); Inc(py^,yi);

      Pen.Color := clBtnShadow;
      PolyLine([Point(x1,y1),Point(x2,y2)]);
      Inc(i); Inc(px^,xi); Inc(py^,yi);
      PolyLine([Point(x1,y1),Point(x2,y2)]);
      Inc(i); Inc(px^,xi); Inc(py^,yi);

      Pen.Color := clBtnFace;
      PolyLine([Point(x1,y1),Point(x2,y2)]);
      Inc(i); Inc(px^,xi); Inc(py^,yi);
    end;
end;

procedure TSizeGripEh.ParentResized;
begin
  if Assigned(FParentResized) then FParentResized(Self);
end;

procedure TSizeGripEh.SetPosition(const Value: TSizeGripPostion);
begin
  if FPosition = Value then Exit;
  FPosition := Value;
  RecreateWnd;
  HandleNeeded;
end;

procedure TSizeGripEh.SetTriangleWindow(const Value: Boolean);
begin
  if FTriangleWindow = Value then Exit;
  FTriangleWindow := Value;
  RecreateWnd;
  HandleNeeded;
end;

procedure TSizeGripEh.UpdatePosition;
begin
  FInternalMove := True;
  case Position of
    sgpBottomRight: MoveWindow(Handle,Parent.ClientWidth-Width,Parent.ClientHeight-Height,Width,Height,True);
    sgpBottomLeft: MoveWindow(Handle,0,Parent.ClientHeight-Height,Width,Height,True);
    sgpTopLeft: MoveWindow(Handle,0,0,Width,Height,True);
    sgpTopRight: MoveWindow(Handle,Parent.ClientWidth-Width,0,Width,Height,True);
  end;
  FInternalMove := False;
end;

procedure TSizeGripEh.WMMove(var Message: TMessage);
begin
  if not FInternalMove then UpdatePosition;
  inherited;
end;

procedure TSizeGripEh.ChangePosition(NewPosition: TSizeGripChangePosition);
begin
  if NewPosition = sgcpToLeft then
  begin
    if Position = sgpTopRight then Position := sgpTopLeft
    else if Position = sgpBottomRight then Position := sgpBottomLeft;
  end else if NewPosition = sgcpToRight then
  begin
    if Position = sgpTopLeft then Position := sgpTopRight
    else if Position = sgpBottomLeft then Position := sgpBottomRight
  end else if NewPosition = sgcpToTop then
  begin
    if Position = sgpBottomRight then Position := sgpTopRight
    else if Position = sgpBottomLeft then Position := sgpTopLeft
  end else if NewPosition = sgcpToBottom then
  begin
    if Position = sgpTopRight then Position := sgpBottomRight
    else if Position = sgpTopLeft then Position := sgpBottomLeft
  end
end;

function TSizeGripEh.GetVisible: Boolean;
begin
  Result := IsWindowVisible(Handle);
end;

procedure TSizeGripEh.SetVisible(const Value: Boolean);
begin
  if Value then
    ShowWindow(Handle,SW_SHOW)
  else
    ShowWindow(Handle,SW_HIDE);
end;

{ TPopupMonthCalendarEh }

constructor TPopupMonthCalendarEh.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  //FOwner := AOwner;
  AutoSize := True;
end;

procedure TPopupMonthCalendarEh.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or WS_BORDER or WS_POPUP;
    ExStyle := WS_EX_TOOLWINDOW {or WS_EX_TOPMOST};
    WindowClass.Style := CS_SAVEBITS;
  end;
end;

procedure TPopupMonthCalendarEh.KeyDown(var Key: Word; Shift: TShiftState);
var ComobEdit: IComobEditEh;
begin
  inherited KeyDown(Key,Shift);
  if Key in [VK_RETURN,VK_ESCAPE] then
  begin
    if Supports(Owner,IComobEditEh,ComobEdit) then
      ComobEdit.CloseUp(Key = VK_RETURN);
    Key := 0;
  end;
end;

procedure TPopupMonthCalendarEh.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var ComobEdit: IComobEditEh;
begin
  inherited MouseDown(Button,Shift,X,Y);
  if not PtInRect(Rect(0,0,Width,Height),Point(X,Y)) then
    if Supports(Owner,IComobEditEh,ComobEdit) then
      ComobEdit.CloseUp(False);
end;

procedure TPopupMonthCalendarEh.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var MCHInfo: TMCHitTestInfo;
    ComobEdit: IComobEditEh;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if not Supports(Owner,IComobEditEh,ComobEdit) then Exit;
  if not PtInRect(Rect(0,0,Width,Height),Point(X,Y)) then Exit;
  MCHInfo.cbSize := SizeOf(TMCHitTestInfo);
  MCHInfo.pt.x := X;
  MCHInfo.pt.y := Y;
  MonthCal_HitTest(Handle,MCHInfo);
  if ((MCHInfo.uHit and MCHT_CALENDARDATE) > 0) and  (MCHInfo.uHit <> MCHT_CALENDARDAY) and
   (MCHInfo.uHit <> MCHT_TITLEBTNNEXT) and (MCHInfo.uHit <> MCHT_TITLEBTNPREV) then
    ComobEdit.CloseUp(True)
  else if (MCHInfo.uHit and MCHT_NOWHERE > 0) then
    ComobEdit.CloseUp(False)
  else if not ((X >= 0) and (Y >= 0) and (X < Width) and (Y < Height)) then
    ComobEdit.CloseUp(False);
end;

procedure TPopupMonthCalendarEh.CMWantSpecialKey(var Message: TCMWantSpecialKey);
var ComobEdit: IComobEditEh;
begin
  if not Supports(Owner,IComobEditEh,ComobEdit) then Exit;
  if (Message.CharCode in [VK_RETURN, VK_ESCAPE]) then
  begin
    ComobEdit.CloseUp(Message.CharCode = VK_RETURN);
    Message.Result := 1;
  end else
    inherited;
end;

procedure TPopupMonthCalendarEh.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  inherited;
  Message.Result := Message.Result or DLGC_WANTARROWS or DLGC_WANTCHARS or DLGC_WANTTAB;
end;

procedure TPopupMonthCalendarEh.WMKillFocus(var Message: TWMKillFocus);
var //ComobEdit: IComobEditEh;
    a: array[0..255] of Char;
begin
  inherited;
  GetWindowText(Message.FocusedWnd,a,255);
  if (GetParent(Message.FocusedWnd) <> Handle) then
    PostCloseUp(False);
//    if Supports(Owner,IComobEditEh,ComobEdit) then
//      ComobEdit.CloseUp(False);
end;

procedure TPopupMonthCalendarEh.PostCloseUp(Accept: Boolean);
begin
  PostMessage(Handle,CM_CLOSEUPEH,Integer(Accept),0);
end;

procedure TPopupMonthCalendarEh.CMCloseUpEh(var Message: TMessage);
var ComobEdit: IComobEditEh;
begin
  if Supports(Owner,IComobEditEh,ComobEdit) then
    ComobEdit.CloseUp(False);
end;

function TPopupMonthCalendarEh.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelDown(Shift, MousePos);
  if not Result then
  begin
    Date := Date + 1;
    Result := True;
  end;
end;

function TPopupMonthCalendarEh.DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
  Result := inherited DoMouseWheelDown(Shift, MousePos);
  if not Result then
  begin
    Date := Date - 1;
    Result := True;
  end;
end;

initialization
  FlatButtonWidth := GetDefaultFlatButtonWidth;
  ButtonsBitmapCache := TButtonsBitmapCache.Create;
finalization
  ButtonsBitmapCache.Free;
end.