abzipout.inc

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

    property DragCursor;
{$ENDIF}
    property DragMode;
    property Enabled;
    property ExtractOptions;
    property Font;
    property Hierarchy;
    property LogFile;
    property Logging;
    property OnProcessItemFailure;
    property OnArchiveItemProgress;
    property OnArchiveProgress;
    property OnChange;
    property OnClick;
    property OnConfirmProcessItem;
    property OnConfirmOverwrite;
    property OnConfirmSave;
    property OnCollapse;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnExpand;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnLoad;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
{$IFNDEF NeedMouseWheel}
  {$IFNDEF UsingCLX}
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
  {$ENDIF}
{$ENDIF}
    property OnNeedPassword;
    property OnRequestImage;
    property OnRequestLastDisk;
    property OnRequestNthDisk;
    property OnRequestBlankDisk;
    property OnSave;
{$IFDEF Win32}
    property OnStartDrag;
{$ENDIF Win32}
    property OnWindowsDrop;
    property ParentColor
             default AbDefParentColor;
{$IFNDEF UsingCLX}
    property ParentCtl3D;
{$ENDIF}
    property ParentFont;
    property ParentShowHint;
    property Password;
    property PasswordRetries;
    property PictureDirectory;
    property PictureDirectorySelected;
    property PictureFile;
    property PictureFileSelected;
    property PictureZipAttribute;
    property PictureZipAttributeSelected;
    property PopupMenu;
    property ShowHint;
    property StoreOptions;
    property TabOrder;
    property TabStop;
    property SpanningThreshold;
    property Version;
    property TempDirectory;
    property Visible;
    property FileName; {must be after OnLoad}                          
  end;

implementation

uses
{$IFDEF WIN32}
  ShellApi,
{$ENDIF}
  AbConst;

{$R AbZipOut.res}

var
  MethodStrings : TMethodStrings;

type
  TAbZipArchiveFriend = class(TAbZipArchive)
  end;
  
{ -------------------------------------------------------------------------- }
{ ========================================================================== }
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.IndexBitmaps;
begin
  FImageList.Clear;

  FImageList.Height := FBitMapHeight;
  FImageList.Width  := FBitMapWidth;

  if not FAttrBitMap.Empty then
   FAttrIndex := FImageList.Add( FAttrBitMap, nil );
  if not FAttrBitMap.Empty then
    FAttrSelectedIndex := FImageList.Add( FAttrBitMapSelected, nil );
  if not FAttrBitMap.Empty then
    FDirectoryIndex := FImageList.Add( FDirBitMap, nil );
  if not FAttrBitMap.Empty then
    FDirSelectedIndex := FImageList.Add( FDirBitMapSelected , nil );
  if not FAttrBitMap.Empty then
    FFileIndex := FImageList.Add( FFileBitMap, nil );
  if not FAttrBitMap.Empty then
    FFileSelectedIndex := FImageList.Add( FFileBitMapSelected, nil );
end;
{ -------------------------------------------------------------------------- }
constructor TAbZipDisplayOutline.Create(AOwner : TComponent);
begin
  FBitMapHeight := cBitmapHeight;
  FBitMapWidth  := cBitmapWidth;

  FDirBitMap := TBitMap.Create;
  FFileBitMap := TBitMap.Create;
  FAttrBitMap := TBitMap.Create;
  FDirBitMapSelected  := TBitMap.Create;
  FFileBitMapSelected := TBitMap.Create;
  FAttrBitMapSelected := TBitMap.Create;

  FDirBitMap.LoadFromResourceName( HInstance, 'DIR' );
  FFileBitMap.LoadFromResourceName( HInstance, 'FILEFIX' );
  FAttrBitMap.LoadFromResourceName( HInstance, 'ATTR' );
  FDirBitMapSelected.LoadFromResourceName ( HInstance, 'DIRS'  );
  FFileBitMapSelected.LoadFromResourceName( HInstance, 'FILES' );
  FAttrBitMapSelected.LoadFromResourceName( HInstance, 'ATTRS' );

  inherited Create(AOwner);

  FImageList := TImageList.Create(Self);
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.Loaded;
begin
  inherited Loaded;
{$IFNDEF UsingCLX}
  if Assigned(FOnWindowsDrop) then
    DragAcceptFiles(Handle, True);
{$ENDIF}
end;
{ -------------------------------------------------------------------------- }
destructor TAbZipDisplayOutline.Destroy;
begin
  FImageList.Free;
  FDirBitMap.Free;
  FFileBitMap.Free;
  FAttrBitMap.Free;
  FDirBitMapSelected.Free;
  FFileBitMapSelected.Free;
  FAttrBitMapSelected.Free;
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetAttributeBitMap(Value : TBitmap);
begin
  if Value <> nil then begin
    FAttrBitMap.assign( Value )
  end else begin
    FAttrBitMap.LoadFromResourceName( HInstance, 'ATTR' );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetDirectoryBitMap(Value : TBitmap);
begin
  if Value <> nil then begin
    FDirBitMap.assign( Value )
  end else begin
    FDirBitMap.LoadFromResourceName( HInstance, 'DIR' );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetFileBitMap(Value : TBitmap);
begin
  if Value <> nil then begin
    FFileBitMap.assign( Value )
  end else begin
    FFileBitMap.LoadFromResourceName( HInstance, 'FILEFIX' );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetAttributeBitMapSelected(Value : TBitmap);
begin
  if Value <> nil then
    FAttrBitMapSelected.assign( Value )
  else begin
    FAttrBitMapSelected.LoadFromResourceName( HInstance, 'ATTRS' );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetDirectoryBitMapSelected(Value : TBitmap);
begin
  if Value <> nil then
    FDirBitMapSelected.assign( Value )
  else begin
    FDirBitMapSelected.LoadFromResourceName ( HInstance, 'DIRS'  );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetFileBitMapSelected(Value : TBitmap);
begin
  if Value <> nil then
    FFileBitMapSelected.assign( Value )
  else begin
    FFileBitMapSelected.LoadFromResourceName( HInstance, 'FILES' );
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetBitMapHeight(Value : Integer);
begin
  if FBitMapHeight <> Value then
    FBitMapHeight := Value;
end;
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.SetBitMapWidth(Value : Integer);
begin
  if FBitMapWidth <> Value then
    FBitMapWidth := Value;
end;
{ -------------------------------------------------------------------------- }
{$IFDEF NeedMouseWheel}
procedure TAbZipDisplayOutline.WMMouseWheel(var Msg : TMessage);
begin
  inherited;

  with Msg do
    DoOnMouseWheel(KeysToShiftState(LOWORD(wParam)) {fwKeys},
                   HIWORD(wParam) {zDelta},
                   LOWORD(lParam) {xPos},   HIWORD(lParam) {yPos});
end;
{$ENDIF}
{$IFNDEF UsingCLX}
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.WMDropFiles(var Msg : TWMDropFiles);
var
  FileName : string;
  I : Integer;
  NumFiles : Integer;
  DroppedName : array [0..79] of Char;
begin
  Msg.Result := 1;
  NumFiles := DragQueryFile(Msg.Drop, Cardinal(-1), DroppedName,
                             sizeof(DroppedName));
  try
    for I := 0 to pred(NumFiles) do begin
      DragQueryFile(Msg.Drop, I, DroppedName, sizeof(DroppedName));
      FileName := StrPas(DroppedName);
      DoOnWindowsDrop(FileName);
    end;
  finally
    DragFinish(Msg.Drop);
  end;
  if IsIconic(Application.Handle) then
    ShowWindow(Application.Handle, SW_SHOWNORMAL)
  else
    BringWindowToTop(Handle);
end;
{$ENDIF}
{ -------------------------------------------------------------------------- }
procedure TAbZipDisplayOutline.DoOnWindowsDrop(FileName : string);
begin
  if csDesigning in ComponentState then
    Exit;
  if csLoading in ComponentState then
    Exit;
  if Assigned(FOnWindowsDrop) then
    FOnWindowsDrop(Self, FileName);
end;

{$IFDEF NeedMouseWheel}
procedure TAbZipDisplayOutline.DoOnMouseWheel(Shift : TShiftState;
                                               Delta, XPos, YPos : SmallInt);
const
  WHEEL_DELTA = 120;
var
//  Next : LongInt;
  oHold : TTreeNode;
  oNode : TTreeNode;
begin
  if Assigned(FOnMouseWheel) then
    FOnMouseWheel(Self, Shift, Delta, XPos, YPos);

  if Items.Count = 0 then
    Exit;

  if Selected = nil then
    exit;

  if Selected.HasChildren then
    Selected.Expand( false );

  oNode := nil;
  oHold := Selected;  
  if Delta < 0 then begin
    if oHold.HasChildren then
      oNode := oHold.getFirstChild;
    if oNode = nil then
      oNode := oHold.GetNextChild( oHold );
    if oNode = nil then
      oNode := oHold.GetNext;
  end else begin
    oNode := oHold.GetPrevChild( oHold );
    if oNode <> nil then begin
      if oNode.HasChildren then
        oNode := oNode.GetLastChild;
    end else
      oNode := oHold.GetPrev;
  end;
  if oNode <> nil then
    Selected := oNode;
end;
{$ELSE}
  {$IFDEF LINUX}
    function TAbZipDisplayOutline.DoMouseWheel(Shift: TShiftState; 
       WheelDelta: Integer; const MousePos: TPoint): Boolean;
     const
       WHEEL_DELTA = 120;
     var
      oHold : TTreeNode;
      oNode : TTreeNode;
    begin
      { We always return true - if there's an event handler that returns }
      { false, we'll do the work; if it returns true, the work has been  }
      { done, ergo this routine should return true.                      }
      Result := True;
      if not inherited DoMouseWheel(Shift, WheelDelta, MousePos) then begin
        if Items.Count = 0 then
          Exit;
    
          if Selected = nil then
            exit;
          if Selected.HasChildren then
            Selected.Expand( false );
            
          oNode := nil;
          oHold := Selected;  
          if WheelDelta < 0 then begin
            if oHold.HasChildren then
              oNode := oHold.getFirstChild;
            if oNode = nil then
              oNode := oHold.GetNextChild( oHold );
            if oNode = nil then
              oNode := oHold.GetNext;
          end else begin
            oNode := oHold.GetPrevChild( oHold );
            if oNode <> nil then begin
              if oNode.HasChildren then
                oNode := oNode.GetLastChild;
            end else
              oNode := oHold.GetPrev;
          end;
          if oNode <> nil then
            Selected := oNode;
      end;
    end; 
  {$ELSE}