fmain.pas

siMail, siMail, siMail, siMail

    with frmAddressBook do begin
      BorderStyle := bsNone;
      Parent := pnlAddressBook;
      Align := alClient;
      Show;
    end;
  except
    MessageDlg(Format(_('Window creation failed ''%s''.'), ['TfrmAddressBook']),
      mtError, [mbOK], 0);
    Self.Close;
  end;

  try
    with frmMaillist do begin
      BorderStyle := bsNone;
      Parent := pnlMailList;
      Align := alClient;
      Show;
    end;
  except
    MessageDlg(Format(_('Window creation failed ''%s''.'), ['TfrmMaillist']),
      mtError, [mbOK], 0);
    Self.Close;
  end;

  //load users
  frmSplash.lblStatus.Caption := _('Loading user data ...');
  //create this form here so we can ask for password if profile has it
  frmMIB := TfrmMIB.Create(Self);
  //create form here so we can ask for another user if current not found
  frmProfiles := TfrmProfiles.Create(Application);

  frmMailbox.LoadUsers;

  frmSplash.lblStatus.Caption := _('Loading address book ...');
  //frmAddressBook.LoadBook( -1);

  tmpStr := df.Application + 'locale\';
  if FileExists(tmpStr + GetCurrentLanguage + '\help\siMail.chm') then
    tmpStr := tmpStr + GetCurrentLanguage + '\help\siMail.chm'
  else
    tmpstr := tmpStr + 'en\help\siMail.chm';
  help := THookHelpSystem.Create(tmpStr, '', htHHAPI);

  GetLocaleFormatSettings(GetSystemDefaultLCID, FormatSettings);
  SelectedTheme := 0;
  //mGesture.Active := True;
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  tray.HideTaskbarIcon;
  FreeAndNil(xmlIni);
  FreeAndNil(help);
  FreeAndNil(lstThemes);
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  //translate me
  TranslateComponent(Self);
  processCommandLine;
  //try to read self position & size
  try
    frmMailbox.Profile.Config.ReadControlSettings(Self);
  except
  end;

  frmMailbox.LoadBackgrounds(frmMailbox.SelectedTheme);
  frmMaillist.lstMailList.SetFocus;
end;

//exception handler routine
procedure TfrmMain.AppException(Sender: TObject; E: Exception);
begin
  Application.ShowException(E);
end;

function TfrmMain.GetFileVersion(const FileName: string; var Major: Word;
  var Minor: Word; var Release: Word; var Build: Word): Boolean;
var
  VerInfoSize: Longword;
  VerInfo: Pointer;
  VerValueSize: Longword;
  VerValue: PVSFixedFileInfo;
  Dummy: Longword;
begin
  Result := False;;
  VerInfoSize := GetFileVersionInfoSize(PChar(FileName), Dummy);
  if VerInfoSize = 0 then exit;

  GetMem(VerInfo, VerInfoSize);
  if not assigned(VerInfo) then exit;

  try
    if GetFileVersionInfo(PChar(FileName), 0, VerInfoSize, VerInfo) then begin
      if VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize) then begin
        with VerValue^ do begin
          Major := dwFileVersionMS shr 16;
          Minor := dwFileVersionMS and $FFFF;
          Release := dwFileVersionLS shr 16;
          Build := dwFileVersionLS and $FFFF;
        end;
        Result := True;
      end;
    end;
  finally
    FreeMem(VerInfo, VerInfoSize);
  end;
end;

function TfrmMain.GetFileVersionAsString(const FileName: string): String;
var Major: Word;
var Minor: Word;
var Release: Word;
var Build: Word;
begin
  Result := '';
  if GetFileVersion(FileName, Major, Minor, Release, Build) then
    Result := IntToStr(Major) + '.' + IntToStr(Minor) + '.' + IntToStr(Release) +
      '.' + IntToStr(Build);
end;

procedure TfrmMain.actDeleteExecute(Sender: TObject);
begin
  actDeleteF;
end;

function TfrmMain.actDeleteF: Boolean;
begin
  Result := False;
  if GetFocus = frmMailbox.trMailbox.Handle then begin
    Result := frmMailbox.actMailboxDeleteF;
    exit;
  end;

  if GetFocus = frmMaillist.lstMaillist.Handle then begin
    Result := frmMaillist.actMaillistDeleteF;
    exit;
  end;

  if GetFocus = frmAddressBook.trAddressBook.Handle then begin
    Result := frmAddressBook.actDeleteContactF;
    exit;
  end;
end;

procedure TfrmMain.actDeleteUpdate(Sender: TObject);
begin
  if GetFocus = frmMailbox.trMailbox.Handle then begin
    frmMailbox.actMailboxDeleteUpdate;
    exit;
  end;

  if GetFocus = frmMaillist.lstMaillist.Handle then begin
    frmMaillist.actMaillistDeleteUpdate;
    exit;
  end;
end;

procedure TfrmMain.actTBMessageNewExecute(Sender: TObject);
begin
  frmMaillist.actMessageNew.Execute;
end;

procedure TfrmMain.actTBExitExecute(Sender: TObject);
begin
  actFileExit.Execute;
end;

procedure TfrmMain.actTBFetchExecute(Sender: TObject);
begin
  if frmMailbox.SelectedNodeType = sntUser then
    frmMailbox.actAccountFetchMessagesAll.Execute
  else
    frmMailbox.actAccountFetchMessagesThis.Execute;
end;

procedure TfrmMain.actTBFetchUpdate(Sender: TObject);
begin
  actTBFetch.Enabled := frmMailbox.actAccountFetchMessagesThis.Enabled or
    frmMailbox.actAccountFetchMessagesAll.Enabled;
end;

procedure TfrmMain.actTBMaximizeExecute(Sender: TObject);
begin
  if frmMaillist.Minimized then begin
    pnlMailList.Height := FmaillistOldHeight;
    frmMaillist.Restore;
  end
  else begin
    FmaillistOldHeight := pnlMailList.Height;
    pnlMailList.Height := 50;
    frmMaillist.Minimize;
  end;
end;

function TfrmMain.sizeToString(size: Int64): String;
begin
  case size of
    0..1023:
      Result := IntToStr(size) + ' B';
    1024..(1024 * 1024) - 1:
      Result := Format('%.2f kB', [size / 1024]);
    1024 * 1024..(1024 * 1024 * 1024) - 1:
      Result := Format('%.2f MB', [size / (1024 * 1024)]);
    else Result := Format('%.2f GB', [size / (1024 * 1024 * 1024)]);
  end;
end;

procedure TfrmMain.actTrayExitExecute(Sender: TObject);
begin
  actFileExit.Execute;
end;

procedure TfrmMain.actTrayShowExecute(Sender: TObject);
begin
  if Self.Visible = False then tray.ShowMainForm
  else tray.HideMainForm;
end;

procedure TfrmMain.actTrayShowUpdate(Sender: TObject);
begin
  if Self.Visible then actTrayShow.Caption := _('Hide')
  else actTrayShow.Caption := _('Show');
end;

function TfrmMain.getEnvirometVar(variableName: String): String;
var i: Integer;
var str: PChar;
begin
  Result := '';
  //how much space do we need
  i := GetEnvironmentVariable(PChar(variableName), nil, 0);
  if i > 0 then begin
    str := StrAlloc(i);
    i := GetEnvironmentVariable(PChar(variableName), str, i);
    if i >= 0 then Result := str;
    StrDispose(str);
  end;
end;

procedure TfrmMain.findTemporaryFolder;
begin
  df.Temp := getEnvirometVar('TEMP');
  if df.Temp[Length(df.Temp)] <> '\' then df.Temp := df.Temp + '\';
  if df.Temp <> '' then Exit;

  df.Temp := getEnvirometVar('TMP');
  if df.Temp[Length(df.Temp)] <> '\' then df.Temp := df.Temp + '\';
  if df.Temp <> '' then Exit;

  df.Temp := df.Application + 'Temp\';
end;

procedure TfrmMain.actFileExitExecute(Sender: TObject);
begin
  Self.Close;
end;

procedure TfrmMain.actHelpAboutExecute(Sender: TObject);
begin
  frmAbout.ShowModal;
end;

procedure TfrmMain.actHelpHomeExecute(Sender: TObject);
begin
  ShellExecute(Self.Handle, 'open', siMailHome, nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.actViewToolbarExecute(Sender: TObject);
begin
  tb1.Visible := actViewToolbar.Checked;
  frmMailbox.Profile.Config.WriteBool(Self.Name, 'viewToolbar', tb1.Visible);
end;

procedure TfrmMain.actViewStatusbarExecute(Sender: TObject);
begin
  StatusBar1.Visible :=actViewStatusbar.Checked;
  frmMailbox.Profile.Config.WriteBool(Self.Name, 'viewStatusbar', StatusBar1.Visible);
end;

procedure TfrmMain.actViewAddressBookUpdate(Sender: TObject);
begin
  actViewAddressBook.Checked := pnlAddressBook.Visible;
end;

procedure TfrmMain.actViewMailViewUpdate(Sender: TObject);
begin
  actViewMailView.Checked := pnlPreview.Visible;
end;

procedure TfrmMain.actViewAddressBookExecute(Sender: TObject);
begin
  pnlAddressBook.Visible := not pnlAddressBook.Visible;
  dfsSplitter2.Visible := not dfsSplitter2.Visible;
  frmMailbox.Profile.Config.WriteBool(Self.Name, 'viewAddressBook',
    pnlAddressBook.Visible);
end;

procedure TfrmMain.actViewMailViewExecute(Sender: TObject);
begin
  pnlMailList.Visible := not pnlMailList.Visible;
  if pnlMaillist.Align = alClient then begin
    pnlMaillist.Align := alTop;
    pnlMailList.Height := Trunc(0.45 * pnlMails.Height);
  end
  else
    pnlMaillist.Align := alClient;

  dfsSplitter3.Visible := not dfsSplitter3.Visible;
  pnlPreview.Visible := not pnlPreview.Visible;
  pnlMailList.Visible := not pnlMailList.Visible;
  frmMailbox.Profile.Config.WriteBool(Self.Name, 'viewMailView', pnlPreview.Visible);
end;

procedure TfrmMain.actViewLargeHdrsUpdate(Sender: TObject);
begin
  actViewLargeHdrs.Checked := frmMailView.LargeHeaders;
end;

procedure TfrmMain.actViewLargeHdrsExecute(Sender: TObject);
begin
  frmMailView.LargeHeaders := not frmMailView.LargeHeaders;
end;

procedure TfrmMain.actTBMessageNewUpdate(Sender: TObject);
begin
  frmMaillist.actMessageNew.Update;
end;

procedure TfrmMain.trayDblClick(Sender: TObject);
begin
  tray.ShowMainForm;
end;

function TfrmMain.FindFileIcon(imageList: TimageList; fileName: String; Large: Boolean): Integer;
var FileInfo: TSHFileInfo;
var Flags: Integer;
var ico: TIcon;
var guid: TGUID;
var f: File;
var myFile: Boolean;
begin
  myFile := False;
  if not FileExists(fileName) then begin
    CreateGUID(guid);
    fileName := df.Temp + tmpFilePrefix + GUIDToString(guid) + ExtractFileExt(fileName);
    AssignFile(f, fileName);
    Rewrite(f);
    System.Close(f);
    myFile := True;
  end;

  FillChar(FileInfo, sizeOf(FileInfo), #0);
  Flags := SHGFI_SYSICONINDEX or SHGFI_ICON;
  if Large then Flags := Flags or SHGFI_LARGEICON
  else Flags := Flags or SHGFI_SMALLICON;
  SHGetFileInfo(PChar(fileName), 0, FileInfo, sizeof(TSHFileInfo), Flags);

  if myFile then
    DeleteFile(fileName);

  ico := TIcon.Create;
  try
    ico.Handle := FileInfo.hIcon;
    Result := imageList.AddIcon(ico);
    ico.Handle := 0;
  finally
    FreeAndNil(ico);
  end;

end;

procedure TfrmMain.ConvertToHighColor(ImageList: TImageList);
//convert image list to show 32bit colors
var IL: TImageList;
begin
  // Have to create a temporary copy of the given list, because the list is cleared on handle creation.
  IL := TImageList.Create(nil);
  IL.Assign(ImageList);

  with ImageList do
    Handle := ImageList_Create(Width, Height, ILC_COLOR32 or ILC_MASK, Count, AllocBy);
  ImageList.Assign(IL);
  FreeAndNil(IL);
end;

procedure TfrmMain.actToolsSignaturesExecute(Sender: TObject);
begin
  frmSignatures.ShowModal;
end;

procedure TfrmMain.actToolsOptionsExecute(Sender: TObject);
begin
  frmSettings.ShowModal;
end;

procedure TfrmMain.FormHide(Sender: TObject);
begin
  //try to write self position & size
  try
    frmMailbox.Profile.Config.WriteControlSettings(Self);
  except
  end;
end;

procedure TfrmMain.actToolsTranslationFlagAsTextExecute(Sender: TObject);
begin
  frmFlagPrepare.ShowModal;
end;

procedure TfrmMain.actToolsTranslationSystemLocaleExecute(Sender: TObject);
begin
  MessageDlg(Format(_('Your current system locale is: %s.'), [GetOSLanguage]),
    mtInformation, [mbOK], 0);
end;

procedure TfrmMain.actHelpHOWTOTranslateExecute(Sender: TObject);
begin
  ShellExecute(Self.Handle, 'open', PChar(df.Application +
    '\locale\HOWTO Translate.html'), nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.FindFolders(path, mask: String; var lst: TStringList);
var sr: TSearchRec;
begin
  if FindFirst(path + mask, faDirectory, sr) = 0 then begin
    if ((sr.Attr and faDirectory) = faDirectory) and
      ((AnsiCompareFileName(sr.Name, '.') <> 0) and
      (AnsiCompareFileName(sr.Name, '..') <> 0))
    then lst.Add(sr.Name);
    while FindNext(sr) = 0 do begin
      if ((sr.Attr and faDirectory) = faDirectory) and
        ((AnsiCompareFileName(sr.Name, '.') <> 0) and
        (AnsiCompareFileName(sr.Name, '..') <> 0))
      then lst.Add(sr.Name);
    end;
    FindClose(sr);
  end;
end;

procedure TfrmMain.actFileOnlineExecute(Sender: TObject);
begin
  Online := not Online;
end;

function TfrmMain.GetOnline: Boolean;
begin
  Result := actFileOnline.Caption = _('Work online');
end;

procedure TfrmMain.SetOnline(const Value: Boolean);
begin
  if actFileOnline.Caption = _('Work online') then begin
    actFileOnline.Caption := _('Work offline');
    actTBOnline.ImageIndex := actTBOnline.ImageIndex - 1;
    actTBOnline.Hint := _('Go offline');
  end
  else begin
    actFileOnline.Caption := _('Work online');
    actTBOnline.ImageIndex := actTBOnline.ImageIndex + 1;
    actTBOnline.Hint := _('Go online')
  end;
end;

procedure TfrmMain.actTBOnlineExecute(Sender: TObject);
begin
  actFileOnline.Execute;
end;

procedure TfrmMain.LoadUserSettings;
begin
  tb1.Visible := frmMailbox.Profile.Config.ReadBool(