structstorageexamplemain.pas

East make Tray Icon in delphi

      OleError(SS.LastError)
    else
    begin
      AddFile(N, S, SS);
      Modified := true;
    end;
  end;
  SortTree;
end;

procedure TfrmMain.acDeleteExecute(Sender: TObject);
begin
  if YesNoDlg(SConfirm, SDeletePrompt) then
    if not TJclStructStorageFolder(tvDocInfo.Selected.Parent.Data).Delete(tvDocInfo.Selected.Text) then
      OleError(TJclStructStorageFolder(tvDocInfo.Selected.Parent.Data).LastError)
    else
    begin
      tvDocInfo.Selected.Delete;
      Modified := true;
    end;
end;

procedure TfrmMain.acAboutExecute(Sender: TObject);
var
  ParamsW: TMsgBoxParamsW;
  ParamsA: TMsgBoxParamsA;
begin
  if Win32Platform = VER_PLATFORM_WIN32_NT then
  begin
    with ParamsW do
    begin
      cbSize := sizeof(TMsgBoxParamsW);
      hwndOwner := Handle;
      hInstance := SysInit.hInstance;
      lpszText := PWideChar(WideString(SAboutMsg));
      lpszCaption := PWideChar(WideString(SAboutCaption));
      dwStyle := MB_OK or MB_USERICON;
      lpszIcon := PWideChar(WideString('MAINICON'));
      dwContextHelpId := 0;
      lpfnMsgBoxCallback := nil;
      dwLanguageId := GetUserDefaultLangID;
      MessageBoxIndirectW(ParamsW);
    end
  end
  else
    with ParamsA do
    begin
      cbSize := sizeof(TMsgBoxParamsA);
      hwndOwner := Handle;
      hInstance := SysInit.hInstance;
      lpszText := PChar(SAboutMsg);
      lpszCaption := PChar(SAboutCaption);
      dwStyle := MB_OK or MB_USERICON;
      lpszIcon := PChar('MAINICON');
      dwContextHelpId := 0;
      lpfnMsgBoxCallback := nil;
      dwLanguageId := GetUserDefaultLangID;
      MessageBoxIndirectA(ParamsA);
    end;
end;

procedure TfrmMain.alMainUpdate(Action: TBasicAction;
  var Handled: Boolean);
var
  IsReadOnly: boolean;
begin
  IsReadOnly := ReadOnly;
  acTransacted.Enabled := not IsReadOnly;
  acSave.Enabled := not IsReadOnly and Modified;
  acSaveAs.Enabled := not IsReadOnly and (FFilename <> '');
  acDelete.Enabled := not IsReadOnly and
    (tvDocInfo.Selected <> nil) and (tvDocInfo.Selected.Parent <> nil);
  acAddFolder.Enabled := not IsReadOnly and
    (tvDocInfo.Selected <> nil) and not reDetails.Focused;
  acAddFile.Enabled := acAddFolder.Enabled;
  acEditData.Enabled := not ReadOnly and (GetStream(tvDocInfo.Selected) <> nil);
  acSaveData.Enabled := not IsReadOnly and acEditData.Enabled
    and acEditData.Checked and reDetails.Modified;
  acRename.Enabled := not IsReadOnly and (tvDocInfo.Selected <> nil)
    and (tvDocInfo.Selected.Parent <> nil);
  acProperties.Enabled := (tvDocInfo.Selected <> nil);
end;

function TreeSort(lParam1, lParam2, lParamSort: Longint): Integer; stdcall;

begin
  if IsFolder(TTreeNode(lParam1)) = IsFolder(TTreeNode(lParam2)) then
    Result := AnsiCompareText(TTreeNode(lParam1).Text, TTreeNode(lParam2).Text)
  else if IsFolder(TTreeNode(lParam1)) then
    Result := -1
  else if IsFolder(TTreeNode(lParam2)) then
    Result := 1
  else
    Result := 0;
end;

procedure TfrmMain.SortTree;
begin
  tvDocInfo.CustomSort(TreeSort, 0{$IFDEF COMPILER6_UP}, true{$ENDIF});
end;

function TfrmMain.GetModified: boolean;
begin
  // can never be modified when running in direct mode or as ReadOnly
  Result := FModified and not ReadOnly and (FFilename <> '') and
    acTransacted.Checked and (tvDocInfo.Items.Count > 0);
end;

procedure TfrmMain.SetModified(const Value: boolean);
begin
  FModified := Value;
end;

function TfrmMain.GetReadOnly: boolean;
begin
  Result := ofReadOnly in OpenDialog.Options;
end;

procedure TfrmMain.SetReadOnly(const Value: boolean);
begin
  if Value then
    OpenDialog.Options := OpenDialog.Options + [ofReadOnly]
  else
    OpenDialog.Options := OpenDialog.Options - [ofReadOnly];
end;

procedure TfrmMain.AddFile(ParentNode: TTreeNode; AName: string;
  Storage: TJclStructStorageFolder);
var
  Stream: TStream;
begin
  if ParentNode <> nil then
    with ParentNode do
    begin
      ImageIndex := Ord(Expanded);
      SelectedIndex := ImageIndex;
    end;
  if not Storage.GetFileStream(AName, Stream) then
    OleError(Storage.LastError)
  else
    with tvDocInfo.Items.AddChildObject(ParentNode, AName, Stream) do
    begin
      ImageIndex := cImageDoc;
      SelectedIndex := cImageDoc;
      if not FUpdating then
        MakeVisible;
    end;
end;

procedure TfrmMain.AddFolder(ParentNode: TTreeNode; AName: string;
  Storage: TJclStructStorageFolder);
var
  S: TStringlist;
  i: integer;
  N: TTreeNode;
  ST: TJclStructStorageFolder;
begin
  if ParentNode <> nil then
    with ParentNode do
    begin
      ImageIndex := Ord(Expanded);
      SelectedIndex := ImageIndex;
    end;
  N := tvDocInfo.Items.AddChildObject(ParentNode, AName, Storage);
  with N do
  begin
    ImageIndex := Ord(Expanded);
    SelectedIndex := ImageIndex;
    if not FUpdating then
      MakeVisible;
  end;

  S := TStringlist.Create;
  try
    // folders
    Storage.GetSubItems(S, true);
    for i := 0 to S.Count - 1 do
    begin
      if not Storage.GetFolder(S[i], ST) then
        OleError(Storage.LastError)
      else
        AddFolder(N, S[i], ST);
    end;
    S.Clear;
    // files
    Storage.GetSubItems(S, false);
    for i := 0 to S.Count - 1 do
      AddFile(N, S[i], Storage);
  finally
    S.Free;
  end;
end;

procedure TfrmMain.acEditDataExecute(Sender: TObject);
begin
  acEditData.Checked := not acEditData.Checked;
  if acEditData.Checked then
  begin
    reDetails.Visible := true;
    HD.Visible := false;
    reDetails.Lines.LoadFromStream(GetStream(tvDocInfo.Selected));
    reDetails.Modified := false;
    reDetails.SelStart := MaxInt;
    reDetails.SetFocus;
  end
  else
  begin
    HD.Visible := true;
    reDetails.Visible := false;
    tvDocInfoChange(Sender, tvDocInfo.Selected);
  end;
end;

procedure TfrmMain.acSaveDataExecute(Sender: TObject);
var
  S: TStream;
begin
  S := GetStream(tvDocInfo.Selected);
  if (S <> nil) and reDetails.Modified then
  begin
    S.Size := 0; // clear so we don't have old data at the end of the stream (if it's shorter now)
    reDetails.Lines.SaveToStream(S); // add new
    Modified := true;
    if (tvDocInfo.Selected <> nil) then
      with tvDocInfo.Selected do
      begin
        ImageIndex := cImageDoc + Ord(acTransacted.Checked);
        SelectedIndex := ImageIndex;
      end;
  end;
  acEditData.Execute; // toggle into browse mode
end;

procedure TfrmMain.tvDocInfoChange(Sender: TObject; Node: TTreeNode);
begin
  if Node = tvDocInfo.Items.getFirstNode then
    ViewDocument
  else
    ViewDetails(GetStream(Node));
end;

procedure TfrmMain.tvDocInfoEditing(Sender: TObject; Node: TTreeNode;
  var AllowEdit: Boolean);
begin
  AllowEdit := (Node <> nil) and (Node.Parent <> nil);
end;

procedure TfrmMain.FreeData(const Node: TTreeNode);
var
  N: TTreeNode;
begin
  TObject(Node.Data).Free;
  Node.Data := nil;
  N := Node.getFirstChild;
  while Assigned(N) do
  begin
    FreeData(N);
    N := N.GetNextSibling;
  end;
end;

procedure TfrmMain.acRenameExecute(Sender: TObject);
begin
  tvDocInfo.Selected.EditText;
end;

procedure TfrmMain.UpdateFolderData(Node: TTreeNode; const AName: string; Storage: TJclStructStorageFolder);
var
  SS: TJclStructStorageFolder;
  S: TStringlist;
  i: integer;
begin
  TObject(Node.Data).Free;
  Node.Data := nil;
  if Storage <> nil then
  begin
    Node.Data := Storage;
    Node.Text := AName;
  end
  else
    Exit;
  Node.DeleteChildren;
  S := TStringlist.Create;
  try
    // sub folders
    Storage.GetSubItems(S, true);
    for i := 0 to S.Count - 1 do
    begin
      if not Storage.GetFolder(S[i], SS) then
        OleError(Storage.LastError)
      else
        AddFolder(Node, S[i], SS);
    end;
    S.Clear;
    // sub files
    if not Storage.GetSubItems(S, false) then
      OleError(Storage.LastError)
    else
      for i := 0 to S.Count - 1 do
        AddFile(Node, S[i], Storage);
  finally
    S.Free;
  end;
end;

procedure TfrmMain.UpdateFileData(Node: TTreeNode; const AName: string; Storage: TJclStructStorageFolder);
var
  SS: TStream;
begin
  TObject(Node.Data).Free;
  Node.Data := nil;
  if Storage.GetFileStream(AName, SS) then
  begin
    Node.Data := SS;
    Node.Text := AName;
  end
  else
    OleError(Storage.LastError);
end;

procedure TfrmMain.tvDocInfoEdited(Sender: TObject; Node: TTreeNode;
  var S: string);
var
  SS, SS2: TJclStructStorageFolder;
  WasFolder: boolean;
begin
  // this is a bit convoluted since we can't rename a node that is open
  // so we have to destroy the Node.Data and recreate it again after the rename
  if (Node = nil) or (Node.Parent = nil) then
  begin
    ErrorDlg(SError, SErrNodeEdit);
    Node.EndEdit(true);
  end
  else
  begin
    SS := GetFolder(Node.Parent);
    WasFolder := IsFolder(Node);
    FreeData(Node); // release any storages / streams so we can rename
    if (SS = nil) or not SS.Rename(Node.Text, S) then
    begin
      if SS <> nil then
        OleError(SS.LastError)
      else
        ErrorDlg(SError, SErrNodeRename);
      S := Node.Text;
      Node.EndEdit(true);
    end
    else
    begin // update the node's (and subnodes') Data with new storages / streams
      if WasFolder then
      begin
        if not SS.GetFolder(S, SS2) then
          OleError(SS.LastError)
        else
          UpdateFolderData(Node, S, SS2);
      end
      else
        UpdateFileData(Node, S, SS);
    end;
    Modified := true;
  end;
  SortTree;
end;

procedure TfrmMain.acRefreshExecute(Sender: TObject);
begin
  SortTree;
end;

procedure TfrmMain.acPropertiesExecute(Sender: TObject);
var
  Stat: TStatStg;
  B: Boolean;
begin
  B := false;
  if IsFolder(tvDocInfo.Selected) then
    B := TJclStructStorageFolder(tvDocInfo.Selected.Data).GetStats(Stat, true)
  else if tvDocInfo.Selected <> nil then
    B := TJclStructStorageStream(tvDocInfo.Selected.Data).GetStats(Stat, true);
  if B then
  begin
    TfrmProps.ShowProperties(Stat);
    JclStructStorage.CoMallocFree(Stat.pwcsName);
  end;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  PostMessage(Handle, WM_SHOWABOUT, 0, 0);
end;

procedure TfrmMain.WmShowAbout(var Msg: TMEssage);
begin
  acAbout.Execute;
end;

procedure TfrmMain.acTransactedExecute(Sender: TObject);
begin
  acTransacted.Checked := not acTransacted.Checked;
  if FileExists(FFilename) then
  begin
    CheckModified;
    LoadFile(FFilename, false);
  end;
end;

procedure TfrmMain.tvDocInfoDblClick(Sender: TObject);
begin
  if (tvDocInfo.Selected <> nil) and not tvDocInfo.Selected.HasChildren then
    acProperties.Execute;
end;

procedure TfrmMain.acNewExecute(Sender: TObject);
begin
  CheckModified;
  ReadOnly := false;
  if SaveDialog.Execute then
    LoadFile(SaveDialog.Filename, true);
end;

procedure TfrmMain.acSaveExecute(Sender: TObject);
var
  N: TTreeNode;
begin
  if Modified then
  begin
    // we must call Commit on *every* storage to save our changes (the fine print!)
    N := tvDocInfo.Items.getFirstNode;
    while Assigned(N) do
    begin
      if IsFolder(N) then
      begin
        TJclStructStorageFolder(N.Data).Commit;
        N.ImageIndex := cImageDoc;
        N.SelectedIndex := cImageDoc;
      end;
      N := N.GetNext;
    end;
  end;
  Modified := false;
end;

procedure TfrmMain.acSaveAsExecute(Sender: TObject);
var
  AFile: TJclStructStorageFolder;
begin
  // I know: I could just as well have done a standard FileCopy, but that's not any fun!
  if SaveDialog.Execute then
  begin
    AFile := TJclStructStorageFolder.Create(SaveDialog.Filename, [smCreate], true);
    try
      AFile.Assign(TJclStructStorageFolder(tvDocInfo.Items.GetFirstNode.Data));
    finally
      AFile.Free;
    end;
    LoadFile(SaveDialog.Filename, false);
  end;
end;

// History:

// $Log: StructStorageExampleMain.pas,v $
// Revision 1.3  2004/10/02 05:47:27  marquardt
// added check for incompatible jedi.inc
// replaced jedi.inc with jvcl.inc
//
// Revision 1.2  2004/06/12 04:44:16  rrossmair
// mistakenly commited the wrong (outdated) file version at first; corrected
//
// Revision 1.1  2004/06/12 03:44:01  rrossmair
// structured storage demo initial check-in; adapted for JCL
//

end.