delphiXE7开发的进销存安卓APP

【实例简介】安装 MyPack.dpk 即可使用，源码也在里面，直接编译即可！简单的进销存示例，基本上包含了所有的进销存功能，

【实例截图】

【核心代码】unit MainU;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes,
  System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.MultiView, FMX.Objects, System.Generics.Collections, mainFrameU,
  buttonFrame, TextButton, FMX.Gestures, FMX.Layouts, tgView,
  FMX.MediaLibrary.Actions, System.Actions, FMX.ActnList, FMX.StdActns;

type
  TfmMain = class(TForm)
    GestureManager1: TGestureManager;
    rcMaster: TRectangle;
    tb客户管理: TfrTextButton;
    Layout2: TLayout;
    pnDetail: TRectangle;
    slyMaster: TScaledLayout;
    slyDetail: TScaledLayout;
    tb投保管理: TfrTextButton;
    tb工作日志: TfrTextButton;
    tb任务管理: TfrTextButton;
    GridPanelLayout1: TGridPanelLayout;
    tb组织: TfrTextButton;
    tb目标管理: TfrTextButton;
    tb保额: TfrTextButton;
    tb客户分析: TfrTextButton;
    Layout1: TLayout;
    Label6: TLabel;
    tb定投: TfrTextButton;
    tb备份: TfrTextButton;
    Label2: TLabel;
    pop: TPopup;
    lb提示: TLabel;
    RoundRect1: TRoundRect;
    Timer1: TTimer;
    Rcs: TRectangle;
    LayoutLocation: TLayout;
    Rectangle3: TRectangle;
    rc渐变背景: TRectangle;
    rc渐变背景1: TRectangle;
    ActionList1: TActionList;
    TakePhotoFromCameraAction1: TTakePhotoFromCameraAction;
    ShowShareSheetAction1: TShowShareSheetAction;
    ftb拍照: TfrButtonFrame;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormGesture(Sender: TObject; const EventInfo: TGestureEventInfo;
      var Handled: Boolean);
    procedure menurectClick(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
    procedure FormTouch(Sender: TObject; const Touches: TTouches;
      const Action: TTouchAction);
    procedure 主菜单click(Sender: TObject);
    procedure tb目标管理rectClick(Sender: TObject);
    procedure tb定投rectClick(Sender: TObject);
    procedure tb保额rectClick(Sender: TObject);
    procedure tb备份rectClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure popKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
      Shift: TShiftState);
    procedure ftb拍照rectClick(Sender: TObject);
    procedure RcsPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
  private
    { Private declarations }
    FisMove: Boolean;
    FisMasrterShowed: Boolean;
    FCurrentIndex: integer;
    FLastPosition: TpointF;
    TouchPosition: TpointF;
    FWaiteClose: Boolean;
    FrameList: TObjectList<TfrMain>;
    pFrame, cFrame, nFrame: TfrMain;
    FMasterShow: Boolean;
    procedure SetCurrentIndex(const Value: integer);
    procedure SetMasterShow(const Value: Boolean);
    procedure Aligning;
    procedure AnimMoveFrame;
    procedure exitApp;
  public
    { Public declarations }
    isModal: Boolean;
    procedure CreateFrames;
    procedure HideMaster;
    procedure ShowMaster;
    property CurrentIndex: integer read FCurrentIndex write SetCurrentIndex;
    property MasterShow: Boolean read FMasterShow write SetMasterShow;
  end;

var
  fmMain: TfmMain;

implementation

{$R *.fmx}

uses dateUtils, JournalMrgU, TaskMgU, csMrgU, orderU, FixInv, RiskCal,
{$IFDEF ANDROID} FMX.Helpers.Android, Androidapi.JNI.JavaTypes,
  Androidapi.JNI.GraphicsContentViewText, FMX.Platform.Android,
{$ENDIF}System.IOUtils, uDm, SplashFormUnit, CameraU;

const
  RC_MASTER_WIDTH = 15;
  AM_DURA = 0.3;
  FrameMargin = 6;
  SCALE_F = 0.9;

  { TfmMain }

procedure TfmMain.Aligning;
begin
  slyMaster.Position.X := -slyMaster.Width;
  slyMaster.OriginalHeight := ClientHeight;;
  slyMaster.Height := ClientHeight;
  slyMaster.Position.Y := slyMaster.Width * (1 - SCALE_F) / 2;
  slyMaster.Scale.X := SCALE_F;
  slyMaster.Scale.Y := SCALE_F;

  slyDetail.Position.X := 0;
  slyDetail.Position.Y := 0;

  slyDetail.OriginalWidth := ClientWidth;
  slyDetail.OriginalHeight := ClientHeight;
  slyDetail.Width := ClientWidth;
  slyDetail.Height := ClientHeight;

end;

procedure TfmMain.CreateFrames;
begin
  FrameList := TObjectList<TfrMain>.Create(True);
  frCsMgr := TfrCsMgr.Create(self);
  FrameList.Add(frCsMgr);
  frTaskMg := TfrTaskMg.Create(self);
  FrameList.Add(frTaskMg);
  frJournalMrg := TfrJournalMrg.Create(self);
  FrameList.Add(frJournalMrg);
  frOrder := Tfrorder.Create(self);
  FrameList.Add(frOrder);
end;

procedure TfmMain.exitApp;
begin
{$IFDEF ANDROID}
  MainActivity.finish;
{$ENDIF}
end;

procedure TfmMain.FormCreate(Sender: TObject);
begin
  FisMove := false;
  Aligning;
  SplashForm.rcWait.Visible := false;
  SplashForm.AniIndicator1.Enabled := false;
  SplashForm.Layout1.Visible := True;
end;

procedure TfmMain.FormDestroy(Sender: TObject);
begin
  FrameList.Free;
end;

procedure TfmMain.FormGesture(Sender: TObject;
  const EventInfo: TGestureEventInfo; var Handled: Boolean);
var
  mid: Double;
  DetalX: Double;
  DetalY: Double;
  moveX: Double;
begin
  // 取得触控原点
  if isModal then
    exit;
  if TInteractiveGestureFlag.gfBegin in EventInfo.Flags then
    TouchPosition := EventInfo.Location;
  if not(TInteractiveGestureFlag.gfBegin in EventInfo.Flags) then
  begin

    DetalX := abs(TouchPosition.X - FLastPosition.X);
    DetalY := abs(TouchPosition.Y - FLastPosition.Y);
    if (FisMove or (DetalX > 20)) and (DetalX > 2 * DetalY 20) and
      (not FMasterShow) then
    // 移动条件
    begin
      FisMove := True;
      moveX := EventInfo.Location.X - FLastPosition.X;
      cFrame.Position.X := cFrame.Position.X moveX;
      pFrame.Position.X := cFrame.Position.X - pnDetail.Width - FrameMargin;
      nFrame.Position.X := cFrame.Position.X pnDetail.Width FrameMargin;
    end;
  end;

  if TInteractiveGestureFlag.gfEnd in EventInfo.Flags then
  begin
    if FMasterShow then
    begin
      if (TouchPosition.X > EventInfo.Location.X 20) then
        MasterShow := false
    end
    else
    begin
      mid := pnDetail.Width / 3;
      if cFrame.Position.X >= mid then
        CurrentIndex := CurrentIndex - 1
      else if cFrame.Position.X <= -mid then
        CurrentIndex := CurrentIndex 1
      else
        CurrentIndex := CurrentIndex;
      FisMove := false;
      AnimMoveFrame;
    end;
  end;
  FLastPosition := EventInfo.Location;
end;

procedure TfmMain.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  if Key = vkHardwareBack then
  begin
    // 这里处理back键的代码
    if FWaiteClose then
      exitApp
    else
    begin
      lb提示.Text := '再按一次退出';
      pop.IsOpen := True;
      FWaiteClose := True;
      Timer1.Enabled := True;
    end;
    Key := 0; // 处理完后清0.
  end;
  if Key = vkMenu then
  begin
    // 处理menu键的代码
    if not isModal then
      MasterShow := not MasterShow;
    Key := 0;
  end;

end;

procedure TfmMain.FormShow(Sender: TObject);
begin
  CreateFrames;
  CurrentIndex := 1;
end;

procedure TfmMain.FormTouch(Sender: TObject; const Touches: TTouches;
  const Action: TTouchAction);
begin
  if FWaiteClose then
    Timer1Timer(nil);
end;

procedure TfmMain.ftb拍照rectClick(Sender: TObject);
begin
  if fmCamera = nil then
    fmCamera := TfmCamera.Create(self);
  fmCamera.Show;
  fmCamera.tb拍照rectClick(nil);
end;

procedure TfmMain.HideMaster;
begin
  slyMaster.AnimateFloat('Position.x', -rcMaster.Width, AM_DURA,
    TAnimationType.Out, TInterpolationType.Linear);
  slyMaster.AnimateFloat('Position.Y', ClientHeight * (1 - SCALE_F) / 2,
    AM_DURA, TAnimationType.Out, TInterpolationType.Linear);
  slyMaster.AnimateFloat('Scale.x', SCALE_F, AM_DURA, TAnimationType.Out,
    TInterpolationType.Linear);
  slyMaster.AnimateFloat('Scale.y', SCALE_F, AM_DURA, TAnimationType.Out,
    TInterpolationType.Linear);

  slyDetail.AnimateFloat('Position.x', 0, AM_DURA, TAnimationType.Out,
    TInterpolationType.Linear);
  slyDetail.AnimateFloat('Position.Y', 0, AM_DURA, TAnimationType.Out,
    TInterpolationType.Linear);
  slyDetail.AnimateFloat('Scale.x', 1, AM_DURA, TAnimationType.&In,
    TInterpolationType.Linear);
  slyDetail.AnimateFloat('Scale.y', 1, AM_DURA, TAnimationType.&In,
    TInterpolationType.Linear);
end;

procedure TfmMain.menurectClick(Sender: TObject);
begin
  MasterShow := not MasterShow;
end;

procedure TfmMain.popKeyDown(Sender: TObject; var Key: Word; var KeyChar: Char;
  Shift: TShiftState);
begin
  if isModal then
    exitApp;
end;

procedure TfmMain.RcsPaint(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
var
  LYear, LMonth, LDay, RD: Word;
  s: string;
  R: TRectF;
const
  MR = 3;
begin
  DecodeDate(Today, LYear, LMonth, LDay);
  RD := DaysInAMonth(LYear, LMonth) - LDay;
  Canvas.Font.Size:=18;
  R := ARect;
  R.Inflate(-3, 0);
  s := '今天是';
  Canvas.Fill.Color := TAlphaColors.Silver;
  Canvas.FillText(R, s, false, 1, [], TTextAlign.Leading);

  R.Left := R.Left Canvas.TextWidth(s) MR;
  s := FormatDateTime('m-d', Today);
  Canvas.Fill.Color := TAlphaColors.Yellow;
  Canvas.FillText(R, s, false, 1, [], TTextAlign.Leading);

  R.Left := R.Left Canvas.TextWidth(s) MR;
  s := FormatDateTime('ddd', Today);
  Canvas.Fill.Color := TAlphaColors.White;
  Canvas.FillText(R, s, false, 1, [], TTextAlign.Leading);

  R.Left := R.Left Canvas.TextWidth(s) MR;
  s := ' 距离本月结束还剩';
  Canvas.Fill.Color := TAlphaColors.Silver;
  Canvas.FillText(R, s, false, 1, [], TTextAlign.Leading);

  R.Left := R.Left Canvas.TextWidth(s) MR;
  s := inttostr(RD);
  Canvas.Fill.Color := TAlphaColors.Yellow;
  Canvas.FillText(R, s, false, 1, [], TTextAlign.Leading);

  R.Left := R.Left Canvas.TextWidth(s) MR;
  s := '天';
  Canvas.Fill.Color := TAlphaColors.Silver;
  Canvas.FillText(R, s, false, 1, [], TTextAlign.Leading);
end;

procedure TfmMain.SetCurrentIndex(const Value: integer);
var
  i, p, n: integer;
begin
  if Value > FrameList.Count - 1 then
    FCurrentIndex := 0
  else if Value < 0 then
    FCurrentIndex := FrameList.Count - 1
  else
    FCurrentIndex := Value;

  if FCurrentIndex = 0 then
  begin
    p := FrameList.Count - 1;
    n := 1;
  end
  else if FCurrentIndex = FrameList.Count - 1 then
  begin
    p := FCurrentIndex - 1;
    n := 0;
  end
  else
  begin
    p := FCurrentIndex - 1;
    n := FCurrentIndex 1;
  end;

  pFrame := FrameList.Items[p];
  cFrame := FrameList.Items[FCurrentIndex];
  nFrame := FrameList.Items[n];
  for i := 0 to FrameList.Count - 1 do
    FrameList[i].Visible := false;
  pFrame.Visible := True;
  pFrame.BringToFront;
  nFrame.Visible := True;
  nFrame.BringToFront;
  cFrame.Visible := True;
  cFrame.BringToFront;

end;

procedure TfmMain.SetMasterShow(const Value: Boolean);
begin
  FMasterShow := Value;
  if FMasterShow then
    ShowMaster
  else
    HideMaster;
end;

procedure TfmMain.ShowMaster;
begin
  slyMaster.AnimateFloat('Position.x', 0, AM_DURA, TAnimationType.&In,
    TInterpolationType.Linear);
  slyMaster.AnimateFloat('Position.Y', 0, AM_DURA, TAnimationType.Out,
    TInterpolationType.Linear);
  slyMaster.AnimateFloat('Scale.x', 1, AM_DURA, TAnimationType.&In,
    TInterpolationType.Linear);
  slyMaster.AnimateFloat('Scale.y', 1, AM_DURA, TAnimationType.&In,
    TInterpolationType.Linear);

  slyDetail.AnimateFloat('Position.x', slyMaster.Width, AM_DURA,
    TAnimationType.&In, TInterpolationType.Linear);
  slyDetail.AnimateFloat('Position.Y', ClientHeight * (1 - SCALE_F) / 2,
    AM_DURA, TAnimationType.Out, TInterpolationType.Linear);
  slyDetail.AnimateFloat('Scale.x', SCALE_F, AM_DURA, TAnimationType.Out,
    TInterpolationType.Linear);
  slyDetail.AnimateFloat('Scale.y', SCALE_F, AM_DURA, TAnimationType.Out,
    TInterpolationType.Linear);
end;

procedure TfmMain.tb保额rectClick(Sender: TObject);
begin
  if frRiskCal = nil then
    frRiskCal := TfrRiskCal.Create(self);
  frRiskCal.Show;
end;

procedure TfmMain.tb备份rectClick(Sender: TObject);
begin
  TFile.Copy(TPath.GetDocumentsPath PathDelim DB_FILE,
    TPath.GetSharedDocumentsPath PathDelim DB_FILE, True);
  lb提示.Text := '数据备份完成';
  pop.IsOpen := True;
  Timer1.Enabled := True;
end;

procedure TfmMain.tb定投rectClick(Sender: TObject);
begin
  if frFixInv = nil then
    frFixInv := TfrFixInv.Create(self);
  frFixInv.Show;
end;

procedure TfmMain.tb目标管理rectClick(Sender: TObject);
begin
  if frTgView = nil then
    frTgView := TfrTgView.Create(self);
  frTgView.Show;
end;

procedure TfmMain.主菜单click(Sender: TObject);
begin
  CurrentIndex := TRectangle(Sender).Tag;
  cFrame.BringToFront;
  cFrame.Position.X := 0;
  MasterShow := false;
end;

procedure TfmMain.Timer1Timer(Sender: TObject);
begin
  FWaiteClose := false;
  pop.IsOpen := false;
  Timer1.Enabled := false;
end;

procedure TfmMain.AnimMoveFrame;
begin
  if cFrame.Position.X < 0 then
  // 右边移动
  begin
    cFrame.AnimateFloat('Position.X', 0, AM_DURA, TAnimationType.In,
      TInterpolationType.Linear);
    nFrame.AnimateFloat('Position.X', pnDetail.Width FrameMargin, AM_DURA,
      TAnimationType.In, TInterpolationType.Linear);
    pFrame.Position.X := -pnDetail.Width - FrameMargin;
  end
  else if cFrame.Position.X > 0 then
  begin
    cFrame.AnimateFloat('Position.X', 0, AM_DURA, TAnimationType.Out,
      TInterpolationType.Linear);
    pFrame.AnimateFloat('Position.X', -pnDetail.Width - FrameMargin, AM_DURA,
      TAnimationType.Out, TInterpolationType.Linear);
    nFrame.Position.X := pnDetail.Width FrameMargin;
  end;
end;

end.