« หน้าที่แล้ว ต่อไป »
หน้า: [1]   ลงล่าง

ผู้เขียน หัวข้อ: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ  (อ่าน 11826 ครั้ง)

0 สมาชิก และ 1 บุคคลทั่วไป กำลังดูหัวข้อนี้

ออฟไลน์ woravet

  • Sr. Member
  • ****
  • กระทู้: 409
  • Respect: +12
    • ดูรายละเอียด
มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« เมื่อ: พฤศจิกายน 23, 2006, 02:37:45 AM »
0
พอดีจะทำ Export ของ 504 เป็น DBF ครับ
โดยโครงสร้าง DBF เป็น
HOSP C(12)
DATE C(4)
CASE1...CASE21 N(5)
*****
ลองทำส่วนดึงข้อมูลพอทำได้
แต่ทำส่วน Export ไม่เป็นครับ
*****
ตอนนี้ Exoprt โดยใช้ VFP ครับ
บันทึกการเข้า
รพ.บึงสามัคคี จ.กำแพงเพชร
*********************
อ.สุชัยและคณะ ขึ้นระบบ 29 ตค.49(Linux+Fedara 5)
*********************
ปัจจุบัน
HOSxP version 3.53.4.27
Server:Windows XP SP2,MySQL 5
Client ประมาณ 15 เครื่อง

ออฟไลน์ woravet

  • Sr. Member
  • ****
  • กระทู้: 409
  • Respect: +12
    • ดูรายละเอียด
Re: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« ตอบกลับ #1 เมื่อ: พฤศจิกายน 23, 2006, 02:47:33 AM »
0
ตัวอย่างที่ผมลองทำครับ ดึงเฉพาะข้อมูล
unit RP504;

var
  MainForm: TForm;
  OKButton, SaveButton, PrintButton, ExitButton: TButton;
  ds1, ds2: TDateEdit;
  lds1, lds2, lcode, lid, lname,lpath: TLabel;
  tcode, tid, tname,tpath: TEdit;
  FAborting: boolean;
  yymm:string;
  rp:TTzDBF;
  rphosp:TStringField;
  rpdate:TStringField;
  rpcase1:TStringField;
  rpcase2:TStringField;
  rpcase3:TStringField;
  rpcase4:TStringField;
  rpcase5:TStringField;
  rpcase6:TStringField;
  rpcase7:TStringField;
  rpcase8:TStringField;
  rpcase9:TStringField;
  rpcase10:TStringField;
  rpcase11:TStringField;
  rpcase12:TStringField;
  rpcase13:TStringField;
  rpcase14:TStringField;
  rpcase15:TStringField;
  rpcase16:TStringField;
  rpcase17:TStringField;
  rpcase18:TStringField;
  rpcase19:TStringField;
  rpcase20:TStringField;
  rpcase21:TStringField;

implementation

procedure OKClick(Sender: TObject);
var
  sdate,edate:tdatetime;
  tc:Tclientdataset;
begin
  yymm:=formatdatetime('yymm',strtodate(ds2.text));
  sdate:=ds1.text;
  edate:=ds2.text;
  tc:=TClientDataset.create(nil);
  tc.data:=HOSxP_GetDataset('select a.*,ifnull(d.amount,0) as amount from rpt_504_name a left join '+
  ' (select b.id,count(b.id) as amount from rpt_504_code b,ovstdiag c '+
  ' where c.icd10 between b.code1 and b.code2 and c.icd10 is not null '+
  ' and c.vstdate between "'+formatdatetime('yyyy-mm-dd',sdate)+'" and "'+formatdatetime('yyyy-mm-dd',edate)+'"'+
  ' group by b.id) d on d.id=a.id'+
  ' order by a.id');
  while not tc.eof do
  begin
  showmessage(tc.fieldbyname('id').asstring+'=>'+tc.fieldbyname('amount').asstring);
  tc.next;
  end;
end;

procedure ExitClick(Sender: TObject);
begin
  mainform.close
end;

procedure Main;
begin
  MainForm := TForm.Create(nil);
  MainForm.top := 200;
  MainForm.left := 200;
  MainForm.Width := 400;
  MainForm.Height := 400;

  lcode := tlabel.create(mainform);
  lcode.parent := mainform;
  lcode.top := 10;
  lcode.left := 10;
  lcode.caption := 'Code';

  tcode := tedit.create(mainform);
  tcode.parent := mainform;
  tcode.top := 10;
  tcode.left := 70;
  tcode.width := 85;
  tcode.text := '110962100000';

  lid := tlabel.create(mainform);
  lid.parent := mainform;
  lid.top := 35;
  lid.left := 10;
  lid.caption := 'Off_ID';

  tid := tedit.create(mainform);
  tid.parent := mainform;
  tid.top := 35;
  tid.left := 70;
  tid.width := 40;
  tid.text := VarToStr(GetSQLData('select hospitalcode from opdconfig'));

  lname := tlabel.create(mainform);
  lname.parent := mainform;
  lname.top := 60;
  lname.left := 10;
  lname.caption := 'Name';

  tname := tedit.create(mainform);
  tname.parent := mainform;
  tname.top := 60;
  tname.left := 70;
  tname.width := 200;
  tname.text := VarToStr(GetSQLData('select hospitalname from opdconfig'));

  lds1 := tlabel.create(mainform);
  lds1.parent := mainform;
  lds1.top := 85;
  lds1.left := 10;
  lds1.caption := 'Begin Date';

  ds1 := TDateEdit.Create(MainForm);
  ds1.parent := mainForm;
  ds1.left := 70;
  ds1.top := 85;
  ds1.Width := 85;
  ds1.text := now-formatdatetime('dd',now)+1;

  lds2 := tlabel.create(mainform);
  lds2.parent := mainform;
  lds2.top := 85;
  lds2.left := 200;
  lds2.caption := 'End Date';

  ds2 := TDateEdit.Create(MainForm);
  ds2.parent := mainForm;
  ds2.left := 270;
  ds2.top := 85;
  ds2.Width := 85;
  ds2.text := now;

  lpath := tlabel.create(mainform);
  lpath.parent := mainform;
  lpath.top := 110;
  lpath.left := 10;
  lpath.caption := 'Send To';

  tpath := tedit.create(mainform);
  tpath.parent := mainform;
  tpath.top := 110;
  tpath.left := 70;
  tpath.width := 200;
  tpath.text := 'C:\TEMP';

  OKButton := TButton.Create(MainForm);
  OKButton.parent := mainForm;
  OKButton.left := 30;
  OKButton.top := 180;
  OKButton.Width := 60;
  OKButton.caption := 'OK';
  OKButton.OnClick := OKClick;

  ExitButton := TButton.Create(MainForm);
  ExitButton.parent := mainForm;
  ExitButton.left := 140;
  ExitButton.top := 180;
  ExitButton.Width := 60;
  ExitButton.caption := 'Exit';
  ExitButton.OnClick := ExitClick;

  MainForm.Caption := 'ÃÒ§ҹ 504';
  MainForm.Showmodal;
  MainForm.free;
end;

end.
บันทึกการเข้า
รพ.บึงสามัคคี จ.กำแพงเพชร
*********************
อ.สุชัยและคณะ ขึ้นระบบ 29 ตค.49(Linux+Fedara 5)
*********************
ปัจจุบัน
HOSxP version 3.53.4.27
Server:Windows XP SP2,MySQL 5
Client ประมาณ 15 เครื่อง

ออฟไลน์ manoi

  • Hero Member
  • *****
  • กระทู้: 8,669
  • Respect: +170
    • ดูรายละเอียด
    • HOSxP Community Center
Re: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« ตอบกลับ #2 เมื่อ: พฤศจิกายน 25, 2006, 14:15:17 PM »
0
ตัวอย่าง Code สำหรับ Export ClientDataset ไปเป็น DBF ครับ

(ใช้กับ HOSxP 2.49.11.25 ขึ้นไปนะครับ)

pascal source
โค๊ด: Delphi
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  7.   Dialogs, ExtCtrls, StdCtrls, DB, DBClient, Grids, DBGrids, ComCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Panel1: TPanel;
  12.     Panel2: TPanel;
  13.     Panel3: TPanel;
  14.     DBGrid1: TDBGrid;
  15.     cds: TClientDataSet;
  16.     ds: TDataSource;
  17.     Button1: TButton;
  18.     Button2: TButton;
  19.     Button3: TButton;
  20.     Label1: TLabel;
  21.     cxDateEdit1: TcxDateEdit;
  22.     procedure Button1Click(Sender: TObject);
  23.     procedure Button2Click(Sender: TObject);
  24.     procedure Button3Click(Sender: TObject);
  25.   private
  26.     { Private declarations }
  27.   public
  28.     { Public declarations }
  29.   end;
  30.  
  31. var
  32.   Form1: TForm1;
  33.  
  34. implementation
  35.  
  36. {$R *.dfm}
  37.  
  38. function IMin(Val1, Val2: Integer): Integer;
  39. begin
  40.   Result := Val1;
  41.   if Val2 < Val1 then
  42.     Result := Val2;
  43. end;
  44.  
  45. procedure AssignRecordx(Source, Dest: TDataSet; ByName: Boolean);
  46.  
  47. var
  48.   I: Integer;
  49.   F, FSrc: TField;
  50. begin
  51.  
  52.   if ByName then
  53.   begin
  54.     for I := 0 to Source.FieldCount - 1 do
  55.     begin
  56.       F := Dest.FindField(Source.Fields[I].FieldName);
  57.       if F <> nil then
  58.       begin
  59.         try
  60.           F.Value := Source.Fields[I].Value;
  61.         except
  62.         end;
  63.       end;
  64.     end;
  65.   end
  66.   else
  67.   begin
  68.     for I := 0 to iMin(Source.FieldDefs.Count - 1, Dest.FieldDefs.Count - 1) do
  69.     begin
  70.       F := Dest.FindField(Dest.FieldDefs[I].Name);
  71.       FSrc := Source.FindField(Source.FieldDefs[I].Name);
  72.       if (F <> nil) and (FSrc <> nil) then
  73.       begin
  74.         try
  75.           F.Value := FSrc.Value;
  76.         except
  77.         end;
  78.       end;
  79.     end;
  80.   end;
  81. end;
  82.  
  83. procedure TForm1.Button1Click(Sender: TObject);
  84. begin
  85.   cds.data := hosxp_getdataset('select o.hn,o.vstdate,o.vsttime,p.pname,p.fname,p.lname ' +
  86.     ' from ovst o ' +
  87.     ' left outer join patient p on p.hn = o.hn ' +
  88.     ' where o.vstdate = "' + formatdatetime('yyyy-mm-dd', cxdateedit1.date) + '"');
  89. end;
  90.  
  91. procedure TForm1.Button2Click(Sender: TObject);
  92. var dbf1: tdbf;
  93.   i: integer;
  94.   nf: boolean;
  95. begin
  96.   dbf1 := tdbf.create(nil);
  97.   dbf1.close;
  98.   dbf1.tablelevel := 4;
  99.   dbf1.fielddefs.assign(cds.fielddefs);
  100.   repeat
  101.     nf := false;
  102.     for i := 0 to (dbf1.fielddefs.count - 1) do
  103.     begin
  104.       if not nf then
  105.         if (dbf1.fielddefs.items[i].datatype = ftTime) then
  106.         begin
  107.           dbf1.fielddefs.items[i].datatype := ftstring;
  108.           dbf1.fielddefs.items[i].size := 8;
  109.           nf := true;
  110.         end;
  111.     end;
  112.  
  113.   until not nf;
  114.  
  115.   dbf1.tablename := 'c:\dbase.dbf';
  116.   dbf1.createtable;
  117.   dbf1.open;
  118.   cds.first;
  119.   while not cds.eof do
  120.   begin
  121.  
  122.  
  123.     dbf1.append;
  124.     assignrecordx(cds, dbf1, true);
  125.     dbf1.post;
  126.     cds.next;
  127.   end;
  128.   dbf1.close;
  129.   dbf1.free;
  130.  
  131.   showmessage('Done.');
  132.  
  133.  
  134. end;
  135.  
  136. procedure TForm1.Button3Click(Sender: TObject);
  137. begin
  138.   fcds.data := cds.data;
  139.   CreateDatasetReport('HOSxP Report');
  140.  
  141. end;
  142.  
  143. end.
  144.  

dfm source

โค๊ด: Delphi
  1. object Form1: TForm1
  2.   Left = 0
  3.   Top = 0
  4.   Caption = 'HOSxP Script Demo'
  5.   ClientHeight = 511
  6.   ClientWidth = 597
  7.   Color = clBtnFace
  8.   Font.Charset = DEFAULT_CHARSET
  9.   Font.Color = clWindowText
  10.   Font.Height = -11
  11.   Font.Name = 'Tahoma'
  12.   Font.Style = []
  13.   OldCreateOrder = False
  14.   Position = poMainFormCenter
  15.   PixelsPerInch = 96
  16.   TextHeight = 13
  17.   object Panel1: TPanel
  18.     Left = 0
  19.     Top = 0
  20.     Width = 597
  21.     Height = 40
  22.     Align = alTop
  23.     Caption = 'HOSxP Script Form Demo'
  24.     Font.Charset = DEFAULT_CHARSET
  25.     Font.Color = clWindowText
  26.     Font.Height = -13
  27.     Font.Name = 'Tahoma'
  28.     Font.Style = [fsBold]
  29.     ParentFont = False
  30.     TabOrder = 0
  31.   end
  32.   object Panel2: TPanel
  33.     Left = 0
  34.     Top = 470
  35.     Width = 597
  36.     Height = 41
  37.     Align = alBottom
  38.     BevelInner = bvRaised
  39.     BevelOuter = bvLowered
  40.     TabOrder = 1
  41.   end
  42.   object Panel3: TPanel
  43.     Left = 0
  44.     Top = 40
  45.     Width = 597
  46.     Height = 48
  47.     Align = alTop
  48.     BevelInner = bvRaised
  49.     BevelOuter = bvLowered
  50.     TabOrder = 2
  51.     object Label1: TLabel
  52.       Left = 15
  53.       Top = 18
  54.       Width = 59
  55.       Height = 13
  56.       Caption = 'Patient View'
  57.     end
  58.     object Button1: TButton
  59.       Left = 286
  60.       Top = 12
  61.       Width = 75
  62.       Height = 25
  63.       Caption = 'Open'
  64.       TabOrder = 0
  65.       OnClick = Button1Click
  66.     end
  67.     object Button2: TButton
  68.       Left = 372
  69.       Top = 12
  70.       Width = 75
  71.       Height = 25
  72.       Caption = 'DBF Export'
  73.       TabOrder = 1
  74.       OnClick = Button2Click
  75.     end
  76.     object Button3: TButton
  77.       Left = 472
  78.       Top = 12
  79.       Width = 75
  80.       Height = 25
  81.       Caption = 'report'
  82.       TabOrder = 1
  83.       OnClick = Button3Click
  84.     end
  85.     object cxDateEdit1: TcxDateEdit
  86.       Left = 84
  87.       Top = 15
  88.       TabOrder = 2
  89.       Width = 154
  90.     end
  91.   end
  92.   object DBGrid1: TDBGrid
  93.     Left = 0
  94.     Top = 88
  95.     Width = 597
  96.     Height = 382
  97.     Align = alClient
  98.     DataSource = ds
  99.     TabOrder = 3
  100.     TitleFont.Charset = DEFAULT_CHARSET
  101.     TitleFont.Color = clWindowText
  102.     TitleFont.Height = -11
  103.     TitleFont.Name = 'Tahoma'
  104.     TitleFont.Style = []
  105.   end
  106.   object cds: TClientDataSet
  107.     Aggregates = <>
  108.     Params = <>
  109.     Left = 39
  110.     Top = 6
  111.   end
  112.   object ds: TDataSource
  113.     DataSet = cds
  114.     Left = 78
  115.     Top = 6
  116.   end
  117. end
  118.  
บันทึกการเข้า
HOSxP Project Manager / Cheif Developer / BMS MD

ออฟไลน์ armds

  • Hero Member
  • *****
  • กระทู้: 1,084
  • armds
  • Respect: +10
    • ดูรายละเอียด
Re: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« ตอบกลับ #3 เมื่อ: เมษายน 03, 2008, 15:03:35 PM »
0
อ.mamni  ครับ  มีตัวอย่าง Pascal Script ->Export->txt       ส่งออกเป็น text  ไฟล์  บ้างไหมครับ  รบกวนขอโค้ดตัวอย่างด้วยครับ 

และ  มีตัวอย่าง Pascal Script->Export->XML  ด้วยครับ
ผมกำลังทำตัวส่งออกของโปรแกรม  SmartDM  และ SmartTB  ด้วยอะครับ  รบกวน อ. ด้วยครับ
ขอบคุณครับ
« แก้ไขครั้งสุดท้าย: เมษายน 03, 2008, 16:18:31 PM โดย armds »
บันทึกการเข้า
โรงพยาบาลสมเด็จพระยุพราชด่านซ้าย จ.เลย
ขนาด 60 เตียง นวก. คอมพิวเตอร์ ขึ้นระบบ ปี 2548
ขอบคุณ อ.ชัยพร อ.สุชัย อ.เดชา อ.doreamon อ.naj อ.ขวด และอ.ในเว็บ hosxp.net ทุกท่าน

ออฟไลน์ sungoku

  • Full Member
  • ***
  • กระทู้: 199
  • Respect: 0
    • ดูรายละเอียด
Re: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« ตอบกลับ #4 เมื่อ: เมษายน 03, 2008, 21:05:24 PM »
0
เย้ ดีใจจังในที่สุด ก็ มีคนขี่ม้าขาวมาช่วยผม     ขอด้วยครับ ตอนนี้ smartTB กับ SmartDM   ผมเป็น รพท.  แย่เหมือนกัน คีย์ไม่ไหวอะ
« แก้ไขครั้งสุดท้าย: เมษายน 04, 2008, 09:45:00 AM โดย sungoku »
บันทึกการเข้า
Tosapon Sookrak
Computer Center, Chainat Hospital
e-mail:Tosapon_t@hotmail.com

ชุมชน HOSXP มีแต่ความรู้จริงๆ ครับ

doramon

  • บุคคลทั่วไป
Re: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« ตอบกลับ #5 เมื่อ: เมษายน 04, 2008, 00:31:49 AM »
0
 ;D

ขอผมดูก่อนครับ
บันทึกการเข้า

ออฟไลน์ armds

  • Hero Member
  • *****
  • กระทู้: 1,084
  • armds
  • Respect: +10
    • ดูรายละเอียด
Re: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« ตอบกลับ #6 เมื่อ: เมษายน 04, 2008, 08:11:53 AM »
0
อ้างจาก: doraemon(saiyok) ที่ เมษายน 04, 2008, 00:31:49 AM
;D

ขอผมดูก่อนครับ


ขอบคุณครับ อ.อ๊อด  ...  เดี่ยวเสร็จแล้วจะแจ้งให้ท่าน  sungoku  อีกครั้งนะครับ
บันทึกการเข้า
โรงพยาบาลสมเด็จพระยุพราชด่านซ้าย จ.เลย
ขนาด 60 เตียง นวก. คอมพิวเตอร์ ขึ้นระบบ ปี 2548
ขอบคุณ อ.ชัยพร อ.สุชัย อ.เดชา อ.doreamon อ.naj อ.ขวด และอ.ในเว็บ hosxp.net ทุกท่าน

doramon

  • บุคคลทั่วไป
Re: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« ตอบกลับ #7 เมื่อ: เมษายน 04, 2008, 09:28:44 AM »
0
มันรับข้อมูลภายนอกได้ด้วยหรือเปล่าครับ

กำลังทำตัวส่งออกของโปรแกรม  SmartDM  และ SmartTB
บันทึกการเข้า

ออฟไลน์ armds

  • Hero Member
  • *****
  • กระทู้: 1,084
  • armds
  • Respect: +10
    • ดูรายละเอียด
Re: มีตัวอย่าง Pascal Script ->Export->DBF บ้างมัยครับ
« ตอบกลับ #8 เมื่อ: เมษายน 04, 2008, 09:42:37 AM »
0
รับข้อมูลจากภายนอกได้ครับ  เช่น  รับจาก 18 แฟ้ม ชื่อ  person  หรือจะรับจากฐานข้อมูล DBPOP  ก็ได้ครับ  รบกวน  อ.อ๊อด  ด้วยนะครับ
บันทึกการเข้า
โรงพยาบาลสมเด็จพระยุพราชด่านซ้าย จ.เลย
ขนาด 60 เตียง นวก. คอมพิวเตอร์ ขึ้นระบบ ปี 2548
ขอบคุณ อ.ชัยพร อ.สุชัย อ.เดชา อ.doreamon อ.naj อ.ขวด และอ.ในเว็บ hosxp.net ทุกท่าน
หน้า: [1]   ขึ้นบน
« หน้าที่แล้ว ต่อไป »