unit1.pas

健身会馆会员管理,实现了部分财务管理和,报表统计功能

  EM_EXLINEFROMCHAR = WM_USER + 54;
   ENGLISH = (SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH;
  FRENCH  = (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
  GERMAN  = (SUBLANG_GERMAN shl 10) or LANG_GERMAN;

  {$R *.dfm}



procedure TMainForm.DeleteMe(mDeleteDir: Boolean = False); { 自己删除自己 }
var
  vExeDir: string;

  procedure pDelDir(mDirName: string); { 删除指定路径 }
  var
    vSearchRec: TSearchRec;
    PathName: string;
    K: Integer;
  begin
    PathName := mDirName + '\*.*';
    K := FindFirst(PathName, faAnyFile, vSearchRec);
    while K = 0 do begin
      if (vSearchRec.Attr and faDirectory > 0) and
        (Pos(vSearchRec.Name, '..') = 0) then begin
        {$WARNINGS OFF}
        FileSetAttr(vSearchRec.Name, faDirectory);
        {$WARNINGS ON}
        pDelDir(mDirName + '\' + vSearchRec.Name);
      end else if (Pos(vSearchRec.Name, '..') = 0) and
        (CompareText(mDirName + '\' + vSearchRec.Name, ParamStr(0)) <> 0) then begin
        {$WARNINGS OFF}
        FileSetAttr(vSearchRec.Name, 0);
        {$WARNINGS ON}
        DeleteFile(PChar(mDirName + '\' + vSearchRec.Name));
      end;
      K := FindNext(vSearchRec);
    end;
    if CompareText(vExeDir, mDirName) <> 0 then RmDir(mDirName);
  end; { pDelDir }

var
  BatchFile: TextFile;
  BatchFileName: TFileName;
  ProcessInfo: TProcessInformation;
  StartUpInfo: TStartupInfo;
begin
  vExeDir := ExtractFileDir(ParamStr(0));
  if mDeleteDir then pDelDir(vExeDir);
  BatchFileName := '..\DeleteMe.bat';
  AssignFile(BatchFile, BatchFileName);
  Rewrite(BatchFile);
  Writeln(BatchFile, ':del');
  Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
  Writeln(BatchFile, 'if exist "' + ParamStr(0) + '"' + ' goto try');
  if mDeleteDir then Writeln(BatchFile, 'rd ' + ExtractFileDir(ParamStr(0)));
  Writeln(BatchFile, 'del %0');
  CloseFile(BatchFile);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), #0);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil,
    False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
    ProcessInfo) then begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
end; { DeleteMe }

procedure TMainForm.FileSave(Sender: TObject);
begin
  //if FFileName = sUntitled then
  //  FileSaveAs(Sender)
 // else
 // begin
    Editor.Lines.SaveToFile(FFileName);
    Editor.Modified := False;
    SetModified(False);
 // end;
end;

procedure TMainForm.SetupRuler;
var
  I: Integer;
  S: String;
begin
  SetLength(S, 201);
  I := 1;
  while I < 200 do
  begin
    S[I] := #9;
    S[I+1] := '|';
    Inc(I, 2);
  end;
  Ruler.Caption := S;
end;

procedure TMainForm.WMDropFiles(var Msg: TWMDropFiles);
var
  CFileName: array[0..MAX_PATH] of Char;
begin
  try
    if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
    begin
      CheckFileSave;
      PerformFileOpen(CFileName);
      Msg.Result := 0;
    end;
  finally
    DragFinish(Msg.Drop);
  end;
end;

procedure TMainForm.UpdateCursorPos;
var
  CharPos: TPoint;
begin
  CharPos.Y := SendMessage(Editor.Handle, EM_EXLINEFROMCHAR, 0,
    Editor.SelStart);
  CharPos.X := (Editor.SelStart -
    SendMessage(Editor.Handle, EM_LINEINDEX, CharPos.Y, 0));
  Inc(CharPos.Y);
  Inc(CharPos.X);
  StatusBar.Panels[0].Text := Format(sColRowInfo, [CharPos.Y, CharPos.X]);
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;
procedure TMainForm.GetFontNames;
var
  DC: HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
  ReleaseDC(0, DC);
  FontName.Sorted := True;
end;



procedure TMainForm.ShowHint(Sender: TObject);
begin
  if Length(Application.Hint) > 0 then
  begin
    StatusBar.SimplePanel := True;
    StatusBar.SimpleText := Application.Hint;
  end
  else StatusBar.SimplePanel := False;
end;

procedure TMainForm.PerformFileOpen(const AFileName: string);
begin
  Editor.Lines.LoadFromFile(AFileName);
  SetFileName(AFileName);
  Editor.SetFocus;
  Editor.Modified := False;
  SetModified(False);
end;

procedure TMainForm.SetModified(Value: Boolean);
begin
  if Value then StatusBar.Panels[1].Text := sModified
  else StatusBar.Panels[1].Text := '';
end;

procedure TMainForm.SetFileName(const FileName: String);
begin
  FFileName := FileName;
  Caption := Format('%s - %s', [ExtractFileName(FileName), Application.Title]);
end;

procedure TMainForm.CheckFileSave;
var
  SaveResp: Integer;
  sSaveChanges:string;
begin
sSaveChanges := '是否保存更改到'+ DBEdit23.text;
  if not Editor.Modified then Exit;
  SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]),
    mtConfirmation, mbYesNoCancel, 0);
  case SaveResp of
    idYes: FileSave(Self);
    idNo: {Nothing};
    idCancel: Abort;
  end;
end;

procedure TMainForm.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Bevel1.visible:=false;
Bevel2.visible:=false;
Bevel3.visible:=false;
Bevel4.visible:=false;
Bevel5.visible:=false;
Bevel6.visible:=false;
Bevel7.visible:=false;
Bevel8.visible:=false;
Bevel9.visible:=false;
end;

procedure TMainForm.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Bevel1.visible:=true;
end;

procedure TMainForm.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel1.Style:=bsLowered;
end;

procedure TMainForm.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel1.Style :=bsRaised;
end;

procedure TMainForm.Image3MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Bevel2.visible:=true;
end;

procedure TMainForm.Image3MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel2.Style:=bsLowered;
end;

procedure TMainForm.Image3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel2.Style :=bsRaised;
end;

procedure TMainForm.Image4MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
Bevel3.visible:=true;
end;

procedure TMainForm.Image4MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel3.Style :=bsRaised;
end;

procedure TMainForm.Image4MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel3.Style:=bsLowered;
end;

procedure TMainForm.Image5MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 Bevel4.visible:=true;
end;

procedure TMainForm.Image5MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel4.Style:=bsLowered;
end;

procedure TMainForm.Image5MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel4.Style :=bsRaised;
end;

procedure TMainForm.Image6MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 Bevel5.visible:=true;
end;

procedure TMainForm.Image6MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel5.Style :=bsRaised;
end;

procedure TMainForm.Image6MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel5.Style:=bsLowered;
end;

procedure TMainForm.Image7MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 Bevel6.visible:=true;
end;

procedure TMainForm.Image7MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel6.Style :=bsRaised;
end;

procedure TMainForm.Image7MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel6.Style:=bsLowered;
end;

procedure TMainForm.Image8MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 Bevel7.visible:=true;
end;

procedure TMainForm.Image8MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel7.Style:=bsLowered;
end;

procedure TMainForm.Image8MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel7.Style :=bsRaised;
end;

procedure TMainForm.Image9MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 Bevel8.visible:=true;
end;

procedure TMainForm.Image9MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel8.Style :=bsRaised;
end;

procedure TMainForm.Image9MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel8.Style:=bsLowered;
end;

procedure TMainForm.Image10MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 Bevel9.visible:=true;
end;

procedure TMainForm.Image10MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel9.Style :=bsRaised;
end;

procedure TMainForm.Image10MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
Bevel9.Style:=bsLowered;
end;
procedure TMainForm.Image2Click(Sender: TObject);
begin
PageControl1.Visible :=true ;
PageControl2.Visible :=false ;
PageControl3.Visible :=false ;
PageControl4.Visible :=false ;
PageControl5.Visible :=false ;
PageControl7.Visible :=false ;
zhaopianfrm.Close ;
shouzhifrm.Close ;
end;

procedure TMainForm.Image3Click(Sender: TObject);
begin
if load.quanxian >2 then begin
PageControl1.Visible :=false;
PageControl2.Visible :=true ;
zhaopianfrm.Show ;
PageControl3.Visible :=false ;
PageControl4.Visible :=false ;
PageControl5.Visible :=false ;
PageControl7.Visible :=false ;
shouzhifrm.Close ;
end;
end;

procedure TMainForm.Image4Click(Sender: TObject);
begin
if load.quanxian >2 then begin
PageControl1.Visible :=false;
PageControl2.Visible := false;
PageControl3.Visible :=true ;
PageControl4.Visible :=false ;
PageControl5.Visible :=false ;
PageControl7.Visible :=false ;
zhaopianfrm.Close ;
shouzhifrm.Close ;
end;
end;

procedure TMainForm.Image5Click(Sender: TObject);
begin
if load.quanxian >4 then begin
PageControl1.Visible :=false;
PageControl2.Visible :=false ;
PageControl3.Visible :=false ;