outlook.pas

请使用Mobile FBUS——用来创建与NOKIA手机连接的软件的理想解决方案！功能包括：发送SMS

procedure TOutlook.WMSize(var Message: TWMSize);
var a: integer;
begin
   For a := 0 to Panels.count -1 do
     TPanel(Panels[a]).Width := FItemCab.width;
   For a := 0 to TempImages.count -1 do
     TImage(TempImages[a]).Left := (width-40) div 2;
   For a := 0 to TempLabels.count -1 do
     TLabel(TempLabels[a]).Left :=
            (width - TLabel(TempLabels[a]).width) div 2;
  RefreshItems;
end;

{ TOutlookItems }

constructor TOutlookItems.create(AOwner: TOutLook);
begin
  Inherited Create;
  Owner := AOwner;
  FHeaders := TStringList.Create;
  FItems := TList.Create;
  FImages:= TList.Create;
  AllImages := TImageList.Create(nil);
  AllImages.Height := 32;
  AllImages.Width := 32;
end;

procedure TOutlookItems.DefineProperties(Filer: TFiler);
begin
  Filer.DefineProperty('Headers',ReadHeaders,WriteHeaders,True);
  Filer.DefineProperty('Contents',ReadItems,WriteItems,True);
  Filer.DefineBinaryProperty('Images', ReadImages, WriteImages,True);
end;

destructor TOutlookItems.destroy;
begin
  FHeaders.Free;
  FItems.Free;
  FImages.Free;
  AllImages.Free;
  Inherited Destroy;
end;

function TOutlookItems.GetCounts(idx: integer): integer;
begin
  result := 0;
  if idx = 0 then
    result := FHeaders.Count
  else
  begin
    if Idx > FHeaders.Count then
      result := 0
    else
      result := TstringList(FItems[idx-1]).count;
  end;
end;

function TOutlookItems.GetHeader(HeaderIndex: integer): string;
begin
  If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
    result := ''
  else
    result := FHeaders[HeaderIndex-1];
end;

function TOutlookItems.GetImage(HeaderIndex, ItemIndex: integer): TPicture;
var List : TList;
begin
  If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
  begin
    result := nil;
  end
  else
  begin
    List := TList(FImages[HeaderIndex-1]);
    if (ItemIndex > List.Count) or (ItemIndex =0) then
      result := nil
    else
      Result := TPicture(List[ItemIndex-1]);
  end;
end;

function TOutlookItems.GetItem(HeaderIndex, ItemIndex: integer): String;
var List : TStringlIst;
begin
  If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
  begin
    result := '';
  end
  else
  begin
    List := TStringList(FItems[HeaderIndex-1]);
    if (ItemIndex > List.Count) or (ItemIndex =0) then
      result := ''
    else
      Result := List[ItemIndex-1];
  end;

end;

procedure TOutlookItems.LoadFromImageList(IList: TImageList);
var a,b,x: integer;
    Picture : TPicture;
begin
  x := 0;
  For a := 1 to Counts[0] do
  begin
    TList(FImages[a-1]).Clear;
    For b:= 1 to Counts[a] do
    begin
      Picture := TPicture.Create;
      IList.GetIcon(x,Picture.Icon);
      TList(FImages[a-1]).Add(Picture);
      inc(x);
    end;
  end;

end;

procedure TOutlookItems.AssignContent(value: TOutlookItems);
begin
  FHeaders := Value.FHeaders;
  FItems := Value.FItems;
  FImages := Value.FImages;
end;

procedure TOutlookItems.ReadHeaders(Reader: TReader);
var a: integer;
begin
  FHeaders.Text := Reader.ReadString;
  For a := 0 to FHeaders.Count -1 do
  begin
    FItems.Add(TStringList.Create);
    FImages.Add(TList.Create);
  end;
end;

procedure TOutlookItems.ReadItems(Reader: TReader);
var TotalItems,list: TStringList;
    a,x: integer;
begin
  TotalItems := TstringList.Create;
  TotalItems.Text := Reader.ReadString;
  x := 0;
  List := Nil;
  For a := 0 to TotalItems.Count- 1 do
  begin
    if inttostr(x) = TotalItems[a] then
    begin
      List := TstringList(FItems[x]);
      x := x+1;
    end
    else
    begin
      If List <> nil then List.Add(TotalItems[a]);
    end;
  end;
end;

procedure TOutlookItems.ReadImages(Stream: TStream);
var
  SA: TStreamAdapter;
begin
  SA := TStreamAdapter.Create(Stream);
  try
    AllImages.Handle := ImageList_Read(SA);
    if AllImages.Handle = 0 then
      raise EReadError.Create(SImageReadFail);
    LoadFromImageList(AllImages);
  finally
    SA.Free;
  end;
  If owner <> nil then Owner.RefreshDisplay;
end;


procedure TOutlookItems.SaveToImageList(IList: TImageList);
Var
  a,b: integer;
  Picture: TPicture;
Begin
  For a := 1 to Counts[0] do
  begin
    For b:= 1 to Counts[a] do
    begin
      Picture := Images[a,b];
      IList.AddIcon(Picture.Icon)
    end;
  end;
end;

procedure TOutlookItems.SetHeader(HeaderIndex: integer;
  const Value: string);
var a,dif : integer;
begin
  If HeaderIndex = 0 then exit;
  Dif := HeaderIndex-FHeaders.Count;
  If (HeaderIndex > FHeaders.Count) then
  begin
    for a := 1 to dif do
    begin
      FHeaders.Add('');
      FItems.Add(TStringList.Create());
      FImages.Add(TList.Create());
    end;
  end;
  FHeaders[HeaderIndex -1] := value;
end;

procedure TOutlookItems.SetImage(HeaderIndex, ItemIndex: integer;
  const Value: TPicture);
var List : TlIst;
begin
  If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
    exit
  else
  begin
    List := TList(FImages[HeaderIndex-1]);
    if (ItemIndex > List.Count) or (ItemIndex =0) then
      exit
    else
      List[ItemIndex-1] := Value;
  end;
end;

procedure TOutlookItems.SetItem(HeaderIndex, ItemIndex: integer;
  const Value: String);
var List : TStringlIst;
    a,dif : integer;
begin
  If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then
  begin
    exit;
  end
  else
  begin
    List := TStringList(FItems[HeaderIndex-1]);
    if ItemIndex = 0 then exit;
    Dif := ItemIndex - List.Count;
    if (ItemIndex > List.Count)then
    begin
      for a := 1 to dif do
      begin
        List.Add('');
        TList(FImages[HeaderIndex-1]).Add(TPicture.Create);
      end;
    end;
    List[ItemIndex-1] := Value;
  end;
end;

procedure TOutlookItems.WriteHeaders(Writer: TWriter);
begin
  Writer.WriteString(FHeaders.Text);
end;

procedure TOutlookItems.WriteImages(Stream: TStream);
var
  SA: TStreamAdapter;
begin
  SA := TStreamAdapter.Create(Stream);
  AllImages.Clear;
  SaveToImageList(AllImages);
  try
    if not ImageList_Write(AllImages.Handle, SA) then
      raise EWriteError.Create(SImageWriteFail);
  finally
    SA.Free;
  end;
end;

procedure TOutlookItems.WriteItems(Writer: TWriter);
var TotalItems,List: TstringList;
    a,b : integer;
begin
  TotalItems := TstringList.Create;
  For a := 0 to FHeaders.Count -1 do
  begin
     TotalItems.Add(inttostr(a));
     List := TStringList(FItems[a]);
     For b := 0 to List.Count -1 do
       TotalItems.Add(List[b]);
  end;
  Writer.WriteString(TotalItems.Text);
  TotalItems.Free;
end;


procedure TOutlookItems.DeleteHeader(HeaderIndex: integer);
begin
  If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then exit;
  FHeaders.Delete(HeaderIndex-1);
  TStringList(FItems[HeaderIndex-1]).Destroy;
  FItems.Delete(HeaderIndex-1);
  TList(FImages[HeaderIndex-1]).Destroy;
  FImages.Delete(HeaderIndex-1);
end;

procedure TOutlookItems.DeleteItem(HeaderIndex, ItemIndex: integer);
begin
  If (HeaderIndex > FHeaders.Count) or (HeaderIndex = 0) then exit;
  TStringList(FItems[HeaderIndex-1]).Delete(ItemIndex-1);
  TList(FImages[HeaderIndex-1]).Delete(ItemIndex-1);
end;

procedure TOutlookItems.ExchangeHeader(idx1, idx2: integer);
begin
  If (idx1 = 0) or (idx2 = 0) then exit;
  if (idx1 > Fheaders.Count) or (idx2 > Fheaders.Count) then exit;
  FHeaders.Exchange(idx1-1,idx2-1);
  FItems.Exchange(idx1-1,idx2-1);
  FImages.Exchange(idx1-1,idx2-1);
end;

procedure TOutlookItems.ExchangeItem(HeaderIdx, idx1, idx2: integer);
begin
  if (HeaderIdx = 0) or (idx1=0) or (idx2=0) then exit;
  if HeaderIdx > counts[0] then exit;
  if (idx1 > Counts[HeaderIdx]) or
     (idx2 > Counts[HeaderIdx]) then exit;
  TstringList(FItems[HeaderIdx-1]).Exchange(idx1-1,idx2-1);
  TList(FImages[HeaderIdx-1]).Exchange(idx1-1,idx2-1);
end;

end.