1
Development / Chromium Embedded รุ่น 63 นี้เปิดใช้งานอย่างไรครับ
« เมื่อ: สิงหาคม 24, 2018, 22:35:47 PM »
อยากทราบว่าเปิดใช้งานอย่างไรครับ และใช้กับปุ่มไหนได้บ้างครับ
This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Spin, WideStrings, DB, SqlExpr,
DBXMySql, FMTBcd, XPMan, DBClient, DBXMsSQL,DateUtils,jvjclutils;
type
Tfrmmain = class(TForm)
Panel1: TPanel;
Label3: TLabel;
BtnOk: TButton;
BtnCancel: TButton;
Label4: TLabel;
Label6: TLabel;
CboClinic: TComboBox;
DTPStart: TDateTimePicker;
Label1: TLabel;
txttotalAppointment: TEdit;
GroupBox1: TGroupBox;
chkMon: TCheckBox;
chkTue: TCheckBox;
ChkThr: TCheckBox;
ChkWen: TCheckBox;
ChkFri: TCheckBox;
ChkSat: TCheckBox;
ChkSun: TCheckBox;
GroupBox2: TGroupBox;
cds: TClientDataSet;
ds: TDataSource;
procedure BtnCancelClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtnOkClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure BtnRefreshClick(Sender: TObject);
function GetListFromTable(sql:string):TStringList;
function UpdateLimit(StrDate:string):boolean;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmmain: Tfrmmain;
implementation
{$R *.dfm}
procedure Tfrmmain.BtnCancelClick(Sender: TObject);
begin
// Show a confirmation dialog at 20,100
if MessageDlg('¤Ø³µéͧ¡ÒáàÅÔ¡¡ÒÃãªé§Ò¹ã¹Êèǹ¹ÕéãªèËÃ×ÍäÁè', mtConfirmation, [mbYes, mbNo], 0) = mrYes then close;
end;
procedure Tfrmmain.BtnOkClick(Sender: TObject);
Var
MyMonthID:string;
MyYear:string;
MyTHyear:string;
MyIntYear:integer;
MyIntMonth:integer;
MyDep:string;
MyDashPos:Integer;
MyLastDayCurrMon:string;
MyLastDayCurrMonth:word;
intStartLoop:integer;
CurrDateSet:tdatetime;
MyCurrDateSet:string;
MyCustomDate:string;
DaysInMonth: array[1..12]of Integer ;
tcd:tclientdataset;
strsql:string;
ChkDate:boolean;
BolShowDebug:boolean;
begin
if MessageDlg('¤Ø³µéͧ¡Òúѹ·Ö¡¢éÍÁÙÅ¡ÒùѴËÁÒÂãªèËÃ×ÍäÁè', mtConfirmation, [mbYes, mbNo], 0) = mrNo then
begin
exit;
End;
ChkDate:=false;
if chkMon.State = cbchecked then
begin
ChkDate:=true;
end;
if chkTue.State = cbchecked then
begin
ChkDate:=true;
end;
if chkWen.state = cbchecked then
begin
ChkDate:=true;
end;
if ChkThr.State = cbchecked then
begin
ChkDate:=true;
end;
if ChkFri.State = cbchecked then
begin
ChkDate:=true;
end;
if ChkSat.State = cbchecked then
begin
ChkDate:=true;
end;
if ChkSun.State = cbchecked then
begin
ChkDate:=true;
end;
if ChkDate=false then
begin
MessageDlg('¡ÃسÒàÅ×Í¡ÇѹÍÂèÒ§¹éÍ 1 Çѹ ', mtWarning, [mbOK], 0) ;
exit;
end;
if CboClinic.Text='' then
MessageDlg('¡ÃسÒàÅ×Í¡¤ÅÔ¹Ô¤¡è͹', mtWarning, [mbOK], 0) ;
if txttotalAppointment.text= '' then
begin
MessageDlg('¡ÃسÒãÊè¨Ó¹Ç¹¤¹·Õèµéͧ¡Òáè͹', mtWarning, [mbOK], 0) ;
exit;
end;
if StrToInt(txttotalAppointment.text) <= 0 then
begin
MessageDlg('¨Ó¹Ç¹¤¹µéͧÁÒ¡¡ÇèÒ 1 ', mtWarning, [mbOK], 0) ;
exit;
end;
if ChkShowDBug.State = cbChecked then
begin
BolShowDebug:=true;
end;
if ChkShowDBug.State = cbUnChecked then
begin
BolShowDebug:=false;
end;
MyMonthID:=formatDateTime('MM',DTPStart.Date);
MyYear:=formatDateTime('yyyy',DTPStart.Date);
MyTHyear:=MyYear;
MyIntYear:=StrToInt(MyYear)-543;
MyYear:=inttostr(MyIntYear);
MyIntMonth:= StrToInt(MyMonthID);
MyDashPos:= Pos('-',CboClinic.Text);
MyDep:= Copy(CboClinic.Text,0,MyDashPos-1);
DaysInMonth[1]:=(31);
DaysInMonth[2]:=(28);
DaysInMonth[3]:=(31);
DaysInMonth[4]:=(30);
DaysInMonth[5]:=(31);
DaysInMonth[6]:=(30);
DaysInMonth[7]:=(31);
DaysInMonth[8]:=(31);
DaysInMonth[9]:=(30);
DaysInMonth[10]:=(31);
DaysInMonth[11]:=(30);
DaysInMonth[12]:=(31);
//MyLastDayCurrMonth:=DaysInMonth(DTPStart.Date);
MyLastDayCurrMonth:=DaysInMonth[MyIntMonth];
//ntStartLoop:= 1;
for intStartLoop:=1 to Integer(MyLastDayCurrMonth) do
begin
if Length(IntToStr(intStartLoop)) = 1 then
begin
MyCustomDate:= '0'+ IntToStr(intStartLoop) ;
end;
if Length(IntToStr(intStartLoop)) > 1 then
begin
MyCustomDate:= IntToStr(intStartLoop) ;
end;
CurrDateSet:=StrToDate(MyCustomDate+'/'+MyMonthID+'/'+MyTHyear);
MyCurrDateSet:= Inttostr(DayOfWeek(CurrDateSet));
// showdebugtext('MyCurrDateSet = '+MyCurrDateSet);
case StrToInt(MyCurrDateSet) of
2:
if chkMon.State = cbChecked then
begin
//MessageDlg(('Clinic '+ MyDep +' ¨Ñ¹·Ãì·Õè '+MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
end;
3:
if chkTue.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' Íѧ¤Ò÷Õè '+MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
4:
if ChkWen.state = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' ¾Ø¸·Õè '+MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
5:
if ChkThr.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' ¾ÄËÑʺ´Õ·Õè ' +MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
6:
if ChkFri.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' ÈØ¡Ãì·Õè ' +MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
7:
if ChkSat.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' àÊÒÃì·Õè '+MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
1:
if ChkSun.State = cbChecked then
//MessageDlg(('Clinic '+ MyDep +' ÍÒ·ÔµÂì·Õè ' +MyCustomDate+'/'+MyMonthID+'/'+MyTHyear+'¨Ó¹Ç¹ '+ txttotalAppointment.Text) ,mtWarning, [mbOK], 0) ;
UpdateLimit(MyTHyear+'/'+MyMonthID+'/'+ MyCustomDate,MyCustomDate+'/'+MyMonthID+'/'+MyYear,MyDep,txttotalAppointment.Text,BolShowDebug);
end;
end;
cds.data := hosxp_getdataset('select * from oapp_limit');
MessageDlg('Done', mtInformation, [mbOK], 0) ;
end;
procedure Tfrmmain.BtnRefreshClick(Sender: TObject);
var
MyMonthID:string;
MyIntMonth:integer;
MyYear:string;
MyTHyear:string;
MyIntYear:integer;
begin
MyMonthID:=formatDateTime('MM',DTPStart.Date);
MyIntMonth:= StrToInt(MyMonthID);
MyYear:=formatDateTime('yyyy',DTPStart.Date);
MyTHyear:=MyYear;
MyIntYear:=StrToInt(MyYear)-543;
MyYear:=inttostr(MyIntYear);
cds.data := hosxp_getdataset('select * from oapp_limit where month(oapp_date) = "' +MyMonthID + '"' );
end;
procedure Tfrmmain.FormCreate(Sender: TObject);
var
MyMonthID:string;
MyIntMonth:integer;
MyYear:string;
MyTHyear:string;
MyIntYear:integer;
begin
DTPStart.Date := Now;
{ GetList from Hosxp }
CboClinic.items.assign(GetListFromTable('select concat(clinic,"-",name) from clinic order by clinic'));
MyMonthID:=formatDateTime('MM',DTPStart.Date);
MyIntMonth:= StrToInt(MyMonthID);
MyYear:=formatDateTime('yyyy',DTPStart.Date);
MyTHyear:=MyYear;
MyIntYear:=StrToInt(MyYear)-543;
MyYear:=inttostr(MyIntYear);
cds.data := hosxp_getdataset('select * from oapp_limit where month(oapp_date) = "' +MyMonthID + '"' );
end;
procedure Tfrmmain.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key ='' then
begin
if MessageDlg('¤Ø³µéͧ¡ÒáàÅÔ¡¡ÒÃãªé§Ò¹ã¹Êèǹ¹ÕéãªèËÃ×ÍäÁè', mtConfirmation, [mbYes, mbNo], 0) = mrYes then close;
end;
end;
{ Pas addition Code }
function GetListFromTable(sql:string):TStringList;
var tc:tclientdataset;
begin
result:=TStringList.create;
tc:=tclientdataset.create(nil);
tc.data:=HOSxP_Getdataset(sql);
while not tc.eof do
begin
result.add(tc.fields[0].asstring);
tc.next;
end;
tc.free;
end;
function UpdateLimit(StrTHDate,StrENDate,StrClinic :string;IntLimit:integer;showDBug:boolean):boolean;
var tc,tc2:tclientdataset;NextSerialId:integer;
begin
result:=false;
tc:=tclientdataset.create(nil);
tc.data:=HOSxP_Getdataset('select * from oapp_limit where oapp_date = "'+StrTHDate+'" and oapp_clinic = "'+StrClinic+'"');
if showDBug = true then
begin
showdebugtext('select * from oapp_limit where oapp_date = "'+StrTHDate+'" and oapp_clinic = "'+StrClinic+'"');
end;
if tc.recordcount > 0 then
begin
tc.edit;
tc.fieldbyname('oapp_limit').asstring := IntLimit;
tc.post;
if tc.changecount > 0 then
begin
HOSxP_UpdateDelta(tc.delta,'select * from oapp_limit where oapp_date ="'+StrTHDate+'" and oapp_clinic = "'+StrClinic+'"');
if showDBug = true then
begin
showdebugtext('Found 1 Record : Update Field (limit) = '+IntLimit);
showdebugtext('Update Complete');
end;
end;
end;
if tc.recordcount = 0 then
begin
tc2:=tclientdataset.create(nil);
tc2.data:=HOSxP_Getdataset('select * from serial where name = "oapp_limit_id"');
if tc2.recordcount > 0 then
begin
NextSerialId := tc2.fieldbyname('serial_no').asstring+1;
//showdebugtext(NextSerialId);
tc2.edit;
tc2.fieldbyname('serial_no').asstring := NextSerialId;
tc2.post;
end;
tc.Insert;
tc.fieldbyname('oapp_limit_id').asstring := NextSerialId;
tc.fieldbyname('oapp_limit').asstring := IntLimit;
tc.fieldbyname('oapp_clinic').asstring := StrClinic;
tc.fieldbyname('oapp_date').asstring := StrToDate(StrENDate);
tc.post;
if tc.changecount > 0 then
HOSxP_UpdateDelta(tc.delta,'select * from oapp_limit where oapp_date = "'+StrTHDate+'" and oapp_clinic = "'+StrClinic+'"');
HOSxP_UpdateDelta(tc2.delta,'select * from serial where name = "oapp_limit_id"');
if showDBug = true then
begin
showdebugtext('Record not found : Insert New Record');
showdebugtext('oapp_limit_id = '+InttoStr(NextSerialId));
showdebugtext('oapp_limit = '+IntLimit);
showdebugtext('oapp_clinic = '+StrClinic);
showdebugtext('oapp_date = '+StrENDate);
showdebugtext('Insert Complete');
end;
end;
tc.free;
result:=true;
end;
end.
object frmmain: Tfrmmain
Left = 0
Top = 0
BorderStyle = bsDialog
Caption = #3619#3632#3610#3610#3585#3635#3627#3609#3604#3592#3635#3609#3623#3609#3609#3633#3604#3627#3617#3634#3618#3626#3635#3627#3619#3633#3610#3588#3621#3636#3609#3636#3588#3605#3656#3634#3591#3654
ClientHeight = 536
ClientWidth = 416
Color = clCream
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
KeyPreview = True
OldCreateOrder = False
Position = poScreenCenter
OnCreate = FormCreate
OnKeyPress = FormKeyPress
PixelsPerInch = 96
TextHeight = 13
object Label3: TLabel
Left = 257
Top = 199
Width = 40
Height = 16
Caption = #3592#3635#3609#3623#3609
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Label4: TLabel
Left = 345
Top = 199
Width = 18
Height = 16
Caption = #3588#3609
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Label6: TLabel
Left = 27
Top = 70
Width = 64
Height = 16
Caption = #3648#3621#3639#3629#3585#3588#3621#3636#3609#3636#3588
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object Label1: TLabel
Left = 26
Top = 199
Width = 115
Height = 16
Caption = #3648#3621#3639#3629#3585#3648#3604#3639#3629#3609#3607#3637#3656#3605#3657#3629#3591#3585#3634#3619
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object GroupBox2: TGroupBox
Left = 8
Top = 55
Width = 401
Height = 226
TabOrder = 7
end
object GroupBox1: TGroupBox
Left = 20
Top = 104
Width = 373
Height = 78
Caption = #3609#3633#3604#3648#3593#3614#3634#3632#3623#3633#3609
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 6
object chkMon: TCheckBox
Left = 12
Top = 24
Width = 61
Height = 17
Caption = #3623#3633#3609#3592#3633#3609#3607#3619#3660
TabOrder = 0
end
object chkTue: TCheckBox
Left = 87
Top = 24
Width = 61
Height = 17
Caption = #3623#3633#3609#3629#3633#3591#3588#3634#3619
TabOrder = 1
end
object ChkThr: TCheckBox
Left = 258
Top = 24
Width = 77
Height = 17
Caption = #3623#3633#3609#3614#3620#3627#3633#3626#3610#3604#3637
TabOrder = 2
end
object ChkWen: TCheckBox
Left = 171
Top = 24
Width = 61
Height = 17
Caption = #3623#3633#3609#3614#3640#3608
TabOrder = 3
end
object ChkFri: TCheckBox
Left = 12
Top = 47
Width = 61
Height = 17
Caption = #3623#3633#3609#3624#3640#3585#3619#3660
TabOrder = 4
end
object ChkSat: TCheckBox
Left = 87
Top = 47
Width = 61
Height = 17
Caption = #3623#3633#3609#3648#3626#3634#3619#3660
TabOrder = 5
end
object ChkSun: TCheckBox
Left = 171
Top = 47
Width = 73
Height = 17
Caption = #3623#3633#3609#3629#3634#3607#3636#3605#3618#3660
TabOrder = 6
end
end
object Panel1: TPanel
Left = 6
Top = 8
Width = 403
Height = 41
Caption = #3619#3632#3610#3610#3585#3635#3627#3609#3604#3592#3635#3609#3623#3609#3609#3633#3604#3627#3617#3634#3618#3626#3635#3627#3619#3633#3610#3588#3621#3636#3609#3636#3588#3605#3656#3634#3591#3654
Color = clMoneyGreen
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentBackground = False
ParentFont = False
TabOrder = 2
end
object BtnOk: TButton
Left = 132
Top = 242
Width = 75
Height = 25
Caption = #3605#3585#3621#3591
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 0
OnClick = BtnOkClick
end
object BtnCancel: TButton
Left = 213
Top = 242
Width = 75
Height = 25
Caption = #3618#3585#3648#3621#3636#3585
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 1
OnClick = BtnCancelClick
end
object CboClinic: TComboBox
Left = 97
Top = 69
Width = 225
Height = 21
AutoDropDown = True
Style = csDropDownList
ItemHeight = 13
TabOrder = 3
Items.Strings = (
'00-'#3652#3617#3656#3619#3632#3610#3640)
end
object DTPStart: TDateTimePicker
Left = 147
Top = 199
Width = 104
Height = 21
Date = 40212.000000000000000000
Format = 'MMM yyyy'
Time = 40212.000000000000000000
TabOrder = 4
end
object txttotalAppointment: TEdit
Left = 306
Top = 198
Width = 33
Height = 21
TabOrder = 5
Text = '80'
end
object cds: TClientDataSet
Aggregates = <>
CommandText =
#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39 +
#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39#39';kk'
Params = <>
ProviderName = 'DataSetProvider1'
Left = 360
Top = 64
end
object ds: TDataSource
DataSet = cds
Left = 328
Top = 64
end
object ChkShowDBug: TCheckBox
Left = 280
Top = 287
Width = 129
Height = 17
Caption = 'Show Debug Messages'
TabOrder = 9
end
object LimitGrid: TDBGrid
Left = 8
Top = 312
Width = 399
Height = 217
TabOrder = 8
DataSource = ds
TitleFont.Charset = DEFAULT_CHARSET
TitleFont.Color = clWindowText
TitleFont.Height = -11
TitleFont.Name = 'Tahoma'
TitleFont.Style = []
end
object BtnRefresh: TButton
Left = 294
Top = 242
Width = 109
Height = 25
Caption = #3649#3626#3604#3591#3612#3621#3605#3634#3619#3634#3591#3651#3627#3617#3656
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
TabOrder = 10
OnClick = BtnRefreshClick
end
end