extlistview.~pas

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

end;

function ListView_GetColumnOrderArray(LVWnd: HWnd; Count: integer;
                                      IntArray: PIntArray): boolean;
begin
  Result := (SendMessage(LVWnd, LVM_GETCOLUMNORDERARRAY, Count,
     LPARAM(IntArray)) <> 0);
end;

function ListView_SetHotItem(LVWnd: HWnd; Item: integer): integer;
begin
  Result := SendMessage(LVWnd, LVM_SETHOTITEM, Item, 0);
end;

function ListView_GetHotItem(LVWnd: HWnd): integer;
begin
  Result := SendMessage(LVWnd, LVM_GETHOTITEM, 0, 0);
end;

function ListView_SetHotCursor(LVWnd: HWnd; Cursor: HCursor): HCursor;
begin
  Result := HCursor(SendMessage(LVWnd, LVM_SETHOTCURSOR, 0, LPARAM(Cursor)));
end;

function ListView_GetHotCursor(LVWnd: HWnd): HCursor;
begin
  Result := HCursor(SendMessage(LVWnd, LVM_GETHOTCURSOR, 0, 0));
end;

function ListView_ApproximateViewRect(LVWnd: HWnd; Width, Height,
   Count: integer): DWORD;
begin
  Result := SendMessage(LVWnd, LVM_APPROXIMATEVIEWRECT, Count,
     MAKELPARAM(Width, Height));
end;

function ListView_SetWorkArea(LVWnd: HWnd; const Rect: TRect): boolean;
begin
  Result := (SendMessage(LVWnd, LVM_SETWORKAREA, 0, LPARAM(@Rect)) <> 0);
end;

function ListView_GetCheckState(LVWnd: HWnd; Index: UINT): boolean;
begin
  Result := (SendMessage(LVWnd, LVM_GETITEMSTATE, Index,
     LVIS_STATEIMAGEMASK) SHR 12)-1 <> 0;
end;

procedure ListView_SetCheckState(LVWnd: HWnd; Index: UINT; Checked: boolean);
const
  LVIS_UNCHECKED = $1000;
  LVIS_CHECKED = $2000;
var
  Data: integer;
begin
  if Checked then Data := LVIS_CHECKED
  else Data := LVIS_UNCHECKED;
  ListView_SetItemState(LVWnd, Index, Data, LVIS_STATEIMAGEMASK);
end;

procedure ListView_SetItemCountEx(LVWnd: HWnd; Items: integer; Flags: DWORD);
begin
  SendMessage(LVWnd, LVM_SETITEMCOUNT, Items, Flags);
end;

{$IFNDEF DFS_C3D4COMMCTRL}
function ListView_SetExtendedListViewStyleEx(LVWnd: HWnd; Mask: DWord;
   ExStyle: LPARAM): DWORD;
begin
  Result := SendMessage(LVWnd, LVM_SETEXTENDEDLISTVIEWSTYLE, Mask, ExStyle);
end;
{$ENDIF}

function ListView_GetSelectionMark(LVWnd: HWnd): integer;
begin
  Result := SendMessage(LVWnd, LVM_GETSELECTIONMARK, 0, 0);
end;

function ListView_SetSelectionMark(LVWnd: HWnd; iIndex: integer): integer;
begin
  Result := SendMessage(LVWnd, LVM_SETSELECTIONMARK, 0, iIndex);
end;

{$IFNDEF DFS_C3D4COMMCTRL}
function ListView_SetHoverTime(LVWnd: HWnd; dwHoverTimeMS: DWORD): DWORD;
begin
  Result := SendMessage(LVWnd, LVM_SETHOVERTIME, 0, dwHoverTimeMs);
end;

function ListView_GetHoverTime(LVWnd: HWnd): DWORD;
begin
  Result := DWORD(SendMessage(LVWnd, LVM_GETHOVERTIME, 0, 0));
end;

function ListView_SetToolTips(LVWnd, NewWnd: HWnd): HWnd;
begin
  Result := SendMessage(LVWnd, LVM_SETTOOLTIPS, NewWnd, 0);
end;

function ListView_GetToolTips(LVWnd: HWnd): HWnd;
begin
  Result := SendMessage(LVWnd, LVM_GETTOOLTIPS, 0, 0);
end;

function ListView_SetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
begin
  Result := (SendMessage(LVWnd, LVM_SETBKIMAGE, 0, LPARAM(plvbki)) <> 0);
end;

function ListView_GetBkImage(LVWnd: HWnd; plvbki: PLVBkImage): BOOL;
begin
  Result := (SendMessage(LVWnd, LVM_GETBKIMAGE, 0, LPARAM(plvbki)) <> 0);
end;
{$ENDIF}



{$IFDEF DFS_TRY_BACKGROUND_IMAGE}

constructor TELVBackgroundImage.Create(AOwner: TCustomExtListView);
begin
  inherited Create;
  FBrushBmp := TBitmap.Create;
  FOwningListView := AOwner;
end;

destructor TELVBackgroundImage.Destroy;
begin
  FBrushBmp.Free;
  inherited Destroy;
end;

procedure TELVBackgroundImage.Assign(Source: TPersistent);
begin
  if Source is TELVBackgroundImage then
  begin
    FFilename := TELVBackgroundImage(Source).Filename;
    FTile := TELVBackgroundImage(Source).Tile;
    FXOffsetPercent := TELVBackgroundImage(Source).XOffsetPercent;
    FYOffsetPercent := TELVBackgroundImage(Source).YOffsetPercent;
    ApplyToListView;
  end;
end;

procedure TELVBackgroundImage.SetFilename(const Val: string);
begin
  if FFilename <> Val then
    FFilename := Val;
  ApplyToListView;
end;

procedure TELVBackgroundImage.SetTile(Val: boolean);
begin
  if FTile <> Val then
    FTile := Val;
  ApplyToListView;
end;

procedure TELVBackgroundImage.SetXOffsetPercent(Val: integer);
begin
  if FXOffsetPercent <> Val then
    FXOffsetPercent := Val;
  ApplyToListView;
end;

procedure TELVBackgroundImage.SetYOffsetPercent(Val: integer);
begin
  if FYOffsetPercent <> Val then
    FYOffsetPercent := Val;
  ApplyToListView;
end;

procedure TELVBackgroundImage.ApplyToListView;
var
  LVBkImg: TLVBkImage;
begin
  if assigned(FOwningListView) and FOwningListView.HandleAllocated then
  begin
    if FFilename <> '' then
      LVBkImg.ulFlags := LVBKIF_SOURCE_URL
    else
      LVBkImg.ulFlags := LVBKIF_SOURCE_NONE;
    if FTile then
      LVBkImg.ulFlags := LVBkImg.ulFlags or LVBKIF_STYLE_TILE
    else
      LVBkImg.ulFlags := LVBkImg.ulFlags or LVBKIF_STYLE_NORMAL;
    LVBkImg.hbm := 0;
    LVBkImg.pszImage := PChar(FFilename);
    LVBkImg.cchImageMax := Length(FFilename);
    LVBkImg.xOffsetPercent := FXOffsetPercent;
    LVBkImg.yOffsetPercent := FYOffsetPercent;
    // Transparent
    ListView_SettExtBkColor(FOwningListView.Handle, $FFFFFFFF);
    ListView_SetBkImage(FOwningListView.Handle, @LVBkImg);
  end;
end;
{$ENDIF}


constructor TdfsExtLVSaveSettings.Create;
begin
  inherited Create;
  FSaveColumnOrder := TRUE;
end;

procedure TdfsExtLVSaveSettings.StoreColumnOrder(ColCount: integer;
   const IntArray: array of integer);
var
  Reg: TRegIniFile;
  x: integer;
  s: string;
begin
  if ColCount < 1 then exit;
  s := '';
  for x := 0 to ColCount-1 do
    s := s + IntToStr(IntArray[x]) + ',';
  SetLength(s, Length(s)-1);
  Reg := TRegIniFile.Create(RegistryKey);
  try
    Reg.WriteString('Columns', 'Order', s);
  finally
    Reg.Free;
  end;
end;

procedure TdfsExtLVSaveSettings.ReadColumnOrder(ColCount: integer;
   var IntArray: array of integer);
var
  Reg: TRegIniFile;
  x,y: integer;
  s: string;
begin
  if ColCount < 1 then exit;
  s := '';
  Reg := TRegIniFile.Create(RegistryKey);
  try
    s := Reg.ReadString('Columns', 'Order', '');
  finally
    Reg.Free;
  end;
  if s = '' then
  begin
    for x := 0 to ColCount-1 do
      IntArray[x] := x;
    exit;
  end;
  y := 0;
  for x := 0 to ColCount-1 do
  begin
    try
      y := Pos(',', s);
      if y = 0 then
        y := Length(s)+1;
      IntArray[x] := StrToInt(Copy(s, 1, y-1));
    except
      IntArray[x] := 0;
    end;
    s := copy(s, y+1, length(s));
    if s = '' then break;
  end;
end;



// Override constructor to "zero out" our internal variable.
constructor TCustomExtListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FItemCountEx := 0;
  FItemCountExFlags := [];
  FSelectionMark := -1;
  FHoverTime := -1;
  FExtendedStyles := [lvxInfoTip];
  FColumnOrder := NIL;
  FColumnOrderCount := 0;
  FRequireComCtlUpdate := FALSE;
  FSaveSettings := TdfsExtLVSaveSettings.Create;
  FColumnsFormatChangeLink := TChangeLink.Create;
  FColumnsFormatChangeLink.OnChange := ColumnHeaderImagesChange;
  FVirtualMode := FALSE;
  FColumnsFormat := TdfsExtListColumns.Create(Self);
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  FBackgroundImage := TELVBackgroundImage.Create(Self);
{$ENDIF}
{$IFDEF DFS_COMPILER_4_UP}
  OnData := FeedOwnerDataMode;
{$ENDIF}
end;

destructor TCustomExtListView.Destroy;
begin
  FColumnsFormat.Free; { don't think i need this, it has an Owner property }
  FColumnsFormatChangeLink.Free;

  if FColumnOrder <> NIL then
    FreeMem(FColumnOrder, FColumnOrderCount * SizeOf(Integer));
  FRecreateStream.Free;
  FRecreateStream := NIL;

  inherited Destroy;

  FSaveSettings.Free;
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  { Free after inherited because inherited calls DestroyWnd and it is needed
    until after that...}
  FBackgroundImage.Free;
{$ENDIF}
end;

procedure TCustomExtListView.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  if FVirtualMode then
    Params.Style := Params.Style or LVS_OWNERDATA;
end;

procedure TCustomExtListView.CreateWnd;
begin
  inherited CreateWnd;

//  RestoreChecks;
  SetSelectionMark(FSelectionMark);
  SetHoverTime(FHoverTime);
  SetExtendedStyles(FExtendedStyles);
  if VirtualMode and (FItemCountEx > 0) then
    SetItemCountEx(FItemCountEx, FItemCountExFlags);

  if FColumnOrder <> NIL then
  begin
    SendMessage(Handle, LVM_SETCOLUMNORDERARRAY, FColumnOrderCount,
       LongInt(FColumnOrder));
    Refresh;
  end;
{$IFDEF DFS_TRY_BACKGROUND_IMAGE}
  FBackgroundImage.ApplyToListView;
{$ENDIF}
  if not (csLoading in ComponentState) then
  begin
    if (StateImages <> NIL) then
      ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
        LVIS_STATEIMAGEMASK);
    ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
      LVIS_OVERLAYMASK);
  end;
  RestoreChecks;
end;

procedure TCustomExtListView.Loaded;
begin
  inherited Loaded;

  HandleNeeded;
  UpdateColumnsImages;
  if StateImages <> NIL then
    ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
      LVIS_STATEIMAGEMASK);
  ListView_SetCallbackMask(Handle, ListView_GetCallbackMask(Handle) or
    LVIS_OVERLAYMASK);
end;

// Subitem set to -1 means Caption Text
function TCustomExtListView.GetSubItemText(Index, SubItem: integer): string;
var
  x,
  ColCount: integer;
  ColArray: PIntArray;
begin
  // needs to account for modified column order
  Result := '';
  if Items[Index] = NIL then
    exit;

  ColCount := Columns.Count;
  if (SubItem + 2 > ColCount) then
  begin
    if SubItem < Items[Index].SubItems.Count then
      Result := Items[Index].SubItems[SubItem];
  end else begin
    GetMem(ColArray, SizeOf(Integer)*ColCount);
    try
      GetColumnOrder(ColCount, ColArray^);
      x := ColArray[SubItem+1];
      if x = 0 then
        Result := Items[Index].Caption
      else
        Result := Items[Index].SubItems[x-1];
    finally
      FreeMem(ColArray);
    end;
  end;
end;

function TCustomExtListView.GetActualColumn(Index: integer): TListColumn;
var
//  x,
  ColCount: integer;
  ColArray: PIntArray;
begin