main.pas

this is sample for traders

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, JvMenus, SkinCtrls, DynamicSkinForm, JvTimer, ComCtrls,
  JvExComCtrls, JvStatusBar, jpeg, JvExControls, JvFormWallpaper, ImgList,
  SkinMenus, ExtCtrls, JvGradientCaption, JvImageList, spDialogs;

type
  TmainForm = class(TForm)
    JvFormWallpaper1: TJvFormWallpaper;
    StatusBar1: TJvStatusBar;
    Timer1: TJvTimer;
    ImageList1: TImageList;
    JvMainMenu1: TJvMainMenu;
    JvOfficeMenuItemPainter1: TJvOfficeMenuItemPainter;
    FileMaster1: TMenuItem;
    Gudang: TMenuItem;
    ItemPenjualan: TMenuItem;
    N4: TMenuItem;
    Salesman: TMenuItem;
    Penjualan: TMenuItem;
    Pembelian: TMenuItem;
    FakturPenjualan: TMenuItem;
    DataPenjualan: TMenuItem;
    FakturBeli: TMenuItem;
    N1: TMenuItem;
    DataPembelian: TMenuItem;
    N2: TMenuItem;
    ReturPembelian: TMenuItem;
    spSkinToolBar1: TspSkinToolBar;
    spSkinSpeedButton1: TspSkinSpeedButton;
    spSkinSpeedButton2: TspSkinSpeedButton;
    spSkinSpeedButton3: TspSkinSpeedButton;
    spSkinBevel1: TspSkinBevel;
    spSkinSpeedButton4: TspSkinSpeedButton;
    spSkinSpeedButton5: TspSkinSpeedButton;
    spSkinSpeedButton6: TspSkinSpeedButton;
    spSkinBevel2: TspSkinBevel;
    spSkinSpeedButton7: TspSkinSpeedButton;
    Supplier: TMenuItem;
    N3: TMenuItem;
    System: TMenuItem;
    Langganan: TMenuItem;
    N5: TMenuItem;
    JvGradientCaption1: TJvGradientCaption;
    N6: TMenuItem;
    NotaTransfer: TMenuItem;
    InputDialog1: TspSkinInputDialog;
    N7: TMenuItem;
    N8: TMenuItem;
    KartuPiutang1: TMenuItem;
    Laporan1: TMenuItem;
    LaporanPenjualan1: TMenuItem;
    LaporanPembelian1: TMenuItem;
    N9: TMenuItem;
    procedure CreateMDIChild(frm : TFormClass);
    procedure GudangClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ItemPenjualanClick(Sender: TObject);
    procedure LanggananClick(Sender: TObject);
    procedure SalesmanClick(Sender: TObject);
    procedure FakturPenjualanClick(Sender: TObject);
    procedure FakturBeliClick(Sender: TObject);
    procedure DataPembelianClick(Sender: TObject);
    procedure DataPenjualanClick(Sender: TObject);
    procedure KartuPiutang1Click(Sender: TObject);
  private
    procedure OnMessage(var Msg: TMsg; var Handled: Boolean);
    procedure WMSettingChange( var Msg: TMessage); message WM_SETTINGCHANGE;
    procedure CloseAllMDIChild;
    //procedure AksesMenu;
    //procedure InitApp;
  public
    procedure ErrHandle(Sender: TObject; E: Exception);
    procedure CreateParams(var Params: TCreateParams);override ;

    published
  end;

var
  mainForm: TmainForm;

implementation

{$R *.dfm}

uses DataMod1, funclib , lsGudang, lsItem, lsLgn, lsPegawai,
Sales, Purc, lsPurc, lsSales, PiutangCard ;

procedure TMainForm.OnMessage (var Msg: TMsg; var Handled: Boolean) ;
var
  i: SmallInt;
begin
  if Msg.message = WM_MOUSEWHEEL then
  begin
  Msg.message := WM_KEYDOWN;
  Msg.lParam := 0;
  i := HiWord(Msg.wParam) ;
  if i > 0 then
  Msg.wParam := VK_UP
  else
  Msg.wParam := VK_DOWN;
  Handled := False;
  end;
end;

procedure TMainForm.CreateParams(var Params : TCreateParams);
begin
  inherited CreateParams(Params);
  Params.ExStyle := Params.ExStyle or WS_EX_WINDOWEDGE;
  //Params.WndParent := GetDesktopWindow;
end;

procedure TMainForm.WMSettingChange( var Msg: TMessage);
var
  R: TRect;
begin
  Exit;
  if (Msg.WParam=SPI_SETWORKAREA) then begin
    SystemParametersInfo(SPI_GETWORKAREA, 0, @R, 0);
    SetBounds(R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top);
  end;
  Msg.Result:=0;
end;

procedure TMainForm.CreateMDIChild(frm : TFormClass);
var
  i:integer;
  bCreated:boolean;
  f:TForm;
begin
  bCreated:=False;
  f:=Nil;
  for i:= 0 to MainForm.MDIChildCount-1 do
  begin
    if MainForm.MDIChildren[i] is frm then
    begin
      f:=MainForm.MDIChildren[i] as frm ;
      bCreated:=True;
      Break;
    end;
  end;
  if not bCreated then frm.Create(Application) else f.Show;
end;

procedure TMainForm.ErrHandle(Sender: TObject; E: Exception);
begin
  MessageDlg('Class :' + E.ClassName +Chr(13)+
             'Messg :' + E.Message +Chr(13)+
             'ECode :' + IntToStr(Error),mtError,[mbOk],0);
end;

procedure TmainForm.GudangClick(Sender: TObject);
begin
  CreateMDIChild(TlsgudangForm);
end;

procedure TmainForm.Timer1Timer(Sender: TObject);
begin
  StatusBar1.Panels[0].Text := FormatDateTime('"" dd-mmm-yyyy',now());
  StatusBar1.Panels[1].Text := FormatDateTime('"" hh : mm : ss',now());
  StatusBar1.Panels[2].Text := AppUserName;
  StatusBar1.Panels[3].Text := mPeriode;
  StatusBar1.Panels[4].Text := ' '+mNode+'/'+mPcName;
end;

procedure TmainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TmainForm.FormCreate(Sender: TObject);
begin
  AddFontResource('..\FONTS\Dina.fon') ;
  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
  ShortDateFormat:='dd/mm/yyyy';DateSeparator := '-';
  Application.OnMessage := OnMessage ;
  //InitApp;
end;

procedure TmainForm.FormDestroy(Sender: TObject);
begin
  DM1.dtaCon.Disconnect;
  DM1.Free;
  RemoveFontResource('..\FONTS\Dina.fon') ;
  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
  Screen.OnActiveFormChange:=Nil;
end;

procedure TmainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CloseAllMDIChild;
end;

procedure TMainForm.CloseAllMDIChild;
var
  i: Integer;
begin
  with MainForm do
  begin
    for I := MDIChildCount-1 downto 0 do
      MDIChildren[I].Close;
  end;
end;

procedure TmainForm.ItemPenjualanClick(Sender: TObject);
begin
  CreateMDIChild(TlsItemForm);
end;

procedure TmainForm.LanggananClick(Sender: TObject);
begin
  CreateMDIChild(TlsLgnForm);
end;

procedure TmainForm.SalesmanClick(Sender: TObject);
begin
  CreateMDIChild(TlsPegawaiForm);
end;

procedure TmainForm.FakturPenjualanClick(Sender: TObject);
var
  nSP: String;
  nOk: Boolean;
begin
  with SQLp do
  begin
    Script.Clear;
    Script.Add('DELETE FROM REGSPNO WHERE SPNO NOT IN (SELECT TRNO FROM SALES);');
    Execute;
  end;
  nOK:= InputDialog1.InputQuery(' INPUT NOMOR SP ','No-SP: ',nSP);
  if (nOK = False) or (length(Trim(nSP))=0) then Abort;
  with qSQL do
  begin
    Close;
    SQL.Clear;
    SQL.Add('SELECT SPNO FROM REGSPNO WHERE SPNO=:nSP ');
    ParamByName('nSP').Value:=nSP;
    Open;
  end;
  if qSQL.RecordCount=0 then
  begin
    with SQLp do
    begin
      Script.Clear;
      Script.Add('INSERT INTO REGSPNO (SPNO) VALUES (:nSP); ');
      ParamByname('nSP').Value:=nSP;
      Execute;
    end;
    SalesForm.Enter(nSP);
  end else
  begin
    ShowMessage('NOMOR SP sudah ada...!, Input Nomor Lainnya.');
  end;
end;

procedure TmainForm.FakturBeliClick(Sender: TObject);
begin
  PurcForm.Enter;
end;

procedure TmainForm.DataPembelianClick(Sender: TObject);
begin
  CreateMDIChild(TlsPurcForm);
end;

procedure TmainForm.DataPenjualanClick(Sender: TObject);
begin
  CreateMDIChild(TlsSalesForm);
end;

procedure TmainForm.KartuPiutang1Click(Sender: TObject);
begin
  CreateMDIChild(TPiutangCardForm);
end;

end.