extlistview.pas

上传个考勤系统,希望别人也能用.该代码只能算初级的东东,软件代码复用性不高,重复代码比较多.唯一感觉有点取鉴的可能就是端口和dll的连接,还有线程的使用,本想改一改,但是手头没有考勤机了,对应考勤机是

  // account for modified column order

  // Delphi 2 and C++B 1 have a bug in TListColumn.GetWidth.  It returns zero
  // for the width if the handle hasn't been allocated yet instead of returning
  // the value of the internal storage variable like Delphi 3 does.  I've also
  // had some problems similar under Delphi 3, so I'm just always requiring the
  // handle to be valid.
  HandleNeeded;

  Result := NIL;
  ColCount := Columns.Count;
  if Index >= ColCount then
    exit;

  GetMem(ColArray, SizeOf(Integer)*ColCount);
  try
    GetColumnOrder(ColCount, ColArray^);
    Result := Columns[ColArray[Index]];
(* I must have been high
    for x := 0 to ColCount-1 do
      if ColArray[x] = Index then
      begin
        Result := Columns[ColArray[x]];
        exit;
      end;
*)
  finally
    FreeMem(ColArray);
  end;
end;

procedure TCustomExtListView.MeasureItem(var Height: UINT);
begin
  inherited MeasureItem(Height);
end;

procedure TCustomExtListView.DrawItem(var Canvas: TCanvas; Index: Integer;
   Rect: TRect; State: TOwnerDrawState; var DefaultDrawing,
   FullRowSelect: boolean);
begin
  { Default to whatever is in ExtendedStyles settings }
  FullRowSelect := lvxFullRowSelect in ExtendedStyles;
  inherited DrawItem(Canvas, Index, Rect, State, DefaultDrawing,
     FullRowSelect);
end;

procedure TCustomExtListView.DrawSubItem(Index, SubItem: Integer; Rect: TRect;
   State: TOwnerDrawState; var DefaultDrawing: boolean);
begin
  inherited DrawSubItem(Index, SubItem, Rect, State, DefaultDrawing);
end;

procedure TCustomExtListView.DefaultDrawHeader(var Canvas: TCanvas;
   Index: Integer; var Rect: TRect; Selected: boolean);
var
  TheColumn: TListColumn;
  ExtColumn: TdfsExtListColumn;
  ImageOffset: integer;
  Offset: integer;
  R, CR: TRect;
  Bmp: TBitmap;
begin

(******************************************************************************)
(* NOTE:  This method is overriden and replaced from the one in TdfsEnhListView. *)
(*   That means that if changes are made here, they will also need to be made *)
(*   in EnhListView.pas' DefaultDrawHeader method.                            *)
(******************************************************************************)

  if not Selected then
    InflateRect(Rect, -2, -2);
  Canvas.FillRect(Rect);
  if Selected then
    InflateRect(Rect, -2, -2);

  if (Index >= 0) and (Index < Columns.Count) then
  begin
    // Don't use ActualColumn[] here!  That's for SubItem foolery, not header.
    TheColumn := Columns[Index];
//    TheColumn := ActualColumn[Index];

    if Selected then
    begin
      inc(Rect.Top);
      inc(Rect.Left);
    end;

    R := Rect;

    case TheColumn.Alignment of
      taRightJustify:
        Dec(R.Right, 4);
      taLeftJustify:
        Inc(R.Left, 4);
      // taCenter needs no modification
    end;

    if (Index < ColumnsFormat.Count) and assigned(SmallImages) and
       ((ColumnsFormat[Index].ImageIndex >= 0) and
       (ColumnsFormat[Index].ImageIndex < SmallImages.Count)) then
      ExtColumn := ColumnsFormat[Index]
    else
      ExtColumn := NIL;

    if assigned(ExtColumn) then
    begin
      case ExtColumn.ImageAlignment of
        ciaLeftOfText:
          Inc(R.Left, SmallImages.Width + 4);
        ciaRightOfText:
          Dec(R.Right, SmallImages.Width + 4);
      end;
    end;

    if ShowSortArrows and (LastColumnClicked = Index) and
       ((AutoColumnSort <> acsNoSort) or (assigned(OnSortItems))) then
    begin
      if CurrentSortAscending then
        Bmp := SortUpBmp
      else
        Bmp := SortDownBmp;

      Dec(R.Right, Bmp.Width + 8);
      if R.Right < R.Left then
        R.Right := R.Left;

      { How big of a rectangle do we have to work with for the Text? }
      CR := R;
      DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, CR,
         DRAWTEXTEX_FLAGS or DT_CALCRECT or
         DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
      { Note that DT_CALCRECT does not adjust for alignment. We must do that }
      case TheColumn.Alignment of
        taRightJustify:
          R.Left := R.Right - (CR.Right - CR.Left);
        taCenter:
          begin
            R.Left := R.Left + (((R.Right - R.Left) - (CR.Right - CR.Left)) div
               2);
            R.Right := R.Left + (CR.Right - CR.Left);
          end;
      else // taLeftJustify: doesn't matter, that is what DT_CALCRECT returns
        R := CR;
      end;
      if R.Left < Rect.Left then
        R.Left := Rect.Left;
      if R.Right > Rect.Right then
        R.Right := Rect.Right;

      if Selected then
        OffsetRect(R, 1, 1);
      // Draw the caption in the rect available
      DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, R,
         DRAWTEXTEX_FLAGS or DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);

      // Draw column image if we have one
      if assigned(ExtColumn) then
      begin
        ImageOffset := (Rect.Bottom - Rect.Top - SmallImages.Height) div 2;
        case ExtColumn.ImageAlignment of
          ciaLeftOfText:
            SmallImages.Draw(Canvas, R.Left - (SmallImages.Width + 4),
               R.Top + ImageOffset, ExtColumn.ImageIndex);
          ciaRightOfText:
            begin
              SmallImages.Draw(Canvas, R.Right + 4, R.Top + ImageOffset,
                 ExtColumn.ImageIndex);
              inc(R.Right, SmallImages.Width);
              if R.Right > Rect.Right then
                R.Right := Rect.Right;
            end;
        end;
      end;

      // Draw the sort arrow bitmap
      Offset := (Rect.Bottom - Rect.Top - Bmp.Height) div 2;
      // Only draw if we have enough room
      if (R.Right + Bmp.Width + 8) <= Rect.Right then
        Canvas.Draw(R.Right + 8, R.Top + Offset, Bmp);
    end else begin
      if Selected then
        OffsetRect(R, 1, 1);
      CR := R;

      DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, CR,
         DRAWTEXTEX_FLAGS or DT_CALCRECT or
         DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);
      { Note that DT_CALCRECT does not adjust for alignment. We must do that }
      case TheColumn.Alignment of
        taRightJustify:
          R.Left := R.Right - (CR.Right - CR.Left);
        taCenter:
          begin
            R.Left := R.Left + (((R.Right - R.Left) - (CR.Right - CR.Left)) div
               2);
            R.Right := R.Left + (CR.Right - CR.Left);
          end;
      else // taLeftJustify: doesn't matter, that is what DT_CALCRECT returns
        R := CR;
      end;
      if R.Left < Rect.Left then
        R.Left := Rect.Left;
      if R.Right > Rect.Right then
        R.Right := Rect.Right;

      DrawTextEx(Canvas.Handle, PChar(TheColumn.Caption), -1, R,
         DRAWTEXTEX_FLAGS or DRAWTEXTEX_ALIGNMENT[TheColumn.Alignment], NIL);

      // Draw column image if we have one
      if assigned(ExtColumn) then
      begin
        ImageOffset := (Rect.Bottom - Rect.Top - SmallImages.Height) div 2;
        case ExtColumn.ImageAlignment of
          ciaLeftOfText:
            // Only draw if we have enough room
            if (R.Left - (SmallImages.Width + 4)) >= Rect.Left then
              SmallImages.Draw(Canvas, R.Left - (SmallImages.Width + 4),
                 R.Top + ImageOffset, ExtColumn.ImageIndex);
          ciaRightOfText:
            // Only draw if we have enough room
            if (R.Right + SmallImages.Width + 4) <= Rect.Right then
              SmallImages.Draw(Canvas, R.Right + 4, R.Top + ImageOffset,
                 ExtColumn.ImageIndex);
        end;
      end;
    end;
  end;
end;


const
  API_STYLES: array[Low(TLVExtendedStyle)..High(TLVExtendedStyle)] of LPARAM = (
     LVS_EX_GRIDLINES, LVS_EX_SUBITEMIMAGES, LVS_EX_CHECKBOXES,
     LVS_EX_TRACKSELECT, LVS_EX_HEADERDRAGDROP, LVS_EX_FULLROWSELECT,
     LVS_EX_ONECLICKACTIVATE, LVS_EX_TWOCLICKACTIVATE, LVS_EX_FLATSB,
     LVS_EX_INFOTIP, LVS_EX_UNDERLINEHOT, LVS_EX_UNDERLINECOLD,
     {$IFDEF DFS_DELPHI} {$IFDEF DFS_DELPHI_7_UP} LVS_EX_INFOTIP {$ELSE} LVS_EX_LABELTIP {$ENDIF} {$ELSE} $00004000 {$ENDIF});
     // LVS_EX_REGIONAL, LVS_EX_MULTIWORKAREAS - not implemented

// Function to convert our style set type into the value expected by the API.
function TCustomExtListView.SetValueToAPIValue(Styles: TLVExtendedStyles): LPARAM;
var
  x: TLVExtendedStyle;
begin
  Result := 0;
  { Check for each possible style. }
  for x := Low(TLVExtendedStyle) to High(TLVExtendedStyle) do
    { If the style is set... }
    if x in Styles then
      { OR the appropriate value into the result. }
      Result := Result OR API_STYLES[x];
end;

// Function to convert from the API values to our style set type.
function TCustomExtListView.SetValueFromAPIValue(Styles: DWORD): TLVExtendedStyles;
var
  x: TLVExtendedStyle;
begin
  Result := [];
  { Check for each possible style. }
  for x := Low(TLVExtendedStyle) to High(TLVExtendedStyle) do
    { If the style is set... }
    if (API_STYLES[x] and Styles) <> 0 then
      { OR the appropriate value into the result. }
      Result := Result + [x];
end;

// Property method to get the extended style bits.
function TCustomExtListView.GetExtendedStyles: TLVExtendedStyles;
begin
  if HandleAllocated then
    FExtendedStyles :=
       SetValueFromAPIValue(ListView_GetExtendedListViewStyle(Handle));
  Result := FExtendedStyles;
end;

// Property method to set new style bits.
procedure TCustomExtListView.SetExtendedStyles(Val: TLVExtendedStyles);
begin
  { Update the window with the new styles. }
  if (Val * [lvxUnderlineHot, lvxUnderlineCold] <> []) then
  begin
    // lvxUnderlineHot and lvxUnderlineCold require lvxOneClickActivate and/or
    // lvxTwoClickActivate
    if (lvxUnderlineCold in Val) and (not (lvxOneClickActivate in Val)) then
      Include(Val, lvxOneClickActivate);
    if (lvxUnderlineHot in Val) and
       (Val * [lvxOneClickActivate, lvxTwoClickActivate] = []) then
      Include(Val, lvxOneClickActivate);
  end;

  // A real world use of XOR!!!  We need to invalidate if subitem images is in
  // new value and not in old, or in old value and not in new, but NOT if it is
  // set or cleared in both.
  if ((lvxSubItemImages in Val) xor (lvxSubItemImages in FExtendedStyles)) and
    (HandleAllocated) then
    Invalidate;
  FExtendedStyles := Val;
  if HandleAllocated then
    ListView_SetExtendedListViewStyle(Handle, SetValueToAPIValue(Val));
end;

function TCustomExtListView.GetHeaderHandle: HWnd;
begin
  if FHeaderHandle <> 0 then
    Result := FHeaderHandle
  else begin
    if HandleAllocated then
      Result := ListView_GetHeader(Handle)
    else
      Result := 0;
  end;
end;

procedure TCustomExtListView.SetIconSpacing(X, Y: integer);
begin
// Not sure about how to update the view after changing this.  Refresh doesn't
// do the job.  Seems the best way to do it is in client code, something like:
(*
  SetIconSpacing(X, Y);
  // Does strange things if ViewStyle is not set to vsIcon!
  if ViewStyle = vsIcon then
  begin
    SendMessage(Handle, WM_SETREDRAW, 0, 0);
    try
      ViewStyle := vsSmallIcon;
      ViewStyle := vsIcon;
    finally
      SendMessage(Handle, WM_SETREDRAW, 1, 0);
    end;
  end;
*)

  if HandleAllocated then
    if ViewStyle = vsIcon then
      ListView_SetIconSpacing(Handle, X, Y);
end;

function TCustomExtListView.GetSubItemRect(Item, SubItem: integer;
   Index: integer): TRect;
begin
  if HandleAllocated then
    ListView_GetSubItemRect(Handle, Item, SubItem, Index, Result);
end;

function TCustomExtListView.GetSubItemAt(X, Y: integer): string;
var
{$IFNDEF DFS_C3D4COMMCTRL}
  Info: TLVHitTestInfoEx;
{$ELSE}
  Info: TLVHitTestInfo;
{$ENDIF}
begin
  Result := '';
  if HandleAllocated then
  begin
    Info.pt := Point(X, Y);
{$IFNDEF DFS_C3D4COMMCTRL}
    if ListView_SubItemHitTestEx(Handle, Info) <> -1 then
{$ELSE}
    if ListView_SubItemHitTest(Handle, @Info) <> -1 then
{$ENDIF}
    begin
      if (Info.iItem > -1) and (Items[Info.iItem] <> NIL) then
      begin
        if Info.iSubItem = 0 then
          Result := Items[Info.iItem].Caption
        else
          Result := Items[Info.iItem].SubItems[Info.iSubItem-1];
      end;
    end;
  end;
end;

procedure TCustomExtListView.SetColumnOrder(Count: integer; const IntArray:
   array of integer);
begin
  if FColumnOrder <> NIL then
    FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  FColumnOrderCount := Count;
  GetMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  Move(IntArray, FColumnOrder^, FColumnOrderCount * SizeOf(Integer));
  if HandleAllocated then
  begin
    ListView_SetColumnOrderArray(Handle, Count, @IntArray);
    Refresh;
  end;
end;

function TCustomExtListView.GetColumnOrder(Count: integer;
                                     var IntArray: array of integer): boolean;
begin
  if HandleAllocated then
  begin
    if Count <> FColumnOrderCount then
    begin
      FColumnOrderCount := Count;
      if F