syspublictmp.pas

从网友处得到的蓝图财务进销存源程序

 
 
来自：meteor007, 时间：2004-8-23 10:17:04, ID：2774334 
DATEPART
返回代表指定日期的指定日期部分的整数。
var:
 stryourdate:string;
 yourdate:TDateTime;

stryourdate:=FormatDateTime('yyyy/mm/dd',Yourdate);
stryourdate就是你想要的
还可得到年或月,日

语法
DATEPART ( datepart , date ) 
year（datetime）取年
month(datetime)取月
day（datetime）取天


 
 

}

{
SQL语句，纵列转横列 
sTable.db
库位  货物编号 库存数
1     0101     50
1     0102     60
1     0103     50
2     0101     90
2     0103     100
2     0111     30
3     0101     120
3     0102     110
4     0101     11
 
只列出表中库位为1、2、3的数据，格式如下:

货物编号  库位1  库位2  库位3
0101      50     90     120
0102      60            110
0103      50     100
0111             30
请问用一句sql语句怎么实现？

select a.货物编号，sum(b.库存数)，sum(c.库存数)，sum(d.库存数)
from stable  a 
left join (select 货物编号， 库存数 from stable where 库位=1)b on a.货物编号＝b货物编号
left join (select 货物编号， 库存数 from stable where 库位=2)c on a.货物编号＝c。货物编号
left join (select 货物编号， 库存数 from stable where 库位=3)c on a.货物编号＝d。货物编号
group by a.货物编号
//※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※※//

}

{
让edit只输入数字和小数点？
写在onkeypress事件里面
if not (key in ['0'..'9',#8])  then
   begin
      if (key='.') and (pos('.',Tedit(sender).Text)=0) then exit;
      key:=#0;
      Messagebeep(0);
   end;

在KeyPress里控制怎么都不完善！
如果Ctrl+C,Ctrl+V怎么办？
如果右键拷贝、粘贴呢？
所以只有在OnChange事件中才能完善控制：
procedure TForm.EditChange(Sender: TObject);
begin
  try
    StrToFloat((Sender as TEdit).Text);
  except
    (Sender as TEdit).Text:=Copy((Sender as TEdit).Text,1,
      Length((Sender as TEdit).Text)-1);
    (Sender as TEdit).SelStart:=Length((Sender as TEdit).Text);
  end;
end; 


}

{
Format('x=%d', [12]); //'x=12' //最普通
Format('x=%3d', [12]); //'x= 12' //指定宽度
Format('x=%f', [12.0]); //'x=12.00' //浮点数
Format('x=%.3f', [12.0]); //'x=12.000' //指定小数
Format('x=%.*f', [5, 12.0]); //'x=12.00000' //动态配置
Format('x=%.5d', [12]); //'x=00012' //前面补充0
Format('x=%.5x', [12]); //'x=0000C' //十六进制
Format('x=%1:d%0:d', [12, 13]); //'x=1312' //使用索引
Format('x=%p', [nil]); //'x=00000000' //指针
Format('x=%1.1e', [12.0]); //'x=1.2E+001' //科学记数法
Format('x=%%', []); //'x=%' //得到"%"
S := Format('%s%d', [S, I]); //S := S + StrToInt(I); //连接字符串 

}

{

一、Thread类的创建：

unit Thread;
//           线程类的创建
//  编译环境: Windows 2003 Sever  Delphi 7.0 Enterprise

interface
uses classes,sysutils,StdCtrls;
type
  TB = class(TThread)
  private
    i :integer;
    Fedt :TEdit;
    procedure Update ;
  public
    procedure execute;override;
    constructor create(IsSuspended :Boolean;edt :TEdit);
  end;
implementation
uses MainForm;

procedure TB.Update;
begin
  Fedt.Text :=inttostr(i);
end;

constructor TB.create(IsSuspended: Boolean; edt: TEdit);
begin
  inherited create(IsSuspended);
  Fedt := edt;
end;

procedure TB.execute;
begin
  i:=0;
  while(not Terminated) do
  begin
    Synchronize(Update);
    inc(i);
  end;
end;
end.

二、Thread类的使用：

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Thread;

type
  TfrmMain = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ButtonClick(Sender: TObject);
  private
//    { Private declarations }
//  public
//    { Public declarations }
//  end;


{var
  frmMain: TfrmMain;
  a,b:TB;
implementation }

{$R *.dfm}

{procedure TfrmMain.FormCreate(Sender: TObject);
begin
  a:=TB.create(true,edit1);
  b:=TB.create(True,edit2);
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  freeandnil(a);freeandnil(b);
end;

procedure TfrmMain.ButtonClick(Sender: TObject);
var c :TB;
begin
  if sender = Button1 then c :=a
  else c:=b;
  if c.Suspended then begin
    c.Resume ; (sender as TButton).Caption :='暂停';
  end else begin
    c.Suspend ;(Sender as TButton).Caption :='开始';
  end;
end;

end.


}

{
楼住的问题还没有解决吗?
我简单的写了一下,已经能实现你的功能;
unit CustomDBGridEX;

interface

uses
  SysUtils, windows, Classes, Controls, Grids, DBGrids, Graphics;

type
  TCustomDBGridEX = class(TCustomDBGrid)
  private

  protected

    procedure DrawColumnCell(const Rect: TRect; DataCol: Integer;
      Column: TColumn; State: TGridDrawState); override;
  public

    property Canvas;
    property SelectedRows;
  published

    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Columns stored False; //StoreColumns;
    property Constraints;
    property Ctl3D;
    property DataSource;
    property DefaultDrawing;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedColor;
    property Font;
    property ImeMode;
    property ImeName;
    property Options;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property TitleFont;
    property Visible;
    property OnCellClick;
    property OnColEnter;
    property OnColExit;
    property OnColumnMoved;
    property OnDrawDataCell;
    property OnDrawColumnCell;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditButtonClick;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
    property OnTitleClick;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TCustomDBGridEX]);
end;



procedure TCustomDBGridEX.DrawColumnCell(const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  inherited;
  if DataSource.DataSet.RecNo mod 2 = 0 then
    Canvas.Brush.Color := clred
  else
    Canvas.Brush.Color := clAqua;
  DefaultDrawColumnCell(Rect, DataCol, Column, State);
end;

end.

把上面的过程修改为下面会更好点! 呵呵!
procedure TCustomDBGridEX.DrawColumnCell(const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  inherited;
  if DataSource.DataSet.RecNo mod 2 = 0 then
  begin
    Canvas.Brush.Color := clYellow;
    Canvas.Font.Color := clBlack;
    Canvas.TextRect(Rect, Rect.Left, Rect.Top, Column.Field.AsString);
  end
  else
  begin
    Canvas.Brush.Color := clWindow;
    Canvas.Font.Color := clBlack;
    Canvas.TextRect(Rect, Rect.Left, Rect.Top, Column.Field.AsString);
  end;
end;  

}

{

如何判断一个对象是否已经实例化？
我把一个对象Free后，为什么 (对象 = nil) 为 False呢  

function GetM():TMyClass;
var r: TMyClass;
begin
  r := TMyClass.Create;
  Result := r;
end;

}

{
你可以先定义一个基类
//该类为纯虚类，不用实现
TBase=class
  public
    procedure push(num:double);
    function pop:double; virtual; abstract;
    function top:double;  virtual; abstract;
    function count:integer;  virtual; abstract;
  end;

Tfloatstack=class(TBase)
  private
    farr:array of double;
  public
    procedure push(num:double);override;
    function pop:double;override;
    function top:double;override;
    function count:integer;override;
  end;

  Tstringstack=class(TBase)
  private
    farr:array of string;
  public
    procedure push(num:string);override;
    function pop:string;override;
    function top:string;override;
    function count:integer;override;
  end;

}

{
我这有个动态载入dxDBGrid列的函数，也许对你有点作用：
procedure StoreGridColumn(const TableID: Word; DataGrid: TdxDBGrid);
var
  i: Word;
  aType: TdxSummaryType;
  ColQuery: TSQLQuery;
begin
  ColQuery := TSQLQuery.Create(Nil);
  try
    ColQuery.SQLConnection := dmMaster.ConnDB;
    ColQuery.SQL.Text := 'select * from qps_column_note where (table_id = ' + IntToStr(TableID) +
      ') and (col_show = 1) order by col_show_id,auto_id';
    for i := 0 to DataGrid.ColumnCount - 1 do
      DataGrid.Columns[0].Destroy;
    i := 0;
    with ColQuery do begin
      Open;
      while not Eof do begin
        if FieldByName('col_field_type').AsInteger = 0 then
          DataGrid.CreateColumn(TdxDBGridColumn)
        else if FieldByName('col_field_type').AsInteger = 1 then
          DataGrid.CreateColumn(TdxDBGridDateColumn)
        else if FieldByName('col_field_type').AsInteger = 2 then
          DataGrid.CreateColumn(TdxDBGridCheckColumn)
        else if FieldByName('col_field_type').AsInteger = 3 then
          DataGrid.CreateColumn(TdxDBGridCurrencyColumn);
        if FieldByName('col_has_foot').AsInteger > 0 then begin
          aType := cstNone;
          case FieldByName('col_foot_type').AsInteger of
            0: aType := cstAvg;
            1: atype := cstCount;
            2: aType := cstMax;
            3: aType := cstMin;
            4: aType := cstNone;
            5: aType := cstSum;